{-|
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,
  toEnvWithForm,
  toEnvRaw,
) where

import Control.Applicative
import Control.Arrow
import Control.Monad
import Data.ByteString (ByteString)
import Data.CaseInsensitive (CI, 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 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


mkQParams :: Query -> QParams
mkQParams = M.fromList . fmap (bt *** fmap bt)

-- | Given a ByteString, constructs association list
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)
        -- on failed decodings, return Nothing
        decode' = either (const Nothing) Just . decodeUtf8'
        -- keep only form parameters that have values
        parse_ = filter (\(_,x) -> isJust x) . fmap repack . splitOn "&"


mkHeaders :: RequestHeaders -> Headers
mkHeaders = M.fromList . fmap ((mk . bt . original) *** bt)

defaultEnv :: Env
defaultEnv = Env M.empty M.empty M.empty

-- | Expects form data via request body ByteString
-- This is appropriate if you're programming with raw Network.Wai
-- NOTE: if you're expecting form data, and the form data is in an invalid format
-- this will happily construct an Env with empty form data
toEnvRaw :: Request -> ByteString -> Env
toEnvRaw r body = toEnv_ r (mkFParams body)

-- | Construct an Env from a Request and an association list of form parameters
-- If a framework exposes parameters in this fashion (Spock, Scotty),
-- use this over `toEnvRaw`. It's likely the framework consumes the
-- request body when data is sent along using content-type
-- 'application/x-www-form-urlencoded'
toEnvWithForm :: Request -> [(Text,Text)] -> Env
toEnvWithForm r params = toEnv_ r (f params)
  where f = Just . fmap (second Just)

-- | Construct an Env without parsing any form parameters
-- This is ideal if you're not consuming any form data.
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 M.empty fromFormList params
        fromFormList ps = case content_type headers' of
                            Nothing -> M.empty
                            Just ["application/x-www-form-urlencoded"] -> M.fromList ps
                            Just ["application/x-www-form-urlencoded", _] -> M.fromList ps
                            Just _ -> M.empty
        content_type = fmap (splitOn ";") . M.lookup "content-type"