{-|
Module      : Network.Wai.RequestSpec.Internal.Env
Description : Request environment handling
Copyright   : Allele Dev 2015
License     : BSD-3
Maintainer  : allele.dev@gmail.com
Stability   : experimental
Portability : POSIX
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
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)

-- | 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 = Env.fromList . fmap ((mk . bt . original) *** bt)

defaultEnv :: Env
defaultEnv = Env Env.empty Env.empty Env.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 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"