module Yesod.Internal.Request
( parseWaiRequest
, Request (..)
, RequestBodyContents
, FileInfo (..)
, randomString
, parseWaiRequest'
) where
import Control.Applicative ((<$>))
import Control.Arrow (second)
import qualified Network.Wai.Parse as NWP
import Yesod.Internal
import qualified Network.Wai as W
import System.Random (RandomGen, newStdGen, randomRs)
import Web.Cookie (parseCookiesText)
import qualified Data.ByteString.Char8 as S8
import Data.Text (Text, pack)
import Network.HTTP.Types (queryToQueryText)
import Control.Monad (join)
import Data.Maybe (fromMaybe, catMaybes)
import qualified Data.ByteString.Lazy as L
data Request = Request
{ reqGetParams :: [(Text, Text)]
, reqCookies :: [(Text, Text)]
, reqWaiRequest :: W.Request
, reqLangs :: [Text]
, reqNonce :: Maybe Text
}
parseWaiRequest :: W.Request
-> [(Text, Text)]
-> Maybe a
-> IO Request
parseWaiRequest env session' key' = parseWaiRequest' env session' key' <$> newStdGen
parseWaiRequest' :: RandomGen g
=> W.Request
-> [(Text, Text)]
-> Maybe a
-> g
-> Request
parseWaiRequest' env session' key' gen = Request gets'' cookies' env langs' nonce
where
gets' = queryToQueryText $ W.queryString env
gets'' = map (second $ fromMaybe "") gets'
reqCookie = lookup "Cookie" $ W.requestHeaders env
cookies' = maybe [] parseCookiesText reqCookie
acceptLang = lookup "Accept-Language" $ W.requestHeaders env
langs = map (pack . S8.unpack) $ maybe [] NWP.parseHttpAccept acceptLang
langs' = catMaybes [ join $ lookup langKey gets'
, lookup langKey cookies'
, lookup langKey session'
] ++ langs
nonce = case (key', lookup nonceKey session') of
(Nothing, _) -> Nothing
(_, Just x) -> Just x
_ -> Just $ pack $ randomString 10 gen
randomString :: RandomGen g => Int -> g -> String
randomString len = take len . map toChar . randomRs (0, 61)
where
toChar i
| i < 26 = toEnum $ i + fromEnum 'A'
| i < 52 = toEnum $ i + fromEnum 'a' 26
| otherwise = toEnum $ i + fromEnum '0' 52
type RequestBodyContents =
( [(Text, Text)]
, [(Text, FileInfo)]
)
data FileInfo = FileInfo
{ fileName :: Text
, fileContentType :: Text
, fileContent :: L.ByteString
}
deriving (Eq, Show)