{-# LANGUAGE CPP               #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE MonoLocalBinds    #-}
module Airship.Internal.Helpers
    ( parseFormData
    , contentTypeMatches
    , redirectTemporarily
    , redirectPermanently
    , resourceToWai
    , resourceToWaiT
    , resourceToWaiT'
    , appendRequestPath
    , lookupParam
    , lookupParam'
    ) where

#if __GLASGOW_HASKELL__ < 710
import           Control.Applicative
#endif
import           Control.Monad             (join)
import           Data.ByteString           (ByteString, intercalate)
import qualified Data.ByteString.Lazy      as LB
import           Data.Maybe
#if __GLASGOW_HASKELL__ < 710
import           Data.Monoid
#endif
import           Data.Foldable             (forM_)
import qualified Data.HashMap.Strict       as HM
import qualified Data.Map.Strict           as M
import           Data.Text                 (Text)
import           Data.Text.Encoding        (decodeUtf8)
import           Data.Time                 (getCurrentTime)
import           Lens.Micro                ((^.))
import           Network.HTTP.Media
import qualified Network.HTTP.Types        as HTTP
import qualified Network.Wai               as Wai

import           Network.Wai.Parse
import           System.Random

import           Airship.Config
import           Airship.Headers
import           Airship.Internal.Decision
import           Airship.Internal.Route
import           Airship.Resource
import           Airship.Types

-- | Parse form data uploaded with a @Content-Type@ of either
-- @www-form-urlencoded@ or @multipart/form-data@ to return a
-- list of parameter names and values and a list of uploaded
-- files and their information.
parseFormData :: Request -> IO ([Param], [File LB.ByteString])
parseFormData :: Request -> IO ([Param], [File ByteString])
parseFormData Request
r = BackEnd ByteString -> Request -> IO ([Param], [File ByteString])
forall y. BackEnd y -> Request -> IO ([Param], [File y])
parseRequestBody BackEnd ByteString
forall (m :: * -> *) ignored1 ignored2.
Monad m =>
ignored1 -> ignored2 -> m ByteString -> m ByteString
lbsBackEnd Request
r

-- | Returns @True@ if the request's @Content-Type@ header is one of the
-- provided media types. If the @Content-Type@ header is not present,
-- this function will return True.
contentTypeMatches :: Monad m => [MediaType] -> Webmachine m Bool
contentTypeMatches :: [MediaType] -> Webmachine m Bool
contentTypeMatches [MediaType]
validTypes = do
    RequestHeaders
headers <- Request -> RequestHeaders
requestHeaders (Request -> RequestHeaders)
-> Webmachine m Request -> Webmachine m RequestHeaders
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Webmachine m Request
forall (m :: * -> *). Monad m => Webmachine m Request
request
    let cType :: Maybe ByteString
cType = HeaderName -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
HTTP.hContentType RequestHeaders
headers
    Bool -> Webmachine m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Webmachine m Bool) -> Bool -> Webmachine m Bool
forall a b. (a -> b) -> a -> b
$ case Maybe ByteString
cType of
        Maybe ByteString
Nothing -> Bool
True
        Just ByteString
t  -> Maybe MediaType -> Bool
forall a. Maybe a -> Bool
isJust (Maybe MediaType -> Bool) -> Maybe MediaType -> Bool
forall a b. (a -> b) -> a -> b
$ [MediaType] -> ByteString -> Maybe MediaType
forall a. Accept a => [a] -> ByteString -> Maybe a
matchContent [MediaType]
validTypes ByteString
t

-- | Issue an HTTP 302 (Found) response, with `location' as the destination.
redirectTemporarily :: Monad m => ByteString -> Webmachine m a
redirectTemporarily :: ByteString -> Webmachine m a
redirectTemporarily ByteString
location =
    Header -> Webmachine m ()
forall (m :: * -> *). Monad m => Header -> Webmachine m ()
addResponseHeader (HeaderName
"Location", ByteString
location) Webmachine m () -> Webmachine m a -> Webmachine m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Status -> Webmachine m a
forall (m :: * -> *) a. Monad m => Status -> Webmachine m a
halt Status
HTTP.status302

-- | Issue an HTTP 301 (Moved Permantently) response,
-- with `location' as the destination.
redirectPermanently :: Monad m => ByteString -> Webmachine m a
redirectPermanently :: ByteString -> Webmachine m a
redirectPermanently ByteString
location =
    Header -> Webmachine m ()
forall (m :: * -> *). Monad m => Header -> Webmachine m ()
addResponseHeader (HeaderName
"Location", ByteString
location) Webmachine m () -> Webmachine m a -> Webmachine m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Status -> Webmachine m a
forall (m :: * -> *) a. Monad m => Status -> Webmachine m a
halt Status
HTTP.status301

toWaiResponse :: Response -> AirshipConfig -> ByteString -> ByteString -> Wai.Response
toWaiResponse :: Response -> AirshipConfig -> ByteString -> ByteString -> Response
toWaiResponse Response{RequestHeaders
Status
ResponseBody
_responseBody :: Response -> ResponseBody
_responseHeaders :: Response -> RequestHeaders
_responseStatus :: Response -> Status
_responseBody :: ResponseBody
_responseHeaders :: RequestHeaders
_responseStatus :: Status
..} AirshipConfig
cfg ByteString
trace ByteString
quip =
    case ResponseBody
_responseBody of
        (ResponseBuilder Builder
b) ->
            Status -> RequestHeaders -> Builder -> Response
Wai.responseBuilder Status
_responseStatus RequestHeaders
headers Builder
b
        (ResponseFile FilePath
path Maybe FilePart
part) ->
            Status -> RequestHeaders -> FilePath -> Maybe FilePart -> Response
Wai.responseFile Status
_responseStatus RequestHeaders
headers FilePath
path Maybe FilePart
part
        (ResponseStream StreamingBody
streamer) ->
            Status -> RequestHeaders -> StreamingBody -> Response
Wai.responseStream Status
_responseStatus RequestHeaders
headers StreamingBody
streamer
        ResponseBody
Empty ->
            Status -> RequestHeaders -> Builder -> Response
Wai.responseBuilder Status
_responseStatus RequestHeaders
headers Builder
forall a. Monoid a => a
mempty
    where
        headers :: RequestHeaders
headers = RequestHeaders
traced RequestHeaders -> RequestHeaders -> RequestHeaders
forall a. [a] -> [a] -> [a]
++ RequestHeaders
quipHeader RequestHeaders -> RequestHeaders -> RequestHeaders
forall a. [a] -> [a] -> [a]
++ RequestHeaders
_responseHeaders
        traced :: RequestHeaders
traced  = if AirshipConfig
cfgAirshipConfig
-> Getting HeaderInclusion AirshipConfig HeaderInclusion
-> HeaderInclusion
forall s a. s -> Getting a s a -> a
^.Getting HeaderInclusion AirshipConfig HeaderInclusion
Lens' AirshipConfig HeaderInclusion
includeTraceHeader HeaderInclusion -> HeaderInclusion -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderInclusion
IncludeHeader
                      then [(HeaderName
"Airship-Trace", ByteString
trace)]
                      else []

        quipHeader :: RequestHeaders
quipHeader  = if AirshipConfig
cfgAirshipConfig
-> Getting HeaderInclusion AirshipConfig HeaderInclusion
-> HeaderInclusion
forall s a. s -> Getting a s a -> a
^.Getting HeaderInclusion AirshipConfig HeaderInclusion
Lens' AirshipConfig HeaderInclusion
includeQuipHeader HeaderInclusion -> HeaderInclusion -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderInclusion
IncludeHeader
                      then [(HeaderName
"Airship-Quip", ByteString
quip)]
                      else []

-- | Given a 'RoutingSpec', a 404 resource, and a user state @s@, construct a WAI 'Application'.
resourceToWai :: AirshipConfig
              -> RoutingSpec IO ()
              -> ErrorResponses IO
              -> Wai.Application
resourceToWai :: AirshipConfig
-> RoutingSpec IO () -> ErrorResponses IO -> Application
resourceToWai AirshipConfig
cfg RoutingSpec IO ()
routes ErrorResponses IO
errors =
    AirshipConfig
-> (AirshipRequest -> IO Response -> IO Response)
-> RoutingSpec IO ()
-> ErrorResponses IO
-> Application
forall (m :: * -> *).
Monad m =>
AirshipConfig
-> (AirshipRequest -> m Response -> IO Response)
-> RoutingSpec m ()
-> ErrorResponses m
-> Application
resourceToWaiT AirshipConfig
cfg ((IO Response -> IO Response)
-> AirshipRequest -> IO Response -> IO Response
forall a b. a -> b -> a
const IO Response -> IO Response
forall a. a -> a
id) RoutingSpec IO ()
routes ErrorResponses IO
errors

-- | Given a 'AirshipConfig, a function to modify the 'Response' based on the
-- 'AirshipRequest' and the 'Response' (like WAI middleware), a 'RoutingSpec,
-- and 'ErrorResponses' construct a WAI 'Application'.
resourceToWaiT :: Monad m
               => AirshipConfig
               -> (AirshipRequest -> m Wai.Response -> IO Wai.Response)
               -> RoutingSpec m ()
               -> ErrorResponses m
               -> Wai.Application
resourceToWaiT :: AirshipConfig
-> (AirshipRequest -> m Response -> IO Response)
-> RoutingSpec m ()
-> ErrorResponses m
-> Application
resourceToWaiT AirshipConfig
cfg AirshipRequest -> m Response -> IO Response
run RoutingSpec m ()
routes ErrorResponses m
errors Request
req Response -> IO ResponseReceived
respond =
    AirshipConfig
-> (AirshipRequest -> m Response -> IO Response)
-> Trie (RouteLeaf m)
-> ErrorResponses m
-> Application
forall (m :: * -> *).
Monad m =>
AirshipConfig
-> (AirshipRequest -> m Response -> IO Response)
-> Trie (RouteLeaf m)
-> ErrorResponses m
-> Application
resourceToWaiT' AirshipConfig
cfg AirshipRequest -> m Response -> IO Response
run (RoutingSpec m () -> Trie (RouteLeaf m)
forall (m :: * -> *) a. RoutingSpec m a -> Trie (RouteLeaf m)
runRouter RoutingSpec m ()
routes) ErrorResponses m
errors Request
req Response -> IO ResponseReceived
respond

-- | Like 'resourceToWaiT', but expects the 'RoutingSpec' to have been
-- evaluated with 'runRouter'. This is more efficient than 'resourceToWaiT', as
-- the routes will not be evaluated on every request.
--
-- Given @routes :: RoutingSpec IO ()@, 'resourceToWaiT'' can be invoked like so:
--
-- > resourceToWaiT' cfg (const id) (runRouter routes) errors
resourceToWaiT' :: Monad m
               => AirshipConfig
               -> (AirshipRequest -> m Wai.Response -> IO Wai.Response)
               -> Trie (RouteLeaf m)
               -> ErrorResponses m
               -> Wai.Application
resourceToWaiT' :: AirshipConfig
-> (AirshipRequest -> m Response -> IO Response)
-> Trie (RouteLeaf m)
-> ErrorResponses m
-> Application
resourceToWaiT' AirshipConfig
cfg AirshipRequest -> m Response -> IO Response
run Trie (RouteLeaf m)
routeMapping ErrorResponses m
errors Request
req Response -> IO ResponseReceived
respond = do
    let pInfo :: ByteString
pInfo = Request -> ByteString
Wai.rawPathInfo Request
req
    ByteString
quip <- IO ByteString
getQuip
    UTCTime
nowTime <- IO UTCTime
getCurrentTime
    let (Map Status [(MediaType, Webmachine m ResponseBody)]
er, (HashMap Text Text
reqParams, [Text]
dispatched), Text
routePath', Webmachine m Response
r) =
         case Trie (RouteLeaf m)
-> ByteString
-> Maybe (RoutedResource m, (HashMap Text Text, [Text]))
forall (a :: * -> *).
Trie (RouteLeaf a)
-> ByteString
-> Maybe (RoutedResource a, (HashMap Text Text, [Text]))
route Trie (RouteLeaf m)
routeMapping ByteString
pInfo of
             Maybe (RoutedResource m, (HashMap Text Text, [Text]))
Nothing ->
                 (Map Status [(MediaType, Webmachine m ResponseBody)]
ErrorResponses m
errors, (HashMap Text Text
forall a. Monoid a => a
mempty, []), ByteString -> Text
decodeUtf8 ByteString
pInfo, Response -> Webmachine m Response
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> Webmachine m Response)
-> Response -> Webmachine m Response
forall a b. (a -> b) -> a -> b
$ Status -> RequestHeaders -> ResponseBody -> Response
Response Status
HTTP.status404 [(HeaderName
HTTP.hContentType, ByteString
"text/plain")] ResponseBody
Empty)
             Just (RoutedResource Route
rPath Resource m
resource, (HashMap Text Text, [Text])
pm) ->
                 (Map Status [(MediaType, Webmachine m ResponseBody)]
-> Map Status [(MediaType, Webmachine m ResponseBody)]
-> Map Status [(MediaType, Webmachine m ResponseBody)]
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (Resource m -> ErrorResponses m
forall (m :: * -> *).
Resource m
-> Monad m => Map Status [(MediaType, Webmachine m ResponseBody)]
errorResponses Resource m
resource) Map Status [(MediaType, Webmachine m ResponseBody)]
ErrorResponses m
errors, (HashMap Text Text, [Text])
pm, Route -> Text
routeText Route
rPath, Resource m -> Webmachine m Response
forall (m :: * -> *).
Monad m =>
Resource m -> Webmachine m Response
flow Resource m
resource)
        airshipReq :: AirshipRequest
airshipReq = Request -> Text -> AirshipRequest
AirshipRequest Request
req Text
routePath'
        requestReader :: RequestReader
requestReader = UTCTime -> AirshipRequest -> RequestReader
RequestReader UTCTime
nowTime AirshipRequest
airshipReq
        startingState :: ResponseState
startingState = RequestHeaders
-> ResponseBody
-> HashMap Text Text
-> [Text]
-> Trace
-> ResponseState
ResponseState [] ResponseBody
Empty HashMap Text Text
reqParams [Text]
dispatched []
    Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> IO Response -> IO ResponseReceived
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AirshipRequest -> m Response -> IO Response
run AirshipRequest
airshipReq (do
        (Response
response, Trace
trace) <-
            RequestReader
-> ResponseState -> Webmachine m Response -> m (Response, Trace)
forall (m :: * -> *).
Monad m =>
RequestReader
-> ResponseState -> Webmachine m Response -> m (Response, Trace)
eitherResponse RequestReader
requestReader ResponseState
startingState (Webmachine m Response
r Webmachine m Response
-> (Response -> Webmachine m Response) -> Webmachine m Response
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ErrorResponses m -> Response -> Webmachine m Response
forall (m :: * -> *).
Monad m =>
ErrorResponses m -> Response -> Webmachine m Response
errorResponse Map Status [(MediaType, Webmachine m ResponseBody)]
ErrorResponses m
er)
        Response -> m Response
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ Response -> AirshipConfig -> ByteString -> ByteString -> Response
toWaiResponse Response
response AirshipConfig
cfg (Trace -> ByteString
traceHeader Trace
trace) ByteString
quip)

-- | If the Response body is Empty the response body is set based on the error responses
--  provided by the application and resource. If the response body is not Empty or
--  there are no error response configured for the status code in the Response then no
--  action is taken. The contents of the 'Webmachine'' response body will be streamed
--  back to the client.
errorResponse :: Monad m =>
                 ErrorResponses m
              -> Response
              -> Webmachine m Response
errorResponse :: ErrorResponses m -> Response -> Webmachine m Response
errorResponse ErrorResponses m
errResps r :: Response
r@Response{RequestHeaders
Status
ResponseBody
_responseBody :: ResponseBody
_responseHeaders :: RequestHeaders
_responseStatus :: Status
_responseBody :: Response -> ResponseBody
_responseHeaders :: Response -> RequestHeaders
_responseStatus :: Response -> Status
..}
    | (Status -> Bool
HTTP.statusIsClientError Status
_responseStatus Bool -> Bool -> Bool
||
       Status -> Bool
HTTP.statusIsServerError Status
_responseStatus) Bool -> Bool -> Bool
&&
       ResponseBody -> Bool
isResponseBodyEmpty ResponseBody
_responseBody = do
           Request
req <- Webmachine m Request
forall (m :: * -> *). Monad m => Webmachine m Request
request
           let reqHeaders :: RequestHeaders
reqHeaders = Request -> RequestHeaders
requestHeaders Request
req
               acceptStr :: Maybe ByteString
acceptStr = HeaderName -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
HTTP.hAccept RequestHeaders
reqHeaders
               errBodies :: Maybe [(MediaType, (MediaType, Webmachine m ResponseBody))]
errBodies = ((MediaType, Webmachine m ResponseBody)
 -> (MediaType, (MediaType, Webmachine m ResponseBody)))
-> [(MediaType, Webmachine m ResponseBody)]
-> [(MediaType, (MediaType, Webmachine m ResponseBody))]
forall a b. (a -> b) -> [a] -> [b]
map (MediaType, Webmachine m ResponseBody)
-> (MediaType, (MediaType, Webmachine m ResponseBody))
forall a b. (a, b) -> (a, (a, b))
dupContentType ([(MediaType, Webmachine m ResponseBody)]
 -> [(MediaType, (MediaType, Webmachine m ResponseBody))])
-> Maybe [(MediaType, Webmachine m ResponseBody)]
-> Maybe [(MediaType, (MediaType, Webmachine m ResponseBody))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Status
-> Map Status [(MediaType, Webmachine m ResponseBody)]
-> Maybe [(MediaType, Webmachine m ResponseBody)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Status
_responseStatus Map Status [(MediaType, Webmachine m ResponseBody)]
ErrorResponses m
errResps
               mResp :: Maybe (MediaType, Webmachine m ResponseBody)
mResp = Maybe (Maybe (MediaType, Webmachine m ResponseBody))
-> Maybe (MediaType, Webmachine m ResponseBody)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe (MediaType, Webmachine m ResponseBody))
 -> Maybe (MediaType, Webmachine m ResponseBody))
-> Maybe (Maybe (MediaType, Webmachine m ResponseBody))
-> Maybe (MediaType, Webmachine m ResponseBody)
forall a b. (a -> b) -> a -> b
$ [(MediaType, (MediaType, Webmachine m ResponseBody))]
-> ByteString -> Maybe (MediaType, Webmachine m ResponseBody)
forall b. [(MediaType, b)] -> ByteString -> Maybe b
mapAcceptMedia ([(MediaType, (MediaType, Webmachine m ResponseBody))]
 -> ByteString -> Maybe (MediaType, Webmachine m ResponseBody))
-> Maybe [(MediaType, (MediaType, Webmachine m ResponseBody))]
-> Maybe
     (ByteString -> Maybe (MediaType, Webmachine m ResponseBody))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [(MediaType, (MediaType, Webmachine m ResponseBody))]
errBodies Maybe (ByteString -> Maybe (MediaType, Webmachine m ResponseBody))
-> Maybe ByteString
-> Maybe (Maybe (MediaType, Webmachine m ResponseBody))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ByteString
acceptStr
           Maybe (MediaType, Webmachine m ResponseBody)
-> ((MediaType, Webmachine m ResponseBody) -> Webmachine m ())
-> Webmachine m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (MediaType, Webmachine m ResponseBody)
mResp (((MediaType, Webmachine m ResponseBody) -> Webmachine m ())
 -> Webmachine m ())
-> ((MediaType, Webmachine m ResponseBody) -> Webmachine m ())
-> Webmachine m ()
forall a b. (a -> b) -> a -> b
$ \(MediaType
ct, Webmachine m ResponseBody
body) -> do
               ResponseBody -> Webmachine m ()
forall (m :: * -> *). Monad m => ResponseBody -> Webmachine m ()
putResponseBody (ResponseBody -> Webmachine m ())
-> Webmachine m ResponseBody -> Webmachine m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Webmachine m ResponseBody
body
               Header -> Webmachine m ()
forall (m :: * -> *). Monad m => Header -> Webmachine m ()
addResponseHeader (HeaderName
"Content-Type", MediaType -> ByteString
forall h. RenderHeader h => h -> ByteString
renderHeader MediaType
ct)
           Status -> RequestHeaders -> ResponseBody -> Response
Response
               (Status -> RequestHeaders -> ResponseBody -> Response)
-> Webmachine m Status
-> Webmachine m (RequestHeaders -> 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
_responseStatus
               Webmachine m (RequestHeaders -> ResponseBody -> Response)
-> Webmachine m RequestHeaders
-> Webmachine m (ResponseBody -> Response)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Webmachine m RequestHeaders
forall (m :: * -> *). Monad m => Webmachine m RequestHeaders
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
    | Bool
otherwise = Response -> Webmachine m Response
forall (m :: * -> *) a. Monad m => a -> m a
return Response
r
    where
        isResponseBodyEmpty :: ResponseBody -> Bool
isResponseBodyEmpty ResponseBody
Empty = Bool
True
        isResponseBodyEmpty ResponseBody
_ = Bool
False
        dupContentType :: (a, b) -> (a, (a, b))
dupContentType (a
a, b
b) = (a
a, (a
a, b
b))


getQuip :: IO ByteString
getQuip :: IO ByteString
getQuip = do
  Int
idx <- (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
0, Trace -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Trace
quips Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Trace
quips Trace -> Int -> ByteString
forall a. [a] -> Int -> a
!! Int
idx
  where quips :: Trace
quips = [ ByteString
"never breaks eye contact"
                , ByteString
"blame me if inappropriate"
                , ByteString
"firm pat on the back"
                , ByteString
"sharkfed"
                , ByteString
"$300,000 worth of cows"
                , ByteString
"RB_GC_GUARD"
                , ByteString
"evacuation not done in time"
                , ByteString
"javascript doesn't have integers"
                , ByteString
"WARNING: ulimit -n is 1024"
                , ByteString
"shut it down"
                ]

traceHeader :: [ByteString] -> ByteString
traceHeader :: Trace -> ByteString
traceHeader = ByteString -> Trace -> ByteString
intercalate ByteString
","

-- | Lookup routing parameter and return 500 Internal Server Error if not found.
-- Not finding the paramter usually means the route doesn't match what
-- the resource is expecting.
lookupParam :: Monad m => Text -> Webmachine m Text
lookupParam :: Text -> Webmachine m Text
lookupParam Text
p = Text -> Webmachine m (Maybe Text)
forall (m :: * -> *). Monad m => Text -> Webmachine m (Maybe Text)
lookupParam' Text
p Webmachine m (Maybe Text)
-> (Maybe Text -> Webmachine m Text) -> Webmachine m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Webmachine m Text
-> (Text -> Webmachine m Text) -> Maybe Text -> Webmachine m Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Status -> Webmachine m Text
forall (m :: * -> *) a. Monad m => Status -> Webmachine m a
halt Status
HTTP.status500) Text -> Webmachine m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Lookup routing parameter.
lookupParam' :: Monad m => Text -> Webmachine m (Maybe Text)
lookupParam' :: Text -> Webmachine m (Maybe Text)
lookupParam' Text
p = Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
p (HashMap Text Text -> Maybe Text)
-> Webmachine m (HashMap Text Text) -> Webmachine m (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Webmachine m (HashMap Text Text)
forall (m :: * -> *). Monad m => Webmachine m (HashMap Text Text)
params