module HTTP.Request
( Wai.Request
, MonadHasRequest
, lookupRequestHeader
, lookupRequestHeaders
, lookupQueryParameters
, boolParameterValue
, boolQueryParameter
, requestHost
, requestURI
) where
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import Network.HTTP.Types (HeaderName)
import Network.URI (URI(..), URIAuth(..))
import qualified Network.Wai as Wai
import Has (MonadHas)
type MonadHasRequest c m = MonadHas Wai.Request c m
lookupRequestHeader :: HeaderName -> Wai.Request -> Maybe BS.ByteString
lookupRequestHeader h = lookup h . Wai.requestHeaders
lookupRequestHeaders :: HeaderName -> Wai.Request -> [BS.ByteString]
lookupRequestHeaders h = map snd . filter ((h ==) . fst) . Wai.requestHeaders
lookupQueryParameters :: BS.ByteString -> Wai.Request -> [Maybe BS.ByteString]
lookupQueryParameters q = map snd . filter ((q ==) . fst) . Wai.queryString
boolValue :: BS.ByteString -> Bool
boolValue "0" = False
boolValue "false" = False
boolValue "off" = False
boolValue "" = False
boolValue _ = True
boolParameterValue :: Maybe BS.ByteString -> Bool
boolParameterValue = all boolValue
boolQueryParameter :: BS.ByteString -> Wai.Request -> Bool
boolQueryParameter q = any boolParameterValue . lookupQueryParameters q
defaultHost :: BS.ByteString
defaultHost = "databrary.org"
requestHost :: Wai.Request -> BS.ByteString
requestHost req =
(if Wai.isSecure req then "https://" else "http://")
<> fromMaybe "databrary.org" (Wai.requestHeaderHost req)
requestURI :: Wai.Request -> URI
requestURI req = URI
{ uriScheme = if Wai.isSecure req then "https:" else "http:"
, uriAuthority = Just URIAuth
{ uriUserInfo = ""
, uriRegName = BSC.unpack $ fromMaybe defaultHost $ Wai.requestHeaderHost req
, uriPort = ""
}
, uriPath = BSC.unpack $ Wai.rawPathInfo req
, uriQuery = BSC.unpack $ Wai.rawQueryString req
, uriFragment = ""
}