module Network.Wai.RequestSpec.Internal.Env (
Env(..),
EnvMap,
ParamMap,
QueryParams,
FormParams,
defaultEnv,
mkHeaders,
mkQParams,
mkFParams,
toEnv,
toEnvWithForm,
toEnvRaw,
) where
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Control.Arrow
import Control.Monad
import Data.ByteString (ByteString)
import Data.CaseInsensitive (original, mk)
import Data.Maybe
import Data.Text (Text, splitOn)
import Data.Text.Encoding (decodeUtf8, decodeUtf8')
import Network.HTTP.Types
import Network.Wai (Request, requestHeaders, queryString)
import Network.Wai.RequestSpec.Internal.Env.Types hiding (
fromList, empty, lookup
)
import qualified Network.Wai.RequestSpec.Internal.Env.Types as Env
mkQParams :: Query -> QParams
mkQParams = Env.fromList . fmap (bt *** fmap bt)
mkFParams :: ByteString -> Maybe [(Text, Maybe Text)]
mkFParams b =
mplus (parse_ <$> decode' b) Nothing
where repack t = case splitOn "=" t of
["", ""] -> ("", Nothing)
["", _] -> ("", Nothing)
[x, ""] -> (x, Nothing)
[x, y] -> (x, Just y)
_ -> ("", Nothing)
decode' = either (const Nothing) Just . decodeUtf8'
parse_ = filter (\(_,x) -> isJust x) . fmap repack . splitOn "&"
mkHeaders :: RequestHeaders -> Headers
mkHeaders = Env.fromList . fmap ((mk . bt . original) *** bt)
defaultEnv :: Env
defaultEnv = Env Env.empty Env.empty Env.empty
toEnvRaw :: Request -> ByteString -> Env
toEnvRaw r body = toEnv_ r (mkFParams body)
toEnvWithForm :: Request -> [(Text,Text)] -> Env
toEnvWithForm r params = toEnv_ r (f params)
where f = Just . fmap (second Just)
toEnv :: Request -> Env
toEnv r = toEnv_ r Nothing
bt :: ByteString -> Text
bt = decodeUtf8
toEnv_ :: Request -> Maybe [(Text, Maybe Text)] -> Env
toEnv_ r params = Env headers' qParams' fParams'
where headers' = (mkHeaders . requestHeaders) r
qParams' = (mkQParams . queryString) r
fParams' = maybe Env.empty fromFormList params
fromFormList ps = case content_type headers' of
Nothing -> Env.empty
Just ["application/x-www-form-urlencoded"] -> Env.fromList ps
Just ["application/x-www-form-urlencoded", _] -> Env.fromList ps
Just _ -> Env.empty
content_type = fmap (splitOn ";") . Env.lookup "content-type"