{-# LANGUAGE CPP               #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE LambdaCase #-}
{-# language ScopedTypeVariables #-}
module Web.Scotty.Action
    ( addHeader
    , body
    , bodyReader
    , file
    , rawResponse
    , files
    , filesOpts
    , W.ParseRequestBodyOptions, W.defaultParseRequestBodyOptions
    , finish
    , header
    , headers
    , html
    , htmlLazy
    , json
    , jsonData
    , formData
    , next
    , pathParam
    , captureParam
    , formParam
    , queryParam
    , pathParamMaybe
    , captureParamMaybe
    , formParamMaybe
    , queryParamMaybe
    , pathParams
    , captureParams
    , formParams
    , queryParams
    , throw
    , raw
    , nested
    , readEither
    , redirect
    , redirect300
    , redirect301
    , redirect302
    , redirect303
    , redirect304
    , redirect307
    , redirect308
    , request
    , setHeader
    , status
    , stream
    , text
    , textLazy
    , getResponseStatus
    , getResponseHeaders
    , getResponseContent
    , Param
    , Parsable(..)
    , ActionT
      -- private to Scotty
    , runAction
    ) where

import           Blaze.ByteString.Builder   (fromLazyByteString)

import qualified Control.Exception          as E
import           Control.Monad              (when)
import           Control.Monad.IO.Class     (MonadIO(..))
import UnliftIO (MonadUnliftIO(..))
import           Control.Monad.Reader       (MonadReader(..), ReaderT(..), asks)
import Control.Monad.Trans.Resource (withInternalState, runResourceT)

import           Control.Concurrent.MVar

import qualified Data.Aeson                 as A
import Data.Bool (bool)
import qualified Data.ByteString.Char8      as B
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.CaseInsensitive       as CI
import           Data.Traversable (for)
import qualified Data.Map.Strict            as Map
import qualified Data.HashMap.Strict        as HM
import           Data.Int
import           Data.List (foldl')
import           Data.Maybe                 (maybeToList)
import qualified Data.Text                  as T
import           Data.Text.Encoding         as STE
import qualified Data.Text.Lazy             as TL
import qualified Data.Text.Lazy.Encoding    as TLE
import           Data.Time                  (UTCTime)
import           Data.Time.Format           (parseTimeM, defaultTimeLocale)
import           Data.Typeable              (typeOf)
import           Data.Word

import           Network.HTTP.Types
-- not re-exported until version 0.11
#if !MIN_VERSION_http_types(0,11,0)
import           Network.HTTP.Types.Status
#endif
import           Network.Wai (Request, Response, StreamingBody, Application, requestHeaders)
import Network.Wai.Handler.Warp (InvalidRequest(..))
import qualified Network.Wai.Parse as W (FileInfo(..), ParseRequestBodyOptions, defaultParseRequestBodyOptions)

import           Numeric.Natural

import           Web.FormUrlEncoded (Form(..), FromForm(..))
import           Web.Scotty.Internal.Types
import           Web.Scotty.Util (mkResponse, addIfNotPresent, add, replace, lazyTextToStrictByteString, decodeUtf8Lenient)
import           UnliftIO.Exception (Handler(..), catches, throwIO)
import           System.IO (hPutStrLn, stderr)

import Network.Wai.Internal (ResponseReceived(..))


-- | Evaluate a route, catch all exceptions (user-defined ones, internal and all remaining, in this order)
--   and construct the 'Response'
--
-- 'Nothing' indicates route failed (due to Next) and pattern matching should try the next available route.
-- 'Just' indicates a successful response.
runAction :: MonadUnliftIO m =>
             Options
          -> Maybe (ErrorHandler m) -- ^ this handler (if present) is in charge of user-defined exceptions
          -> ActionEnv
          -> ActionT m () -- ^ Route action to be evaluated
          -> m (Maybe Response)
runAction :: forall (m :: * -> *).
MonadUnliftIO m =>
Options
-> Maybe (ErrorHandler m)
-> ActionEnv
-> ActionT m ()
-> m (Maybe Response)
runAction Options
options Maybe (ErrorHandler m)
mh ActionEnv
env ActionT m ()
action = do
  Bool
ok <- (ReaderT ActionEnv m Bool -> ActionEnv -> m Bool)
-> ActionEnv -> ReaderT ActionEnv m Bool -> m Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT ActionEnv m Bool -> ActionEnv -> m Bool
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ActionEnv
env (ReaderT ActionEnv m Bool -> m Bool)
-> ReaderT ActionEnv m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ActionT m Bool -> ReaderT ActionEnv m Bool
forall (m :: * -> *) a. ActionT m a -> ReaderT ActionEnv m a
runAM (ActionT m Bool -> ReaderT ActionEnv m Bool)
-> ActionT m Bool -> ReaderT ActionEnv m Bool
forall a b. (a -> b) -> a -> b
$ ActionT m () -> ActionT m Bool
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m Bool
tryNext (ActionT m () -> ActionT m Bool) -> ActionT m () -> ActionT m Bool
forall a b. (a -> b) -> a -> b
$ ActionT m ()
action ActionT m () -> [ErrorHandler m] -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> [Handler m a] -> m a
`catches` [[ErrorHandler m]] -> [ErrorHandler m]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [ErrorHandler m
forall (m :: * -> *). MonadIO m => ErrorHandler m
actionErrorHandler]
    , Maybe (ErrorHandler m) -> [ErrorHandler m]
forall a. Maybe a -> [a]
maybeToList Maybe (ErrorHandler m)
mh
    , [Options -> ErrorHandler m
forall (m :: * -> *). MonadIO m => Options -> ErrorHandler m
scottyExceptionHandler Options
options, Options -> ErrorHandler m
forall (m :: * -> *). MonadIO m => Options -> ErrorHandler m
someExceptionHandler Options
options]
    ]
  ScottyResponse
res <- ActionEnv -> m ScottyResponse
forall (m :: * -> *). MonadIO m => ActionEnv -> m ScottyResponse
getResponse ActionEnv
env
  Maybe Response -> m (Maybe Response)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Response -> m (Maybe Response))
-> Maybe Response -> m (Maybe Response)
forall a b. (a -> b) -> a -> b
$ Maybe Response -> Maybe Response -> Bool -> Maybe Response
forall a. a -> a -> Bool -> a
bool Maybe Response
forall a. Maybe a
Nothing (Response -> Maybe Response
forall a. a -> Maybe a
Just (Response -> Maybe Response) -> Response -> Maybe Response
forall a b. (a -> b) -> a -> b
$ ScottyResponse -> Response
mkResponse ScottyResponse
res) Bool
ok

-- | Exception handler in charge of 'ActionError'. Rethrowing 'Next' here is caught by 'tryNext'.
-- All other cases of 'ActionError' are converted to HTTP responses.
actionErrorHandler :: MonadIO m => ErrorHandler m
actionErrorHandler :: forall (m :: * -> *). MonadIO m => ErrorHandler m
actionErrorHandler = (ActionError -> ActionT m ()) -> Handler (ActionT m) ()
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((ActionError -> ActionT m ()) -> Handler (ActionT m) ())
-> (ActionError -> ActionT m ()) -> Handler (ActionT m) ()
forall a b. (a -> b) -> a -> b
$ \case
  AERedirect Status
s Text
url -> do
    Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
s
    Text -> Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> Text -> ActionT m ()
setHeader Text
"Location" Text
url
  ActionError
AENext -> ActionT m ()
forall (m :: * -> *) a. Monad m => ActionT m a
next
  ActionError
AEFinish -> () -> ActionT m ()
forall a. a -> ActionT m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Default handler for exceptions from scotty
scottyExceptionHandler :: MonadIO m => Options -> ErrorHandler m
scottyExceptionHandler :: forall (m :: * -> *). MonadIO m => Options -> ErrorHandler m
scottyExceptionHandler Options{Bool
jsonMode :: Bool
jsonMode :: Options -> Bool
jsonMode} = (ScottyException -> ActionT m ()) -> Handler (ActionT m) ()
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((ScottyException -> ActionT m ()) -> Handler (ActionT m) ())
-> (ScottyException -> ActionT m ()) -> Handler (ActionT m) ()
forall a b. (a -> b) -> a -> b
$ \case
  ScottyException
RequestTooLarge -> do
    Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status413
    if Bool
jsonMode
      then Value -> ActionT m ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json (Value -> ActionT m ()) -> Value -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object [Key
"status" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Int
413 :: Int), Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Text
"Request body is too large" :: T.Text)]
      else Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
text Text
"Request body is too large"
  MalformedJSON ByteString
bs Text
err -> do
    Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status400
    if Bool
jsonMode
      then Value -> ActionT m ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json (Value -> ActionT m ()) -> Value -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
        [ Key
"status" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Int
400 :: Int)
        , Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Text
"jsonData: malformed" :: T.Text)
        , Key
"body" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= ByteString -> Text
decodeUtf8Lenient (ByteString -> ByteString
BL.toStrict ByteString
bs)
        , Key
"error" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text
err
        ]
      else ByteString -> ActionT m ()
forall (m :: * -> *). MonadIO m => ByteString -> ActionT m ()
raw (ByteString -> ActionT m ()) -> ByteString -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BL.unlines
        [ ByteString
"jsonData: malformed"
        , ByteString
"Body: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs
        , ByteString
"Error: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
BL.fromStrict (Text -> ByteString
encodeUtf8 Text
err)
        ]
  FailedToParseJSON ByteString
bs Text
err -> do
    Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status422
    if Bool
jsonMode
      then Value -> ActionT m ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json (Value -> ActionT m ()) -> Value -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
        [ Key
"status" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Int
422 :: Int)
        , Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Text
"jsonData: failed to parse" :: T.Text)
        , Key
"body" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= ByteString -> Text
decodeUtf8Lenient (ByteString -> ByteString
BL.toStrict ByteString
bs)
        , Key
"error" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text
err
        ]
      else ByteString -> ActionT m ()
forall (m :: * -> *). MonadIO m => ByteString -> ActionT m ()
raw (ByteString -> ActionT m ()) -> ByteString -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BL.unlines
        [ ByteString
"jsonData: failed to parse"
        , ByteString
"Body: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs
        , ByteString
"Error: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
BL.fromStrict (Text -> ByteString
encodeUtf8 Text
err)
        ]
  MalformedForm Text
err -> do
    Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status400
    if Bool
jsonMode
      then Value -> ActionT m ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json (Value -> ActionT m ()) -> Value -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
        [ Key
"status" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Int
400 :: Int)
        , Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Text
"formData: malformed" :: T.Text)
        , Key
"error" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text
err
        ]
      else ByteString -> ActionT m ()
forall (m :: * -> *). MonadIO m => ByteString -> ActionT m ()
raw (ByteString -> ActionT m ()) -> ByteString -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BL.unlines
        [ ByteString
"formData: malformed"
        , ByteString
"Error: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
BL.fromStrict (Text -> ByteString
encodeUtf8 Text
err)
        ]
  PathParameterNotFound Text
k -> do
    Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status500
    if Bool
jsonMode
      then Value -> ActionT m ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json (Value -> ActionT m ()) -> Value -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
        [ Key
"status" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Int
500 :: Int)
        , Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= [Text] -> Text
T.unwords [ Text
"Path parameter", Text
k, Text
"not found"]
        ]
      else Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
text (Text -> ActionT m ()) -> Text -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [ Text
"Path parameter", Text
k, Text
"not found"]
  QueryParameterNotFound Text
k -> do
    Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status400
    if Bool
jsonMode
      then Value -> ActionT m ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json (Value -> ActionT m ()) -> Value -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
        [ Key
"status" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Int
400 :: Int)
        , Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= [Text] -> Text
T.unwords [ Text
"Query parameter", Text
k, Text
"not found"]
        ]
      else Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
text (Text -> ActionT m ()) -> Text -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [ Text
"Query parameter", Text
k, Text
"not found"]
  FormFieldNotFound Text
k -> do
    Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status400
    if Bool
jsonMode
      then Value -> ActionT m ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json (Value -> ActionT m ()) -> Value -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
        [ Key
"status" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Int
400 :: Int)
        , Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= [Text] -> Text
T.unwords [ Text
"Form field", Text
k, Text
"not found"]
        ]
      else Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
text (Text -> ActionT m ()) -> Text -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [ Text
"Form field", Text
k, Text
"not found"]
  FailedToParseParameter Text
k Text
v Text
e -> do
    Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status400
    if Bool
jsonMode
      then Value -> ActionT m ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json (Value -> ActionT m ()) -> Value -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
        [ Key
"status" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Int
400 :: Int)
        , Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= [Text] -> Text
T.unwords [ Text
"Failed to parse parameter", Text
k, Text
v, Text
":", Text
e]
        ]
      else Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
text (Text -> ActionT m ()) -> Text -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [ Text
"Failed to parse parameter", Text
k, Text
v, Text
":", Text
e]
  WarpRequestException InvalidRequest
we -> case InvalidRequest
we of
    InvalidRequest
RequestHeaderFieldsTooLarge -> do
      Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status413
      if Bool
jsonMode
        then Value -> ActionT m ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json (Value -> ActionT m ()) -> Value -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
          [ Key
"status" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Int
413 :: Int)
          , Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Text
"Request header fields too large" :: T.Text)
          ]
        else Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
text Text
"Request header fields too large"
    InvalidRequest
weo -> do -- FIXME fall-through case on InvalidRequest, it would be nice to return more specific error messages and codes here
      Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status400
      if Bool
jsonMode
        then Value -> ActionT m ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json (Value -> ActionT m ()) -> Value -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
          [ Key
"status" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Int
400 :: Int)
          , Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= [Text] -> Text
T.unwords [Text
"Request Exception:", String -> Text
T.pack (InvalidRequest -> String
forall a. Show a => a -> String
show InvalidRequest
weo)]
          ]
        else Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
text (Text -> ActionT m ()) -> Text -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text
"Request Exception:", String -> Text
T.pack (InvalidRequest -> String
forall a. Show a => a -> String
show InvalidRequest
weo)]
  WaiRequestParseException RequestParseException
we -> do
    Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status413 -- 413 Content Too Large https://developer.mozilla.org/en-US/docs/Web/HTTP/Status/413
    if Bool
jsonMode
      then Value -> ActionT m ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json (Value -> ActionT m ()) -> Value -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
        [ Key
"status" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Int
413 :: Int)
        , Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= [Text] -> Text
T.unwords [Text
"wai-extra Exception:", String -> Text
T.pack (RequestParseException -> String
forall a. Show a => a -> String
show RequestParseException
we)]
        ]
      else Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
text (Text -> ActionT m ()) -> Text -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text
"wai-extra Exception:", String -> Text
T.pack (RequestParseException -> String
forall a. Show a => a -> String
show RequestParseException
we)]
  ResourceTException InvalidAccess
rte -> do
    Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status500
    if Bool
jsonMode
      then Value -> ActionT m ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json (Value -> ActionT m ()) -> Value -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
        [ Key
"status" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Int
500 :: Int)
        , Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= [Text] -> Text
T.unwords [Text
"resourcet Exception:", String -> Text
T.pack (InvalidAccess -> String
forall a. Show a => a -> String
show InvalidAccess
rte)]
        ]
      else Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
text (Text -> ActionT m ()) -> Text -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text
"resourcet Exception:", String -> Text
T.pack (InvalidAccess -> String
forall a. Show a => a -> String
show InvalidAccess
rte)]

-- | Uncaught exceptions turn into HTTP 500 Server Error codes
someExceptionHandler :: MonadIO m => Options -> ErrorHandler m
someExceptionHandler :: forall (m :: * -> *). MonadIO m => Options -> ErrorHandler m
someExceptionHandler Options{Int
verbose :: Int
verbose :: Options -> Int
verbose, Bool
jsonMode :: Options -> Bool
jsonMode :: Bool
jsonMode} =
  (SomeException -> ActionT m ()) -> Handler (ActionT m) ()
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((SomeException -> ActionT m ()) -> Handler (ActionT m) ())
-> (SomeException -> ActionT m ()) -> Handler (ActionT m) ()
forall a b. (a -> b) -> a -> b
$ \(E.SomeException e
e) -> do
    Bool -> ActionT m () -> ActionT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
verbose Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$
      IO () -> ActionT m ()
forall a. IO a -> ActionT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ActionT m ()) -> IO () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$
      Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
      String
"Unhandled exception of " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TypeRep -> String
forall a. Show a => a -> String
show (e -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf e
e) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> e -> String
forall a. Show a => a -> String
show e
e
    Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status500
    if Bool
jsonMode
      then Value -> ActionT m ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json (Value -> ActionT m ()) -> Value -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
        [ Key
"status" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Int
500 :: Int)
        , Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Text
"Internal Server Error" :: T.Text)
        ]
      else Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
text Text
"Internal Server Error"

-- | Throw an exception which can be caught within the scope of the current Action with 'catch'.
--
-- If the exception is not caught locally, another option is to implement a global 'Handler' (with 'defaultHandler') that defines its interpretation and a translation to HTTP error codes.
--
-- Uncaught exceptions turn into HTTP 500 responses.
throw :: (MonadIO m, E.Exception e) => e -> ActionT m a
throw :: forall (m :: * -> *) e a.
(MonadIO m, Exception e) =>
e -> ActionT m a
throw = e -> ActionT m a
forall a e. Exception e => e -> a
E.throw

-- | Abort execution of this action and continue pattern matching routes.
-- Like an exception, any code after 'next' is not executed.
--
-- NB : Internally, this is implemented with an exception that can only be
-- caught by the library, but not by the user.
--
-- As an example, these two routes overlap. The only way the second one will
-- ever run is if the first one calls 'next'.
--
-- > get "/foo/:bar" $ do
-- >   w :: Text <- pathParam "bar"
-- >   unless (w == "special") next
-- >   text "You made a request to /foo/special"
-- >
-- > get "/foo/:baz" $ do
-- >   w <- pathParam "baz"
-- >   text $ "You made a request to: " <> w
next :: Monad m => ActionT m a
next :: forall (m :: * -> *) a. Monad m => ActionT m a
next = ActionError -> ActionT m a
forall a e. Exception e => e -> a
E.throw ActionError
AENext

-- | Synonym for 'redirect302'.
-- If you are unsure which redirect to use, you probably want this one.
--
-- > redirect "http://www.google.com"
--
-- OR
--
-- > redirect "/foo/bar"
redirect :: (Monad m) => T.Text -> ActionT m a
redirect :: forall (m :: * -> *) a. Monad m => Text -> ActionT m a
redirect = Text -> ActionT m a
forall (m :: * -> *) a. Monad m => Text -> ActionT m a
redirect302

-- | Redirect to given URL with status 300 (Multiple Choices). Like throwing
-- an uncatchable exception. Any code after the call to
-- redirect will not be run.
redirect300 :: (Monad m) => T.Text -> ActionT m a
redirect300 :: forall (m :: * -> *) a. Monad m => Text -> ActionT m a
redirect300 = Status -> Text -> ActionT m a
forall (m :: * -> *) a. Monad m => Status -> Text -> ActionT m a
redirectStatus Status
status300

-- | Redirect to given URL with status 301 (Moved Permanently). Like throwing
-- an uncatchable exception. Any code after the call to
-- redirect will not be run.
redirect301 :: (Monad m) => T.Text -> ActionT m a
redirect301 :: forall (m :: * -> *) a. Monad m => Text -> ActionT m a
redirect301 = Status -> Text -> ActionT m a
forall (m :: * -> *) a. Monad m => Status -> Text -> ActionT m a
redirectStatus Status
status301

-- | Redirect to given URL with status 302 (Found). Like throwing
-- an uncatchable exception. Any code after the call to
-- redirect will not be run.
redirect302 :: (Monad m) => T.Text -> ActionT m a
redirect302 :: forall (m :: * -> *) a. Monad m => Text -> ActionT m a
redirect302 = Status -> Text -> ActionT m a
forall (m :: * -> *) a. Monad m => Status -> Text -> ActionT m a
redirectStatus Status
status302

-- | Redirect to given URL with status 303 (See Other). Like throwing
-- an uncatchable exception. Any code after the call to
-- redirect will not be run.
redirect303 :: (Monad m) => T.Text -> ActionT m a
redirect303 :: forall (m :: * -> *) a. Monad m => Text -> ActionT m a
redirect303 = Status -> Text -> ActionT m a
forall (m :: * -> *) a. Monad m => Status -> Text -> ActionT m a
redirectStatus Status
status303

-- | Redirect to given URL with status 304 (Not Modified). Like throwing
-- an uncatchable exception. Any code after the call to
-- redirect will not be run.
redirect304 :: (Monad m) => T.Text -> ActionT m a
redirect304 :: forall (m :: * -> *) a. Monad m => Text -> ActionT m a
redirect304 = Status -> Text -> ActionT m a
forall (m :: * -> *) a. Monad m => Status -> Text -> ActionT m a
redirectStatus Status
status304

-- | Redirect to given URL with status 307 (Temporary Redirect). Like throwing
-- an uncatchable exception. Any code after the call to
-- redirect will not be run.
redirect307 :: (Monad m) => T.Text -> ActionT m a
redirect307 :: forall (m :: * -> *) a. Monad m => Text -> ActionT m a
redirect307 = Status -> Text -> ActionT m a
forall (m :: * -> *) a. Monad m => Status -> Text -> ActionT m a
redirectStatus Status
status307

-- | Redirect to given URL with status 308 (Permanent Redirect). Like throwing
-- an uncatchable exception. Any code after the call to
-- redirect will not be run.
redirect308 :: (Monad m) => T.Text -> ActionT m a
redirect308 :: forall (m :: * -> *) a. Monad m => Text -> ActionT m a
redirect308 = Status -> Text -> ActionT m a
forall (m :: * -> *) a. Monad m => Status -> Text -> ActionT m a
redirectStatus Status
status308

redirectStatus :: (Monad m) => Status -> T.Text -> ActionT m a
redirectStatus :: forall (m :: * -> *) a. Monad m => Status -> Text -> ActionT m a
redirectStatus Status
s = ActionError -> ActionT m a
forall a e. Exception e => e -> a
E.throw (ActionError -> ActionT m a)
-> (Text -> ActionError) -> Text -> ActionT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Text -> ActionError
AERedirect Status
s

-- | Finish the execution of the current action. Like throwing an uncatchable
-- exception. Any code after the call to finish will not be run.
--
-- /Since: 0.10.3/
finish :: (Monad m) => ActionT m a
finish :: forall (m :: * -> *) a. Monad m => ActionT m a
finish = ActionError -> ActionT m a
forall a e. Exception e => e -> a
E.throw ActionError
AEFinish

-- | Get the 'Request' object.
request :: Monad m => ActionT m Request
request :: forall (m :: * -> *). Monad m => ActionT m Request
request = ReaderT ActionEnv m Request -> ActionT m Request
forall (m :: * -> *) a. ReaderT ActionEnv m a -> ActionT m a
ActionT (ReaderT ActionEnv m Request -> ActionT m Request)
-> ReaderT ActionEnv m Request -> ActionT m Request
forall a b. (a -> b) -> a -> b
$ ActionEnv -> Request
envReq (ActionEnv -> Request)
-> ReaderT ActionEnv m ActionEnv -> ReaderT ActionEnv m Request
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ActionEnv m ActionEnv
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | Get list of uploaded files.
--
-- NB: Loads all file contents in memory with options 'W.defaultParseRequestBodyOptions'
files :: MonadUnliftIO m => ActionT m [File BL.ByteString]
files :: forall (m :: * -> *).
MonadUnliftIO m =>
ActionT m [File ByteString]
files = ResourceT (ActionT m) [File ByteString]
-> ActionT m [File ByteString]
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT (ActionT m) [File ByteString]
 -> ActionT m [File ByteString])
-> ResourceT (ActionT m) [File ByteString]
-> ActionT m [File ByteString]
forall a b. (a -> b) -> a -> b
$ (InternalState -> ActionT m [File ByteString])
-> ResourceT (ActionT m) [File ByteString]
forall (m :: * -> *) a. (InternalState -> m a) -> ResourceT m a
withInternalState ((InternalState -> ActionT m [File ByteString])
 -> ResourceT (ActionT m) [File ByteString])
-> (InternalState -> ActionT m [File ByteString])
-> ResourceT (ActionT m) [File ByteString]
forall a b. (a -> b) -> a -> b
$ \InternalState
istate -> do
  ([Param]
_, [File String]
fs) <- InternalState
-> ParseRequestBodyOptions -> ActionT m ([Param], [File String])
forall (m :: * -> *).
MonadUnliftIO m =>
InternalState
-> ParseRequestBodyOptions -> ActionT m ([Param], [File String])
formParamsAndFilesWith InternalState
istate ParseRequestBodyOptions
W.defaultParseRequestBodyOptions
  [File String]
-> (File String -> ActionT m (File ByteString))
-> ActionT m [File ByteString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [File String]
fs (\(Text
fname, FileInfo String
f) -> do
                   ByteString
bs <- IO ByteString -> ActionT m ByteString
forall a. IO a -> ActionT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ActionT m ByteString)
-> IO ByteString -> ActionT m ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BL.readFile (FileInfo String -> String
forall c. FileInfo c -> c
W.fileContent FileInfo String
f)
                   File ByteString -> ActionT m (File ByteString)
forall a. a -> ActionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
fname, FileInfo String
f{ W.fileContent = bs})
                   )


-- | Get list of uploaded temp files and form parameters decoded from multipart payloads.
--
-- NB the temp files are deleted when the continuation exits.
filesOpts :: MonadUnliftIO m =>
             W.ParseRequestBodyOptions
          -> ([Param] -> [File FilePath] -> ActionT m a) -- ^ temp files validation, storage etc
          -> ActionT m a
filesOpts :: forall (m :: * -> *) a.
MonadUnliftIO m =>
ParseRequestBodyOptions
-> ([Param] -> [File String] -> ActionT m a) -> ActionT m a
filesOpts ParseRequestBodyOptions
prbo [Param] -> [File String] -> ActionT m a
io = ResourceT (ActionT m) a -> ActionT m a
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT (ActionT m) a -> ActionT m a)
-> ResourceT (ActionT m) a -> ActionT m a
forall a b. (a -> b) -> a -> b
$ (InternalState -> ActionT m a) -> ResourceT (ActionT m) a
forall (m :: * -> *) a. (InternalState -> m a) -> ResourceT m a
withInternalState ((InternalState -> ActionT m a) -> ResourceT (ActionT m) a)
-> (InternalState -> ActionT m a) -> ResourceT (ActionT m) a
forall a b. (a -> b) -> a -> b
$ \InternalState
istate -> do
  ([Param]
ps, [File String]
fs) <- InternalState
-> ParseRequestBodyOptions -> ActionT m ([Param], [File String])
forall (m :: * -> *).
MonadUnliftIO m =>
InternalState
-> ParseRequestBodyOptions -> ActionT m ([Param], [File String])
formParamsAndFilesWith InternalState
istate ParseRequestBodyOptions
prbo
  [Param] -> [File String] -> ActionT m a
io [Param]
ps [File String]
fs



-- | Get a request header. Header name is case-insensitive.
header :: (Monad m) => T.Text -> ActionT m (Maybe T.Text)
header :: forall (m :: * -> *). Monad m => Text -> ActionT m (Maybe Text)
header Text
k = do
    RequestHeaders
hs <- Request -> RequestHeaders
requestHeaders (Request -> RequestHeaders)
-> ActionT m Request -> ActionT m RequestHeaders
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT m Request
forall (m :: * -> *). Monad m => ActionT m Request
request
    Maybe Text -> ActionT m (Maybe Text)
forall a. a -> ActionT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ActionT m (Maybe Text))
-> Maybe Text -> ActionT m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
decodeUtf8Lenient (Maybe ByteString -> Maybe Text) -> Maybe ByteString -> Maybe Text
forall a b. (a -> b) -> a -> b
$ CI ByteString -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (Text -> ByteString
encodeUtf8 Text
k)) RequestHeaders
hs

-- | Get all the request headers. Header names are case-insensitive.
headers :: (Monad m) => ActionT m [(T.Text, T.Text)]
headers :: forall (m :: * -> *). Monad m => ActionT m [Param]
headers = do
    RequestHeaders
hs <- Request -> RequestHeaders
requestHeaders (Request -> RequestHeaders)
-> ActionT m Request -> ActionT m RequestHeaders
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT m Request
forall (m :: * -> *). Monad m => ActionT m Request
request
    [Param] -> ActionT m [Param]
forall a. a -> ActionT m a
forall (m :: * -> *) a. Monad m => a -> m a
return [ ( ByteString -> Text
decodeUtf8Lenient (CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
k)
             , ByteString -> Text
decodeUtf8Lenient ByteString
v)
           | (CI ByteString
k,ByteString
v) <- RequestHeaders
hs ]

-- | Get the request body.
--
-- NB This loads the whole request body in memory at once.
body :: (MonadIO m) => ActionT m BL.ByteString
body :: forall (m :: * -> *). MonadIO m => ActionT m ByteString
body = ReaderT ActionEnv m ActionEnv -> ActionT m ActionEnv
forall (m :: * -> *) a. ReaderT ActionEnv m a -> ActionT m a
ActionT ReaderT ActionEnv m ActionEnv
forall r (m :: * -> *). MonadReader r m => m r
ask ActionT m ActionEnv
-> (ActionEnv -> ActionT m ByteString) -> ActionT m ByteString
forall a b. ActionT m a -> (a -> ActionT m b) -> ActionT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IO ByteString -> ActionT m ByteString
forall a. IO a -> ActionT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ActionT m ByteString)
-> (ActionEnv -> IO ByteString)
-> ActionEnv
-> ActionT m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionEnv -> IO ByteString
envBody)

-- | Get an IO action that reads body chunks
--
-- * This is incompatible with 'body' since 'body' consumes all chunks.
bodyReader :: Monad m => ActionT m (IO B.ByteString)
bodyReader :: forall (m :: * -> *). Monad m => ActionT m (IO ByteString)
bodyReader = ReaderT ActionEnv m (IO ByteString) -> ActionT m (IO ByteString)
forall (m :: * -> *) a. ReaderT ActionEnv m a -> ActionT m a
ActionT (ReaderT ActionEnv m (IO ByteString) -> ActionT m (IO ByteString))
-> ReaderT ActionEnv m (IO ByteString) -> ActionT m (IO ByteString)
forall a b. (a -> b) -> a -> b
$ ActionEnv -> IO ByteString
envBodyChunk (ActionEnv -> IO ByteString)
-> ReaderT ActionEnv m ActionEnv
-> ReaderT ActionEnv m (IO ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ActionEnv m ActionEnv
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | Parse the request body as a JSON object and return it.
--
--   If the JSON object is malformed, this sets the status to
--   400 Bad Request, and throws an exception.
--
--   If the JSON fails to parse, this sets the status to
--   422 Unprocessable Entity.
--
--   These status codes are as per https://www.restapitutorial.com/httpstatuscodes.html.
--
-- NB : Internally this uses 'body'.
jsonData :: (A.FromJSON a, MonadIO m) => ActionT m a
jsonData :: forall a (m :: * -> *). (FromJSON a, MonadIO m) => ActionT m a
jsonData = do
    ByteString
b <- ActionT m ByteString
forall (m :: * -> *). MonadIO m => ActionT m ByteString
body
    Bool -> ActionT m () -> ActionT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
b ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"") (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ ScottyException -> ActionT m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (ScottyException -> ActionT m ())
-> ScottyException -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Text -> ScottyException
MalformedJSON ByteString
b Text
"no data"
    case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode ByteString
b of
      Left String
err -> ScottyException -> ActionT m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (ScottyException -> ActionT m a) -> ScottyException -> ActionT m a
forall a b. (a -> b) -> a -> b
$ ByteString -> Text -> ScottyException
MalformedJSON ByteString
b (Text -> ScottyException) -> Text -> ScottyException
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
err
      Right Value
value -> case Value -> Result a
forall a. FromJSON a => Value -> Result a
A.fromJSON Value
value of
        A.Error String
err -> ScottyException -> ActionT m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (ScottyException -> ActionT m a) -> ScottyException -> ActionT m a
forall a b. (a -> b) -> a -> b
$ ByteString -> Text -> ScottyException
FailedToParseJSON ByteString
b (Text -> ScottyException) -> Text -> ScottyException
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
err
        A.Success a
a -> a -> ActionT m a
forall a. a -> ActionT m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Parse the request body as @x-www-form-urlencoded@ form data and return it.
--
--   The form is parsed using 'urlDecodeAsForm'. If that returns 'Left', the
--   status is set to 400 and an exception is thrown.
formData :: (FromForm a, MonadUnliftIO m) => ActionT m a
formData :: forall a (m :: * -> *).
(FromForm a, MonadUnliftIO m) =>
ActionT m a
formData = do
  Form
form <- [Param] -> Form
paramListToForm ([Param] -> Form) -> ActionT m [Param] -> ActionT m Form
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT m [Param]
forall (m :: * -> *). MonadUnliftIO m => ActionT m [Param]
formParams
  case Form -> Either Text a
forall a. FromForm a => Form -> Either Text a
fromForm Form
form of
    Left Text
err -> ScottyException -> ActionT m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (ScottyException -> ActionT m a) -> ScottyException -> ActionT m a
forall a b. (a -> b) -> a -> b
$ Text -> ScottyException
MalformedForm Text
err
    Right a
value -> a -> ActionT m a
forall a. a -> ActionT m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
value
  where
    -- This rather contrived implementation uses cons and reverse to avoid
    -- quadratic complexity when constructing a Form from a list of Param.
    -- It's equivalent to using HashMap.insertWith (++) which does have
    -- quadratic complexity due to appending at the end of list.
    paramListToForm :: [Param] -> Form
    paramListToForm :: [Param] -> Form
paramListToForm = HashMap Text [Text] -> Form
Form (HashMap Text [Text] -> Form)
-> ([Param] -> HashMap Text [Text]) -> [Param] -> Form
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> [Text]) -> HashMap Text [Text] -> HashMap Text [Text]
forall a b. (a -> b) -> HashMap Text a -> HashMap Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> [Text]
forall a. [a] -> [a]
reverse (HashMap Text [Text] -> HashMap Text [Text])
-> ([Param] -> HashMap Text [Text])
-> [Param]
-> HashMap Text [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Text [Text] -> Param -> HashMap Text [Text])
-> HashMap Text [Text] -> [Param] -> HashMap Text [Text]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\HashMap Text [Text]
f (Text
k, Text
v) -> (Maybe [Text] -> Maybe [Text])
-> Text -> HashMap Text [Text] -> HashMap Text [Text]
forall k v.
Hashable k =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HM.alter (Text -> Maybe [Text] -> Maybe [Text]
forall a. a -> Maybe [a] -> Maybe [a]
prependValue Text
v) Text
k HashMap Text [Text]
f) HashMap Text [Text]
forall k v. HashMap k v
HM.empty

    prependValue :: a -> Maybe [a] -> Maybe [a]
    prependValue :: forall a. a -> Maybe [a] -> Maybe [a]
prependValue a
v = [a] -> Maybe [a]
forall a. a -> Maybe a
Just ([a] -> Maybe [a]) -> (Maybe [a] -> [a]) -> Maybe [a] -> Maybe [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ([a] -> [a]) -> Maybe [a] -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a
v] (a
v a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)

-- | Synonym for 'pathParam'
captureParam :: (Parsable a, MonadIO m) => T.Text -> ActionT m a
captureParam :: forall a (m :: * -> *).
(Parsable a, MonadIO m) =>
Text -> ActionT m a
captureParam = Text -> ActionT m a
forall a (m :: * -> *).
(Parsable a, MonadIO m) =>
Text -> ActionT m a
pathParam

-- | Look up a path parameter.
--
-- * Raises an exception which can be caught by 'catch' if parameter is not found. If the exception is not caught, scotty will return a HTTP error code 500 ("Internal Server Error") to the client.
--
-- * If the parameter is found, but 'parseParam' fails to parse to the correct type, 'next' is called.
--
-- /Since: 0.20/
pathParam :: (Parsable a, MonadIO m) => T.Text -> ActionT m a
pathParam :: forall a (m :: * -> *).
(Parsable a, MonadIO m) =>
Text -> ActionT m a
pathParam Text
k = do
  Maybe Text
val <- ReaderT ActionEnv m (Maybe Text) -> ActionT m (Maybe Text)
forall (m :: * -> *) a. ReaderT ActionEnv m a -> ActionT m a
ActionT (ReaderT ActionEnv m (Maybe Text) -> ActionT m (Maybe Text))
-> ReaderT ActionEnv m (Maybe Text) -> ActionT m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> [Param] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k ([Param] -> Maybe Text)
-> (ActionEnv -> [Param]) -> ActionEnv -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionEnv -> [Param]
envPathParams (ActionEnv -> Maybe Text)
-> ReaderT ActionEnv m ActionEnv
-> ReaderT ActionEnv m (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ActionEnv m ActionEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
  case Maybe Text
val of
    Maybe Text
Nothing -> ScottyException -> ActionT m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (ScottyException -> ActionT m a) -> ScottyException -> ActionT m a
forall a b. (a -> b) -> a -> b
$ Text -> ScottyException
PathParameterNotFound Text
k
    Just Text
v -> case Text -> Either Text a
forall a. Parsable a => Text -> Either Text a
parseParam (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
v of
      Left Text
_ -> ActionT m a
forall (m :: * -> *) a. Monad m => ActionT m a
next
      Right a
a -> a -> ActionT m a
forall a. a -> ActionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

-- | Look up a form parameter.
--
-- * Raises an exception which can be caught by 'catch' if parameter is not found. If the exception is not caught, scotty will return a HTTP error code 400 ("Bad Request") to the client.
--
-- * This function raises a code 400 also if the parameter is found, but 'parseParam' fails to parse to the correct type.
--
-- /Since: 0.20/
formParam :: (MonadUnliftIO m, Parsable b) => T.Text -> ActionT m b
formParam :: forall (m :: * -> *) b.
(MonadUnliftIO m, Parsable b) =>
Text -> ActionT m b
formParam Text
k = ResourceT (ActionT m) b -> ActionT m b
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT (ActionT m) b -> ActionT m b)
-> ResourceT (ActionT m) b -> ActionT m b
forall a b. (a -> b) -> a -> b
$ (InternalState -> ActionT m b) -> ResourceT (ActionT m) b
forall (m :: * -> *) a. (InternalState -> m a) -> ResourceT m a
withInternalState ((InternalState -> ActionT m b) -> ResourceT (ActionT m) b)
-> (InternalState -> ActionT m b) -> ResourceT (ActionT m) b
forall a b. (a -> b) -> a -> b
$ \InternalState
istate -> do
  ([Param]
ps, [File String]
_) <- InternalState
-> ParseRequestBodyOptions -> ActionT m ([Param], [File String])
forall (m :: * -> *).
MonadUnliftIO m =>
InternalState
-> ParseRequestBodyOptions -> ActionT m ([Param], [File String])
formParamsAndFilesWith InternalState
istate ParseRequestBodyOptions
W.defaultParseRequestBodyOptions
  case Text -> [Param] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k [Param]
ps of
    Maybe Text
Nothing -> ScottyException -> ActionT m b
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (ScottyException -> ActionT m b) -> ScottyException -> ActionT m b
forall a b. (a -> b) -> a -> b
$ Text -> ScottyException
FormFieldNotFound Text
k
    Just Text
v -> case Text -> Either Text b
forall a. Parsable a => Text -> Either Text a
parseParam (Text -> Either Text b) -> Text -> Either Text b
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
v of
      Left Text
e -> ScottyException -> ActionT m b
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (ScottyException -> ActionT m b) -> ScottyException -> ActionT m b
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> ScottyException
FailedToParseParameter Text
k Text
v (Text -> Text
TL.toStrict Text
e)
      Right b
a -> b -> ActionT m b
forall a. a -> ActionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a

-- | Look up a query parameter.
--
-- * Raises an exception which can be caught by 'catch' if parameter is not found. If the exception is not caught, scotty will return a HTTP error code 400 ("Bad Request") to the client.
--
-- * This function raises a code 400 also if the parameter is found, but 'parseParam' fails to parse to the correct type.
--
-- /Since: 0.20/
queryParam :: (Parsable a, MonadIO m) => T.Text -> ActionT m a
queryParam :: forall a (m :: * -> *).
(Parsable a, MonadIO m) =>
Text -> ActionT m a
queryParam = (Text -> ScottyException)
-> (ActionEnv -> [Param]) -> Text -> ActionT m a
forall (m :: * -> *) b.
(MonadIO m, Parsable b) =>
(Text -> ScottyException)
-> (ActionEnv -> [Param]) -> Text -> ActionT m b
paramWith Text -> ScottyException
QueryParameterNotFound ActionEnv -> [Param]
envQueryParams

-- | Look up a path parameter. Returns 'Nothing' if the parameter is not found or cannot be parsed at the right type.
--
-- NB : Doesn't throw exceptions. In particular, route pattern matching will not continue, so developers
-- must 'raiseStatus' or 'throw' to signal something went wrong.
--
-- /Since: 0.21/
pathParamMaybe :: (Parsable a, Monad m) => T.Text -> ActionT m (Maybe a)
pathParamMaybe :: forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m (Maybe a)
pathParamMaybe = (ActionEnv -> [Param]) -> Text -> ActionT m (Maybe a)
forall (m :: * -> *) b.
(Monad m, Parsable b) =>
(ActionEnv -> [Param]) -> Text -> ActionT m (Maybe b)
paramWithMaybe ActionEnv -> [Param]
envPathParams

-- | Look up a capture parameter. Returns 'Nothing' if the parameter is not found or cannot be parsed at the right type.
--
-- NB : Doesn't throw exceptions. In particular, route pattern matching will not continue, so developers
-- must 'raiseStatus' or 'throw' to signal something went wrong.
--
-- /Since: 0.21/
captureParamMaybe :: (Parsable a, Monad m) => T.Text -> ActionT m (Maybe a)
captureParamMaybe :: forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m (Maybe a)
captureParamMaybe = (ActionEnv -> [Param]) -> Text -> ActionT m (Maybe a)
forall (m :: * -> *) b.
(Monad m, Parsable b) =>
(ActionEnv -> [Param]) -> Text -> ActionT m (Maybe b)
paramWithMaybe ActionEnv -> [Param]
envPathParams

-- | Look up a form parameter. Returns 'Nothing' if the parameter is not found or cannot be parsed at the right type.
--
-- NB : Doesn't throw exceptions, so developers must 'raiseStatus' or 'throw' to signal something went wrong.
--
-- /Since: 0.21/
formParamMaybe :: (MonadUnliftIO m, Parsable a) =>
                  T.Text -> ActionT m (Maybe a)
formParamMaybe :: forall (m :: * -> *) a.
(MonadUnliftIO m, Parsable a) =>
Text -> ActionT m (Maybe a)
formParamMaybe Text
k = ResourceT (ActionT m) (Maybe a) -> ActionT m (Maybe a)
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT (ActionT m) (Maybe a) -> ActionT m (Maybe a))
-> ResourceT (ActionT m) (Maybe a) -> ActionT m (Maybe a)
forall a b. (a -> b) -> a -> b
$ (InternalState -> ActionT m (Maybe a))
-> ResourceT (ActionT m) (Maybe a)
forall (m :: * -> *) a. (InternalState -> m a) -> ResourceT m a
withInternalState ((InternalState -> ActionT m (Maybe a))
 -> ResourceT (ActionT m) (Maybe a))
-> (InternalState -> ActionT m (Maybe a))
-> ResourceT (ActionT m) (Maybe a)
forall a b. (a -> b) -> a -> b
$ \InternalState
istate -> do
  ([Param]
ps, [File String]
_) <- InternalState
-> ParseRequestBodyOptions -> ActionT m ([Param], [File String])
forall (m :: * -> *).
MonadUnliftIO m =>
InternalState
-> ParseRequestBodyOptions -> ActionT m ([Param], [File String])
formParamsAndFilesWith InternalState
istate ParseRequestBodyOptions
W.defaultParseRequestBodyOptions
  case Text -> [Param] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k [Param]
ps of
    Maybe Text
Nothing -> Maybe a -> ActionT m (Maybe a)
forall a. a -> ActionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Just Text
v -> (Text -> ActionT m (Maybe a))
-> (a -> ActionT m (Maybe a))
-> Either Text a
-> ActionT m (Maybe a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ActionT m (Maybe a) -> Text -> ActionT m (Maybe a)
forall a b. a -> b -> a
const (ActionT m (Maybe a) -> Text -> ActionT m (Maybe a))
-> ActionT m (Maybe a) -> Text -> ActionT m (Maybe a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> ActionT m (Maybe a)
forall a. a -> ActionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing) (Maybe a -> ActionT m (Maybe a)
forall a. a -> ActionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> ActionT m (Maybe a))
-> (a -> Maybe a) -> a -> ActionT m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just) (Either Text a -> ActionT m (Maybe a))
-> Either Text a -> ActionT m (Maybe a)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text a
forall a. Parsable a => Text -> Either Text a
parseParam (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
v


-- | Look up a query parameter. Returns 'Nothing' if the parameter is not found or cannot be parsed at the right type.
--
-- NB : Doesn't throw exceptions, so developers must 'raiseStatus' or 'throw' to signal something went wrong.
--
-- /Since: 0.21/
queryParamMaybe :: (Parsable a, Monad m) => T.Text -> ActionT m (Maybe a)
queryParamMaybe :: forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m (Maybe a)
queryParamMaybe = (ActionEnv -> [Param]) -> Text -> ActionT m (Maybe a)
forall (m :: * -> *) b.
(Monad m, Parsable b) =>
(ActionEnv -> [Param]) -> Text -> ActionT m (Maybe b)
paramWithMaybe ActionEnv -> [Param]
envQueryParams

data ParamType = PathParam
               | FormParam
               | QueryParam
instance Show ParamType where
  show :: ParamType -> String
show = \case
    ParamType
PathParam -> String
"path"
    ParamType
FormParam -> String
"form"
    ParamType
QueryParam -> String
"query"

paramWith :: (MonadIO m, Parsable b) =>
             (T.Text -> ScottyException)
          -> (ActionEnv -> [Param])
          -> T.Text -- ^ parameter name
          -> ActionT m b
paramWith :: forall (m :: * -> *) b.
(MonadIO m, Parsable b) =>
(Text -> ScottyException)
-> (ActionEnv -> [Param]) -> Text -> ActionT m b
paramWith Text -> ScottyException
toError ActionEnv -> [Param]
f Text
k = do
    Maybe Text
val <- ReaderT ActionEnv m (Maybe Text) -> ActionT m (Maybe Text)
forall (m :: * -> *) a. ReaderT ActionEnv m a -> ActionT m a
ActionT (ReaderT ActionEnv m (Maybe Text) -> ActionT m (Maybe Text))
-> ReaderT ActionEnv m (Maybe Text) -> ActionT m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ (Text -> [Param] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k ([Param] -> Maybe Text)
-> (ActionEnv -> [Param]) -> ActionEnv -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionEnv -> [Param]
f) (ActionEnv -> Maybe Text)
-> ReaderT ActionEnv m ActionEnv
-> ReaderT ActionEnv m (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ActionEnv m ActionEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
    case Maybe Text
val of
      Maybe Text
Nothing -> ScottyException -> ActionT m b
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (ScottyException -> ActionT m b) -> ScottyException -> ActionT m b
forall a b. (a -> b) -> a -> b
$ Text -> ScottyException
toError Text
k
      Just Text
v -> case Text -> Either Text b
forall a. Parsable a => Text -> Either Text a
parseParam (Text -> Either Text b) -> Text -> Either Text b
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
v of
        Left Text
e -> ScottyException -> ActionT m b
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (ScottyException -> ActionT m b) -> ScottyException -> ActionT m b
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> ScottyException
FailedToParseParameter Text
k Text
v (Text -> Text
TL.toStrict Text
e)
        Right b
a -> b -> ActionT m b
forall a. a -> ActionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a

-- | Look up a parameter. Returns 'Nothing' if the parameter is not found or cannot be parsed at the right type.
--
-- NB : Doesn't throw exceptions.
--
-- /Since: 0.21/
paramWithMaybe :: (Monad m, Parsable b) =>
                  (ActionEnv -> [Param])
               -> T.Text -- ^ parameter name
               -> ActionT m (Maybe b)
paramWithMaybe :: forall (m :: * -> *) b.
(Monad m, Parsable b) =>
(ActionEnv -> [Param]) -> Text -> ActionT m (Maybe b)
paramWithMaybe ActionEnv -> [Param]
f Text
k = do
    Maybe Text
val <- ReaderT ActionEnv m (Maybe Text) -> ActionT m (Maybe Text)
forall (m :: * -> *) a. ReaderT ActionEnv m a -> ActionT m a
ActionT (ReaderT ActionEnv m (Maybe Text) -> ActionT m (Maybe Text))
-> ReaderT ActionEnv m (Maybe Text) -> ActionT m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ (ActionEnv -> Maybe Text) -> ReaderT ActionEnv m (Maybe Text)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Text -> [Param] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k ([Param] -> Maybe Text)
-> (ActionEnv -> [Param]) -> ActionEnv -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionEnv -> [Param]
f)
    case Maybe Text
val of
      Maybe Text
Nothing -> Maybe b -> ActionT m (Maybe b)
forall a. a -> ActionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
      Just Text
v -> (Text -> ActionT m (Maybe b))
-> (b -> ActionT m (Maybe b))
-> Either Text b
-> ActionT m (Maybe b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ActionT m (Maybe b) -> Text -> ActionT m (Maybe b)
forall a b. a -> b -> a
const (ActionT m (Maybe b) -> Text -> ActionT m (Maybe b))
-> ActionT m (Maybe b) -> Text -> ActionT m (Maybe b)
forall a b. (a -> b) -> a -> b
$ Maybe b -> ActionT m (Maybe b)
forall a. a -> ActionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing) (Maybe b -> ActionT m (Maybe b)
forall a. a -> ActionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe b -> ActionT m (Maybe b))
-> (b -> Maybe b) -> b -> ActionT m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe b
forall a. a -> Maybe a
Just) (Either Text b -> ActionT m (Maybe b))
-> Either Text b -> ActionT m (Maybe b)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text b
forall a. Parsable a => Text -> Either Text a
parseParam (Text -> Either Text b) -> Text -> Either Text b
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
v

-- | Get path parameters
pathParams :: Monad m => ActionT m [Param]
pathParams :: forall (m :: * -> *). Monad m => ActionT m [Param]
pathParams = (ActionEnv -> [Param]) -> ActionT m [Param]
forall (m :: * -> *) a. Monad m => (ActionEnv -> a) -> ActionT m a
paramsWith ActionEnv -> [Param]
envPathParams

-- | Get path parameters
captureParams :: Monad m => ActionT m [Param]
captureParams :: forall (m :: * -> *). Monad m => ActionT m [Param]
captureParams = (ActionEnv -> [Param]) -> ActionT m [Param]
forall (m :: * -> *) a. Monad m => (ActionEnv -> a) -> ActionT m a
paramsWith ActionEnv -> [Param]
envPathParams

-- | Get form parameters
formParams :: MonadUnliftIO m => ActionT m [Param]
formParams :: forall (m :: * -> *). MonadUnliftIO m => ActionT m [Param]
formParams = ResourceT (ActionT m) [Param] -> ActionT m [Param]
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT (ActionT m) [Param] -> ActionT m [Param])
-> ResourceT (ActionT m) [Param] -> ActionT m [Param]
forall a b. (a -> b) -> a -> b
$ (InternalState -> ActionT m [Param])
-> ResourceT (ActionT m) [Param]
forall (m :: * -> *) a. (InternalState -> m a) -> ResourceT m a
withInternalState ((InternalState -> ActionT m [Param])
 -> ResourceT (ActionT m) [Param])
-> (InternalState -> ActionT m [Param])
-> ResourceT (ActionT m) [Param]
forall a b. (a -> b) -> a -> b
$ \InternalState
istate -> do
  ([Param], [File String]) -> [Param]
forall a b. (a, b) -> a
fst (([Param], [File String]) -> [Param])
-> ActionT m ([Param], [File String]) -> ActionT m [Param]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InternalState
-> ParseRequestBodyOptions -> ActionT m ([Param], [File String])
forall (m :: * -> *).
MonadUnliftIO m =>
InternalState
-> ParseRequestBodyOptions -> ActionT m ([Param], [File String])
formParamsAndFilesWith InternalState
istate ParseRequestBodyOptions
W.defaultParseRequestBodyOptions

-- | Get query parameters
queryParams :: Monad m => ActionT m [Param]
queryParams :: forall (m :: * -> *). Monad m => ActionT m [Param]
queryParams = (ActionEnv -> [Param]) -> ActionT m [Param]
forall (m :: * -> *) a. Monad m => (ActionEnv -> a) -> ActionT m a
paramsWith ActionEnv -> [Param]
envQueryParams

paramsWith :: Monad m => (ActionEnv -> a) -> ActionT m a
paramsWith :: forall (m :: * -> *) a. Monad m => (ActionEnv -> a) -> ActionT m a
paramsWith ActionEnv -> a
f = ReaderT ActionEnv m a -> ActionT m a
forall (m :: * -> *) a. ReaderT ActionEnv m a -> ActionT m a
ActionT ((ActionEnv -> a) -> ReaderT ActionEnv m a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ActionEnv -> a
f)

-- === access the fields of the Response being constructed

-- | Access the HTTP 'Status' of the Response
--
-- /SINCE 0.21/
getResponseStatus :: (MonadIO m) => ActionT m Status
getResponseStatus :: forall (m :: * -> *). MonadIO m => ActionT m Status
getResponseStatus = ScottyResponse -> Status
srStatus (ScottyResponse -> Status)
-> ActionT m ScottyResponse -> ActionT m Status
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT m ScottyResponse
forall (m :: * -> *). MonadIO m => ActionT m ScottyResponse
getResponseAction
-- | Access the HTTP headers of the Response
--
-- /SINCE 0.21/
getResponseHeaders :: (MonadIO m) => ActionT m ResponseHeaders
getResponseHeaders :: forall (m :: * -> *). MonadIO m => ActionT m RequestHeaders
getResponseHeaders = ScottyResponse -> RequestHeaders
srHeaders (ScottyResponse -> RequestHeaders)
-> ActionT m ScottyResponse -> ActionT m RequestHeaders
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT m ScottyResponse
forall (m :: * -> *). MonadIO m => ActionT m ScottyResponse
getResponseAction
-- | Access the content of the Response
--
-- /SINCE 0.21/
getResponseContent :: (MonadIO m) => ActionT m Content
getResponseContent :: forall (m :: * -> *). MonadIO m => ActionT m Content
getResponseContent = ScottyResponse -> Content
srContent (ScottyResponse -> Content)
-> ActionT m ScottyResponse -> ActionT m Content
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT m ScottyResponse
forall (m :: * -> *). MonadIO m => ActionT m ScottyResponse
getResponseAction


-- | Minimum implemention: 'parseParam'
class Parsable a where
    -- | Take a 'T.Text' value and parse it as 'a', or fail with a message.
    parseParam :: TL.Text -> Either TL.Text a

    -- | Default implementation parses comma-delimited lists.
    --
    -- > parseParamList t = mapM parseParam (T.split (== ',') t)
    parseParamList :: TL.Text -> Either TL.Text [a]
    parseParamList Text
t = (Text -> Either Text a) -> [Text] -> Either Text [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Text -> Either Text a
forall a. Parsable a => Text -> Either Text a
parseParam ((Char -> Bool) -> Text -> [Text]
TL.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') Text
t)

-- No point using 'read' for Text, ByteString, Char, and String.
instance Parsable T.Text where parseParam :: Text -> Either Text Text
parseParam = Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text)
-> (Text -> Text) -> Text -> Either Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict
instance Parsable TL.Text where parseParam :: Text -> Either Text Text
parseParam = Text -> Either Text Text
forall a b. b -> Either a b
Right
instance Parsable B.ByteString where parseParam :: Text -> Either Text ByteString
parseParam = ByteString -> Either Text ByteString
forall a b. b -> Either a b
Right (ByteString -> Either Text ByteString)
-> (Text -> ByteString) -> Text -> Either Text ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
lazyTextToStrictByteString
instance Parsable BL.ByteString where parseParam :: Text -> Either Text ByteString
parseParam = ByteString -> Either Text ByteString
forall a b. b -> Either a b
Right (ByteString -> Either Text ByteString)
-> (Text -> ByteString) -> Text -> Either Text ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TLE.encodeUtf8
-- | Overrides default 'parseParamList' to parse String.
instance Parsable Char where
    parseParam :: Text -> Either Text Char
parseParam Text
t = case Text -> String
TL.unpack Text
t of
                    [Char
c] -> Char -> Either Text Char
forall a b. b -> Either a b
Right Char
c
                    String
_   -> Text -> Either Text Char
forall a b. a -> Either a b
Left Text
"parseParam Char: no parse"
    parseParamList :: Text -> Either Text String
parseParamList = String -> Either Text String
forall a b. b -> Either a b
Right (String -> Either Text String)
-> (Text -> String) -> Text -> Either Text String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TL.unpack -- String
-- | Checks if parameter is present and is null-valued, not a literal '()'.
-- If the URI requested is: '/foo?bar=()&baz' then 'baz' will parse as (), where 'bar' will not.
instance Parsable () where
    parseParam :: Text -> Either Text ()
parseParam Text
t = if Text -> Bool
TL.null Text
t then () -> Either Text ()
forall a b. b -> Either a b
Right () else Text -> Either Text ()
forall a b. a -> Either a b
Left Text
"parseParam Unit: no parse"

instance (Parsable a) => Parsable [a] where parseParam :: Text -> Either Text [a]
parseParam = Text -> Either Text [a]
forall a. Parsable a => Text -> Either Text [a]
parseParamList

instance Parsable Bool where
    parseParam :: Text -> Either Text Bool
parseParam Text
t = if Text
t' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
TL.toCaseFold Text
"true" Bool -> Bool -> Bool
|| Text
t' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
TL.toCaseFold Text
"on"
                   then Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
True
                   else if Text
t' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
TL.toCaseFold Text
"false"
                        then Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
False
                        else Text -> Either Text Bool
forall a b. a -> Either a b
Left Text
"parseParam Bool: no parse"
        where t' :: Text
t' = Text -> Text
TL.toCaseFold Text
t

instance Parsable Double where parseParam :: Text -> Either Text Double
parseParam = Text -> Either Text Double
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Float where parseParam :: Text -> Either Text Float
parseParam = Text -> Either Text Float
forall a. Read a => Text -> Either Text a
readEither

instance Parsable Int where parseParam :: Text -> Either Text Int
parseParam = Text -> Either Text Int
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Int8 where parseParam :: Text -> Either Text Int8
parseParam = Text -> Either Text Int8
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Int16 where parseParam :: Text -> Either Text Int16
parseParam = Text -> Either Text Int16
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Int32 where parseParam :: Text -> Either Text Int32
parseParam = Text -> Either Text Int32
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Int64 where parseParam :: Text -> Either Text Int64
parseParam = Text -> Either Text Int64
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Integer where parseParam :: Text -> Either Text Integer
parseParam = Text -> Either Text Integer
forall a. Read a => Text -> Either Text a
readEither

instance Parsable Word where parseParam :: Text -> Either Text Word
parseParam = Text -> Either Text Word
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Word8 where parseParam :: Text -> Either Text Word8
parseParam = Text -> Either Text Word8
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Word16 where parseParam :: Text -> Either Text Word16
parseParam = Text -> Either Text Word16
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Word32 where parseParam :: Text -> Either Text Word32
parseParam = Text -> Either Text Word32
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Word64 where parseParam :: Text -> Either Text Word64
parseParam = Text -> Either Text Word64
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Natural where parseParam :: Text -> Either Text Natural
parseParam = Text -> Either Text Natural
forall a. Read a => Text -> Either Text a
readEither

-- | parse a UTCTime timestamp formatted as a ISO 8601 timestamp:
--
-- @yyyy-mm-ddThh:mm:ssZ@ , where the seconds can have a decimal part with up to 12 digits and no trailing zeros.
instance Parsable UTCTime where
    parseParam :: Text -> Either Text UTCTime
parseParam Text
t =
      let
        fmt :: String
fmt = String
"%FT%T%QZ"
      in
        case Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
fmt (Text -> String
TL.unpack Text
t) of
            Just UTCTime
d -> UTCTime -> Either Text UTCTime
forall a b. b -> Either a b
Right UTCTime
d
            Maybe UTCTime
_      -> Text -> Either Text UTCTime
forall a b. a -> Either a b
Left (Text -> Either Text UTCTime) -> Text -> Either Text UTCTime
forall a b. (a -> b) -> a -> b
$ Text
"parseParam UTCTime: no parse of \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""

-- | Useful for creating 'Parsable' instances for things that already implement 'Read'. Ex:
--
-- > instance Parsable Int where parseParam = readEither
readEither :: Read a => TL.Text -> Either TL.Text a
readEither :: forall a. Read a => Text -> Either Text a
readEither Text
t = case [ a
x | (a
x,String
"") <- ReadS a
forall a. Read a => ReadS a
reads (Text -> String
TL.unpack Text
t) ] of
                [a
x] -> a -> Either Text a
forall a b. b -> Either a b
Right a
x
                []  -> Text -> Either Text a
forall a b. a -> Either a b
Left Text
"readEither: no parse"
                [a]
_   -> Text -> Either Text a
forall a b. a -> Either a b
Left Text
"readEither: ambiguous parse"

-- | Set the HTTP response status.
status :: MonadIO m => Status -> ActionT m ()
status :: forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status = (ScottyResponse -> ScottyResponse) -> ActionT m ()
forall (m :: * -> *).
MonadIO m =>
(ScottyResponse -> ScottyResponse) -> ActionT m ()
modifyResponse ((ScottyResponse -> ScottyResponse) -> ActionT m ())
-> (Status -> ScottyResponse -> ScottyResponse)
-> Status
-> ActionT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> ScottyResponse -> ScottyResponse
setStatus

-- Not exported, but useful in the functions below.
changeHeader :: MonadIO m
             => (CI.CI B.ByteString -> B.ByteString -> [(HeaderName, B.ByteString)] -> [(HeaderName, B.ByteString)])
             -> T.Text -> T.Text -> ActionT m ()
changeHeader :: forall (m :: * -> *).
MonadIO m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT m ()
changeHeader CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders
f Text
k =
  (ScottyResponse -> ScottyResponse) -> ActionT m ()
forall (m :: * -> *).
MonadIO m =>
(ScottyResponse -> ScottyResponse) -> ActionT m ()
modifyResponse ((ScottyResponse -> ScottyResponse) -> ActionT m ())
-> (Text -> ScottyResponse -> ScottyResponse)
-> Text
-> ActionT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RequestHeaders -> RequestHeaders)
-> ScottyResponse -> ScottyResponse
setHeaderWith ((RequestHeaders -> RequestHeaders)
 -> ScottyResponse -> ScottyResponse)
-> (Text -> RequestHeaders -> RequestHeaders)
-> Text
-> ScottyResponse
-> ScottyResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders
f (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (ByteString -> CI ByteString) -> ByteString -> CI ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
k) (ByteString -> RequestHeaders -> RequestHeaders)
-> (Text -> ByteString) -> Text -> RequestHeaders -> RequestHeaders
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

-- | Add to the response headers. Header names are case-insensitive.
addHeader :: MonadIO m => T.Text -> T.Text -> ActionT m ()
addHeader :: forall (m :: * -> *). MonadIO m => Text -> Text -> ActionT m ()
addHeader = (CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT m ()
forall (m :: * -> *).
MonadIO m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT m ()
changeHeader CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders
forall a b. a -> b -> [(a, b)] -> [(a, b)]
add

-- | Set one of the response headers. Will override any previously set value for that header.
-- Header names are case-insensitive.
setHeader :: MonadIO m => T.Text -> T.Text -> ActionT m ()
setHeader :: forall (m :: * -> *). MonadIO m => Text -> Text -> ActionT m ()
setHeader = (CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT m ()
forall (m :: * -> *).
MonadIO m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT m ()
changeHeader CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders
forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
replace

-- | Set the body of the response to the given 'T.Text' value. Also sets \"Content-Type\"
-- header to \"text/plain; charset=utf-8\" if it has not already been set.
text :: (MonadIO m) => T.Text -> ActionT m ()
text :: forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
text Text
t = do
    (CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT m ()
forall (m :: * -> *).
MonadIO m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT m ()
changeHeader CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders
forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
addIfNotPresent Text
"Content-Type" Text
"text/plain; charset=utf-8"
    ByteString -> ActionT m ()
forall (m :: * -> *). MonadIO m => ByteString -> ActionT m ()
raw (ByteString -> ActionT m ()) -> ByteString -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
t

-- | Set the body of the response to the given 'T.Text' value. Also sets \"Content-Type\"
-- header to \"text/plain; charset=utf-8\" if it has not already been set.
textLazy :: (MonadIO m) => TL.Text -> ActionT m ()
textLazy :: forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
textLazy Text
t = do
    (CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT m ()
forall (m :: * -> *).
MonadIO m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT m ()
changeHeader CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders
forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
addIfNotPresent Text
"Content-Type" Text
"text/plain; charset=utf-8"
    ByteString -> ActionT m ()
forall (m :: * -> *). MonadIO m => ByteString -> ActionT m ()
raw (ByteString -> ActionT m ()) -> ByteString -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TLE.encodeUtf8 Text
t

-- | Set the body of the response to the given 'T.Text' value. Also sets \"Content-Type\"
-- header to \"text/html; charset=utf-8\" if it has not already been set.
html :: (MonadIO m) => T.Text -> ActionT m ()
html :: forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
html Text
t = do
    (CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT m ()
forall (m :: * -> *).
MonadIO m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT m ()
changeHeader CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders
forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
addIfNotPresent Text
"Content-Type" Text
"text/html; charset=utf-8"
    ByteString -> ActionT m ()
forall (m :: * -> *). MonadIO m => ByteString -> ActionT m ()
raw (ByteString -> ActionT m ()) -> ByteString -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
t

-- | Set the body of the response to the given 'T.Text' value. Also sets \"Content-Type\"
-- header to \"text/html; charset=utf-8\" if it has not already been set.
htmlLazy :: (MonadIO m) => TL.Text -> ActionT m ()
htmlLazy :: forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
htmlLazy Text
t = do
    (CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT m ()
forall (m :: * -> *).
MonadIO m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT m ()
changeHeader CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders
forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
addIfNotPresent Text
"Content-Type" Text
"text/html; charset=utf-8"
    ByteString -> ActionT m ()
forall (m :: * -> *). MonadIO m => ByteString -> ActionT m ()
raw (ByteString -> ActionT m ()) -> ByteString -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TLE.encodeUtf8 Text
t

-- | Send a file as the response. Doesn't set the \"Content-Type\" header, so you probably
-- want to do that on your own with 'setHeader'. Setting a status code will have no effect
-- because Warp will overwrite that to 200 (see 'Network.Wai.Handler.Warp.Internal.sendResponse').
file :: MonadIO m => FilePath -> ActionT m ()
file :: forall (m :: * -> *). MonadIO m => String -> ActionT m ()
file = (ScottyResponse -> ScottyResponse) -> ActionT m ()
forall (m :: * -> *).
MonadIO m =>
(ScottyResponse -> ScottyResponse) -> ActionT m ()
modifyResponse ((ScottyResponse -> ScottyResponse) -> ActionT m ())
-> (String -> ScottyResponse -> ScottyResponse)
-> String
-> ActionT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> ScottyResponse -> ScottyResponse
setContent (Content -> ScottyResponse -> ScottyResponse)
-> (String -> Content)
-> String
-> ScottyResponse
-> ScottyResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Content
ContentFile

rawResponse :: MonadIO m => Response -> ActionT m ()
rawResponse :: forall (m :: * -> *). MonadIO m => Response -> ActionT m ()
rawResponse = (ScottyResponse -> ScottyResponse) -> ActionT m ()
forall (m :: * -> *).
MonadIO m =>
(ScottyResponse -> ScottyResponse) -> ActionT m ()
modifyResponse ((ScottyResponse -> ScottyResponse) -> ActionT m ())
-> (Response -> ScottyResponse -> ScottyResponse)
-> Response
-> ActionT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> ScottyResponse -> ScottyResponse
setContent (Content -> ScottyResponse -> ScottyResponse)
-> (Response -> Content)
-> Response
-> ScottyResponse
-> ScottyResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response -> Content
ContentResponse

-- | Set the body of the response to the JSON encoding of the given value. Also sets \"Content-Type\"
-- header to \"application/json; charset=utf-8\" if it has not already been set.
json :: (A.ToJSON a, MonadIO m) => a -> ActionT m ()
json :: forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json a
v = do
    (CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT m ()
forall (m :: * -> *).
MonadIO m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT m ()
changeHeader CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders
forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
addIfNotPresent Text
"Content-Type" Text
"application/json; charset=utf-8"
    ByteString -> ActionT m ()
forall (m :: * -> *). MonadIO m => ByteString -> ActionT m ()
raw (ByteString -> ActionT m ()) -> ByteString -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode a
v

-- | Set the body of the response to a Source. Doesn't set the
-- \"Content-Type\" header, so you probably want to do that on your
-- own with 'setHeader'.
stream :: MonadIO m => StreamingBody -> ActionT m ()
stream :: forall (m :: * -> *). MonadIO m => StreamingBody -> ActionT m ()
stream = (ScottyResponse -> ScottyResponse) -> ActionT m ()
forall (m :: * -> *).
MonadIO m =>
(ScottyResponse -> ScottyResponse) -> ActionT m ()
modifyResponse ((ScottyResponse -> ScottyResponse) -> ActionT m ())
-> (StreamingBody -> ScottyResponse -> ScottyResponse)
-> StreamingBody
-> ActionT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> ScottyResponse -> ScottyResponse
setContent (Content -> ScottyResponse -> ScottyResponse)
-> (StreamingBody -> Content)
-> StreamingBody
-> ScottyResponse
-> ScottyResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamingBody -> Content
ContentStream

-- | Set the body of the response to the given 'BL.ByteString' value. Doesn't set the
-- \"Content-Type\" header, so you probably want to do that on your
-- own with 'setHeader'.
raw :: MonadIO m => BL.ByteString -> ActionT m ()
raw :: forall (m :: * -> *). MonadIO m => ByteString -> ActionT m ()
raw = (ScottyResponse -> ScottyResponse) -> ActionT m ()
forall (m :: * -> *).
MonadIO m =>
(ScottyResponse -> ScottyResponse) -> ActionT m ()
modifyResponse ((ScottyResponse -> ScottyResponse) -> ActionT m ())
-> (ByteString -> ScottyResponse -> ScottyResponse)
-> ByteString
-> ActionT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> ScottyResponse -> ScottyResponse
setContent (Content -> ScottyResponse -> ScottyResponse)
-> (ByteString -> Content)
-> ByteString
-> ScottyResponse
-> ScottyResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Content
ContentBuilder (Builder -> Content)
-> (ByteString -> Builder) -> ByteString -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
fromLazyByteString

-- | Nest a whole WAI application inside a Scotty handler.
-- See Web.Scotty for further documentation
nested :: (MonadIO m) => Network.Wai.Application -> ActionT m ()
nested :: forall (m :: * -> *). MonadIO m => Application -> ActionT m ()
nested Application
app = do
  -- Is MVar really the best choice here? Not sure.
  Request
r <- ActionT m Request
forall (m :: * -> *). Monad m => ActionT m Request
request
  MVar Response
ref <- IO (MVar Response) -> ActionT m (MVar Response)
forall a. IO a -> ActionT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar Response) -> ActionT m (MVar Response))
-> IO (MVar Response) -> ActionT m (MVar Response)
forall a b. (a -> b) -> a -> b
$ IO (MVar Response)
forall a. IO (MVar a)
newEmptyMVar
  ResponseReceived
_ <- IO ResponseReceived -> ActionT m ResponseReceived
forall a. IO a -> ActionT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ResponseReceived -> ActionT m ResponseReceived)
-> IO ResponseReceived -> ActionT m ResponseReceived
forall a b. (a -> b) -> a -> b
$ Application
app Request
r (\Response
res -> MVar Response -> Response -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Response
ref Response
res IO () -> IO ResponseReceived -> IO ResponseReceived
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ResponseReceived -> IO ResponseReceived
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseReceived
ResponseReceived)
  Response
res <- IO Response -> ActionT m Response
forall a. IO a -> ActionT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Response -> ActionT m Response)
-> IO Response -> ActionT m Response
forall a b. (a -> b) -> a -> b
$ MVar Response -> IO Response
forall a. MVar a -> IO a
readMVar MVar Response
ref
  Response -> ActionT m ()
forall (m :: * -> *). MonadIO m => Response -> ActionT m ()
rawResponse Response
res