{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE LambdaCase #-}
{-# language ScopedTypeVariables #-}
module Web.Scotty.Action
( addHeader
, body
, bodyReader
, file
, rawResponse
, files
, 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
, 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.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.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.Word
import Network.HTTP.Types
#if !MIN_VERSION_http_types(0,11,0)
import Network.HTTP.Types.Status
#endif
import Network.Wai (Request, Response, StreamingBody, Application, requestHeaders)
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 Network.Wai.Internal (ResponseReceived(..))
runAction :: MonadUnliftIO m =>
Maybe (ErrorHandler m)
-> ActionEnv
-> ActionT m ()
-> m (Maybe Response)
runAction :: forall (m :: * -> *).
MonadUnliftIO m =>
Maybe (ErrorHandler m)
-> ActionEnv -> ActionT m () -> m (Maybe Response)
runAction Maybe (ErrorHandler m)
mh ActionEnv
env ActionT m ()
action = do
Bool
ok <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ActionEnv
env forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ActionT m a -> ReaderT ActionEnv m a
runAM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadUnliftIO m => m a -> m Bool
tryNext forall a b. (a -> b) -> a -> b
$ ActionT m ()
action forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> [Handler m a] -> m a
`catches` forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [forall (m :: * -> *). MonadIO m => ErrorHandler m
actionErrorHandler]
, forall a. Maybe a -> [a]
maybeToList Maybe (ErrorHandler m)
mh
, [forall (m :: * -> *). MonadIO m => ErrorHandler m
statusErrorHandler, forall (m :: * -> *). MonadIO m => ErrorHandler m
scottyExceptionHandler, forall (m :: * -> *). MonadIO m => ErrorHandler m
someExceptionHandler]
]
ScottyResponse
res <- forall (m :: * -> *). MonadIO m => ActionEnv -> m ScottyResponse
getResponse ActionEnv
env
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> Bool -> a
bool forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ScottyResponse -> Response
mkResponse ScottyResponse
res) Bool
ok
statusErrorHandler :: MonadIO m => ErrorHandler m
statusErrorHandler :: forall (m :: * -> *). MonadIO m => ErrorHandler m
statusErrorHandler = forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler forall a b. (a -> b) -> a -> b
$ \case
StatusError Status
s Text
e -> do
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
s
let code :: Text
code = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Status -> Int
statusCode Status
s
let msg :: Text
msg = ByteString -> Text
decodeUtf8Lenient forall a b. (a -> b) -> a -> b
$ Status -> ByteString
statusMessage Status
s
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
html forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Text
"<h1>", Text
code, Text
" ", Text
msg, Text
"</h1>", Text
e]
actionErrorHandler :: MonadIO m => ErrorHandler m
actionErrorHandler :: forall (m :: * -> *). MonadIO m => ErrorHandler m
actionErrorHandler = forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler forall a b. (a -> b) -> a -> b
$ \case
AERedirect Text
url -> do
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status302
forall (m :: * -> *). MonadIO m => Text -> Text -> ActionT m ()
setHeader Text
"Location" Text
url
ActionError
AENext -> forall (m :: * -> *) a. Monad m => ActionT m a
next
ActionError
AEFinish -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
scottyExceptionHandler :: MonadIO m => ErrorHandler m
scottyExceptionHandler :: forall (m :: * -> *). MonadIO m => ErrorHandler m
scottyExceptionHandler = forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler forall a b. (a -> b) -> a -> b
$ \case
ScottyException
RequestTooLarge -> do
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status413
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
text Text
"Request body is too large"
MalformedJSON ByteString
bs Text
err -> do
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status400
forall (m :: * -> *). MonadIO m => ByteString -> ActionT m ()
raw forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BL.unlines
[ ByteString
"jsonData: malformed"
, ByteString
"Body: " forall a. Semigroup a => a -> a -> a
<> ByteString
bs
, ByteString
"Error: " forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
BL.fromStrict (Text -> ByteString
encodeUtf8 Text
err)
]
FailedToParseJSON ByteString
bs Text
err -> do
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status422
forall (m :: * -> *). MonadIO m => ByteString -> ActionT m ()
raw forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BL.unlines
[ ByteString
"jsonData: failed to parse"
, ByteString
"Body: " forall a. Semigroup a => a -> a -> a
<> ByteString
bs
, ByteString
"Error: " forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
BL.fromStrict (Text -> ByteString
encodeUtf8 Text
err)
]
PathParameterNotFound Text
k -> do
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status500
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
text forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [ Text
"Path parameter", Text
k, Text
"not found"]
QueryParameterNotFound Text
k -> do
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status400
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
text forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [ Text
"Query parameter", Text
k, Text
"not found"]
FormFieldNotFound Text
k -> do
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status400
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
text 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
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status400
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
text forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [ Text
"Failed to parse parameter", Text
k, Text
v, Text
":", Text
e]
someExceptionHandler :: MonadIO m => ErrorHandler m
someExceptionHandler :: forall (m :: * -> *). MonadIO m => ErrorHandler m
someExceptionHandler = forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler forall a b. (a -> b) -> a -> b
$ \case
(SomeException
_ :: E.SomeException) -> forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status500
raise :: (MonadIO m) =>
T.Text
-> ActionT m a
raise :: forall (m :: * -> *) a. MonadIO m => Text -> ActionT m a
raise = forall (m :: * -> *) a. Monad m => Status -> Text -> ActionT m a
raiseStatus Status
status500
{-# DEPRECATED raise "Throw an exception instead" #-}
raiseStatus :: Monad m => Status -> T.Text -> ActionT m a
raiseStatus :: forall (m :: * -> *) a. Monad m => Status -> Text -> ActionT m a
raiseStatus Status
s = forall a e. Exception e => e -> a
E.throw 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 :: (MonadIO m, E.Exception e) => e -> ActionT m a
throw :: forall (m :: * -> *) e a.
(MonadIO m, Exception e) =>
e -> ActionT m a
throw = forall a e. Exception e => e -> a
E.throw
next :: Monad m => ActionT m a
next :: forall (m :: * -> *) a. Monad m => ActionT m a
next = forall a e. Exception e => e -> a
E.throw ActionError
AENext
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 = forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
{-# DEPRECATED rescue "Use catch instead" #-}
liftAndCatchIO :: MonadIO m => IO a -> ActionT m a
liftAndCatchIO :: forall (m :: * -> *) a. MonadIO m => IO a -> ActionT m a
liftAndCatchIO = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
{-# DEPRECATED liftAndCatchIO "Use liftIO instead" #-}
redirect :: (Monad m) => T.Text -> ActionT m a
redirect :: forall (m :: * -> *) a. Monad m => Text -> ActionT m a
redirect = forall a e. Exception e => e -> a
E.throw forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ActionError
AERedirect
finish :: (Monad m) => ActionT m a
finish :: forall (m :: * -> *) a. Monad m => ActionT m a
finish = forall a e. Exception e => e -> a
E.throw ActionError
AEFinish
request :: Monad m => ActionT m Request
request :: forall (m :: * -> *). Monad m => ActionT m Request
request = forall (m :: * -> *) a. ReaderT ActionEnv m a -> ActionT m a
ActionT forall a b. (a -> b) -> a -> b
$ ActionEnv -> Request
envReq forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
files :: Monad m => ActionT m [File]
files :: forall (m :: * -> *). Monad m => ActionT m [File]
files = forall (m :: * -> *) a. ReaderT ActionEnv m a -> ActionT m a
ActionT forall a b. (a -> b) -> a -> b
$ ActionEnv -> [File]
envFiles forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
header :: (Monad m) => T.Text -> ActionT m (Maybe T.Text)
Text
k = do
RequestHeaders
hs <- Request -> RequestHeaders
requestHeaders forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => ActionT m Request
request
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
decodeUtf8Lenient forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (forall s. FoldCase s => s -> CI s
CI.mk (Text -> ByteString
encodeUtf8 Text
k)) RequestHeaders
hs
headers :: (Monad m) => ActionT m [(T.Text, T.Text)]
= do
RequestHeaders
hs <- Request -> RequestHeaders
requestHeaders forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => ActionT m Request
request
forall (m :: * -> *) a. Monad m => a -> m a
return [ ( ByteString -> Text
decodeUtf8Lenient (forall s. CI s -> s
CI.original CI ByteString
k)
, ByteString -> Text
decodeUtf8Lenient ByteString
v)
| (CI ByteString
k,ByteString
v) <- RequestHeaders
hs ]
body :: (MonadIO m) => ActionT m BL.ByteString
body :: forall (m :: * -> *). MonadIO m => ActionT m ByteString
body = forall (m :: * -> *) a. ReaderT ActionEnv m a -> ActionT m a
ActionT forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionEnv -> IO ByteString
envBody)
bodyReader :: Monad m => ActionT m (IO B.ByteString)
bodyReader :: forall (m :: * -> *). Monad m => ActionT m (IO ByteString)
bodyReader = forall (m :: * -> *) a. ReaderT ActionEnv m a -> ActionT m a
ActionT forall a b. (a -> b) -> a -> b
$ ActionEnv -> IO ByteString
envBodyChunk forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
jsonData :: (A.FromJSON a, MonadIO m) => ActionT m a
jsonData :: forall a (m :: * -> *). (FromJSON a, MonadIO m) => ActionT m a
jsonData = do
ByteString
b <- forall (m :: * -> *). MonadIO m => ActionT m ByteString
body
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
b forall a. Eq a => a -> a -> Bool
== ByteString
"") forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ ByteString -> Text -> ScottyException
MalformedJSON ByteString
b Text
"no data"
case forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode ByteString
b of
Left String
err -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ ByteString -> Text -> ScottyException
MalformedJSON ByteString
b forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
err
Right Value
value -> case forall a. FromJSON a => Value -> Result a
A.fromJSON Value
value of
A.Error String
err -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ ByteString -> Text -> ScottyException
FailedToParseJSON ByteString
b forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
err
A.Success a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
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 <- forall (m :: * -> *) a. ReaderT ActionEnv m a -> ActionT m a
ActionT forall a b. (a -> b) -> a -> b
$ (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionEnv -> [Param]
getParams) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
case Maybe Text
val of
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => Status -> Text -> ActionT m a
raiseStatus Status
status500 forall a b. (a -> b) -> a -> b
$ Text
"Param: " forall a. Semigroup a => a -> a -> a
<> Text
k forall a. Semigroup a => a -> a -> a
<> Text
" not found!"
Just Text
v -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall (m :: * -> *) a. Monad m => ActionT m a
next) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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. "#-}
captureParam :: (Parsable a, MonadIO m) => T.Text -> ActionT m a
captureParam :: forall a (m :: * -> *).
(Parsable a, MonadIO m) =>
Text -> ActionT m a
captureParam = forall a (m :: * -> *).
(Parsable a, MonadIO m) =>
Text -> ActionT m a
pathParam
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 <- forall (m :: * -> *) a. ReaderT ActionEnv m a -> ActionT m a
ActionT forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionEnv -> [Param]
envPathParams forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
case Maybe Text
val of
Maybe Text
Nothing -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> ScottyException
PathParameterNotFound Text
k
Just Text
v -> case forall a. Parsable a => Text -> Either Text a
parseParam forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
v of
Left Text
_ -> forall (m :: * -> *) a. Monad m => ActionT m a
next
Right a
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
formParam :: (Parsable a, MonadIO m) => T.Text -> ActionT m a
formParam :: forall a (m :: * -> *).
(Parsable a, MonadIO m) =>
Text -> ActionT m a
formParam = forall (m :: * -> *) b.
(MonadIO m, Parsable b) =>
(Text -> ScottyException)
-> (ActionEnv -> [Param]) -> Text -> ActionT m b
paramWith Text -> ScottyException
FormFieldNotFound ActionEnv -> [Param]
envFormParams
queryParam :: (Parsable a, MonadIO m) => T.Text -> ActionT m a
queryParam :: forall a (m :: * -> *).
(Parsable a, MonadIO m) =>
Text -> ActionT m a
queryParam = forall (m :: * -> *) b.
(MonadIO m, Parsable b) =>
(Text -> ScottyException)
-> (ActionEnv -> [Param]) -> Text -> ActionT m b
paramWith Text -> ScottyException
QueryParameterNotFound ActionEnv -> [Param]
envQueryParams
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 = forall (m :: * -> *) b.
(Monad m, Parsable b) =>
(ActionEnv -> [Param]) -> Text -> ActionT m (Maybe b)
paramWithMaybe ActionEnv -> [Param]
envPathParams
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 = forall (m :: * -> *) b.
(Monad m, Parsable b) =>
(ActionEnv -> [Param]) -> Text -> ActionT m (Maybe b)
paramWithMaybe ActionEnv -> [Param]
envPathParams
formParamMaybe :: (Parsable a, Monad m) => T.Text -> ActionT m (Maybe a)
formParamMaybe :: forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m (Maybe a)
formParamMaybe = forall (m :: * -> *) b.
(Monad m, Parsable b) =>
(ActionEnv -> [Param]) -> Text -> ActionT m (Maybe b)
paramWithMaybe ActionEnv -> [Param]
envFormParams
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 = 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
-> 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 <- forall (m :: * -> *) a. ReaderT ActionEnv m a -> ActionT m a
ActionT forall a b. (a -> b) -> a -> b
$ (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionEnv -> [Param]
f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
case Maybe Text
val of
Maybe Text
Nothing -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> ScottyException
toError Text
k
Just Text
v -> case forall a. Parsable a => Text -> Either Text a
parseParam forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
v of
Left Text
e -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a
paramWithMaybe :: (Monad m, Parsable b) =>
(ActionEnv -> [Param])
-> T.Text
-> 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 <- forall (m :: * -> *) a. ReaderT ActionEnv m a -> ActionT m a
ActionT forall a b. (a -> b) -> a -> b
$ (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionEnv -> [Param]
f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
case Maybe Text
val of
Maybe Text
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Just Text
v -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) forall a b. (a -> b) -> a -> b
$ forall a. Parsable a => Text -> Either Text a
parseParam forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
v
params :: Monad m => ActionT m [Param]
params :: forall (m :: * -> *). Monad m => ActionT m [Param]
params = 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. "#-}
pathParams :: Monad m => ActionT m [Param]
pathParams :: forall (m :: * -> *). Monad m => ActionT m [Param]
pathParams = forall (m :: * -> *) a. Monad m => (ActionEnv -> a) -> ActionT m a
paramsWith ActionEnv -> [Param]
envPathParams
captureParams :: Monad m => ActionT m [Param]
captureParams :: forall (m :: * -> *). Monad m => ActionT m [Param]
captureParams = forall (m :: * -> *) a. Monad m => (ActionEnv -> a) -> ActionT m a
paramsWith ActionEnv -> [Param]
envPathParams
formParams :: Monad m => ActionT m [Param]
formParams :: forall (m :: * -> *). Monad m => ActionT m [Param]
formParams = forall (m :: * -> *) a. Monad m => (ActionEnv -> a) -> ActionT m a
paramsWith ActionEnv -> [Param]
envFormParams
queryParams :: Monad m => ActionT m [Param]
queryParams :: forall (m :: * -> *). Monad m => ActionT m [Param]
queryParams = 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 = forall (m :: * -> *) a. ReaderT ActionEnv m a -> ActionT m a
ActionT (ActionEnv -> a
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask)
{-# DEPRECATED getParams "(#204) Not a good idea to treat all parameters identically" #-}
getParams :: ActionEnv -> [Param]
getParams :: ActionEnv -> [Param]
getParams ActionEnv
e = ActionEnv -> [Param]
envPathParams ActionEnv
e forall a. Semigroup a => a -> a -> a
<> ActionEnv -> [Param]
envFormParams ActionEnv
e forall a. Semigroup a => a -> a -> a
<> ActionEnv -> [Param]
envQueryParams ActionEnv
e
getResponseStatus :: (MonadIO m) => ActionT m Status
getResponseStatus :: forall (m :: * -> *). MonadIO m => ActionT m Status
getResponseStatus = ScottyResponse -> Status
srStatus forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => ActionT m ScottyResponse
getResponseAction
getResponseHeaders :: (MonadIO m) => ActionT m ResponseHeaders
= ScottyResponse -> RequestHeaders
srHeaders forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => ActionT m ScottyResponse
getResponseAction
getResponseContent :: (MonadIO m) => ActionT m Content
getResponseContent :: forall (m :: * -> *). MonadIO m => ActionT m Content
getResponseContent = ScottyResponse -> Content
srContent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => ActionT m ScottyResponse
getResponseAction
class Parsable a where
parseParam :: TL.Text -> Either TL.Text a
parseParamList :: TL.Text -> Either TL.Text [a]
parseParamList Text
t = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Parsable a => Text -> Either Text a
parseParam ((Char -> Bool) -> Text -> [Text]
TL.split (forall a. Eq a => a -> a -> Bool
== Char
',') Text
t)
instance Parsable T.Text where parseParam :: Text -> Either Text Text
parseParam = forall a b. b -> Either a b
Right 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 = forall a b. b -> Either a b
Right
instance Parsable B.ByteString where parseParam :: Text -> Either Text ByteString
parseParam = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
lazyTextToStrictByteString
instance Parsable BL.ByteString where parseParam :: Text -> Either Text ByteString
parseParam = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TLE.encodeUtf8
instance Parsable Char where
parseParam :: Text -> Either Text Char
parseParam Text
t = case Text -> String
TL.unpack Text
t of
[Char
c] -> forall a b. b -> Either a b
Right Char
c
String
_ -> forall a b. a -> Either a b
Left Text
"parseParam Char: no parse"
parseParamList :: Text -> Either Text String
parseParamList = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TL.unpack
instance Parsable () where
parseParam :: Text -> Either Text ()
parseParam Text
t = if Text -> Bool
TL.null Text
t then forall a b. b -> Either a b
Right () else 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 = forall a. Parsable a => Text -> Either Text [a]
parseParamList
instance Parsable Bool where
parseParam :: Text -> Either Text Bool
parseParam Text
t = if Text
t' forall a. Eq a => a -> a -> Bool
== Text -> Text
TL.toCaseFold Text
"true"
then forall a b. b -> Either a b
Right Bool
True
else if Text
t' forall a. Eq a => a -> a -> Bool
== Text -> Text
TL.toCaseFold Text
"false"
then forall a b. b -> Either a b
Right Bool
False
else 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 = forall a. Read a => Text -> Either Text a
readEither
instance Parsable Float where parseParam :: Text -> Either Text Float
parseParam = forall a. Read a => Text -> Either Text a
readEither
instance Parsable Int where parseParam :: Text -> Either Text Int
parseParam = forall a. Read a => Text -> Either Text a
readEither
instance Parsable Int8 where parseParam :: Text -> Either Text Int8
parseParam = forall a. Read a => Text -> Either Text a
readEither
instance Parsable Int16 where parseParam :: Text -> Either Text Int16
parseParam = forall a. Read a => Text -> Either Text a
readEither
instance Parsable Int32 where parseParam :: Text -> Either Text Int32
parseParam = forall a. Read a => Text -> Either Text a
readEither
instance Parsable Int64 where parseParam :: Text -> Either Text Int64
parseParam = forall a. Read a => Text -> Either Text a
readEither
instance Parsable Integer where parseParam :: Text -> Either Text Integer
parseParam = forall a. Read a => Text -> Either Text a
readEither
instance Parsable Word where parseParam :: Text -> Either Text Word
parseParam = forall a. Read a => Text -> Either Text a
readEither
instance Parsable Word8 where parseParam :: Text -> Either Text Word8
parseParam = forall a. Read a => Text -> Either Text a
readEither
instance Parsable Word16 where parseParam :: Text -> Either Text Word16
parseParam = forall a. Read a => Text -> Either Text a
readEither
instance Parsable Word32 where parseParam :: Text -> Either Text Word32
parseParam = forall a. Read a => Text -> Either Text a
readEither
instance Parsable Word64 where parseParam :: Text -> Either Text Word64
parseParam = forall a. Read a => Text -> Either Text a
readEither
instance Parsable Natural where parseParam :: Text -> Either Text Natural
parseParam = forall a. Read a => Text -> Either Text a
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
"") <- forall a. Read a => ReadS a
reads (Text -> String
TL.unpack Text
t) ] of
[a
x] -> forall a b. b -> Either a b
Right a
x
[] -> forall a b. a -> Either a b
Left Text
"readEither: no parse"
[a]
_ -> forall a b. a -> Either a b
Left Text
"readEither: ambiguous parse"
status :: MonadIO m => Status -> ActionT m ()
status :: forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status = forall (m :: * -> *).
MonadIO m =>
(ScottyResponse -> ScottyResponse) -> ActionT m ()
modifyResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> ScottyResponse -> ScottyResponse
setStatus
changeHeader :: MonadIO m
=> (CI.CI B.ByteString -> B.ByteString -> [(HeaderName, B.ByteString)] -> [(HeaderName, B.ByteString)])
-> T.Text -> T.Text -> ActionT m ()
CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders
f Text
k =
forall (m :: * -> *).
MonadIO m =>
(ScottyResponse -> ScottyResponse) -> ActionT m ()
modifyResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RequestHeaders -> RequestHeaders)
-> ScottyResponse -> ScottyResponse
setHeaderWith forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders
f (forall s. FoldCase s => s -> CI s
CI.mk forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
addHeader :: MonadIO m => T.Text -> T.Text -> ActionT m ()
= forall (m :: * -> *).
MonadIO m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT m ()
changeHeader forall a b. a -> b -> [(a, b)] -> [(a, b)]
add
setHeader :: MonadIO m => T.Text -> T.Text -> ActionT m ()
= forall (m :: * -> *).
MonadIO m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT m ()
changeHeader forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
replace
text :: (MonadIO m) => T.Text -> ActionT m ()
text :: forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
text Text
t = do
forall (m :: * -> *).
MonadIO m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT m ()
changeHeader forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
addIfNotPresent Text
"Content-Type" Text
"text/plain; charset=utf-8"
forall (m :: * -> *). MonadIO m => ByteString -> ActionT m ()
raw forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.fromStrict forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
t
textLazy :: (MonadIO m) => TL.Text -> ActionT m ()
textLazy :: forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
textLazy Text
t = do
forall (m :: * -> *).
MonadIO m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT m ()
changeHeader forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
addIfNotPresent Text
"Content-Type" Text
"text/plain; charset=utf-8"
forall (m :: * -> *). MonadIO m => ByteString -> ActionT m ()
raw forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TLE.encodeUtf8 Text
t
html :: (MonadIO m) => T.Text -> ActionT m ()
html :: forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
html Text
t = do
forall (m :: * -> *).
MonadIO m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT m ()
changeHeader forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
addIfNotPresent Text
"Content-Type" Text
"text/html; charset=utf-8"
forall (m :: * -> *). MonadIO m => ByteString -> ActionT m ()
raw forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.fromStrict forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
t
htmlLazy :: (MonadIO m) => TL.Text -> ActionT m ()
htmlLazy :: forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
htmlLazy Text
t = do
forall (m :: * -> *).
MonadIO m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT m ()
changeHeader forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
addIfNotPresent Text
"Content-Type" Text
"text/html; charset=utf-8"
forall (m :: * -> *). MonadIO m => ByteString -> ActionT m ()
raw forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TLE.encodeUtf8 Text
t
file :: MonadIO m => FilePath -> ActionT m ()
file :: forall (m :: * -> *). MonadIO m => String -> ActionT m ()
file = forall (m :: * -> *).
MonadIO m =>
(ScottyResponse -> ScottyResponse) -> ActionT m ()
modifyResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> ScottyResponse -> ScottyResponse
setContent 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 = forall (m :: * -> *).
MonadIO m =>
(ScottyResponse -> ScottyResponse) -> ActionT m ()
modifyResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> ScottyResponse -> ScottyResponse
setContent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response -> Content
ContentResponse
json :: (A.ToJSON a, MonadIO m) => a -> ActionT m ()
json :: forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json a
v = do
forall (m :: * -> *).
MonadIO m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT m ()
changeHeader forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
addIfNotPresent Text
"Content-Type" Text
"application/json; charset=utf-8"
forall (m :: * -> *). MonadIO m => ByteString -> ActionT m ()
raw forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
A.encode a
v
stream :: MonadIO m => StreamingBody -> ActionT m ()
stream :: forall (m :: * -> *). MonadIO m => StreamingBody -> ActionT m ()
stream = forall (m :: * -> *).
MonadIO m =>
(ScottyResponse -> ScottyResponse) -> ActionT m ()
modifyResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> ScottyResponse -> ScottyResponse
setContent forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamingBody -> Content
ContentStream
raw :: MonadIO m => BL.ByteString -> ActionT m ()
raw :: forall (m :: * -> *). MonadIO m => ByteString -> ActionT m ()
raw = forall (m :: * -> *).
MonadIO m =>
(ScottyResponse -> ScottyResponse) -> ActionT m ()
modifyResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> ScottyResponse -> ScottyResponse
setContent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Content
ContentBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
fromLazyByteString
nested :: (MonadIO m) => Network.Wai.Application -> ActionT m ()
nested :: forall (m :: * -> *). MonadIO m => Application -> ActionT m ()
nested Application
app = do
Request
r <- forall (m :: * -> *). Monad m => ActionT m Request
request
MVar Response
ref <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO (MVar a)
newEmptyMVar
ResponseReceived
_ <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Application
app Request
r (\Response
res -> forall a. MVar a -> a -> IO ()
putMVar MVar Response
ref Response
res forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ResponseReceived
ResponseReceived)
Response
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
readMVar MVar Response
ref
forall (m :: * -> *). MonadIO m => Response -> ActionT m ()
rawResponse Response
res