module Network.Wai.RequestSpec.Internal.Env (
Env(..),
EnvMap,
ParamMap,
QueryParams,
FormParams,
defaultEnv,
mkHeaders,
mkQParams,
mkFParams,
toEnv
) where
import Data.ByteString (ByteString)
import Data.CaseInsensitive (CI, original, mk)
import Data.Text (Text, splitOn)
import Data.Text.Encoding (decodeUtf8)
import Network.HTTP.Types
import Network.Wai (Request, requestHeaders, queryString)
import qualified Data.Map as M
data QueryParams
data FormParams
type EnvMap k v = M.Map k v
type Headers = EnvMap (CI Text) Text
type ParamMap a = EnvMap Text (Maybe Text)
type QParams = ParamMap QueryParams
type FParams = ParamMap FormParams
data Env = Env { headers :: Headers
, qParams :: QParams
, fParams :: FParams
} deriving Show
bt :: ByteString -> Text
bt = decodeUtf8
mkQParams :: Query -> QParams
mkQParams = M.fromList . fmap (\(a,b) -> (bt a, fmap bt b))
mkFParams :: ByteString -> FParams
mkFParams b =
M.fromList . filter (\(_,x) -> x /= Nothing) . fmap repack . splitOn "&" . decodeUtf8 $ b
where repack t = case splitOn "=" t of
["", ""] -> ("", Nothing)
["", _] -> ("", Nothing)
[x, ""] -> (x, Nothing)
[x, y] -> (x, Just y)
_ -> ("", Nothing)
mkHeaders :: RequestHeaders -> Headers
mkHeaders = M.fromList . fmap (\(a,b) -> (mk . bt . original $ a, bt b))
defaultEnv :: Env
defaultEnv = Env M.empty M.empty M.empty
toEnv :: Request -> ByteString -> Env
toEnv r body = Env headers' qParams' (fParams' body)
where headers' = (mkHeaders . requestHeaders) r
qParams' = (mkQParams . queryString) r
fParams' :: ByteString -> FParams
fParams' b =
case (b, M.lookup "content-type" headers') of
("", _) -> M.empty
(_, Nothing) -> M.empty
(_, Just "application/x-www-form-urlencoded") -> mkFParams b
(_, Just _) -> M.empty