{-# LANGUAGE OverloadedStrings #-} module Hack2.Contrib.RequestExtra where import Prelude () import Data.Maybe import Air.Env import Air.Extra import Data.ByteString.Char8 (ByteString) import Hack2 hiding (body) import Hack2.Contrib.Request import Hack2.Contrib.Utils import qualified Data.ByteString.Char8 as B import Network.CGI.Protocol (decodeInput, inputValue, inputFilename) media_type :: Env -> ByteString media_type env = case env.content_type.B.unpack.split "\\s*[;,]\\s*" of [] -> "" x:_ -> x.lower.B.pack media_type_params :: Env -> [(ByteString, ByteString)] media_type_params env | env.content_type.B.unpack.empty = [] | otherwise = env .content_type .B.unpack .split "\\s*[;,]\\s" .drop 1 .map (split "=") .select (length > is 2) .map (tuple2 > fromMaybe def) .map_fst (lower > B.pack) .map_snd (B.pack) content_charset :: Env -> ByteString content_charset env = env.media_type_params.lookup "charset" .fromMaybe "" inputs :: Env -> IO [(ByteString, ByteString)] inputs env = do _body <- env.input_bytestring return - env .httpHeaders .map_fst (B.unpack > upper > map (\x -> if x == '-' then '_' else x)) -- cgi env use all cap letters .map_snd B.unpack .(("REQUEST_METHOD", env.request_method.show) : ) -- for cgi request .flip decodeInput (_body.s2l) .fst .concatMap to_headers where to_headers (k, input) = case input.inputFilename of Nothing -> [(k.B.pack, input.inputValue.l2s)] Just name -> [ (k.B.pack, input.inputValue.l2s) , ("hack2_input_file_name_" + k.B.pack, name.B.pack) ]