{-|
Module      : Network.Wai.RequestSpec.Internal.Env
Description : Request environment handling
Copyright   : Alej Cabrera 2015
License     : BSD-3
Maintainer  : cpp.cabrera@gmail.com
Stability   : experimental
Portability : POSIX
-}
{-# LANGUAGE OverloadedStrings #-}
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