{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}
module Web.Scotty.Action
    ( addHeader
    , body
    , bodyReader
    , file
    , files
    , finish
    , header
    , headers
    , html
    , liftAndCatchIO
    , json
    , jsonData
    , next
    , param
    , params
    , raise
    , raiseStatus
    , raw
    , readEither
    , redirect
    , request
    , rescue
    , setHeader
    , status
    , stream
    , text
    , Param
    , Parsable(..)
      -- private to Scotty
    , runAction
    ) where

import           Blaze.ByteString.Builder   (fromLazyByteString)

import qualified Control.Exception          as E
import           Control.Monad.Error.Class
import           Control.Monad.Reader       hiding (mapM)
import qualified Control.Monad.State.Strict as MS
import           Control.Monad.Trans.Except

import qualified Data.Aeson                 as A
import qualified Data.ByteString.Char8      as B
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.CaseInsensitive       as CI
import           Data.Default.Class         (def)
import           Data.Int
import qualified Data.Text                  as ST
import qualified Data.Text.Encoding         as STE
import qualified Data.Text.Lazy             as T
import           Data.Text.Lazy.Encoding    (encodeUtf8)
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

import           Numeric.Natural

import           Prelude ()
import           Prelude.Compat

import           Web.Scotty.Internal.Types
import           Web.Scotty.Util

-- Nothing indicates route failed (due to Next) and pattern matching should continue.
-- Just indicates a successful response.
runAction :: (ScottyError e, Monad m) => ErrorHandler e m -> ActionEnv -> ActionT e m () -> m (Maybe Response)
runAction :: ErrorHandler e m
-> ActionEnv -> ActionT e m () -> m (Maybe Response)
runAction ErrorHandler e m
h ActionEnv
env ActionT e m ()
action = do
    (Either (ActionError e) ()
e,ScottyResponse
r) <- (StateT ScottyResponse m (Either (ActionError e) ())
 -> ScottyResponse -> m (Either (ActionError e) (), ScottyResponse))
-> ScottyResponse
-> StateT ScottyResponse m (Either (ActionError e) ())
-> m (Either (ActionError e) (), ScottyResponse)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT ScottyResponse m (Either (ActionError e) ())
-> ScottyResponse -> m (Either (ActionError e) (), ScottyResponse)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
MS.runStateT ScottyResponse
forall a. Default a => a
def
           (StateT ScottyResponse m (Either (ActionError e) ())
 -> m (Either (ActionError e) (), ScottyResponse))
-> StateT ScottyResponse m (Either (ActionError e) ())
-> m (Either (ActionError e) (), ScottyResponse)
forall a b. (a -> b) -> a -> b
$ (ReaderT
   ActionEnv (StateT ScottyResponse m) (Either (ActionError e) ())
 -> ActionEnv
 -> StateT ScottyResponse m (Either (ActionError e) ()))
-> ActionEnv
-> ReaderT
     ActionEnv (StateT ScottyResponse m) (Either (ActionError e) ())
-> StateT ScottyResponse m (Either (ActionError e) ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  ActionEnv (StateT ScottyResponse m) (Either (ActionError e) ())
-> ActionEnv -> StateT ScottyResponse m (Either (ActionError e) ())
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ActionEnv
env
           (ReaderT
   ActionEnv (StateT ScottyResponse m) (Either (ActionError e) ())
 -> StateT ScottyResponse m (Either (ActionError e) ()))
-> ReaderT
     ActionEnv (StateT ScottyResponse m) (Either (ActionError e) ())
-> StateT ScottyResponse m (Either (ActionError e) ())
forall a b. (a -> b) -> a -> b
$ ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
-> ReaderT
     ActionEnv (StateT ScottyResponse m) (Either (ActionError e) ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
           (ExceptT
   (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
 -> ReaderT
      ActionEnv (StateT ScottyResponse m) (Either (ActionError e) ()))
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
-> ReaderT
     ActionEnv (StateT ScottyResponse m) (Either (ActionError e) ())
forall a b. (a -> b) -> a -> b
$ ActionT e m ()
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
forall e (m :: * -> *) a.
ActionT e m a
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
runAM
           (ActionT e m ()
 -> ExceptT
      (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ())
-> ActionT e m ()
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
forall a b. (a -> b) -> a -> b
$ ActionT e m ()
action ActionT e m ()
-> (ActionError e -> ActionT e m ()) -> ActionT e m ()
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (ErrorHandler e m -> ActionError e -> ActionT e m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
ErrorHandler e m -> ActionError e -> ActionT e m ()
defH ErrorHandler e m
h)
    Maybe Response -> m (Maybe Response)
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
$ (ActionError e -> Maybe Response)
-> (() -> Maybe Response)
-> Either (ActionError e) ()
-> Maybe Response
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Response -> ActionError e -> Maybe Response
forall a b. a -> b -> a
const Maybe Response
forall a. Maybe a
Nothing) (Maybe Response -> () -> Maybe Response
forall a b. a -> b -> a
const (Maybe Response -> () -> Maybe Response)
-> Maybe Response -> () -> Maybe Response
forall a b. (a -> b) -> a -> b
$ 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
r) Either (ActionError e) ()
e

-- | Default error handler for all actions.
defH :: (ScottyError e, Monad m) => ErrorHandler e m -> ActionError e -> ActionT e m ()
defH :: ErrorHandler e m -> ActionError e -> ActionT e m ()
defH ErrorHandler e m
_          (Redirect Text
url)    = do
    Status -> ActionT e m ()
forall (m :: * -> *) e. Monad m => Status -> ActionT e m ()
status Status
status302
    Text -> Text -> ActionT e m ()
forall (m :: * -> *) e. Monad m => Text -> Text -> ActionT e m ()
setHeader Text
"Location" Text
url
defH ErrorHandler e m
Nothing    (ActionError Status
s e
e)   = do
    Status -> ActionT e m ()
forall (m :: * -> *) e. Monad m => Status -> ActionT e 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 = Text -> Text
T.fromStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
STE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Status -> ByteString
statusMessage Status
s
    Text -> ActionT e m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
html (Text -> ActionT e m ()) -> Text -> ActionT e 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>", e -> Text
forall e. ScottyError e => e -> Text
showError e
e]
defH h :: ErrorHandler e m
h@(Just e -> ActionT e m ()
f) (ActionError Status
_ e
e)   = e -> ActionT e m ()
f e
e ActionT e m ()
-> (ActionError e -> ActionT e m ()) -> ActionT e m ()
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (ErrorHandler e m -> ActionError e -> ActionT e m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
ErrorHandler e m -> ActionError e -> ActionT e m ()
defH ErrorHandler e m
h) -- so handlers can throw exceptions themselves
defH ErrorHandler e m
_          ActionError e
Next              = ActionT e m ()
forall e (m :: * -> *) a. (ScottyError e, Monad m) => ActionT e m a
next
defH ErrorHandler e m
_          ActionError e
Finish            = () -> ActionT e m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Throw an exception, which can be caught with 'rescue'. Uncaught exceptions
-- turn into HTTP 500 responses.
raise :: (ScottyError e, Monad m) => e -> ActionT e m a
raise :: e -> ActionT e m a
raise = Status -> e -> ActionT e m a
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
Status -> e -> ActionT e m a
raiseStatus Status
status500

-- | Throw an exception, which can be caught with 'rescue'. Uncaught exceptions turn into HTTP responses corresponding to the given status.
raiseStatus :: (ScottyError e, Monad m) => Status -> e -> ActionT e m a
raiseStatus :: Status -> e -> ActionT e m a
raiseStatus Status
s = ActionError e -> ActionT e m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ActionError e -> ActionT e m a)
-> (e -> ActionError e) -> e -> ActionT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> e -> ActionError e
forall e. Status -> e -> ActionError e
ActionError Status
s

-- | Abort execution of this action and continue pattern matching routes.
-- Like an exception, any code after 'next' is not executed.
--
-- 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 <- param "bar"
-- >   unless (w == "special") next
-- >   text "You made a request to /foo/special"
-- >
-- > get "/foo/:baz" $ do
-- >   w <- param "baz"
-- >   text $ "You made a request to: " <> w
next :: (ScottyError e, Monad m) => ActionT e m a
next :: ActionT e m a
next = ActionError e -> ActionT e m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ActionError e
forall e. ActionError e
Next

-- | Catch an exception thrown by 'raise'.
--
-- > raise "just kidding" `rescue` (\msg -> text msg)
rescue :: (ScottyError e, Monad m) => ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
rescue :: ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
rescue ActionT e m a
action e -> ActionT e m a
h = ActionT e m a -> (ActionError e -> ActionT e m a) -> ActionT e m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ActionT e m a
action ((ActionError e -> ActionT e m a) -> ActionT e m a)
-> (ActionError e -> ActionT e m a) -> ActionT e m a
forall a b. (a -> b) -> a -> b
$ \ActionError e
e -> case ActionError e
e of
    ActionError Status
_ e
err -> e -> ActionT e m a
h e
err            -- handle errors
    ActionError e
other             -> ActionError e -> ActionT e m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ActionError e
other -- rethrow internal error types

-- | Like 'liftIO', but catch any IO exceptions and turn them into 'ScottyError's.
liftAndCatchIO :: (ScottyError e, MonadIO m) => IO a -> ActionT e m a
liftAndCatchIO :: IO a -> ActionT e m a
liftAndCatchIO IO a
io = ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT (ExceptT
   (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
 -> ActionT e m a)
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
forall a b. (a -> b) -> a -> b
$ do
    Either (ActionError e) a
r <- IO (Either (ActionError e) a)
-> ExceptT
     (ActionError e)
     (ReaderT ActionEnv (StateT ScottyResponse m))
     (Either (ActionError e) a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either (ActionError e) a)
 -> ExceptT
      (ActionError e)
      (ReaderT ActionEnv (StateT ScottyResponse m))
      (Either (ActionError e) a))
-> IO (Either (ActionError e) a)
-> ExceptT
     (ActionError e)
     (ReaderT ActionEnv (StateT ScottyResponse m))
     (Either (ActionError e) a)
forall a b. (a -> b) -> a -> b
$ (a -> Either (ActionError e) a)
-> IO a -> IO (Either (ActionError e) a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Either (ActionError e) a
forall a b. b -> Either a b
Right IO a
io IO (Either (ActionError e) a)
-> (SomeException -> IO (Either (ActionError e) a))
-> IO (Either (ActionError e) a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\ SomeException
e -> Either (ActionError e) a -> IO (Either (ActionError e) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ActionError e) a -> IO (Either (ActionError e) a))
-> Either (ActionError e) a -> IO (Either (ActionError e) a)
forall a b. (a -> b) -> a -> b
$ ActionError e -> Either (ActionError e) a
forall a b. a -> Either a b
Left (ActionError e -> Either (ActionError e) a)
-> ActionError e -> Either (ActionError e) a
forall a b. (a -> b) -> a -> b
$ String -> ActionError e
forall e. ScottyError e => String -> e
stringError (String -> ActionError e) -> String -> ActionError e
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show (SomeException
e :: E.SomeException))
    (ActionError e
 -> ExceptT
      (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a)
-> (a
    -> ExceptT
         (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a)
-> Either (ActionError e) a
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ActionError e
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError a
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Either (ActionError e) a
r

-- | 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 :: (ScottyError e, Monad m) => T.Text -> ActionT e m a
redirect :: Text -> ActionT e m a
redirect = ActionError e -> ActionT e m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ActionError e -> ActionT e m a)
-> (Text -> ActionError e) -> Text -> ActionT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ActionError e
forall e. Text -> ActionError e
Redirect

-- | 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 :: (ScottyError e, Monad m) => ActionT e m a
finish :: ActionT e m a
finish = ActionError e -> ActionT e m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ActionError e
forall e. ActionError e
Finish

-- | Get the 'Request' object.
request :: Monad m => ActionT e m Request
request :: ActionT e m Request
request = ExceptT
  (ActionError e)
  (ReaderT ActionEnv (StateT ScottyResponse m))
  Request
-> ActionT e m Request
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT (ExceptT
   (ActionError e)
   (ReaderT ActionEnv (StateT ScottyResponse m))
   Request
 -> ActionT e m Request)
-> ExceptT
     (ActionError e)
     (ReaderT ActionEnv (StateT ScottyResponse m))
     Request
-> ActionT e m Request
forall a b. (a -> b) -> a -> b
$ (ActionEnv -> Request)
-> ExceptT
     (ActionError e)
     (ReaderT ActionEnv (StateT ScottyResponse m))
     ActionEnv
-> ExceptT
     (ActionError e)
     (ReaderT ActionEnv (StateT ScottyResponse m))
     Request
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ActionEnv -> Request
getReq ExceptT
  (ActionError e)
  (ReaderT ActionEnv (StateT ScottyResponse m))
  ActionEnv
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | Get list of uploaded files.
files :: Monad m => ActionT e m [File]
files :: ActionT e m [File]
files = ExceptT
  (ActionError e)
  (ReaderT ActionEnv (StateT ScottyResponse m))
  [File]
-> ActionT e m [File]
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT (ExceptT
   (ActionError e)
   (ReaderT ActionEnv (StateT ScottyResponse m))
   [File]
 -> ActionT e m [File])
-> ExceptT
     (ActionError e)
     (ReaderT ActionEnv (StateT ScottyResponse m))
     [File]
-> ActionT e m [File]
forall a b. (a -> b) -> a -> b
$ (ActionEnv -> [File])
-> ExceptT
     (ActionError e)
     (ReaderT ActionEnv (StateT ScottyResponse m))
     ActionEnv
-> ExceptT
     (ActionError e)
     (ReaderT ActionEnv (StateT ScottyResponse m))
     [File]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ActionEnv -> [File]
getFiles ExceptT
  (ActionError e)
  (ReaderT ActionEnv (StateT ScottyResponse m))
  ActionEnv
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | Get a request header. Header name is case-insensitive.
header :: (ScottyError e, Monad m) => T.Text -> ActionT e m (Maybe T.Text)
header :: Text -> ActionT e m (Maybe Text)
header Text
k = do
    RequestHeaders
hs <- (Request -> RequestHeaders)
-> ActionT e m Request -> ActionT e m RequestHeaders
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Request -> RequestHeaders
requestHeaders ActionT e m Request
forall (m :: * -> *) e. Monad m => ActionT e m Request
request
    Maybe Text -> ActionT e m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ActionT e m (Maybe Text))
-> Maybe Text -> ActionT e m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
strictByteStringToLazyText (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
lazyTextToStrictByteString Text
k)) RequestHeaders
hs

-- | Get all the request headers. Header names are case-insensitive.
headers :: (ScottyError e, Monad m) => ActionT e m [(T.Text, T.Text)]
headers :: ActionT e m [(Text, Text)]
headers = do
    RequestHeaders
hs <- (Request -> RequestHeaders)
-> ActionT e m Request -> ActionT e m RequestHeaders
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Request -> RequestHeaders
requestHeaders ActionT e m Request
forall (m :: * -> *) e. Monad m => ActionT e m Request
request
    [(Text, Text)] -> ActionT e m [(Text, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return [ ( ByteString -> Text
strictByteStringToLazyText (CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
k)
             , ByteString -> Text
strictByteStringToLazyText ByteString
v)
           | (CI ByteString
k,ByteString
v) <- RequestHeaders
hs ]

-- | Get the request body.
body :: (ScottyError e,  MonadIO m) => ActionT e m BL.ByteString
body :: ActionT e m ByteString
body = ExceptT
  (ActionError e)
  (ReaderT ActionEnv (StateT ScottyResponse m))
  ActionEnv
-> ActionT e m ActionEnv
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT ExceptT
  (ActionError e)
  (ReaderT ActionEnv (StateT ScottyResponse m))
  ActionEnv
forall r (m :: * -> *). MonadReader r m => m r
ask ActionT e m ActionEnv
-> (ActionEnv -> ActionT e m ByteString) -> ActionT e m ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IO ByteString -> ActionT e m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ActionT e m ByteString)
-> (ActionEnv -> IO ByteString)
-> ActionEnv
-> ActionT e m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionEnv -> IO ByteString
getBody)

-- | Get an IO action that reads body chunks
--
-- * This is incompatible with 'body' since 'body' consumes all chunks.
bodyReader :: Monad m => ActionT e m (IO B.ByteString)
bodyReader :: ActionT e m (IO ByteString)
bodyReader = ExceptT
  (ActionError e)
  (ReaderT ActionEnv (StateT ScottyResponse m))
  (IO ByteString)
-> ActionT e m (IO ByteString)
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT (ExceptT
   (ActionError e)
   (ReaderT ActionEnv (StateT ScottyResponse m))
   (IO ByteString)
 -> ActionT e m (IO ByteString))
-> ExceptT
     (ActionError e)
     (ReaderT ActionEnv (StateT ScottyResponse m))
     (IO ByteString)
-> ActionT e m (IO ByteString)
forall a b. (a -> b) -> a -> b
$ ActionEnv -> IO ByteString
getBodyChunk (ActionEnv -> IO ByteString)
-> ExceptT
     (ActionError e)
     (ReaderT ActionEnv (StateT ScottyResponse m))
     ActionEnv
-> ExceptT
     (ActionError e)
     (ReaderT ActionEnv (StateT ScottyResponse m))
     (IO ByteString)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ExceptT
  (ActionError e)
  (ReaderT ActionEnv (StateT ScottyResponse 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.
jsonData :: (A.FromJSON a, ScottyError e, MonadIO m) => ActionT e m a
jsonData :: ActionT e m a
jsonData = do
    ByteString
b <- ActionT e m ByteString
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
ActionT e m ByteString
body
    Bool -> ActionT e m () -> ActionT e m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
b ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"") (ActionT e m () -> ActionT e m ())
-> ActionT e m () -> ActionT e m ()
forall a b. (a -> b) -> a -> b
$ do
      let htmlError :: String
htmlError = String
"jsonData - No data was provided."
      Status -> e -> ActionT e m ()
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
Status -> e -> ActionT e m a
raiseStatus Status
status400 (e -> ActionT e m ()) -> e -> ActionT e m ()
forall a b. (a -> b) -> a -> b
$ String -> e
forall e. ScottyError e => String -> e
stringError String
htmlError
    case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode ByteString
b of
      Left String
err -> do
        let htmlError :: String
htmlError = String
"jsonData - malformed."
              String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
" Data was: " String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` ByteString -> String
BL.unpack ByteString
b
              String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
" Error was: " String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
err
        Status -> e -> ActionT e m a
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
Status -> e -> ActionT e m a
raiseStatus Status
status400 (e -> ActionT e m a) -> e -> ActionT e m a
forall a b. (a -> b) -> a -> b
$ String -> e
forall e. ScottyError e => String -> e
stringError String
htmlError
      Right Value
value -> case Value -> Result a
forall a. FromJSON a => Value -> Result a
A.fromJSON Value
value of
        A.Error String
err -> do
          let htmlError :: String
htmlError = String
"jsonData - failed parse."
                String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
" Data was: " String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` ByteString -> String
BL.unpack ByteString
b String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"."
                String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
" Error was: " String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
err
          Status -> e -> ActionT e m a
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
Status -> e -> ActionT e m a
raiseStatus Status
status422 (e -> ActionT e m a) -> e -> ActionT e m a
forall a b. (a -> b) -> a -> b
$ String -> e
forall e. ScottyError e => String -> e
stringError String
htmlError
        A.Success a
a -> do
          a -> ActionT e 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 'rescue' if parameter is not found.
--
-- * If parameter is found, but 'read' 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, ScottyError e, Monad m) => T.Text -> ActionT e m a
param :: Text -> ActionT e m a
param Text
k = do
    Maybe Text
val <- ExceptT
  (ActionError e)
  (ReaderT ActionEnv (StateT ScottyResponse m))
  (Maybe Text)
-> ActionT e m (Maybe Text)
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT (ExceptT
   (ActionError e)
   (ReaderT ActionEnv (StateT ScottyResponse m))
   (Maybe Text)
 -> ActionT e m (Maybe Text))
-> ExceptT
     (ActionError e)
     (ReaderT ActionEnv (StateT ScottyResponse m))
     (Maybe Text)
-> ActionT e m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ (ActionEnv -> Maybe Text)
-> ExceptT
     (ActionError e)
     (ReaderT ActionEnv (StateT ScottyResponse m))
     ActionEnv
-> ExceptT
     (ActionError e)
     (ReaderT ActionEnv (StateT ScottyResponse m))
     (Maybe Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k ([(Text, Text)] -> Maybe Text)
-> (ActionEnv -> [(Text, Text)]) -> ActionEnv -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionEnv -> [(Text, Text)]
getParams) ExceptT
  (ActionError e)
  (ReaderT ActionEnv (StateT ScottyResponse m))
  ActionEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
    case Maybe Text
val of
        Maybe Text
Nothing -> e -> ActionT e m a
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
e -> ActionT e m a
raise (e -> ActionT e m a) -> e -> ActionT e m a
forall a b. (a -> b) -> a -> b
$ String -> e
forall e. ScottyError e => String -> e
stringError (String -> e) -> String -> e
forall a b. (a -> b) -> a -> b
$ String
"Param: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not found!"
        Just Text
v  -> (Text -> ActionT e m a)
-> (a -> ActionT e m a) -> Either Text a -> ActionT e m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ActionT e m a -> Text -> ActionT e m a
forall a b. a -> b -> a
const ActionT e m a
forall e (m :: * -> *) a. (ScottyError e, Monad m) => ActionT e m a
next) a -> ActionT e m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text a -> ActionT e m a) -> Either Text a -> ActionT e m a
forall a b. (a -> b) -> a -> b
$ Text -> Either Text a
forall a. Parsable a => Text -> Either Text a
parseParam Text
v

-- | Get all parameters from capture, form and query (in that order).
params :: Monad m => ActionT e m [Param]
params :: ActionT e m [(Text, Text)]
params = ExceptT
  (ActionError e)
  (ReaderT ActionEnv (StateT ScottyResponse m))
  [(Text, Text)]
-> ActionT e m [(Text, Text)]
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT (ExceptT
   (ActionError e)
   (ReaderT ActionEnv (StateT ScottyResponse m))
   [(Text, Text)]
 -> ActionT e m [(Text, Text)])
-> ExceptT
     (ActionError e)
     (ReaderT ActionEnv (StateT ScottyResponse m))
     [(Text, Text)]
-> ActionT e m [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ (ActionEnv -> [(Text, Text)])
-> ExceptT
     (ActionError e)
     (ReaderT ActionEnv (StateT ScottyResponse m))
     ActionEnv
-> ExceptT
     (ActionError e)
     (ReaderT ActionEnv (StateT ScottyResponse m))
     [(Text, Text)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ActionEnv -> [(Text, Text)]
getParams ExceptT
  (ActionError e)
  (ReaderT ActionEnv (StateT ScottyResponse m))
  ActionEnv
forall r (m :: * -> *). MonadReader r m => m r
ask

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

    -- | Default implementation parses comma-delimited lists.
    --
    -- > parseParamList t = mapM parseParam (T.split (== ',') t)
    parseParamList :: T.Text -> Either T.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)
mapM Text -> Either Text a
forall a. Parsable a => Text -> Either Text a
parseParam ((Char -> Bool) -> Text -> [Text]
T.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
instance Parsable ST.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
T.toStrict
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
encodeUtf8
-- | Overrides default 'parseParamList' to parse String.
instance Parsable Char where
    parseParam :: Text -> Either Text Char
parseParam Text
t = case Text -> String
T.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
T.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
T.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
T.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
T.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
T.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

-- | Useful for creating 'Parsable' instances for things that already implement 'Read'. Ex:
--
-- > instance Parsable Int where parseParam = readEither
readEither :: Read a => T.Text -> Either T.Text a
readEither :: Text -> Either Text a
readEither Text
t = case [ a
x | (a
x,String
"") <- ReadS a
forall a. Read a => ReadS a
reads (Text -> String
T.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. Default is 200.
status :: Monad m => Status -> ActionT e m ()
status :: Status -> ActionT e m ()
status = ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
-> ActionT e m ()
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT (ExceptT
   (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
 -> ActionT e m ())
-> (Status
    -> ExceptT
         (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ())
-> Status
-> ActionT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScottyResponse -> ScottyResponse)
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
MS.modify ((ScottyResponse -> ScottyResponse)
 -> ExceptT
      (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ())
-> (Status -> ScottyResponse -> ScottyResponse)
-> Status
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> ScottyResponse -> ScottyResponse
setStatus

-- Not exported, but useful in the functions below.
changeHeader :: Monad m
             => (CI.CI B.ByteString -> B.ByteString -> [(HeaderName, B.ByteString)] -> [(HeaderName, B.ByteString)])
             -> T.Text -> T.Text -> ActionT e m ()
changeHeader :: (CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT e m ()
changeHeader CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders
f Text
k = ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
-> ActionT e m ()
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT
                 (ExceptT
   (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
 -> ActionT e m ())
-> (Text
    -> ExceptT
         (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ())
-> Text
-> ActionT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScottyResponse -> ScottyResponse)
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
MS.modify
                 ((ScottyResponse -> ScottyResponse)
 -> ExceptT
      (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ())
-> (Text -> ScottyResponse -> ScottyResponse)
-> Text
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse 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
lazyTextToStrictByteString Text
k)
                 (ByteString -> RequestHeaders -> RequestHeaders)
-> (Text -> ByteString) -> Text -> RequestHeaders -> RequestHeaders
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
lazyTextToStrictByteString

-- | Add to the response headers. Header names are case-insensitive.
addHeader :: Monad m => T.Text -> T.Text -> ActionT e m ()
addHeader :: Text -> Text -> ActionT e m ()
addHeader = (CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT e m ()
forall (m :: * -> *) e.
Monad m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT e 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 :: Monad m => T.Text -> T.Text -> ActionT e m ()
setHeader :: Text -> Text -> ActionT e m ()
setHeader = (CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT e m ()
forall (m :: * -> *) e.
Monad m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT e 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 :: (ScottyError e, Monad m) => T.Text -> ActionT e m ()
text :: Text -> ActionT e m ()
text Text
t = do
    (CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT e m ()
forall (m :: * -> *) e.
Monad m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT e 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 e m ()
forall (m :: * -> *) e. Monad m => ByteString -> ActionT e m ()
raw (ByteString -> ActionT e m ()) -> ByteString -> ActionT e m ()
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.
html :: (ScottyError e, Monad m) => T.Text -> ActionT e m ()
html :: Text -> ActionT e m ()
html Text
t = do
    (CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT e m ()
forall (m :: * -> *) e.
Monad m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT e 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 e m ()
forall (m :: * -> *) e. Monad m => ByteString -> ActionT e m ()
raw (ByteString -> ActionT e m ()) -> ByteString -> ActionT e m ()
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
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'.
file :: Monad m => FilePath -> ActionT e m ()
file :: String -> ActionT e m ()
file = ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
-> ActionT e m ()
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT (ExceptT
   (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
 -> ActionT e m ())
-> (String
    -> ExceptT
         (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ())
-> String
-> ActionT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScottyResponse -> ScottyResponse)
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
MS.modify ((ScottyResponse -> ScottyResponse)
 -> ExceptT
      (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ())
-> (String -> ScottyResponse -> ScottyResponse)
-> String
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse 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

-- | 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, ScottyError e, Monad m) => a -> ActionT e m ()
json :: a -> ActionT e m ()
json a
v = do
    (CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT e m ()
forall (m :: * -> *) e.
Monad m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT e 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 e m ()
forall (m :: * -> *) e. Monad m => ByteString -> ActionT e m ()
raw (ByteString -> ActionT e m ()) -> ByteString -> ActionT e 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 :: Monad m => StreamingBody -> ActionT e m ()
stream :: StreamingBody -> ActionT e m ()
stream = ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
-> ActionT e m ()
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT (ExceptT
   (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
 -> ActionT e m ())
-> (StreamingBody
    -> ExceptT
         (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ())
-> StreamingBody
-> ActionT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScottyResponse -> ScottyResponse)
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
MS.modify ((ScottyResponse -> ScottyResponse)
 -> ExceptT
      (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ())
-> (StreamingBody -> ScottyResponse -> ScottyResponse)
-> StreamingBody
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse 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 :: Monad m => BL.ByteString -> ActionT e m ()
raw :: ByteString -> ActionT e m ()
raw = ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
-> ActionT e m ()
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT (ExceptT
   (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
 -> ActionT e m ())
-> (ByteString
    -> ExceptT
         (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ())
-> ByteString
-> ActionT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScottyResponse -> ScottyResponse)
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
MS.modify ((ScottyResponse -> ScottyResponse)
 -> ExceptT
      (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ())
-> (ByteString -> ScottyResponse -> ScottyResponse)
-> ByteString
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse 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