{-# LANGUAGE CPP                        #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImpredicativeTypes         #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}

module Airship.Types
    ( ETag(..)
    , Webmachine
    , AirshipRequest(..)
    , Request(..)
    , RequestReader(..)
    , Response(..)
    , ResponseState(..)
    , ResponseBody(..)
    , ErrorResponses
    , addTrace
    , defaultRequest
    , entireRequestBody
    , etagToByteString
    , eitherResponse
    , escapedResponse
    , mapWebmachine
    , runWebmachine
    , request
    , requestTime
    , routePath
    , getResponseHeaders
    , getResponseBody
    , params
    , dispatchPath
    , putResponseBody
    , putResponseBS
    , halt
    , finishWith
    ) where

import           Airship.RST
import           Blaze.ByteString.Builder            (Builder)
import           Blaze.ByteString.Builder.ByteString (fromByteString)
import           Blaze.ByteString.Builder.Html.Utf8  (fromHtmlEscapedText)
import qualified Data.ByteString                     as BS
import qualified Data.ByteString.Lazy                as LB
#if __GLASGOW_HASKELL__ < 710
import           Control.Applicative
#endif
import           Control.Monad                       (liftM)
import           Control.Monad.Base                  (MonadBase)
import           Control.Monad.IO.Class              (MonadIO, liftIO)
import           Control.Monad.Morph
import           Control.Monad.Reader.Class          (MonadReader, ask)
import           Control.Monad.State.Class
import           Control.Monad.Trans.Control         (MonadBaseControl (..))
import           Data.ByteString.Char8               hiding (reverse)
import           Data.HashMap.Strict                 (HashMap)
import           Data.Map.Strict                     (Map)
import           Data.Monoid                         ((<>))
import           Data.Text                           (Text)
import           Data.Time.Clock                     (UTCTime)
import           Network.HTTP.Media
import qualified Network.HTTP.Types                  as HTTP

import           Network.HTTP.Types                  (ResponseHeaders, Status)

import           Network.Wai                         (Request (..),
                                                      defaultRequest)
import qualified Network.Wai                         as Wai

-- | Reads the entirety of the request body in a single string.
-- This turns the chunks obtained from repeated invocations of 'requestBody' into a lazy 'ByteString'.
entireRequestBody :: MonadIO m => Request -> m LB.ByteString
entireRequestBody :: Request -> m ByteString
entireRequestBody Request
req = IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Request -> IO ByteString
requestBody Request
req) m ByteString -> (ByteString -> m ByteString) -> m ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> ByteString -> m ByteString
strictRequestBody' ByteString
LB.empty
    where strictRequestBody' :: ByteString -> ByteString -> m ByteString
strictRequestBody' ByteString
acc ByteString
prev
            | ByteString -> Bool
BS.null ByteString
prev = ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
acc
            | Bool
otherwise = IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Request -> IO ByteString
requestBody Request
req) m ByteString -> (ByteString -> m ByteString) -> m ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> ByteString -> m ByteString
strictRequestBody' (ByteString
acc ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
LB.fromStrict ByteString
prev)

data RequestReader = RequestReader
      { RequestReader -> UTCTime
_now            :: UTCTime
      , RequestReader -> AirshipRequest
_airshipRequest :: AirshipRequest
      }

data AirshipRequest = AirshipRequest
    { AirshipRequest -> Request
_request   :: Request
    , AirshipRequest -> Text
_routePath :: Text
    }

data ETag = Strong ByteString
          | Weak ByteString
          deriving (ETag -> ETag -> Bool
(ETag -> ETag -> Bool) -> (ETag -> ETag -> Bool) -> Eq ETag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ETag -> ETag -> Bool
$c/= :: ETag -> ETag -> Bool
== :: ETag -> ETag -> Bool
$c== :: ETag -> ETag -> Bool
Eq, Eq ETag
Eq ETag
-> (ETag -> ETag -> Ordering)
-> (ETag -> ETag -> Bool)
-> (ETag -> ETag -> Bool)
-> (ETag -> ETag -> Bool)
-> (ETag -> ETag -> Bool)
-> (ETag -> ETag -> ETag)
-> (ETag -> ETag -> ETag)
-> Ord ETag
ETag -> ETag -> Bool
ETag -> ETag -> Ordering
ETag -> ETag -> ETag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ETag -> ETag -> ETag
$cmin :: ETag -> ETag -> ETag
max :: ETag -> ETag -> ETag
$cmax :: ETag -> ETag -> ETag
>= :: ETag -> ETag -> Bool
$c>= :: ETag -> ETag -> Bool
> :: ETag -> ETag -> Bool
$c> :: ETag -> ETag -> Bool
<= :: ETag -> ETag -> Bool
$c<= :: ETag -> ETag -> Bool
< :: ETag -> ETag -> Bool
$c< :: ETag -> ETag -> Bool
compare :: ETag -> ETag -> Ordering
$ccompare :: ETag -> ETag -> Ordering
$cp1Ord :: Eq ETag
Ord)

instance Show ETag where show :: ETag -> String
show = ByteString -> String
unpack (ByteString -> String) -> (ETag -> ByteString) -> ETag -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ETag -> ByteString
etagToByteString

etagToByteString :: ETag -> ByteString
etagToByteString :: ETag -> ByteString
etagToByteString (Strong ByteString
bs) = ByteString
"\"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
etagToByteString (Weak ByteString
bs) = ByteString
"W/\"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\""

-- | Basically Wai's unexported 'Response' type.
data ResponseBody
    = ResponseFile FilePath (Maybe Wai.FilePart)
    | ResponseBuilder Builder
    | ResponseStream Wai.StreamingBody
    | Empty
    -- ResponseRaw ... (not implemented yet, but useful for websocket upgrades)

-- | Helper function for building a `ResponseBuilder` out of HTML-escaped text.
escapedResponse :: Text -> ResponseBody
escapedResponse :: Text -> ResponseBody
escapedResponse = Builder -> ResponseBody
ResponseBuilder (Builder -> ResponseBody)
-> (Text -> Builder) -> Text -> ResponseBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
fromHtmlEscapedText

data Response = Response { Response -> Status
_responseStatus  :: Status
                         , Response -> ResponseHeaders
_responseHeaders :: ResponseHeaders
                         , Response -> ResponseBody
_responseBody    :: ResponseBody
                         }

data ResponseState = ResponseState { ResponseState -> ResponseHeaders
stateHeaders  :: ResponseHeaders
                                   , ResponseState -> ResponseBody
stateBody     :: ResponseBody
                                   , ResponseState -> HashMap Text Text
_params       :: HashMap Text Text
                                   , ResponseState -> [Text]
_dispatchPath :: [Text]
                                   , ResponseState -> Trace
decisionTrace :: Trace
                                   }

type Trace = [ByteString]

type ErrorResponses m = Monad m => Map HTTP.Status [(MediaType, Webmachine m ResponseBody)]

newtype Webmachine m a =
    Webmachine { Webmachine m a -> RST RequestReader ResponseState Response m a
getWebmachine :: (RST RequestReader ResponseState Response m) a }
        deriving (a -> Webmachine m b -> Webmachine m a
(a -> b) -> Webmachine m a -> Webmachine m b
(forall a b. (a -> b) -> Webmachine m a -> Webmachine m b)
-> (forall a b. a -> Webmachine m b -> Webmachine m a)
-> Functor (Webmachine m)
forall a b. a -> Webmachine m b -> Webmachine m a
forall a b. (a -> b) -> Webmachine m a -> Webmachine m b
forall (m :: * -> *) a b.
Functor m =>
a -> Webmachine m b -> Webmachine m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Webmachine m a -> Webmachine m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Webmachine m b -> Webmachine m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> Webmachine m b -> Webmachine m a
fmap :: (a -> b) -> Webmachine m a -> Webmachine m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Webmachine m a -> Webmachine m b
Functor, Functor (Webmachine m)
a -> Webmachine m a
Functor (Webmachine m)
-> (forall a. a -> Webmachine m a)
-> (forall a b.
    Webmachine m (a -> b) -> Webmachine m a -> Webmachine m b)
-> (forall a b c.
    (a -> b -> c)
    -> Webmachine m a -> Webmachine m b -> Webmachine m c)
-> (forall a b. Webmachine m a -> Webmachine m b -> Webmachine m b)
-> (forall a b. Webmachine m a -> Webmachine m b -> Webmachine m a)
-> Applicative (Webmachine m)
Webmachine m a -> Webmachine m b -> Webmachine m b
Webmachine m a -> Webmachine m b -> Webmachine m a
Webmachine m (a -> b) -> Webmachine m a -> Webmachine m b
(a -> b -> c) -> Webmachine m a -> Webmachine m b -> Webmachine m c
forall a. a -> Webmachine m a
forall a b. Webmachine m a -> Webmachine m b -> Webmachine m a
forall a b. Webmachine m a -> Webmachine m b -> Webmachine m b
forall a b.
Webmachine m (a -> b) -> Webmachine m a -> Webmachine m b
forall a b c.
(a -> b -> c) -> Webmachine m a -> Webmachine m b -> Webmachine m c
forall (m :: * -> *). Monad m => Functor (Webmachine m)
forall (m :: * -> *) a. Monad m => a -> Webmachine m a
forall (m :: * -> *) a b.
Monad m =>
Webmachine m a -> Webmachine m b -> Webmachine m a
forall (m :: * -> *) a b.
Monad m =>
Webmachine m a -> Webmachine m b -> Webmachine m b
forall (m :: * -> *) a b.
Monad m =>
Webmachine m (a -> b) -> Webmachine m a -> Webmachine m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Webmachine m a -> Webmachine m b -> Webmachine m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Webmachine m a -> Webmachine m b -> Webmachine m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
Webmachine m a -> Webmachine m b -> Webmachine m a
*> :: Webmachine m a -> Webmachine m b -> Webmachine m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
Webmachine m a -> Webmachine m b -> Webmachine m b
liftA2 :: (a -> b -> c) -> Webmachine m a -> Webmachine m b -> Webmachine m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Webmachine m a -> Webmachine m b -> Webmachine m c
<*> :: Webmachine m (a -> b) -> Webmachine m a -> Webmachine m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
Webmachine m (a -> b) -> Webmachine m a -> Webmachine m b
pure :: a -> Webmachine m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> Webmachine m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (Webmachine m)
Applicative, Applicative (Webmachine m)
a -> Webmachine m a
Applicative (Webmachine m)
-> (forall a b.
    Webmachine m a -> (a -> Webmachine m b) -> Webmachine m b)
-> (forall a b. Webmachine m a -> Webmachine m b -> Webmachine m b)
-> (forall a. a -> Webmachine m a)
-> Monad (Webmachine m)
Webmachine m a -> (a -> Webmachine m b) -> Webmachine m b
Webmachine m a -> Webmachine m b -> Webmachine m b
forall a. a -> Webmachine m a
forall a b. Webmachine m a -> Webmachine m b -> Webmachine m b
forall a b.
Webmachine m a -> (a -> Webmachine m b) -> Webmachine m b
forall (m :: * -> *). Monad m => Applicative (Webmachine m)
forall (m :: * -> *) a. Monad m => a -> Webmachine m a
forall (m :: * -> *) a b.
Monad m =>
Webmachine m a -> Webmachine m b -> Webmachine m b
forall (m :: * -> *) a b.
Monad m =>
Webmachine m a -> (a -> Webmachine m b) -> Webmachine m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Webmachine m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> Webmachine m a
>> :: Webmachine m a -> Webmachine m b -> Webmachine m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
Webmachine m a -> Webmachine m b -> Webmachine m b
>>= :: Webmachine m a -> (a -> Webmachine m b) -> Webmachine m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
Webmachine m a -> (a -> Webmachine m b) -> Webmachine m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (Webmachine m)
Monad, Monad (Webmachine m)
Monad (Webmachine m)
-> (forall a. IO a -> Webmachine m a) -> MonadIO (Webmachine m)
IO a -> Webmachine m a
forall a. IO a -> Webmachine m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (Webmachine m)
forall (m :: * -> *) a. MonadIO m => IO a -> Webmachine m a
liftIO :: IO a -> Webmachine m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> Webmachine m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (Webmachine m)
MonadIO, MonadBase b,
                  MonadReader RequestReader,
                  MonadState ResponseState)

instance MonadTrans Webmachine where
    lift :: m a -> Webmachine m a
lift = RST RequestReader ResponseState Response m a -> Webmachine m a
forall (m :: * -> *) a.
RST RequestReader ResponseState Response m a -> Webmachine m a
Webmachine (RST RequestReader ResponseState Response m a -> Webmachine m a)
-> (m a -> RST RequestReader ResponseState Response m a)
-> m a
-> Webmachine m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RequestReader
 -> ResponseState -> m (Either Response a, ResponseState))
-> RST RequestReader ResponseState Response m a
forall r s e (m :: * -> *) a.
(r -> s -> m (Either e a, s)) -> RST r s e m a
RST ((RequestReader
  -> ResponseState -> m (Either Response a, ResponseState))
 -> RST RequestReader ResponseState Response m a)
-> (m a
    -> RequestReader
    -> ResponseState
    -> m (Either Response a, ResponseState))
-> m a
-> RST RequestReader ResponseState Response m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a
-> RequestReader
-> ResponseState
-> m (Either Response a, ResponseState)
forall (m :: * -> *) b p b a.
Monad m =>
m b -> p -> b -> m (Either a b, b)
helper where
      helper :: m b -> p -> b -> m (Either a b, b)
helper m b
m p
_ b
s = do
          b
a <- m b
m
          (Either a b, b) -> m (Either a b, b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Either a b, b) -> m (Either a b, b))
-> (Either a b, b) -> m (Either a b, b)
forall a b. (a -> b) -> a -> b
$ (b -> Either a b
forall a b. b -> Either a b
Right b
a, b
s)

newtype StMWebmachine m a = StMWebmachine {
      StMWebmachine m a
-> StM (RST RequestReader ResponseState Response m) a
unStMWebmachine :: StM (RST RequestReader ResponseState Response m) a
    }

instance MonadBaseControl b m => MonadBaseControl b (Webmachine m) where
  type StM (Webmachine m) a = StMWebmachine m a
  liftBaseWith :: (RunInBase (Webmachine m) b -> b a) -> Webmachine m a
liftBaseWith RunInBase (Webmachine m) b -> b a
f = RST RequestReader ResponseState Response m a -> Webmachine m a
forall (m :: * -> *) a.
RST RequestReader ResponseState Response m a -> Webmachine m a
Webmachine
                     (RST RequestReader ResponseState Response m a -> Webmachine m a)
-> RST RequestReader ResponseState Response m a -> Webmachine m a
forall a b. (a -> b) -> a -> b
$ (RunInBase (RST RequestReader ResponseState Response m) b -> b a)
-> RST RequestReader ResponseState Response m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith
                     ((RunInBase (RST RequestReader ResponseState Response m) b -> b a)
 -> RST RequestReader ResponseState Response m a)
-> (RunInBase (RST RequestReader ResponseState Response m) b
    -> b a)
-> RST RequestReader ResponseState Response m a
forall a b. (a -> b) -> a -> b
$ \RunInBase (RST RequestReader ResponseState Response m) b
g' -> RunInBase (Webmachine m) b -> b a
f
                     (RunInBase (Webmachine m) b -> b a)
-> RunInBase (Webmachine m) b -> b a
forall a b. (a -> b) -> a -> b
$ \Webmachine m a
m -> (StM m (Either Response a, ResponseState) -> StMWebmachine m a)
-> b (StM m (Either Response a, ResponseState))
-> b (StMWebmachine m a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM StM m (Either Response a, ResponseState) -> StMWebmachine m a
forall (m :: * -> *) a.
StM (RST RequestReader ResponseState Response m) a
-> StMWebmachine m a
StMWebmachine
                     (b (StM m (Either Response a, ResponseState))
 -> b (StMWebmachine m a))
-> b (StM m (Either Response a, ResponseState))
-> b (StMWebmachine m a)
forall a b. (a -> b) -> a -> b
$ RST RequestReader ResponseState Response m a
-> b (StM (RST RequestReader ResponseState Response m) a)
RunInBase (RST RequestReader ResponseState Response m) b
g' (RST RequestReader ResponseState Response m a
 -> b (StM (RST RequestReader ResponseState Response m) a))
-> RST RequestReader ResponseState Response m a
-> b (StM (RST RequestReader ResponseState Response m) a)
forall a b. (a -> b) -> a -> b
$ Webmachine m a -> RST RequestReader ResponseState Response m a
forall (m :: * -> *) a.
Webmachine m a -> RST RequestReader ResponseState Response m a
getWebmachine Webmachine m a
m
  restoreM :: StM (Webmachine m) a -> Webmachine m a
restoreM = RST RequestReader ResponseState Response m a -> Webmachine m a
forall (m :: * -> *) a.
RST RequestReader ResponseState Response m a -> Webmachine m a
Webmachine (RST RequestReader ResponseState Response m a -> Webmachine m a)
-> (StMWebmachine m a
    -> RST RequestReader ResponseState Response m a)
-> StMWebmachine m a
-> Webmachine m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM m (Either Response a, ResponseState)
-> RST RequestReader ResponseState Response m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM (StM m (Either Response a, ResponseState)
 -> RST RequestReader ResponseState Response m a)
-> (StMWebmachine m a -> StM m (Either Response a, ResponseState))
-> StMWebmachine m a
-> RST RequestReader ResponseState Response m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StMWebmachine m a -> StM m (Either Response a, ResponseState)
forall (m :: * -> *) a.
StMWebmachine m a
-> StM (RST RequestReader ResponseState Response m) a
unStMWebmachine

-- Work around old versions of mtl not having a strict modify function
modify'' :: MonadState s m => (s -> s) -> m ()
#if MIN_VERSION_mtl(2,2,0)
modify'' :: (s -> s) -> m ()
modify'' = (s -> s) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify'
#else
modify'' f = state (\s -> let s' = f s in s' `seq` ((), s'))
#endif

-- Functions inside the Webmachine Monad -------------------------------------
------------------------------------------------------------------------------

-- | Returns the 'Request' that is currently being processed.
request :: Monad m => Webmachine m Request
request :: Webmachine m Request
request = AirshipRequest -> Request
_request (AirshipRequest -> Request)
-> (RequestReader -> AirshipRequest) -> RequestReader -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestReader -> AirshipRequest
_airshipRequest (RequestReader -> Request)
-> Webmachine m RequestReader -> Webmachine m Request
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Webmachine m RequestReader
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | Returns the route path that was matched during route evaluation. This is
-- not the path specified in the request, but rather the route in the
-- 'RoutingSpec' that matched the request URL. Variables names are prefixed
-- with @:@, and free ("star") paths are designated with @*@.
routePath :: Monad m => Webmachine m Text
routePath :: Webmachine m Text
routePath = AirshipRequest -> Text
_routePath (AirshipRequest -> Text)
-> (RequestReader -> AirshipRequest) -> RequestReader -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestReader -> AirshipRequest
_airshipRequest (RequestReader -> Text)
-> Webmachine m RequestReader -> Webmachine m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Webmachine m RequestReader
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | Returns the bound routing parameters extracted from the routing system (see "Airship.Route").
params :: Monad m => Webmachine m (HashMap Text Text)
params :: Webmachine m (HashMap Text Text)
params = ResponseState -> HashMap Text Text
_params (ResponseState -> HashMap Text Text)
-> Webmachine m ResponseState -> Webmachine m (HashMap Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Webmachine m ResponseState
forall s (m :: * -> *). MonadState s m => m s
get

dispatchPath :: Monad m => Webmachine m [Text]
dispatchPath :: Webmachine m [Text]
dispatchPath = ResponseState -> [Text]
_dispatchPath (ResponseState -> [Text])
-> Webmachine m ResponseState -> Webmachine m [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Webmachine m ResponseState
forall s (m :: * -> *). MonadState s m => m s
get

-- | Returns the time at which this request began processing.
requestTime :: Monad m => Webmachine m UTCTime
requestTime :: Webmachine m UTCTime
requestTime = RequestReader -> UTCTime
_now (RequestReader -> UTCTime)
-> Webmachine m RequestReader -> Webmachine m UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Webmachine m RequestReader
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | Returns the current 'ResponseHeaders'.
getResponseHeaders :: Monad m => Webmachine m ResponseHeaders
getResponseHeaders :: Webmachine m ResponseHeaders
getResponseHeaders = ResponseState -> ResponseHeaders
stateHeaders (ResponseState -> ResponseHeaders)
-> Webmachine m ResponseState -> Webmachine m ResponseHeaders
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Webmachine m ResponseState
forall s (m :: * -> *). MonadState s m => m s
get

-- | Returns the current 'ResponseBody'.
getResponseBody :: Monad m => Webmachine m ResponseBody
getResponseBody :: Webmachine m ResponseBody
getResponseBody = ResponseState -> ResponseBody
stateBody (ResponseState -> ResponseBody)
-> Webmachine m ResponseState -> Webmachine m ResponseBody
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Webmachine m ResponseState
forall s (m :: * -> *). MonadState s m => m s
get

-- | Given a new 'ResponseBody', replaces the stored body with the new one.
putResponseBody :: Monad m => ResponseBody -> Webmachine m ()
putResponseBody :: ResponseBody -> Webmachine m ()
putResponseBody ResponseBody
b = (ResponseState -> ResponseState) -> Webmachine m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify'' ResponseState -> ResponseState
updateState
    where updateState :: ResponseState -> ResponseState
updateState ResponseState
rs = ResponseState
rs {stateBody :: ResponseBody
stateBody = ResponseBody
b}

-- | Stores the provided 'ByteString' as the responseBody. This is a shortcut for
-- creating a response body with a 'ResponseBuilder' and a bytestring 'Builder'.
putResponseBS :: Monad m => ByteString -> Webmachine m ()
putResponseBS :: ByteString -> Webmachine m ()
putResponseBS ByteString
bs = ResponseBody -> Webmachine m ()
forall (m :: * -> *). Monad m => ResponseBody -> Webmachine m ()
putResponseBody (ResponseBody -> Webmachine m ())
-> ResponseBody -> Webmachine m ()
forall a b. (a -> b) -> a -> b
$ Builder -> ResponseBody
ResponseBuilder (Builder -> ResponseBody) -> Builder -> ResponseBody
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
fromByteString ByteString
bs

-- | Immediately halts processing with the provided 'Status' code.
-- The contents of the 'Webmachine''s response body will be streamed back to the client.
-- This is a shortcut for constructing a 'Response' with 'getResponseHeaders' and 'getResponseBody'
-- and passing that response to 'finishWith'.
halt :: Monad m => Status -> Webmachine m a
halt :: Status -> Webmachine m a
halt Status
status = Response -> Webmachine m a
forall (m :: * -> *) a. Monad m => Response -> Webmachine m a
finishWith (Response -> Webmachine m a)
-> Webmachine m Response -> Webmachine m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Status -> ResponseHeaders -> ResponseBody -> Response
Response (Status -> ResponseHeaders -> ResponseBody -> Response)
-> Webmachine m Status
-> Webmachine m (ResponseHeaders -> ResponseBody -> Response)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Status -> Webmachine m Status
forall (m :: * -> *) a. Monad m => a -> m a
return Status
status Webmachine m (ResponseHeaders -> ResponseBody -> Response)
-> Webmachine m ResponseHeaders
-> Webmachine m (ResponseBody -> Response)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Webmachine m ResponseHeaders
forall (m :: * -> *). Monad m => Webmachine m ResponseHeaders
getResponseHeaders Webmachine m (ResponseBody -> Response)
-> Webmachine m ResponseBody -> Webmachine m Response
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Webmachine m ResponseBody
forall (m :: * -> *). Monad m => Webmachine m ResponseBody
getResponseBody

-- | Immediately halts processing and writes the provided 'Response' back to the client.
finishWith :: Monad m => Response -> Webmachine m a
finishWith :: Response -> Webmachine m a
finishWith = RST RequestReader ResponseState Response m a -> Webmachine m a
forall (m :: * -> *) a.
RST RequestReader ResponseState Response m a -> Webmachine m a
Webmachine (RST RequestReader ResponseState Response m a -> Webmachine m a)
-> (Response -> RST RequestReader ResponseState Response m a)
-> Response
-> Webmachine m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response -> RST RequestReader ResponseState Response m a
forall (m :: * -> *) e r s a. Monad m => e -> RST r s e m a
failure

-- | Adds the provided ByteString to the Airship-Trace header.
addTrace :: Monad m => ByteString -> Webmachine m ()
addTrace :: ByteString -> Webmachine m ()
addTrace ByteString
t = (ResponseState -> ResponseState) -> Webmachine m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify'' (\ResponseState
s -> ResponseState
s { decisionTrace :: Trace
decisionTrace = ByteString
t ByteString -> Trace -> Trace
forall a. a -> [a] -> [a]
: ResponseState -> Trace
decisionTrace ResponseState
s })

both :: Either a a -> a
both :: Either a a -> a
both = (a -> a) -> (a -> a) -> Either a a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> a
forall a. a -> a
id a -> a
forall a. a -> a
id

eitherResponse :: Monad m => RequestReader -> ResponseState -> Webmachine m Response -> m (Response, Trace)
eitherResponse :: RequestReader
-> ResponseState -> Webmachine m Response -> m (Response, Trace)
eitherResponse RequestReader
requestReader ResponseState
startingState Webmachine m Response
w = do
    (Either Response Response
e, Trace
trace) <- RequestReader
-> ResponseState
-> Webmachine m Response
-> m (Either Response Response, Trace)
forall (m :: * -> *) a.
Monad m =>
RequestReader
-> ResponseState -> Webmachine m a -> m (Either Response a, Trace)
runWebmachine RequestReader
requestReader ResponseState
startingState Webmachine m Response
w
    (Response, Trace) -> m (Response, Trace)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Response Response -> Response
forall a. Either a a -> a
both Either Response Response
e, Trace
trace)

-- | Map both the return value and wrapped computation @m@.
mapWebmachine :: ( m1 (Either Response a1, ResponseState)
                -> m2 (Either Response a2, ResponseState))
              -> Webmachine m1 a1 -> Webmachine m2 a2
mapWebmachine :: (m1 (Either Response a1, ResponseState)
 -> m2 (Either Response a2, ResponseState))
-> Webmachine m1 a1 -> Webmachine m2 a2
mapWebmachine m1 (Either Response a1, ResponseState)
-> m2 (Either Response a2, ResponseState)
f =  RST RequestReader ResponseState Response m2 a2 -> Webmachine m2 a2
forall (m :: * -> *) a.
RST RequestReader ResponseState Response m a -> Webmachine m a
Webmachine (RST RequestReader ResponseState Response m2 a2
 -> Webmachine m2 a2)
-> (Webmachine m1 a1
    -> RST RequestReader ResponseState Response m2 a2)
-> Webmachine m1 a1
-> Webmachine m2 a2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((m1 (Either Response a1, ResponseState)
 -> m2 (Either Response a2, ResponseState))
-> RST RequestReader ResponseState Response m1 a1
-> RST RequestReader ResponseState Response m2 a2
forall (m :: * -> *) e a s (n :: * -> *) b r.
(m (Either e a, s) -> n (Either e b, s))
-> RST r s e m a -> RST r s e n b
mapRST m1 (Either Response a1, ResponseState)
-> m2 (Either Response a2, ResponseState)
f) (RST RequestReader ResponseState Response m1 a1
 -> RST RequestReader ResponseState Response m2 a2)
-> (Webmachine m1 a1
    -> RST RequestReader ResponseState Response m1 a1)
-> Webmachine m1 a1
-> RST RequestReader ResponseState Response m2 a2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Webmachine m1 a1 -> RST RequestReader ResponseState Response m1 a1
forall (m :: * -> *) a.
Webmachine m a -> RST RequestReader ResponseState Response m a
getWebmachine

runWebmachine :: Monad m => RequestReader -> ResponseState -> Webmachine m a -> m (Either Response a, Trace)
runWebmachine :: RequestReader
-> ResponseState -> Webmachine m a -> m (Either Response a, Trace)
runWebmachine RequestReader
requestReader ResponseState
startingState Webmachine m a
w = do
    (Either Response a
e, ResponseState
s) <- RST RequestReader ResponseState Response m a
-> RequestReader
-> ResponseState
-> m (Either Response a, ResponseState)
forall r s e (m :: * -> *) a.
RST r s e m a -> r -> s -> m (Either e a, s)
runRST (Webmachine m a -> RST RequestReader ResponseState Response m a
forall (m :: * -> *) a.
Webmachine m a -> RST RequestReader ResponseState Response m a
getWebmachine Webmachine m a
w) RequestReader
requestReader ResponseState
startingState
    (Either Response a, Trace) -> m (Either Response a, Trace)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Response a
e, Trace -> Trace
forall a. [a] -> [a]
reverse (Trace -> Trace) -> Trace -> Trace
forall a b. (a -> b) -> a -> b
$ ResponseState -> Trace
decisionTrace ResponseState
s)