{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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
    , liftAndCatchIO
    , json
    , jsonData
    , next
    , param
    , pathParam
    , captureParam
    , formParam
    , queryParam
    , pathParamMaybe
    , captureParamMaybe
    , formParamMaybe
    , queryParamMaybe
    , params
    , pathParams
    , captureParams
    , formParams
    , queryParams
    , raise
    , raiseStatus
    , throw
    , raw
    , nested
    , readEither
    , redirect
    , request
    , rescue
    , 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(..))
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           Data.Int
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.Scotty.Internal.Types
import           Web.Scotty.Util (mkResponse, addIfNotPresent, add, replace, lazyTextToStrictByteString, decodeUtf8Lenient)
import           UnliftIO.Exception (Handler(..), catch, 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
    , [ErrorHandler m
forall (m :: * -> *). MonadIO m => ErrorHandler m
statusErrorHandler, ErrorHandler m
forall (m :: * -> *). MonadIO m => ErrorHandler m
scottyExceptionHandler, 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

-- | Catches 'StatusError' and produces an appropriate HTTP response.
statusErrorHandler :: MonadIO m => ErrorHandler m
statusErrorHandler :: forall (m :: * -> *). MonadIO m => ErrorHandler m
statusErrorHandler = (StatusError -> ActionT m ()) -> Handler (ActionT m) ()
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((StatusError -> ActionT m ()) -> Handler (ActionT m) ())
-> (StatusError -> ActionT m ()) -> Handler (ActionT m) ()
forall a b. (a -> b) -> a -> b
$ \case
  StatusError Status
s Text
e -> do
    Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
s
    let code :: Text
code = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Status -> Int
statusCode Status
s
    let msg :: Text
msg = ByteString -> Text
decodeUtf8Lenient (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Status -> ByteString
statusMessage Status
s
    Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
html (Text -> ActionT m ()) -> Text -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"<h1>", Text
code, Text
" ", Text
msg, Text
"</h1>", Text
e]

-- | 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 Text
url -> do
    Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status302
    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 => ErrorHandler m
scottyExceptionHandler :: forall (m :: * -> *). MonadIO m => ErrorHandler m
scottyExceptionHandler = (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
    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
    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
    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)
      ]
  PathParameterNotFound Text
k -> do
    Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status500
    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
    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
    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"]
  FailedToParseParameter Text
k Text
v Text
e -> do
    Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status400
    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
    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
      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
    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
    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} =
  (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


-- | Throw a "500 Server Error" 'StatusError', which can be caught with 'catch'.
--
-- Uncaught exceptions turn into HTTP 500 responses.
raise :: (MonadIO m) =>
         T.Text -- ^ Error text
      -> ActionT m a
raise :: forall (m :: * -> *) a. MonadIO m => Text -> ActionT m a
raise  = Status -> Text -> ActionT m a
forall (m :: * -> *) a. Monad m => Status -> Text -> ActionT m a
raiseStatus Status
status500
{-# DEPRECATED raise "Throw an exception instead" #-}

-- | Throw a 'StatusError' exception that has an associated HTTP error code and can be caught with 'catch'.
--
-- Uncaught exceptions turn into HTTP responses corresponding to the given status.
raiseStatus :: Monad m => Status -> T.Text -> ActionT m a
raiseStatus :: forall (m :: * -> *) a. Monad m => Status -> Text -> ActionT m a
raiseStatus Status
s = StatusError -> ActionT m a
forall a e. Exception e => e -> a
E.throw (StatusError -> ActionT m a)
-> (Text -> StatusError) -> Text -> ActionT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Text -> StatusError
StatusError Status
s
{-# DEPRECATED raiseStatus "Use status, text, and finish instead" #-}

-- | 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

-- | Catch an exception e.g. a 'StatusError' or a user-defined exception.
--
-- > raise JustKidding `catch` (\msg -> text msg)
rescue :: (MonadUnliftIO m, E.Exception e) => ActionT m a -> (e -> ActionT m a) -> ActionT m a
rescue :: forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
ActionT m a -> (e -> ActionT m a) -> ActionT m a
rescue = ActionT m a -> (e -> ActionT m a) -> ActionT m a
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
{-# DEPRECATED rescue "Use catch instead" #-}

-- | Catch any synchronous IO exceptions
liftAndCatchIO :: MonadIO m => IO a -> ActionT m a
liftAndCatchIO :: forall (m :: * -> *) a. MonadIO m => IO a -> ActionT m a
liftAndCatchIO = IO a -> ActionT m a
forall a. IO a -> ActionT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
{-# DEPRECATED liftAndCatchIO "Use liftIO instead" #-}

-- | Redirect to given URL. Like throwing an uncatchable exception. Any code after the call to redirect
-- will not be run.
--
-- > 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 = 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
. Text -> ActionError
AERedirect

-- | 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

-- | Get a parameter. First looks in captures, then form data, then query parameters.
--
-- * Raises an exception which can be caught by 'catch' if parameter is not found.
--
-- * If parameter is found, but 'parseParam' fails to parse to the correct type, 'next' is called.
--   This means captures are somewhat typed, in that a route won't match if a correctly typed
--   capture cannot be parsed.
param :: (Parsable a, MonadIO m) => T.Text -> ActionT m a
param :: forall a (m :: * -> *).
(Parsable a, MonadIO m) =>
Text -> ActionT m a
param 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]
getParams) (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 -> Status -> Text -> ActionT m a
forall (m :: * -> *) a. Monad m => Status -> Text -> ActionT m a
raiseStatus Status
status500 (Text -> ActionT m a) -> Text -> ActionT m a
forall a b. (a -> b) -> a -> b
$ Text
"Param: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" not found!"
        Just Text
v  -> (Text -> ActionT m a)
-> (a -> ActionT m a) -> Either Text a -> ActionT m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ActionT m a -> Text -> ActionT m a
forall a b. a -> b -> a
const ActionT m a
forall (m :: * -> *) a. Monad m => ActionT m a
next) a -> ActionT m a
forall a. a -> ActionT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text a -> ActionT m a) -> Either Text a -> ActionT m a
forall a b. (a -> b) -> a -> b
$ Text -> Either Text a
forall a. Parsable a => Text -> Either Text a
parseParam (Text -> Text
TL.fromStrict Text
v)
{-# DEPRECATED param "(#204) Not a good idea to treat all parameters identically. Use captureParam, formParam and queryParam instead. "#-}

-- | 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
$ (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 -> 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 all parameters from path, form and query (in that order).
params :: Monad m => ActionT m [Param]
params :: forall (m :: * -> *). Monad m => ActionT m [Param]
params = (ActionEnv -> [Param]) -> ActionT m [Param]
forall (m :: * -> *) a. Monad m => (ActionEnv -> a) -> ActionT m a
paramsWith ActionEnv -> [Param]
getParams
{-# DEPRECATED params "(#204) Not a good idea to treat all parameters identically. Use pathParams, formParams and queryParams instead. "#-}

-- | 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
f (ActionEnv -> a)
-> ReaderT ActionEnv m ActionEnv -> ReaderT ActionEnv m a
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)

{-# DEPRECATED getParams "(#204) Not a good idea to treat all parameters identically" #-}
-- | Returns path and query parameters as a single list
getParams :: ActionEnv -> [Param]
getParams :: ActionEnv -> [Param]
getParams ActionEnv
e = ActionEnv -> [Param]
envPathParams ActionEnv
e [Param] -> [Param] -> [Param]
forall a. Semigroup a => a -> a -> a
<> [] [Param] -> [Param] -> [Param]
forall a. Semigroup a => a -> a -> a
<> ActionEnv -> [Param]
envQueryParams ActionEnv
e


-- === 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"
                   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