1 {-# LANGUAGE OverloadedStrings #-}
    2 module Databrary.HTTP.Request
    3   ( Wai.Request
    4   , MonadHasRequest
    5   , lookupRequestHeader
    6   , lookupRequestHeaders
    7   , lookupQueryParameters
    8   , boolParameterValue
    9   , boolQueryParameter
   10   , requestHost
   11   , requestURI
   12   ) where
   13 
   14 import qualified Data.ByteString as BS
   15 import qualified Data.ByteString.Char8 as BSC
   16 import Data.Maybe (fromMaybe)
   17 import Data.Monoid ((<>))
   18 import Network.HTTP.Types (HeaderName)
   19 import Network.URI (URI(..), URIAuth(..))
   20 import qualified Network.Wai as Wai
   21 
   22 import Databrary.Has (MonadHas)
   23 
   24 type MonadHasRequest c m = MonadHas Wai.Request c m
   25 
   26 lookupRequestHeader :: HeaderName -> Wai.Request -> Maybe BS.ByteString
   27 lookupRequestHeader h = lookup h . Wai.requestHeaders
   28 
   29 lookupRequestHeaders :: HeaderName -> Wai.Request -> [BS.ByteString]
   30 lookupRequestHeaders h = map snd . filter ((h ==) . fst) . Wai.requestHeaders
   31 
   32 lookupQueryParameters :: BS.ByteString -> Wai.Request -> [Maybe BS.ByteString]
   33 lookupQueryParameters q = map snd . filter ((q ==) . fst) . Wai.queryString
   34 
   35 boolValue :: BS.ByteString -> Bool
   36 boolValue "0" = False
   37 boolValue "false" = False
   38 boolValue "off" = False
   39 boolValue "" = False
   40 boolValue _ = True
   41 
   42 boolParameterValue :: Maybe BS.ByteString -> Bool
   43 boolParameterValue = all boolValue
   44 
   45 boolQueryParameter :: BS.ByteString -> Wai.Request -> Bool
   46 boolQueryParameter q = any boolParameterValue . lookupQueryParameters q
   47 
   48 defaultHost :: BS.ByteString
   49 defaultHost = "databrary.org"
   50 
   51 requestHost :: Wai.Request -> BS.ByteString
   52 requestHost req =
   53   (if Wai.isSecure req then "https://" else "http://")
   54   <> fromMaybe "databrary.org" (Wai.requestHeaderHost req)
   55 
   56 requestURI :: Wai.Request -> URI
   57 requestURI req = URI
   58   { uriScheme = if Wai.isSecure req then "https:" else "http:"
   59   , uriAuthority = Just URIAuth
   60     { uriUserInfo = ""
   61     , uriRegName = BSC.unpack $ fromMaybe defaultHost $ Wai.requestHeaderHost req
   62     , uriPort = ""
   63     }
   64   , uriPath = BSC.unpack $ Wai.rawPathInfo req
   65   , uriQuery = BSC.unpack $ Wai.rawQueryString req
   66   , uriFragment = ""
   67   }