{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# language ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE RecordWildCards #-}
module Web.Scotty.Internal.Types where
import Blaze.ByteString.Builder (Builder)
import Control.Applicative
import Control.Concurrent.MVar
import Control.Concurrent.STM (TVar, atomically, readTVarIO, modifyTVar')
import qualified Control.Exception as E
import Control.Monad (MonadPlus(..))
import Control.Monad.Base (MonadBase)
import Control.Monad.Catch (MonadCatch, MonadThrow)
import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.IO.Class (MonadIO(..))
import UnliftIO (MonadUnliftIO(..))
import Control.Monad.Reader (MonadReader(..), ReaderT, asks, mapReaderT)
import Control.Monad.State.Strict (State, StateT(..))
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Control (MonadBaseControl, MonadTransControl)
import qualified Control.Monad.Trans.Resource as RT (InternalState, InvalidAccess)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy.Char8 as LBS8 (ByteString)
import Data.Default.Class (Default, def)
import Data.String (IsString(..))
import qualified Data.Text as T (Text, pack)
import Data.Typeable (Typeable)
import Network.HTTP.Types
import Network.Wai hiding (Middleware, Application)
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as W (Settings, defaultSettings, InvalidRequest(..))
import Network.Wai.Parse (FileInfo)
import qualified Network.Wai.Parse as WPS (ParseRequestBodyOptions, RequestParseException(..))
import UnliftIO.Exception (Handler(..), catch, catches)
data Options = Options { Options -> Int
verbose :: Int
, Options -> Settings
settings :: W.Settings
}
instance Default Options where
def :: Options
def = Options
defaultOptions
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Int -> Settings -> Options
Options Int
1 Settings
W.defaultSettings
newtype RouteOptions = RouteOptions { RouteOptions -> Maybe Int
maxRequestBodySize :: Maybe Kilobytes
}
instance Default RouteOptions where
def :: RouteOptions
def = RouteOptions
defaultRouteOptions
defaultRouteOptions :: RouteOptions
defaultRouteOptions :: RouteOptions
defaultRouteOptions = Maybe Int -> RouteOptions
RouteOptions Maybe Int
forall a. Maybe a
Nothing
type Kilobytes = Int
type Middleware m = Application m -> Application m
type Application m = Request -> m Response
data BodyChunkBuffer = BodyChunkBuffer { BodyChunkBuffer -> Bool
hasFinishedReadingChunks :: Bool
, BodyChunkBuffer -> [ByteString]
chunksReadSoFar :: [BS.ByteString]
}
data BodyInfo = BodyInfo { BodyInfo -> MVar Int
bodyInfoReadProgress :: MVar Int
, BodyInfo -> MVar BodyChunkBuffer
bodyInfoChunkBuffer :: MVar BodyChunkBuffer
, BodyInfo -> IO ByteString
bodyInfoDirectChunkRead :: IO BS.ByteString
}
data ScottyState m =
ScottyState { forall (m :: * -> *). ScottyState m -> [Middleware]
middlewares :: [Wai.Middleware]
, forall (m :: * -> *). ScottyState m -> [BodyInfo -> Middleware m]
routes :: [BodyInfo -> Middleware m]
, forall (m :: * -> *). ScottyState m -> Maybe (ErrorHandler m)
handler :: Maybe (ErrorHandler m)
, forall (m :: * -> *). ScottyState m -> RouteOptions
routeOptions :: RouteOptions
}
defaultScottyState :: ScottyState m
defaultScottyState :: forall (m :: * -> *). ScottyState m
defaultScottyState = [Middleware]
-> [BodyInfo -> Middleware m]
-> Maybe (ErrorHandler m)
-> RouteOptions
-> ScottyState m
forall (m :: * -> *).
[Middleware]
-> [BodyInfo -> Middleware m]
-> Maybe (ErrorHandler m)
-> RouteOptions
-> ScottyState m
ScottyState [] [] Maybe (ErrorHandler m)
forall a. Maybe a
Nothing RouteOptions
defaultRouteOptions
addMiddleware :: Wai.Middleware -> ScottyState m -> ScottyState m
addMiddleware :: forall (m :: * -> *). Middleware -> ScottyState m -> ScottyState m
addMiddleware Middleware
m s :: ScottyState m
s@(ScottyState {middlewares :: forall (m :: * -> *). ScottyState m -> [Middleware]
middlewares = [Middleware]
ms}) = ScottyState m
s { middlewares = m:ms }
addRoute :: (BodyInfo -> Middleware m) -> ScottyState m -> ScottyState m
addRoute :: forall (m :: * -> *).
(BodyInfo -> Middleware m) -> ScottyState m -> ScottyState m
addRoute BodyInfo -> Middleware m
r s :: ScottyState m
s@(ScottyState {routes :: forall (m :: * -> *). ScottyState m -> [BodyInfo -> Middleware m]
routes = [BodyInfo -> Middleware m]
rs}) = ScottyState m
s { routes = r:rs }
setHandler :: Maybe (ErrorHandler m) -> ScottyState m -> ScottyState m
setHandler :: forall (m :: * -> *).
Maybe (ErrorHandler m) -> ScottyState m -> ScottyState m
setHandler Maybe (ErrorHandler m)
h ScottyState m
s = ScottyState m
s { handler = h }
updateMaxRequestBodySize :: RouteOptions -> ScottyState m -> ScottyState m
updateMaxRequestBodySize :: forall (m :: * -> *).
RouteOptions -> ScottyState m -> ScottyState m
updateMaxRequestBodySize RouteOptions { Maybe Int
maxRequestBodySize :: RouteOptions -> Maybe Int
maxRequestBodySize :: Maybe Int
.. } s :: ScottyState m
s@ScottyState { routeOptions :: forall (m :: * -> *). ScottyState m -> RouteOptions
routeOptions = RouteOptions
ro } =
let ro' :: RouteOptions
ro' = RouteOptions
ro { maxRequestBodySize = maxRequestBodySize }
in ScottyState m
s { routeOptions = ro' }
newtype ScottyT m a =
ScottyT { forall (m :: * -> *) a.
ScottyT m a -> ReaderT Options (State (ScottyState m)) a
runS :: ReaderT Options (State (ScottyState m)) a }
deriving ( (forall a b. (a -> b) -> ScottyT m a -> ScottyT m b)
-> (forall a b. a -> ScottyT m b -> ScottyT m a)
-> Functor (ScottyT m)
forall a b. a -> ScottyT m b -> ScottyT m a
forall a b. (a -> b) -> ScottyT m a -> ScottyT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) a b. a -> ScottyT m b -> ScottyT m a
forall (m :: * -> *) a b. (a -> b) -> ScottyT m a -> ScottyT m b
$cfmap :: forall (m :: * -> *) a b. (a -> b) -> ScottyT m a -> ScottyT m b
fmap :: forall a b. (a -> b) -> ScottyT m a -> ScottyT m b
$c<$ :: forall (m :: * -> *) a b. a -> ScottyT m b -> ScottyT m a
<$ :: forall a b. a -> ScottyT m b -> ScottyT m a
Functor, Functor (ScottyT m)
Functor (ScottyT m) =>
(forall a. a -> ScottyT m a)
-> (forall a b. ScottyT m (a -> b) -> ScottyT m a -> ScottyT m b)
-> (forall a b c.
(a -> b -> c) -> ScottyT m a -> ScottyT m b -> ScottyT m c)
-> (forall a b. ScottyT m a -> ScottyT m b -> ScottyT m b)
-> (forall a b. ScottyT m a -> ScottyT m b -> ScottyT m a)
-> Applicative (ScottyT m)
forall a. a -> ScottyT m a
forall a b. ScottyT m a -> ScottyT m b -> ScottyT m a
forall a b. ScottyT m a -> ScottyT m b -> ScottyT m b
forall a b. ScottyT m (a -> b) -> ScottyT m a -> ScottyT m b
forall a b c.
(a -> b -> c) -> ScottyT m a -> ScottyT m b -> ScottyT m c
forall (m :: * -> *). Functor (ScottyT m)
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *) a. a -> ScottyT m a
forall (m :: * -> *) a b. ScottyT m a -> ScottyT m b -> ScottyT m a
forall (m :: * -> *) a b. ScottyT m a -> ScottyT m b -> ScottyT m b
forall (m :: * -> *) a b.
ScottyT m (a -> b) -> ScottyT m a -> ScottyT m b
forall (m :: * -> *) a b c.
(a -> b -> c) -> ScottyT m a -> ScottyT m b -> ScottyT m c
$cpure :: forall (m :: * -> *) a. a -> ScottyT m a
pure :: forall a. a -> ScottyT m a
$c<*> :: forall (m :: * -> *) a b.
ScottyT m (a -> b) -> ScottyT m a -> ScottyT m b
<*> :: forall a b. ScottyT m (a -> b) -> ScottyT m a -> ScottyT m b
$cliftA2 :: forall (m :: * -> *) a b c.
(a -> b -> c) -> ScottyT m a -> ScottyT m b -> ScottyT m c
liftA2 :: forall a b c.
(a -> b -> c) -> ScottyT m a -> ScottyT m b -> ScottyT m c
$c*> :: forall (m :: * -> *) a b. ScottyT m a -> ScottyT m b -> ScottyT m b
*> :: forall a b. ScottyT m a -> ScottyT m b -> ScottyT m b
$c<* :: forall (m :: * -> *) a b. ScottyT m a -> ScottyT m b -> ScottyT m a
<* :: forall a b. ScottyT m a -> ScottyT m b -> ScottyT m a
Applicative, Applicative (ScottyT m)
Applicative (ScottyT m) =>
(forall a b. ScottyT m a -> (a -> ScottyT m b) -> ScottyT m b)
-> (forall a b. ScottyT m a -> ScottyT m b -> ScottyT m b)
-> (forall a. a -> ScottyT m a)
-> Monad (ScottyT m)
forall a. a -> ScottyT m a
forall a b. ScottyT m a -> ScottyT m b -> ScottyT m b
forall a b. ScottyT m a -> (a -> ScottyT m b) -> ScottyT m b
forall (m :: * -> *). Applicative (ScottyT m)
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall (m :: * -> *) a. a -> ScottyT m a
forall (m :: * -> *) a b. ScottyT m a -> ScottyT m b -> ScottyT m b
forall (m :: * -> *) a b.
ScottyT m a -> (a -> ScottyT m b) -> ScottyT m b
$c>>= :: forall (m :: * -> *) a b.
ScottyT m a -> (a -> ScottyT m b) -> ScottyT m b
>>= :: forall a b. ScottyT m a -> (a -> ScottyT m b) -> ScottyT m b
$c>> :: forall (m :: * -> *) a b. ScottyT m a -> ScottyT m b -> ScottyT m b
>> :: forall a b. ScottyT m a -> ScottyT m b -> ScottyT m b
$creturn :: forall (m :: * -> *) a. a -> ScottyT m a
return :: forall a. a -> ScottyT m a
Monad )
data ActionError
= AERedirect T.Text
| AENext
| AEFinish
deriving (Int -> ActionError -> ShowS
[ActionError] -> ShowS
ActionError -> String
(Int -> ActionError -> ShowS)
-> (ActionError -> String)
-> ([ActionError] -> ShowS)
-> Show ActionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionError -> ShowS
showsPrec :: Int -> ActionError -> ShowS
$cshow :: ActionError -> String
show :: ActionError -> String
$cshowList :: [ActionError] -> ShowS
showList :: [ActionError] -> ShowS
Show, Typeable)
instance E.Exception ActionError
tryNext :: MonadUnliftIO m => m a -> m Bool
tryNext :: forall (m :: * -> *) a. MonadUnliftIO m => m a -> m Bool
tryNext m a
io = m Bool -> (ActionError -> m Bool) -> m Bool
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch (m a
io m a -> m Bool -> m Bool
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) ((ActionError -> m Bool) -> m Bool)
-> (ActionError -> m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ \ActionError
e ->
case ActionError
e of
ActionError
AENext -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
ActionError
_ -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
data StatusError = StatusError Status T.Text deriving (Int -> StatusError -> ShowS
[StatusError] -> ShowS
StatusError -> String
(Int -> StatusError -> ShowS)
-> (StatusError -> String)
-> ([StatusError] -> ShowS)
-> Show StatusError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StatusError -> ShowS
showsPrec :: Int -> StatusError -> ShowS
$cshow :: StatusError -> String
show :: StatusError -> String
$cshowList :: [StatusError] -> ShowS
showList :: [StatusError] -> ShowS
Show, Typeable)
instance E.Exception StatusError
{-# DEPRECATED StatusError "If it is supposed to be caught, a proper exception type should be defined" #-}
type ErrorHandler m = Handler (ActionT m) ()
data ScottyException
= RequestTooLarge
| MalformedJSON LBS8.ByteString T.Text
| FailedToParseJSON LBS8.ByteString T.Text
| PathParameterNotFound T.Text
| QueryParameterNotFound T.Text
| FormFieldNotFound T.Text
| FailedToParseParameter T.Text T.Text T.Text
| WarpRequestException W.InvalidRequest
| WaiRequestParseException WPS.RequestParseException
| ResourceTException RT.InvalidAccess
deriving (Int -> ScottyException -> ShowS
[ScottyException] -> ShowS
ScottyException -> String
(Int -> ScottyException -> ShowS)
-> (ScottyException -> String)
-> ([ScottyException] -> ShowS)
-> Show ScottyException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScottyException -> ShowS
showsPrec :: Int -> ScottyException -> ShowS
$cshow :: ScottyException -> String
show :: ScottyException -> String
$cshowList :: [ScottyException] -> ShowS
showList :: [ScottyException] -> ShowS
Show, Typeable)
instance E.Exception ScottyException
type Param = (T.Text, T.Text)
type File t = (T.Text, FileInfo t)
data ActionEnv = Env { ActionEnv -> Request
envReq :: Request
, ActionEnv -> [Param]
envPathParams :: [Param]
, ActionEnv -> [Param]
envQueryParams :: [Param]
, ActionEnv
-> InternalState
-> ParseRequestBodyOptions
-> IO ([Param], [File String])
envFormDataAction :: RT.InternalState -> WPS.ParseRequestBodyOptions -> IO ([Param], [File FilePath])
, ActionEnv -> IO ByteString
envBody :: IO LBS8.ByteString
, ActionEnv -> IO ByteString
envBodyChunk :: IO BS.ByteString
, ActionEnv -> TVar ScottyResponse
envResponse :: TVar ScottyResponse
}
formParamsAndFilesWith :: MonadUnliftIO m =>
RT.InternalState
-> WPS.ParseRequestBodyOptions
-> ActionT m ([Param], [File FilePath])
formParamsAndFilesWith :: forall (m :: * -> *).
MonadUnliftIO m =>
InternalState
-> ParseRequestBodyOptions -> ActionT m ([Param], [File String])
formParamsAndFilesWith InternalState
istate ParseRequestBodyOptions
prbo = ActionT m ([Param], [File String])
action ActionT m ([Param], [File String])
-> (InvalidAccess -> ActionT m ([Param], [File String]))
-> ActionT m ([Param], [File String])
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (\(InvalidAccess
e :: RT.InvalidAccess) -> ScottyException -> ActionT m ([Param], [File String])
forall a e. Exception e => e -> a
E.throw (ScottyException -> ActionT m ([Param], [File String]))
-> ScottyException -> ActionT m ([Param], [File String])
forall a b. (a -> b) -> a -> b
$ InvalidAccess -> ScottyException
ResourceTException InvalidAccess
e)
where
action :: ActionT m ([Param], [File String])
action = do
InternalState
-> ParseRequestBodyOptions -> IO ([Param], [File String])
act <- ReaderT
ActionEnv
m
(InternalState
-> ParseRequestBodyOptions -> IO ([Param], [File String]))
-> ActionT
m
(InternalState
-> ParseRequestBodyOptions -> IO ([Param], [File String]))
forall (m :: * -> *) a. ReaderT ActionEnv m a -> ActionT m a
ActionT (ReaderT
ActionEnv
m
(InternalState
-> ParseRequestBodyOptions -> IO ([Param], [File String]))
-> ActionT
m
(InternalState
-> ParseRequestBodyOptions -> IO ([Param], [File String])))
-> ReaderT
ActionEnv
m
(InternalState
-> ParseRequestBodyOptions -> IO ([Param], [File String]))
-> ActionT
m
(InternalState
-> ParseRequestBodyOptions -> IO ([Param], [File String]))
forall a b. (a -> b) -> a -> b
$ (ActionEnv
-> InternalState
-> ParseRequestBodyOptions
-> IO ([Param], [File String]))
-> ReaderT
ActionEnv
m
(InternalState
-> ParseRequestBodyOptions -> IO ([Param], [File String]))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ActionEnv
-> InternalState
-> ParseRequestBodyOptions
-> IO ([Param], [File String])
envFormDataAction
IO ([Param], [File String]) -> ActionT m ([Param], [File String])
forall a. IO a -> ActionT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([Param], [File String]) -> ActionT m ([Param], [File String]))
-> IO ([Param], [File String])
-> ActionT m ([Param], [File String])
forall a b. (a -> b) -> a -> b
$ InternalState
-> ParseRequestBodyOptions -> IO ([Param], [File String])
act InternalState
istate ParseRequestBodyOptions
prbo
getResponse :: MonadIO m => ActionEnv -> m ScottyResponse
getResponse :: forall (m :: * -> *). MonadIO m => ActionEnv -> m ScottyResponse
getResponse ActionEnv
ae = IO ScottyResponse -> m ScottyResponse
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ScottyResponse -> m ScottyResponse)
-> IO ScottyResponse -> m ScottyResponse
forall a b. (a -> b) -> a -> b
$ TVar ScottyResponse -> IO ScottyResponse
forall a. TVar a -> IO a
readTVarIO (ActionEnv -> TVar ScottyResponse
envResponse ActionEnv
ae)
getResponseAction :: (MonadIO m) => ActionT m ScottyResponse
getResponseAction :: forall (m :: * -> *). MonadIO m => ActionT m ScottyResponse
getResponseAction = do
ActionEnv
ae <- 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
ActionEnv -> ActionT m ScottyResponse
forall (m :: * -> *). MonadIO m => ActionEnv -> m ScottyResponse
getResponse ActionEnv
ae
modifyResponse :: (MonadIO m) => (ScottyResponse -> ScottyResponse) -> ActionT m ()
modifyResponse :: forall (m :: * -> *).
MonadIO m =>
(ScottyResponse -> ScottyResponse) -> ActionT m ()
modifyResponse ScottyResponse -> ScottyResponse
f = do
TVar ScottyResponse
tv <- ReaderT ActionEnv m (TVar ScottyResponse)
-> ActionT m (TVar ScottyResponse)
forall (m :: * -> *) a. ReaderT ActionEnv m a -> ActionT m a
ActionT (ReaderT ActionEnv m (TVar ScottyResponse)
-> ActionT m (TVar ScottyResponse))
-> ReaderT ActionEnv m (TVar ScottyResponse)
-> ActionT m (TVar ScottyResponse)
forall a b. (a -> b) -> a -> b
$ (ActionEnv -> TVar ScottyResponse)
-> ReaderT ActionEnv m (TVar ScottyResponse)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ActionEnv -> TVar ScottyResponse
envResponse
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
$ STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar ScottyResponse -> (ScottyResponse -> ScottyResponse) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar ScottyResponse
tv ScottyResponse -> ScottyResponse
f
data BodyPartiallyStreamed = BodyPartiallyStreamed deriving (Int -> BodyPartiallyStreamed -> ShowS
[BodyPartiallyStreamed] -> ShowS
BodyPartiallyStreamed -> String
(Int -> BodyPartiallyStreamed -> ShowS)
-> (BodyPartiallyStreamed -> String)
-> ([BodyPartiallyStreamed] -> ShowS)
-> Show BodyPartiallyStreamed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BodyPartiallyStreamed -> ShowS
showsPrec :: Int -> BodyPartiallyStreamed -> ShowS
$cshow :: BodyPartiallyStreamed -> String
show :: BodyPartiallyStreamed -> String
$cshowList :: [BodyPartiallyStreamed] -> ShowS
showList :: [BodyPartiallyStreamed] -> ShowS
Show, Typeable)
instance E.Exception BodyPartiallyStreamed
data Content = ContentBuilder Builder
| ContentFile FilePath
| ContentStream StreamingBody
| ContentResponse Response
data ScottyResponse = SR { ScottyResponse -> Status
srStatus :: Status
, :: ResponseHeaders
, ScottyResponse -> Content
srContent :: Content
}
setContent :: Content -> ScottyResponse -> ScottyResponse
setContent :: Content -> ScottyResponse -> ScottyResponse
setContent Content
c ScottyResponse
sr = ScottyResponse
sr { srContent = c }
setHeaderWith :: ([(HeaderName, BS.ByteString)] -> [(HeaderName, BS.ByteString)]) -> ScottyResponse -> ScottyResponse
ResponseHeaders -> ResponseHeaders
f ScottyResponse
sr = ScottyResponse
sr { srHeaders = f (srHeaders sr) }
setStatus :: Status -> ScottyResponse -> ScottyResponse
setStatus :: Status -> ScottyResponse -> ScottyResponse
setStatus Status
s ScottyResponse
sr = ScottyResponse
sr { srStatus = s }
instance Default ScottyResponse where
def :: ScottyResponse
def = ScottyResponse
defaultScottyResponse
defaultScottyResponse :: ScottyResponse
defaultScottyResponse :: ScottyResponse
defaultScottyResponse = Status -> ResponseHeaders -> Content -> ScottyResponse
SR Status
status200 [] (Builder -> Content
ContentBuilder Builder
forall a. Monoid a => a
mempty)
newtype ActionT m a = ActionT { forall (m :: * -> *) a. ActionT m a -> ReaderT ActionEnv m a
runAM :: ReaderT ActionEnv m a }
deriving newtype ((forall a b. (a -> b) -> ActionT m a -> ActionT m b)
-> (forall a b. a -> ActionT m b -> ActionT m a)
-> Functor (ActionT m)
forall a b. a -> ActionT m b -> ActionT m a
forall a b. (a -> b) -> ActionT m a -> ActionT m b
forall (m :: * -> *) a b.
Functor m =>
a -> ActionT m b -> ActionT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ActionT m a -> ActionT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ActionT m a -> ActionT m b
fmap :: forall a b. (a -> b) -> ActionT m a -> ActionT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> ActionT m b -> ActionT m a
<$ :: forall a b. a -> ActionT m b -> ActionT m a
Functor, Functor (ActionT m)
Functor (ActionT m) =>
(forall a. a -> ActionT m a)
-> (forall a b. ActionT m (a -> b) -> ActionT m a -> ActionT m b)
-> (forall a b c.
(a -> b -> c) -> ActionT m a -> ActionT m b -> ActionT m c)
-> (forall a b. ActionT m a -> ActionT m b -> ActionT m b)
-> (forall a b. ActionT m a -> ActionT m b -> ActionT m a)
-> Applicative (ActionT m)
forall a. a -> ActionT m a
forall a b. ActionT m a -> ActionT m b -> ActionT m a
forall a b. ActionT m a -> ActionT m b -> ActionT m b
forall a b. ActionT m (a -> b) -> ActionT m a -> ActionT m b
forall a b c.
(a -> b -> c) -> ActionT m a -> ActionT m b -> ActionT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (ActionT m)
forall (m :: * -> *) a. Applicative m => a -> ActionT m a
forall (m :: * -> *) a b.
Applicative m =>
ActionT m a -> ActionT m b -> ActionT m a
forall (m :: * -> *) a b.
Applicative m =>
ActionT m a -> ActionT m b -> ActionT m b
forall (m :: * -> *) a b.
Applicative m =>
ActionT m (a -> b) -> ActionT m a -> ActionT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> ActionT m a -> ActionT m b -> ActionT m c
$cpure :: forall (m :: * -> *) a. Applicative m => a -> ActionT m a
pure :: forall a. a -> ActionT m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
ActionT m (a -> b) -> ActionT m a -> ActionT m b
<*> :: forall a b. ActionT m (a -> b) -> ActionT m a -> ActionT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> ActionT m a -> ActionT m b -> ActionT m c
liftA2 :: forall a b c.
(a -> b -> c) -> ActionT m a -> ActionT m b -> ActionT m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
ActionT m a -> ActionT m b -> ActionT m b
*> :: forall a b. ActionT m a -> ActionT m b -> ActionT m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
ActionT m a -> ActionT m b -> ActionT m a
<* :: forall a b. ActionT m a -> ActionT m b -> ActionT m a
Applicative, Applicative (ActionT m)
Applicative (ActionT m) =>
(forall a b. ActionT m a -> (a -> ActionT m b) -> ActionT m b)
-> (forall a b. ActionT m a -> ActionT m b -> ActionT m b)
-> (forall a. a -> ActionT m a)
-> Monad (ActionT m)
forall a. a -> ActionT m a
forall a b. ActionT m a -> ActionT m b -> ActionT m b
forall a b. ActionT m a -> (a -> ActionT m b) -> ActionT m b
forall (m :: * -> *). Monad m => Applicative (ActionT m)
forall (m :: * -> *) a. Monad m => a -> ActionT m a
forall (m :: * -> *) a b.
Monad m =>
ActionT m a -> ActionT m b -> ActionT m b
forall (m :: * -> *) a b.
Monad m =>
ActionT m a -> (a -> ActionT m b) -> ActionT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
ActionT m a -> (a -> ActionT m b) -> ActionT m b
>>= :: forall a b. ActionT m a -> (a -> ActionT m b) -> ActionT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
ActionT m a -> ActionT m b -> ActionT m b
>> :: forall a b. ActionT m a -> ActionT m b -> ActionT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> ActionT m a
return :: forall a. a -> ActionT m a
Monad, Monad (ActionT m)
Monad (ActionT m) =>
(forall a. IO a -> ActionT m a) -> MonadIO (ActionT m)
forall a. IO a -> ActionT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (ActionT m)
forall (m :: * -> *) a. MonadIO m => IO a -> ActionT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> ActionT m a
liftIO :: forall a. IO a -> ActionT m a
MonadIO, (forall (m :: * -> *). Monad m => Monad (ActionT m)) =>
(forall (m :: * -> *) a. Monad m => m a -> ActionT m a)
-> MonadTrans ActionT
forall (m :: * -> *). Monad m => Monad (ActionT m)
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *). Monad m => Monad (t m)) =>
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (m :: * -> *) a. Monad m => m a -> ActionT m a
lift :: forall (m :: * -> *) a. Monad m => m a -> ActionT m a
MonadTrans, Monad (ActionT m)
Monad (ActionT m) =>
(forall e a. (HasCallStack, Exception e) => e -> ActionT m a)
-> MonadThrow (ActionT m)
forall e a. (HasCallStack, Exception e) => e -> ActionT m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (ActionT m)
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> ActionT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> ActionT m a
throwM :: forall e a. (HasCallStack, Exception e) => e -> ActionT m a
MonadThrow, MonadThrow (ActionT m)
MonadThrow (ActionT m) =>
(forall e a.
(HasCallStack, Exception e) =>
ActionT m a -> (e -> ActionT m a) -> ActionT m a)
-> MonadCatch (ActionT m)
forall e a.
(HasCallStack, Exception e) =>
ActionT m a -> (e -> ActionT m a) -> ActionT m a
forall (m :: * -> *). MonadCatch m => MonadThrow (ActionT m)
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
ActionT m a -> (e -> ActionT m a) -> ActionT m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
(HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
ActionT m a -> (e -> ActionT m a) -> ActionT m a
catch :: forall e a.
(HasCallStack, Exception e) =>
ActionT m a -> (e -> ActionT m a) -> ActionT m a
MonadCatch, MonadBase b, MonadBaseControl b, MonadTrans ActionT
MonadTrans ActionT =>
(forall (m :: * -> *) a.
Monad m =>
(Run ActionT -> m a) -> ActionT m a)
-> (forall (m :: * -> *) a.
Monad m =>
m (StT ActionT a) -> ActionT m a)
-> MonadTransControl ActionT
forall (m :: * -> *) a. Monad m => m (StT ActionT a) -> ActionT m a
forall (m :: * -> *) a.
Monad m =>
(Run ActionT -> m a) -> ActionT m a
forall (t :: (* -> *) -> * -> *).
MonadTrans t =>
(forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a)
-> (forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a)
-> MonadTransControl t
$cliftWith :: forall (m :: * -> *) a.
Monad m =>
(Run ActionT -> m a) -> ActionT m a
liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run ActionT -> m a) -> ActionT m a
$crestoreT :: forall (m :: * -> *) a. Monad m => m (StT ActionT a) -> ActionT m a
restoreT :: forall (m :: * -> *) a. Monad m => m (StT ActionT a) -> ActionT m a
MonadTransControl, MonadIO (ActionT m)
MonadIO (ActionT m) =>
(forall b.
((forall a. ActionT m a -> IO a) -> IO b) -> ActionT m b)
-> MonadUnliftIO (ActionT m)
forall b. ((forall a. ActionT m a -> IO a) -> IO b) -> ActionT m b
forall (m :: * -> *).
MonadIO m =>
(forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
forall (m :: * -> *). MonadUnliftIO m => MonadIO (ActionT m)
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. ActionT m a -> IO a) -> IO b) -> ActionT m b
$cwithRunInIO :: forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. ActionT m a -> IO a) -> IO b) -> ActionT m b
withRunInIO :: forall b. ((forall a. ActionT m a -> IO a) -> IO b) -> ActionT m b
MonadUnliftIO)
withActionEnv :: Monad m =>
(ActionEnv -> ActionEnv) -> ActionT m a -> ActionT m a
withActionEnv :: forall (m :: * -> *) a.
Monad m =>
(ActionEnv -> ActionEnv) -> ActionT m a -> ActionT m a
withActionEnv ActionEnv -> ActionEnv
f (ActionT ReaderT ActionEnv m a
r) = ReaderT ActionEnv m a -> ActionT m a
forall (m :: * -> *) a. ReaderT ActionEnv m a -> ActionT m a
ActionT (ReaderT ActionEnv m a -> ActionT m a)
-> ReaderT ActionEnv m a -> ActionT m a
forall a b. (a -> b) -> a -> b
$ (ActionEnv -> ActionEnv)
-> ReaderT ActionEnv m a -> ReaderT ActionEnv m a
forall a.
(ActionEnv -> ActionEnv)
-> ReaderT ActionEnv m a -> ReaderT ActionEnv m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ActionEnv -> ActionEnv
f ReaderT ActionEnv m a
r
instance MonadReader r m => MonadReader r (ActionT m) where
ask :: ActionT m r
ask = ReaderT ActionEnv m r -> ActionT m r
forall (m :: * -> *) a. ReaderT ActionEnv m a -> ActionT m a
ActionT (ReaderT ActionEnv m r -> ActionT m r)
-> ReaderT ActionEnv m r -> ActionT m r
forall a b. (a -> b) -> a -> b
$ m r -> ReaderT ActionEnv m r
forall (m :: * -> *) a. Monad m => m a -> ReaderT ActionEnv m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
local :: forall a. (r -> r) -> ActionT m a -> ActionT m a
local r -> r
f = ReaderT ActionEnv m a -> ActionT m a
forall (m :: * -> *) a. ReaderT ActionEnv m a -> ActionT m a
ActionT (ReaderT ActionEnv m a -> ActionT m a)
-> (ActionT m a -> ReaderT ActionEnv m a)
-> ActionT m a
-> ActionT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m a -> m a) -> ReaderT ActionEnv m a -> ReaderT ActionEnv m a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((r -> r) -> m a -> m a
forall a. (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f) (ReaderT ActionEnv m a -> ReaderT ActionEnv m a)
-> (ActionT m a -> ReaderT ActionEnv m a)
-> ActionT m a
-> ReaderT ActionEnv m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionT m a -> ReaderT ActionEnv m a
forall (m :: * -> *) a. ActionT m a -> ReaderT ActionEnv m a
runAM
instance (MonadUnliftIO m) => MonadError StatusError (ActionT m) where
throwError :: forall a. StatusError -> ActionT m a
throwError = StatusError -> ActionT m a
forall a e. Exception e => e -> a
E.throw
catchError :: forall a.
ActionT m a -> (StatusError -> ActionT m a) -> ActionT m a
catchError = ActionT m a -> (StatusError -> ActionT m a) -> ActionT m a
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
instance (MonadIO m) => MonadFail (ActionT m) where
fail :: forall a. String -> ActionT m a
fail = StatusError -> ActionT m a
forall a e. Exception e => e -> a
E.throw (StatusError -> ActionT m a)
-> (String -> StatusError) -> String -> ActionT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Text -> StatusError
StatusError Status
status500 (Text -> StatusError) -> (String -> Text) -> String -> StatusError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
instance (MonadUnliftIO m) => Alternative (ActionT m) where
empty :: forall a. ActionT m a
empty = ActionError -> ActionT m a
forall a e. Exception e => e -> a
E.throw ActionError
AENext
ActionT m a
a <|> :: forall a. ActionT m a -> ActionT m a -> ActionT m a
<|> ActionT m a
b = do
Bool
ok <- ActionT m a -> ActionT m Bool
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m Bool
tryAnyStatus ActionT m a
a
if Bool
ok then ActionT m a
a else ActionT m a
b
instance (MonadUnliftIO m) => MonadPlus (ActionT m) where
mzero :: forall a. ActionT m a
mzero = ActionT m a
forall a. ActionT m a
forall (f :: * -> *) a. Alternative f => f a
empty
mplus :: forall a. ActionT m a -> ActionT m a -> ActionT m a
mplus = ActionT m a -> ActionT m a -> ActionT m a
forall a. ActionT m a -> ActionT m a -> ActionT m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
tryAnyStatus :: MonadUnliftIO m => m a -> m Bool
tryAnyStatus :: forall (m :: * -> *) a. MonadUnliftIO m => m a -> m Bool
tryAnyStatus m a
io = (m a
io m a -> m Bool -> m Bool
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) m Bool -> [Handler m Bool] -> m Bool
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> [Handler m a] -> m a
`catches` [Handler m Bool
h1, Handler m Bool
h2, Handler m Bool
h3]
where
h1 :: Handler m Bool
h1 = (ActionError -> m Bool) -> Handler m Bool
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((ActionError -> m Bool) -> Handler m Bool)
-> (ActionError -> m Bool) -> Handler m Bool
forall a b. (a -> b) -> a -> b
$ \(ActionError
_ :: ActionError) -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
h2 :: Handler m Bool
h2 = (StatusError -> m Bool) -> Handler m Bool
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((StatusError -> m Bool) -> Handler m Bool)
-> (StatusError -> m Bool) -> Handler m Bool
forall a b. (a -> b) -> a -> b
$ \(StatusError
_ :: StatusError) -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
h3 :: Handler m Bool
h3 = (ScottyException -> m Bool) -> Handler m Bool
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((ScottyException -> m Bool) -> Handler m Bool)
-> (ScottyException -> m Bool) -> Handler m Bool
forall a b. (a -> b) -> a -> b
$ \(ScottyException
_ :: ScottyException) -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
instance (Semigroup a) => Semigroup (ScottyT m a) where
ScottyT m a
x <> :: ScottyT m a -> ScottyT m a -> ScottyT m a
<> ScottyT m a
y = a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) (a -> a -> a) -> ScottyT m a -> ScottyT m (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScottyT m a
x ScottyT m (a -> a) -> ScottyT m a -> ScottyT m a
forall a b. ScottyT m (a -> b) -> ScottyT m a -> ScottyT m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ScottyT m a
y
instance
( Monoid a
) => Monoid (ScottyT m a) where
mempty :: ScottyT m a
mempty = a -> ScottyT m a
forall a. a -> ScottyT m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty
instance
( Monad m
, Semigroup a
) => Semigroup (ActionT m a) where
ActionT m a
x <> :: ActionT m a -> ActionT m a -> ActionT m a
<> ActionT m a
y = a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) (a -> a -> a) -> ActionT m a -> ActionT m (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT m a
x ActionT m (a -> a) -> ActionT m a -> ActionT m a
forall a b. ActionT m (a -> b) -> ActionT m a -> ActionT m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT m a
y
instance
( Monad m, Monoid a
) => Monoid (ActionT m a) where
mempty :: ActionT m a
mempty = a -> ActionT m a
forall a. a -> ActionT m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty
data RoutePattern = Capture T.Text
| Literal T.Text
| Function (Request -> Maybe [Param])
instance IsString RoutePattern where
fromString :: String -> RoutePattern
fromString = Text -> RoutePattern
Capture (Text -> RoutePattern)
-> (String -> Text) -> String -> RoutePattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack