module WebGear.Types
(
Request
, remoteHost
, httpVersion
, isSecure
, requestMethod
, pathInfo
, setPathInfo
, queryString
, requestHeaders
, requestHeader
, requestBodyLength
, getRequestBodyChunk
, Response (..)
, waiResponse
, addResponseHeader
, Handler
, Middleware
, RequestMiddleware
, ResponseMiddleware
) where
import Control.Arrow (Kleisli)
import Data.ByteString (ByteString)
import Data.List (find)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Network.HTTP.Types (Header, HeaderName, Status)
import Network.Wai (Request, getRequestBodyChunk, httpVersion, isSecure, pathInfo, queryString,
remoteHost, requestBodyLength, requestHeaders, requestMethod)
import WebGear.Trait (Linked)
import qualified Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as HM
import qualified Network.Wai as Wai
requestHeader :: HeaderName -> Request -> Maybe ByteString
h :: HeaderName
h r :: Request
r = (HeaderName, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((HeaderName, ByteString) -> ByteString)
-> Maybe (HeaderName, ByteString) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((HeaderName, ByteString) -> Bool)
-> [(HeaderName, ByteString)] -> Maybe (HeaderName, ByteString)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
h) (HeaderName -> Bool)
-> ((HeaderName, ByteString) -> HeaderName)
-> (HeaderName, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeaderName, ByteString) -> HeaderName
forall a b. (a, b) -> a
fst) (Request -> [(HeaderName, ByteString)]
requestHeaders Request
r)
setPathInfo :: [Text] -> Request -> Request
setPathInfo :: [Text] -> Request -> Request
setPathInfo p :: [Text]
p r :: Request
r = Request
r { pathInfo :: [Text]
pathInfo = [Text]
p }
data Response a = Response
{ Response a -> Status
respStatus :: Status
, :: HM.HashMap HeaderName ByteString
, Response a -> Maybe a
respBody :: Maybe a
}
waiResponse :: Response LBS.ByteString -> Wai.Response
waiResponse :: Response ByteString -> Response
waiResponse Response{..} = Status -> [(HeaderName, ByteString)] -> ByteString -> Response
Wai.responseLBS Status
respStatus (HashMap HeaderName ByteString -> [(HeaderName, ByteString)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap HeaderName ByteString
respHeaders) (ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe "" Maybe ByteString
respBody)
addResponseHeader :: Header -> Response a -> Response a
(name :: HeaderName
name, val :: ByteString
val) resp :: Response a
resp = Response a
resp { respHeaders :: HashMap HeaderName ByteString
respHeaders = (ByteString -> ByteString -> ByteString)
-> HeaderName
-> ByteString
-> HashMap HeaderName ByteString
-> HashMap HeaderName ByteString
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith ByteString -> ByteString -> ByteString
forall b c. b -> c -> c
f HeaderName
name ByteString
val (Response a -> HashMap HeaderName ByteString
forall a. Response a -> HashMap HeaderName ByteString
respHeaders Response a
resp) }
where
f :: b -> c -> c
f = (c -> b -> c) -> b -> c -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip c -> b -> c
forall a b. a -> b -> a
const
type Handler m req res a = Kleisli m (Linked req Request) (Linked res (Response a))
type Middleware m req req' res' res a' a = Handler m req' res' a' -> Handler m req res a
type RequestMiddleware m req req' res a = Middleware m req req' res res a a
type ResponseMiddleware m req res' res a = Middleware m req req res' res a a