    -----------------------------------------------------------------------------
    -- |
    -- 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 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
    $cshowsPrec :: Int -> CGIRequest -> ShowS
    showsPrec :: Int -> CGIRequest -> ShowS
    $cshow :: CGIRequest -> String
    show :: CGIRequest -> String
    $cshowList :: [CGIRequest] -> ShowS
    showList :: [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
    $cshowsPrec :: Int -> Input -> ShowS
    showsPrec :: Int -> Input -> ShowS
    $cshow :: Input -> String
    show :: Input -> String
    $cshowList :: [Input] -> ShowS
    showList :: [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
    $cshowsPrec :: Int -> CGIResult -> ShowS
    showsPrec :: Int -> CGIResult -> ShowS
    $cshow :: CGIResult -> String
    show :: CGIResult -> String
    $cshowList :: [CGIResult] -> ShowS
    showList :: [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
    $creadsPrec :: Int -> ReadS CGIResult
    readsPrec :: Int -> ReadS CGIResult
    $creadList :: ReadS [CGIResult]
    readList :: ReadS [CGIResult]
    $creadPrec :: ReadPrec CGIResult
    readPrec :: ReadPrec CGIResult
    $creadListPrec :: ReadPrec [CGIResult]
    readListPrec :: ReadPrec [CGIResult]
    Read, CGIResult -> CGIResult -> Bool
    (CGIResult -> CGIResult -> Bool)
    -> (CGIResult -> CGIResult -> Bool) -> Eq CGIResult
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CGIResult -> CGIResult -> Bool
    == :: CGIResult -> CGIResult -> Bool
    $c/= :: CGIResult -> CGIResult -> Bool
    /= :: 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
    $ccompare :: CGIResult -> CGIResult -> Ordering
    compare :: CGIResult -> CGIResult -> Ordering
    $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
    >= :: CGIResult -> CGIResult -> Bool
    $cmax :: CGIResult -> CGIResult -> CGIResult
    max :: CGIResult -> CGIResult -> CGIResult
    $cmin :: CGIResult -> CGIResult -> CGIResult
    min :: CGIResult -> CGIResult -> CGIResult
    Ord)

    --
    -- * 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 a. IO a -> m a
    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
           inp <- IO ByteString -> m ByteString
    forall a. IO a -> m a
    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
           outp <- runCGIEnvFPS env inp f
           liftIO $ BS.hPut hout outp
           liftIO $ hFlush 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
             (hs,outp) <- CGIRequest -> m (Headers, CGIResult)
    f (CGIRequest -> m (Headers, CGIResult))
    -> CGIRequest -> m (Headers, CGIResult)
    forall a b. (a -> b) -> a -> b
    $ 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
                                         }
             return $ case 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 { 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 a. IO a -> m a
    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 a. IO a -> m a
    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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
    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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
    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 { 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 a b. (a -> b) -> Maybe a -> Maybe b
    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