content: {-# language OverloadedStrings #-}
  {-# language FlexibleContexts #-}
  {-# language ConstraintKinds #-}
  {-# language RankNTypes #-}
  {-# language ViewPatterns #-}
  module Web.Firefly.Request
    ( getPath
    , getPathInfo
    , getMethod
    , getQueryString
    , getQueries
    , getQueriesMulti
    , getQuery
    , getQueryMulti
    , getHeader
    , getHeaderMulti
    , getHeaders
    , getBody
    , getCookies
    , getCookieMulti
    , getCookie
    , isSecure
    , waiRequest
    , pathMatches
    ) where
  
  import Control.Monad.Reader
  import Data.Maybe
  import Data.Bifunctor
  import qualified Data.Text as T
  import qualified Data.Map as M
  import qualified Data.CaseInsensitive as CI
  import Text.Regex.PCRE
  
  import Web.Cookie
  import qualified Network.Wai as W
  
  import Web.Firefly.Internal.Utils
  import Web.Firefly.Types
  
  type ReqReader m = MonadReader ReqContext m
  
  fromReq :: ReqReader m => (W.Request -> a) -> m a
  fromReq getter = asks (getter . request)
  
  -- | Calls through to 'W.rawPathInfo'; returns the full path of the current
  -- request (without the query string)
  getPath :: ReqReader m => m T.Text
  getPath = fromBS <$> fromReq W.rawPathInfo
  
  -- | Gets the HTTP method of the current request
  getMethod :: ReqReader m => m T.Text
  getMethod = fromBS <$> fromReq W.requestMethod
  
  -- | Calls through to 'W.rawQueryString'; returns the full path of the current
  -- request (without the query string)
  getQueryString :: ReqReader m => m T.Text
  getQueryString = fromBS <$> fromReq W.rawQueryString
  
  -- | Gets full body of the request
  getBody  :: ReqReader m => m T.Text
  getBody = asks requestBody
  
  -- | Gets the headers of the request
  getHeader :: ReqReader m => T.Text -> m (Maybe T.Text)
  getHeader key = listToMaybe <$> getHeaderMulti key
  
  -- | Gets the headers of the request
  getHeaderMulti :: ReqReader m => T.Text -> m [T.Text]
  getHeaderMulti key = fromMaybe [] . M.lookup (CI.mk key) <$> getHeaders
  
  -- | Gets the headers of the request
  getHeaders :: ReqReader m => m HeaderMap
  getHeaders = convertHeaders <$> fromReq W.requestHeaders
  
  -- | Gets all key/values from the query string
  getQueriesMulti :: ReqReader m => m MultiQueryMap
  getQueriesMulti = convertQueries <$> fromReq W.queryString
  
  -- | Get the last set value for each query
  --
  -- If a query is set without a value (e.g. "/?key") it will appear in the
  -- map with a value of @""@
  getQueries :: ReqReader m => m QueryMap
  getQueries = simpleQuery <$>fromReq W.queryString
  
  -- | Get the value for a given query. A query which was passed without a value
  -- (e.g. "/?key") will return @Just ""@
  getQuery :: ReqReader m => T.Text -> m (Maybe T.Text)
  getQuery key = M.lookup key <$> getQueries
  
  -- | Gets all values provided for a given query key
  getQueryMulti :: ReqReader m => T.Text -> m [T.Text]
  getQueryMulti key = fromMaybe [] . M.lookup key <$> getQueriesMulti
  
  -- | Gets a map of cookies sent with the request.
  getCookies :: ReqReader m => m (M.Map T.Text [T.Text])
  getCookies = do
    headers <- getHeaders
    return $ case M.lookup (CI.mk "Cookie") headers of
               Just [cookieHeader] -> M.fromListWith mappend . fmap (second (:[])) . parseCookiesText . toBS $ cookieHeader
               _ -> M.empty
  
  -- | Get all values set for a specific cookie
  getCookieMulti :: ReqReader m => T.Text -> m [T.Text]
  getCookieMulti key = fromMaybe [] . M.lookup key <$> getCookies
  
  -- | Get the value for a cookie if it is set
  getCookie :: ReqReader m => T.Text -> m (Maybe T.Text)
  getCookie key = listToMaybe <$> getCookieMulti key
  
  -- | Calls through to 'W.isSecure'
  isSecure :: ReqReader m => m Bool
  isSecure = fromReq W.isSecure
  
  -- | Calls through to 'W.pathInfo'.
  -- Returns the path's individual '/' separated chunks. '
  getPathInfo :: ReqReader m => m [T.Text]
  getPathInfo = fromReq W.pathInfo
  
  -- | Exposes the underlying 'W.Request'.
  waiRequest :: ReqReader m =>  m W.Request
  waiRequest = asks request
  
  -- | Determine whether a route matches a pattern
  pathMatches :: ReqReader m => Pattern -> m Bool
  pathMatches pattern = checkMatch pattern <$> getPath 
    where
      checkMatch :: Pattern -> Route -> Bool
      checkMatch (T.unpack -> pat) (T.unpack -> rt) =  rt =~ ("^" ++ pat ++ "$")
  