-----------------------------------------------------------------------------
-- |
-- Module      :  Network.CGI.Protocol
-- Copyright   :  (c) Bjorn Bringert 2006
-- License     :  BSD-style
--
-- Maintainer  :  John Chee <cheecheeo@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- An implementation of the program side of the CGI protocol.
--
-----------------------------------------------------------------------------

module Network.CGI.Protocol (
  -- * CGI request
  CGIRequest(..), Input(..),
  -- * CGI response
  CGIResult(..),
  Headers, HeaderName(..),
  -- * Running CGI actions
  hRunCGI, runCGIEnvFPS,
  -- * Inputs
  decodeInput, takeInput,
  -- * Environment variables
  getCGIVars,
  -- * Logging
  logCGI,
  -- * URL encoding
  formEncode, urlEncode, formDecode, urlDecode,
  -- * Utilities
  maybeRead, replace
 ) where

import Control.Monad.Trans (MonadIO(..))
import Data.Char (chr, isHexDigit, digitToInt)
import Data.List (intercalate)
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Maybe (fromMaybe, listToMaybe, isJust)
import Network.URI (escapeURIString,isUnescapedInURI)
import System.Environment (getEnvironment)
import System.IO (Handle, hPutStrLn, stderr, hFlush, hSetBinaryMode)

import qualified Data.ByteString.Lazy.Char8 as BS
import Data.ByteString.Lazy.Char8 (ByteString)

import Data.Typeable
import Network.Multipart



--
-- * CGI request
--

-- | The input to a CGI action.
data CGIRequest =
    CGIRequest {
                -- | Environment variables.
                CGIRequest -> Map String String
cgiVars :: Map String String,
                -- | Input parameters. For better laziness in reading inputs,
                --   this is not a Map.
                CGIRequest -> [(String, Input)]
cgiInputs :: [(String, Input)],
                -- | Raw request body. To avoid memory leaks,
                -- this is the empty string if the request body has been
                -- interpreted as inputs in
                -- "application\/x-www-form-urlencoded" or
                -- "multipart\/form-data" format.
                CGIRequest -> ByteString
cgiRequestBody :: ByteString
               }
    deriving (Int -> CGIRequest -> ShowS
[CGIRequest] -> ShowS
CGIRequest -> String
(Int -> CGIRequest -> ShowS)
-> (CGIRequest -> String)
-> ([CGIRequest] -> ShowS)
-> Show CGIRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CGIRequest] -> ShowS
$cshowList :: [CGIRequest] -> ShowS
show :: CGIRequest -> String
$cshow :: CGIRequest -> String
showsPrec :: Int -> CGIRequest -> ShowS
$cshowsPrec :: Int -> CGIRequest -> ShowS
Show)

-- | The value of an input parameter, and some metadata.
data Input = Input {
                    Input -> ByteString
inputValue :: ByteString,
                    Input -> Maybe String
inputFilename :: Maybe String,
                    Input -> ContentType
inputContentType :: ContentType
                   }
              deriving Int -> Input -> ShowS
[Input] -> ShowS
Input -> String
(Int -> Input -> ShowS)
-> (Input -> String) -> ([Input] -> ShowS) -> Show Input
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Input] -> ShowS
$cshowList :: [Input] -> ShowS
show :: Input -> String
$cshow :: Input -> String
showsPrec :: Int -> Input -> ShowS
$cshowsPrec :: Int -> Input -> ShowS
Show

--
-- * CGI response
--

-- | The result of a CGI program.
data CGIResult = CGIOutput ByteString
               | CGINothing
                 deriving (Int -> CGIResult -> ShowS
[CGIResult] -> ShowS
CGIResult -> String
(Int -> CGIResult -> ShowS)
-> (CGIResult -> String)
-> ([CGIResult] -> ShowS)
-> Show CGIResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CGIResult] -> ShowS
$cshowList :: [CGIResult] -> ShowS
show :: CGIResult -> String
$cshow :: CGIResult -> String
showsPrec :: Int -> CGIResult -> ShowS
$cshowsPrec :: Int -> CGIResult -> ShowS
Show, ReadPrec [CGIResult]
ReadPrec CGIResult
Int -> ReadS CGIResult
ReadS [CGIResult]
(Int -> ReadS CGIResult)
-> ReadS [CGIResult]
-> ReadPrec CGIResult
-> ReadPrec [CGIResult]
-> Read CGIResult
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CGIResult]
$creadListPrec :: ReadPrec [CGIResult]
readPrec :: ReadPrec CGIResult
$creadPrec :: ReadPrec CGIResult
readList :: ReadS [CGIResult]
$creadList :: ReadS [CGIResult]
readsPrec :: Int -> ReadS CGIResult
$creadsPrec :: Int -> ReadS CGIResult
Read, CGIResult -> CGIResult -> Bool
(CGIResult -> CGIResult -> Bool)
-> (CGIResult -> CGIResult -> Bool) -> Eq CGIResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CGIResult -> CGIResult -> Bool
$c/= :: CGIResult -> CGIResult -> Bool
== :: CGIResult -> CGIResult -> Bool
$c== :: CGIResult -> CGIResult -> Bool
Eq, Eq CGIResult
Eq CGIResult
-> (CGIResult -> CGIResult -> Ordering)
-> (CGIResult -> CGIResult -> Bool)
-> (CGIResult -> CGIResult -> Bool)
-> (CGIResult -> CGIResult -> Bool)
-> (CGIResult -> CGIResult -> Bool)
-> (CGIResult -> CGIResult -> CGIResult)
-> (CGIResult -> CGIResult -> CGIResult)
-> Ord CGIResult
CGIResult -> CGIResult -> Bool
CGIResult -> CGIResult -> Ordering
CGIResult -> CGIResult -> CGIResult
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CGIResult -> CGIResult -> CGIResult
$cmin :: CGIResult -> CGIResult -> CGIResult
max :: CGIResult -> CGIResult -> CGIResult
$cmax :: CGIResult -> CGIResult -> CGIResult
>= :: CGIResult -> CGIResult -> Bool
$c>= :: CGIResult -> CGIResult -> Bool
> :: CGIResult -> CGIResult -> Bool
$c> :: CGIResult -> CGIResult -> Bool
<= :: CGIResult -> CGIResult -> Bool
$c<= :: CGIResult -> CGIResult -> Bool
< :: CGIResult -> CGIResult -> Bool
$c< :: CGIResult -> CGIResult -> Bool
compare :: CGIResult -> CGIResult -> Ordering
$ccompare :: CGIResult -> CGIResult -> Ordering
Ord, Typeable)

--
-- * Running CGI actions
--

-- | Runs a CGI action in a given environment. Uses Handles for input and output.
hRunCGI :: MonadIO m =>
           [(String,String)] -- ^ CGI environment variables, e.g. from 'getCGIVars'.
        -> Handle -- ^ Handle that input will be read from, e.g. 'System.IO.stdin'.
        -> Handle -- ^ Handle that output will be written to, e.g. 'System.IO.stdout'.
        -> (CGIRequest -> m (Headers, CGIResult)) -- ^ CGI action
        -> m ()
hRunCGI :: forall (m :: * -> *).
MonadIO m =>
[(String, String)]
-> Handle
-> Handle
-> (CGIRequest -> m (Headers, CGIResult))
-> m ()
hRunCGI [(String, String)]
env Handle
hin Handle
hout CGIRequest -> m (Headers, CGIResult)
f =
    do IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> Bool -> IO ()
hSetBinaryMode Handle
hin Bool
True
       ByteString
inp <- IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Handle -> IO ByteString
BS.hGetContents Handle
hin
       ByteString
outp <- [(String, String)]
-> ByteString
-> (CGIRequest -> m (Headers, CGIResult))
-> m ByteString
forall (m :: * -> *).
Monad m =>
[(String, String)]
-> ByteString
-> (CGIRequest -> m (Headers, CGIResult))
-> m ByteString
runCGIEnvFPS [(String, String)]
env ByteString
inp CGIRequest -> m (Headers, CGIResult)
f
       IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
BS.hPut Handle
hout ByteString
outp
       IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hFlush Handle
hout

-- | Runs a CGI action in a given environment. Uses lazy ByteStrings
--   for input and output.
runCGIEnvFPS :: Monad m =>
             [(String,String)] -- ^ CGI environment variables.
          -> ByteString -- ^ Request body.
          -> (CGIRequest -> m (Headers, CGIResult)) -- ^ CGI action.
          -> m ByteString -- ^ Response (headers and content).
runCGIEnvFPS :: forall (m :: * -> *).
Monad m =>
[(String, String)]
-> ByteString
-> (CGIRequest -> m (Headers, CGIResult))
-> m ByteString
runCGIEnvFPS [(String, String)]
vars ByteString
inp CGIRequest -> m (Headers, CGIResult)
f
    = do let ([(String, Input)]
inputs,ByteString
body) = [(String, String)] -> ByteString -> ([(String, Input)], ByteString)
decodeInput [(String, String)]
vars ByteString
inp
         (Headers
hs,CGIResult
outp) <- CGIRequest -> m (Headers, CGIResult)
f (CGIRequest -> m (Headers, CGIResult))
-> CGIRequest -> m (Headers, CGIResult)
forall a b. (a -> b) -> a -> b
$ CGIRequest :: Map String String -> [(String, Input)] -> ByteString -> CGIRequest
CGIRequest {
                                      cgiVars :: Map String String
cgiVars = [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String, String)]
vars,
                                      cgiInputs :: [(String, Input)]
cgiInputs = [(String, Input)]
inputs,
                                      cgiRequestBody :: ByteString
cgiRequestBody = ByteString
body
                                     }
         ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ case CGIResult
outp of
           CGIOutput ByteString
c -> ByteString -> Headers -> ByteString
formatResponse ByteString
c Headers
hs'
               where hs' :: Headers
hs' = if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (HeaderName -> Headers -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
ct Headers
hs)
                              then Headers
hs else Headers
hs Headers -> Headers -> Headers
forall a. [a] -> [a] -> [a]
++ [(HeaderName
ct,String
defaultContentType)]
                     ct :: HeaderName
ct = String -> HeaderName
HeaderName String
"Content-type"
           CGIResult
CGINothing -> ByteString -> Headers -> ByteString
formatResponse ByteString
BS.empty Headers
hs

formatResponse :: ByteString -> Headers -> ByteString
formatResponse :: ByteString -> Headers -> ByteString
formatResponse ByteString
c Headers
hs =
    -- NOTE: we use CRLF since lighttpd mod_fastcgi can't handle
    -- just LF if there are CRs in the content.
    [ByteString] -> ByteString
unlinesCrLf ([String -> ByteString
BS.pack (String
nString -> ShowS
forall a. [a] -> [a] -> [a]
++String
": "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
v) | (HeaderName String
n,String
v) <- Headers
hs]
                [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString
BS.empty,ByteString
c])
  where unlinesCrLf :: [ByteString] -> ByteString
unlinesCrLf = ByteString -> [ByteString] -> ByteString
BS.intercalate (String -> ByteString
BS.pack String
"\r\n")

defaultContentType :: String
defaultContentType :: String
defaultContentType = String
"text/html; charset=ISO-8859-1"


--
-- * Inputs
--


-- | Gets and decodes the input according to the request
--   method and the content-type.
decodeInput :: [(String,String)] -- ^ CGI environment variables.
            -> ByteString        -- ^ Request body.
            -> ([(String,Input)],ByteString)
               -- ^ A list of input variables and values, and the request body
               -- if it was not interpreted.
decodeInput :: [(String, String)] -> ByteString -> ([(String, Input)], ByteString)
decodeInput [(String, String)]
env ByteString
inp =
  let ([(String, Input)]
inputs, ByteString
body) = [(String, String)] -> ByteString -> ([(String, Input)], ByteString)
bodyInput [(String, String)]
env ByteString
inp in ([(String, String)] -> [(String, Input)]
queryInput [(String, String)]
env [(String, Input)] -> [(String, Input)] -> [(String, Input)]
forall a. [a] -> [a] -> [a]
++ [(String, Input)]
inputs, ByteString
body)

-- | Builds an 'Input' object for a simple value.
simpleInput :: String -> Input
simpleInput :: String -> Input
simpleInput String
v = Input :: ByteString -> Maybe String -> ContentType -> Input
Input { inputValue :: ByteString
inputValue = String -> ByteString
BS.pack String
v,
                        inputFilename :: Maybe String
inputFilename = Maybe String
forall a. Maybe a
Nothing,
                        inputContentType :: ContentType
inputContentType = ContentType
defaultInputType }

-- | The default content-type for variables.
defaultInputType :: ContentType
defaultInputType :: ContentType
defaultInputType = String -> String -> [(String, String)] -> ContentType
ContentType String
"text" String
"plain" [(String
"charset",String
"windows-1252")]

--
-- * Environment variables
--

-- | Gets the values of all CGI variables from the program environment.
getCGIVars :: MonadIO m => m [(String,String)]
getCGIVars :: forall (m :: * -> *). MonadIO m => m [(String, String)]
getCGIVars = IO [(String, String)] -> m [(String, String)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(String, String)]
getEnvironment

--
-- * Logging
--

-- | Logs some message using the server\'s logging facility.
-- FIXME: does this have to be more general to support
-- FastCGI etc? Maybe we should store log messages in the
-- CGIState?
logCGI :: MonadIO m => String -> m ()
logCGI :: forall (m :: * -> *). MonadIO m => String -> m ()
logCGI String
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> String -> IO ()
hPutStrLn Handle
stderr String
s)

--
-- * Query string
--

-- | Gets inputs from the query string.
queryInput :: [(String,String)] -- ^ CGI environment variables.
           -> [(String,Input)] -- ^ Input variables and values.
queryInput :: [(String, String)] -> [(String, Input)]
queryInput [(String, String)]
env = String -> [(String, Input)]
formInput (String -> [(String, Input)]) -> String -> [(String, Input)]
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> String
lookupOrNil String
"QUERY_STRING" [(String, String)]
env

-- | Decodes application\/x-www-form-urlencoded inputs.
formInput :: String
          -> [(String,Input)] -- ^ Input variables and values.
formInput :: String -> [(String, Input)]
formInput String
qs = [(String
n, String -> Input
simpleInput String
v) | (String
n,String
v) <- String -> [(String, String)]
formDecode String
qs]

--
-- * URL encoding
--

-- | Formats name-value pairs as application\/x-www-form-urlencoded.
formEncode :: [(String,String)] -> String
formEncode :: [(String, String)] -> String
formEncode [(String, String)]
xs =
    String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"&" [ShowS
urlEncode String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
urlEncode String
v | (String
n,String
v) <- [(String, String)]
xs]

-- | Converts a single value to the application\/x-www-form-urlencoded encoding.
urlEncode :: String -> String
urlEncode :: ShowS
urlEncode = Char -> Char -> ShowS
forall a. Eq a => a -> a -> [a] -> [a]
replace Char
' ' Char
'+' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
escapeURIString Char -> Bool
okChar
  where okChar :: Char -> Bool
okChar Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
||
                   (Char -> Bool
isUnescapedInURI Char
c Bool -> Bool -> Bool
&& Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
"&=+")

-- | Gets the name-value pairs from application\/x-www-form-urlencoded data.
formDecode :: String -> [(String,String)]
formDecode :: String -> [(String, String)]
formDecode String
"" = []
formDecode String
s = (ShowS
urlDecode String
n, ShowS
urlDecode (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
v)) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: String -> [(String, String)]
formDecode (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
rs)
    where (String
nv,String
rs) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'&') String
s
          (String
n,String
v) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'=') String
nv

-- | Converts a single value from the
--   application\/x-www-form-urlencoded encoding.
urlDecode :: String -> String
urlDecode :: ShowS
urlDecode = ShowS
unEscapeString ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char -> ShowS
forall a. Eq a => a -> a -> [a] -> [a]
replace Char
'+' Char
' '

-- | Unescape a percent-encoded string, but doesn't decode UTF-8 encoding.
--
-- >>> unEscapeString "Hell%C3%B3 w%C3%B3rld"
-- "Hell\195\179 w\195\179rld"
unEscapeString :: String -> String
unEscapeString :: ShowS
unEscapeString [] = String
""
unEscapeString (Char
'%':Char
x1:Char
x2:String
s) | Char -> Bool
isHexDigit Char
x1 Bool -> Bool -> Bool
&& Char -> Bool
isHexDigit Char
x2 =
    Int -> Char
chr (Char -> Int
digitToInt Char
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
x2) Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
unEscapeString String
s
unEscapeString (Char
c:String
s) = Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
unEscapeString String
s

--
-- * Request content and form-data stuff
--

-- | Gets input variables from the body, if any.
bodyInput :: [(String,String)]
          -> ByteString
          -> ([(String,Input)], ByteString)
bodyInput :: [(String, String)] -> ByteString -> ([(String, Input)], ByteString)
bodyInput [(String, String)]
env ByteString
inp =
   case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"REQUEST_METHOD" [(String, String)]
env of
      Just String
"POST" ->
          let ctype :: Maybe ContentType
ctype = String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"CONTENT_TYPE" [(String, String)]
env Maybe String -> (String -> Maybe ContentType) -> Maybe ContentType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe ContentType
forall (m :: * -> *). MonadFail m => String -> m ContentType
parseContentType
           in Maybe ContentType -> ByteString -> ([(String, Input)], ByteString)
decodeBody Maybe ContentType
ctype (ByteString -> ([(String, Input)], ByteString))
-> ByteString -> ([(String, Input)], ByteString)
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> ByteString -> ByteString
takeInput [(String, String)]
env ByteString
inp
      Maybe String
_ -> ([], ByteString
inp)

-- | Decodes a POST body.
decodeBody :: Maybe ContentType
           -> ByteString
           -> ([(String,Input)], ByteString)
decodeBody :: Maybe ContentType -> ByteString -> ([(String, Input)], ByteString)
decodeBody Maybe ContentType
ctype ByteString
inp =
    case Maybe ContentType
ctype of
               Just (ContentType String
"application" String
"x-www-form-urlencoded" [(String, String)]
_)
                   -> (String -> [(String, Input)]
formInput (ByteString -> String
BS.unpack ByteString
inp), ByteString
BS.empty)
               Just (ContentType String
"multipart" String
"form-data" [(String, String)]
ps)
                   -> ([(String, String)] -> ByteString -> [(String, Input)]
multipartDecode [(String, String)]
ps ByteString
inp, ByteString
BS.empty)
               Just ContentType
_ -> ([], ByteString
inp) -- unknown content-type, the user will have to
                            -- deal with it by looking at the raw content
               -- No content-type given, assume x-www-form-urlencoded
               Maybe ContentType
Nothing -> (String -> [(String, Input)]
formInput (ByteString -> String
BS.unpack ByteString
inp), ByteString
BS.empty)

-- | Takes the right number of bytes from the input.
takeInput :: [(String,String)]  -- ^ CGI environment variables.
          -> ByteString         -- ^ Request body.
          -> ByteString         -- ^ CONTENT_LENGTH bytes from the request
                                --   body, or the empty string if there is no
                                --   CONTENT_LENGTH.
takeInput :: [(String, String)] -> ByteString -> ByteString
takeInput [(String, String)]
env ByteString
req =
    case Maybe Int64
len of
           Just Int64
l  -> Int64 -> ByteString -> ByteString
BS.take Int64
l ByteString
req
           Maybe Int64
Nothing -> ByteString
BS.empty
     where len :: Maybe Int64
len = String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"CONTENT_LENGTH" [(String, String)]
env Maybe String -> (String -> Maybe Int64) -> Maybe Int64
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Int64
forall a. Read a => String -> Maybe a
maybeRead

-- | Decodes multipart\/form-data input.
multipartDecode :: [(String,String)] -- ^ Content-type parameters
                -> ByteString        -- ^ Request body
                -> [(String,Input)]  -- ^ Input variables and values.
multipartDecode :: [(String, String)] -> ByteString -> [(String, Input)]
multipartDecode [(String, String)]
ps ByteString
inp =
    case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"boundary" [(String, String)]
ps of
         Just String
b -> let MultiPart [BodyPart]
bs = String -> ByteString -> MultiPart
parseMultipartBody String
b ByteString
inp
                    in (BodyPart -> (String, Input)) -> [BodyPart] -> [(String, Input)]
forall a b. (a -> b) -> [a] -> [b]
map BodyPart -> (String, Input)
bodyPartToInput [BodyPart]
bs
         Maybe String
Nothing -> [] -- FIXME: report that there was no boundary

bodyPartToInput :: BodyPart -> (String,Input)
bodyPartToInput :: BodyPart -> (String, Input)
bodyPartToInput (BodyPart Headers
hs ByteString
b) =
    case Headers -> Maybe ContentDisposition
forall (m :: * -> *).
MonadFail m =>
Headers -> m ContentDisposition
getContentDisposition Headers
hs of
              Just (ContentDisposition String
"form-data" [(String, String)]
ps) ->
                  (String -> [(String, String)] -> String
lookupOrNil String
"name" [(String, String)]
ps,
                   Input :: ByteString -> Maybe String -> ContentType -> Input
Input { inputValue :: ByteString
inputValue = ByteString
b,
                           inputFilename :: Maybe String
inputFilename = String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"filename" [(String, String)]
ps,
                           inputContentType :: ContentType
inputContentType = ContentType
ctype })
              Maybe ContentDisposition
_ -> (String
"ERROR",String -> Input
simpleInput String
"ERROR") -- FIXME: report error
    where ctype :: ContentType
ctype = ContentType -> Maybe ContentType -> ContentType
forall a. a -> Maybe a -> a
fromMaybe ContentType
defaultInputType (Headers -> Maybe ContentType
forall (m :: * -> *). MonadFail m => Headers -> m ContentType
getContentType Headers
hs)


--
-- * Utilities
--

-- | Replaces all instances of a value in a list by another value.
replace :: Eq a =>
           a   -- ^ Value to look for
        -> a   -- ^ Value to replace it with
        -> [a] -- ^ Input list
        -> [a] -- ^ Output list
replace :: forall a. Eq a => a -> a -> [a] -> [a]
replace a
x a
y = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\a
z -> if a
z a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x then a
y else a
z)

maybeRead :: Read a => String -> Maybe a
maybeRead :: forall a. Read a => String -> Maybe a
maybeRead = ((a, String) -> a) -> Maybe (a, String) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, String) -> a
forall a b. (a, b) -> a
fst (Maybe (a, String) -> Maybe a)
-> (String -> Maybe (a, String)) -> String -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, String)] -> Maybe (a, String)
forall a. [a] -> Maybe a
listToMaybe ([(a, String)] -> Maybe (a, String))
-> (String -> [(a, String)]) -> String -> Maybe (a, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(a, String)]
forall a. Read a => ReadS a
reads

-- | Same as 'lookup' specialized to strings, but
--   returns the empty string if lookup fails.
lookupOrNil :: String -> [(String,String)] -> String
lookupOrNil :: String -> [(String, String)] -> String
lookupOrNil String
n = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> ([(String, String)] -> Maybe String)
-> [(String, String)]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
n