{-# LANGUAGE OverloadedStrings, RankNTypes #-}
{-# language LambdaCase #-}
module Web.Scotty.Trans
(
scottyT
, scottyOptsT
, scottySocketT
, Options(..), defaultOptions
, scottyAppT
, middleware, get, post, put, delete, patch, options, addroute, matchAny, notFound, setMaxRequestBodySize
, capture, regex, function, literal
, request, Lazy.header, Lazy.headers, body, bodyReader
, jsonData
, param, params
, pathParam, captureParam, formParam, queryParam
, pathParamMaybe, captureParamMaybe, formParamMaybe, queryParamMaybe
, pathParams, captureParams, formParams, queryParams
, files, filesOpts, ParseRequestBodyOptions
, status, Lazy.addHeader, Lazy.setHeader, Lazy.redirect
, Lazy.text, Lazy.html, file, json, stream, raw, nested
, getResponseHeaders, getResponseStatus, getResponseContent
, Lazy.raise, Lazy.raiseStatus, throw, rescue, next, finish, defaultHandler, liftAndCatchIO
, liftIO, catch
, StatusError(..)
, ScottyException(..)
, Param, Parsable(..), readEither
, RoutePattern, File, Content(..), Kilobytes, ErrorHandler, Handler(..)
, ScottyT, ActionT
, ScottyState, defaultScottyState
) where
import Blaze.ByteString.Builder (fromByteString)
import Blaze.ByteString.Builder.Char8 (fromString)
import Control.Exception (assert)
import Control.Monad (when)
import Control.Monad.Reader (runReaderT)
import Control.Monad.State.Strict (execState, modify)
import Control.Monad.IO.Class
import Network.HTTP.Types (status404, status413, status500)
import Network.Socket (Socket)
import qualified Network.Wai as W (Application, Middleware, Response, responseBuilder)
import Network.Wai.Handler.Warp (Port, runSettings, runSettingsSocket, setPort, getPort)
import Web.Scotty.Action
import Web.Scotty.Route
import Web.Scotty.Internal.Types (ScottyT(..), defaultScottyState, Application, RoutePattern, Options(..), defaultOptions, RouteOptions(..), defaultRouteOptions, ErrorHandler, Kilobytes, File, addMiddleware, setHandler, updateMaxRequestBodySize, routes, middlewares, ScottyException(..), ScottyState, defaultScottyState, StatusError(..), Content(..))
import Web.Scotty.Trans.Lazy as Lazy
import Web.Scotty.Util (socketDescription)
import Web.Scotty.Body (newBodyInfo)
import UnliftIO.Exception (Handler(..), catch)
scottyT :: (Monad m, MonadIO n)
=> Port
-> (m W.Response -> IO W.Response)
-> ScottyT m ()
-> n ()
scottyT :: forall (m :: * -> *) (n :: * -> *).
(Monad m, MonadIO n) =>
Port -> (m Response -> IO Response) -> ScottyT m () -> n ()
scottyT Port
p = Options -> (m Response -> IO Response) -> ScottyT m () -> n ()
forall (m :: * -> *) (n :: * -> *).
(Monad m, MonadIO n) =>
Options -> (m Response -> IO Response) -> ScottyT m () -> n ()
scottyOptsT (Options -> (m Response -> IO Response) -> ScottyT m () -> n ())
-> Options -> (m Response -> IO Response) -> ScottyT m () -> n ()
forall a b. (a -> b) -> a -> b
$ Options
defaultOptions { settings = setPort p (settings defaultOptions) }
scottyOptsT :: (Monad m, MonadIO n)
=> Options
-> (m W.Response -> IO W.Response)
-> ScottyT m ()
-> n ()
scottyOptsT :: forall (m :: * -> *) (n :: * -> *).
(Monad m, MonadIO n) =>
Options -> (m Response -> IO Response) -> ScottyT m () -> n ()
scottyOptsT Options
opts m Response -> IO Response
runActionToIO ScottyT m ()
s = do
Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Port
verbose Options
opts Port -> Port -> Bool
forall a. Ord a => a -> a -> Bool
> Port
0) (n () -> n ()) -> n () -> n ()
forall a b. (a -> b) -> a -> b
$
IO () -> n ()
forall a. IO a -> n a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> n ()) -> IO () -> n ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Setting phasers to stun... (port " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Port -> [Char]
forall a. Show a => a -> [Char]
show (Settings -> Port
getPort (Options -> Settings
settings Options
opts)) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
") (ctrl-c to quit)"
IO () -> n ()
forall a. IO a -> n a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> n ()) -> (Application -> IO ()) -> Application -> n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> Application -> IO ()
runSettings (Options -> Settings
settings Options
opts) (Application -> n ()) -> n Application -> n ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Options
-> (m Response -> IO Response) -> ScottyT m () -> n Application
forall (m :: * -> *) (n :: * -> *).
(Monad m, Monad n) =>
Options
-> (m Response -> IO Response) -> ScottyT m () -> n Application
scottyAppT Options
opts m Response -> IO Response
runActionToIO ScottyT m ()
s
scottySocketT :: (Monad m, MonadIO n)
=> Options
-> Socket
-> (m W.Response -> IO W.Response)
-> ScottyT m ()
-> n ()
scottySocketT :: forall (m :: * -> *) (n :: * -> *).
(Monad m, MonadIO n) =>
Options
-> Socket -> (m Response -> IO Response) -> ScottyT m () -> n ()
scottySocketT Options
opts Socket
sock m Response -> IO Response
runActionToIO ScottyT m ()
s = do
Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Port
verbose Options
opts Port -> Port -> Bool
forall a. Ord a => a -> a -> Bool
> Port
0) (n () -> n ()) -> n () -> n ()
forall a b. (a -> b) -> a -> b
$ do
[Char]
d <- IO [Char] -> n [Char]
forall a. IO a -> n a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> n [Char]) -> IO [Char] -> n [Char]
forall a b. (a -> b) -> a -> b
$ Socket -> IO [Char]
socketDescription Socket
sock
IO () -> n ()
forall a. IO a -> n a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> n ()) -> IO () -> n ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Setting phasers to stun... (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
d [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
") (ctrl-c to quit)"
IO () -> n ()
forall a. IO a -> n a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> n ()) -> (Application -> IO ()) -> Application -> n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> Socket -> Application -> IO ()
runSettingsSocket (Options -> Settings
settings Options
opts) Socket
sock (Application -> n ()) -> n Application -> n ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Options
-> (m Response -> IO Response) -> ScottyT m () -> n Application
forall (m :: * -> *) (n :: * -> *).
(Monad m, Monad n) =>
Options
-> (m Response -> IO Response) -> ScottyT m () -> n Application
scottyAppT Options
opts m Response -> IO Response
runActionToIO ScottyT m ()
s
scottyAppT :: (Monad m, Monad n)
=> Options
-> (m W.Response -> IO W.Response)
-> ScottyT m ()
-> n W.Application
scottyAppT :: forall (m :: * -> *) (n :: * -> *).
(Monad m, Monad n) =>
Options
-> (m Response -> IO Response) -> ScottyT m () -> n Application
scottyAppT Options
options m Response -> IO Response
runActionToIO ScottyT m ()
defs = do
let s :: ScottyState m
s = State (ScottyState m) () -> ScottyState m -> ScottyState m
forall s a. State s a -> s -> s
execState (ReaderT Options (StateT (ScottyState m) Identity) ()
-> Options -> State (ScottyState m) ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ScottyT m ()
-> ReaderT Options (StateT (ScottyState m) Identity) ()
forall (m :: * -> *) a.
ScottyT m a -> ReaderT Options (State (ScottyState m)) a
runS ScottyT m ()
defs) Options
options) ScottyState m
forall (m :: * -> *). ScottyState m
defaultScottyState
let rapp :: Request -> (Response -> IO b) -> IO b
rapp Request
req Response -> IO b
callback = do
BodyInfo
bodyInfo <- Request -> IO BodyInfo
forall (m :: * -> *). MonadIO m => Request -> m BodyInfo
newBodyInfo Request
req
Response
resp <- m Response -> IO Response
runActionToIO ((Request -> m Response)
-> [(Request -> m Response) -> Request -> m Response]
-> Request
-> m Response
forall (t :: * -> *) a. Foldable t => a -> t (a -> a) -> a
applyAll Request -> m Response
forall (m :: * -> *). Monad m => Application m
notFoundApp ([BodyInfo -> (Request -> m Response) -> Request -> m Response
midd BodyInfo
bodyInfo | BodyInfo -> (Request -> m Response) -> Request -> m Response
midd <- ScottyState m
-> [BodyInfo -> (Request -> m Response) -> Request -> m Response]
forall (m :: * -> *). ScottyState m -> [BodyInfo -> Middleware m]
routes ScottyState m
s]) Request
req)
IO Response -> (ScottyException -> IO Response) -> IO Response
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` ScottyException -> IO Response
forall (m :: * -> *). MonadIO m => ScottyException -> m Response
unhandledExceptionHandler
Response -> IO b
callback Response
resp
Application -> n Application
forall a. a -> n a
forall (m :: * -> *) a. Monad m => a -> m a
return (Application -> n Application) -> Application -> n Application
forall a b. (a -> b) -> a -> b
$ Application -> [Application -> Application] -> Application
forall (t :: * -> *) a. Foldable t => a -> t (a -> a) -> a
applyAll Application
forall {b}. Request -> (Response -> IO b) -> IO b
rapp (ScottyState m -> [Application -> Application]
forall (m :: * -> *). ScottyState m -> [Application -> Application]
middlewares ScottyState m
s)
unhandledExceptionHandler :: MonadIO m => ScottyException -> m W.Response
unhandledExceptionHandler :: forall (m :: * -> *). MonadIO m => ScottyException -> m Response
unhandledExceptionHandler = \case
ScottyException
RequestTooLarge -> Response -> m Response
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> Builder -> Response
W.responseBuilder Status
status413 ResponseHeaders
ct Builder
"Request is too big Jim!"
ScottyException
e -> Response -> m Response
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> Builder -> Response
W.responseBuilder Status
status500 ResponseHeaders
ct (Builder -> Response) -> Builder -> Response
forall a b. (a -> b) -> a -> b
$ Builder
"Internal Server Error: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
fromString (ScottyException -> [Char]
forall a. Show a => a -> [Char]
show ScottyException
e)
where
ct :: ResponseHeaders
ct = [(HeaderName
"Content-Type", ByteString
"text/plain")]
applyAll :: Foldable t => a -> t (a -> a) -> a
applyAll :: forall (t :: * -> *) a. Foldable t => a -> t (a -> a) -> a
applyAll = (a -> (a -> a) -> a) -> a -> t (a -> a) -> a
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((a -> a) -> a -> a) -> a -> (a -> a) -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
($))
notFoundApp :: Monad m => Application m
notFoundApp :: forall (m :: * -> *). Monad m => Application m
notFoundApp Request
_ = Response -> m Response
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> Builder -> Response
W.responseBuilder Status
status404 [(HeaderName
"Content-Type",ByteString
"text/html")]
(Builder -> Response) -> Builder -> Response
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
fromByteString ByteString
"<h1>404: File Not Found!</h1>"
defaultHandler :: (Monad m) => ErrorHandler m -> ScottyT m ()
defaultHandler :: forall (m :: * -> *). Monad m => ErrorHandler m -> ScottyT m ()
defaultHandler ErrorHandler m
f = ReaderT Options (State (ScottyState m)) () -> ScottyT m ()
forall (m :: * -> *) a.
ReaderT Options (State (ScottyState m)) a -> ScottyT m a
ScottyT (ReaderT Options (State (ScottyState m)) () -> ScottyT m ())
-> ReaderT Options (State (ScottyState m)) () -> ScottyT m ()
forall a b. (a -> b) -> a -> b
$ (ScottyState m -> ScottyState m)
-> ReaderT Options (State (ScottyState m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ScottyState m -> ScottyState m)
-> ReaderT Options (State (ScottyState m)) ())
-> (ScottyState m -> ScottyState m)
-> ReaderT Options (State (ScottyState m)) ()
forall a b. (a -> b) -> a -> b
$ Maybe (ErrorHandler m) -> ScottyState m -> ScottyState m
forall (m :: * -> *).
Maybe (ErrorHandler m) -> ScottyState m -> ScottyState m
setHandler (Maybe (ErrorHandler m) -> ScottyState m -> ScottyState m)
-> Maybe (ErrorHandler m) -> ScottyState m -> ScottyState m
forall a b. (a -> b) -> a -> b
$ ErrorHandler m -> Maybe (ErrorHandler m)
forall a. a -> Maybe a
Just ErrorHandler m
f
middleware :: W.Middleware -> ScottyT m ()
middleware :: forall (m :: * -> *). (Application -> Application) -> ScottyT m ()
middleware = ReaderT Options (State (ScottyState m)) () -> ScottyT m ()
forall (m :: * -> *) a.
ReaderT Options (State (ScottyState m)) a -> ScottyT m a
ScottyT (ReaderT Options (State (ScottyState m)) () -> ScottyT m ())
-> ((Application -> Application)
-> ReaderT Options (State (ScottyState m)) ())
-> (Application -> Application)
-> ScottyT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScottyState m -> ScottyState m)
-> ReaderT Options (State (ScottyState m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ScottyState m -> ScottyState m)
-> ReaderT Options (State (ScottyState m)) ())
-> ((Application -> Application) -> ScottyState m -> ScottyState m)
-> (Application -> Application)
-> ReaderT Options (State (ScottyState m)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Application -> Application) -> ScottyState m -> ScottyState m
forall (m :: * -> *).
(Application -> Application) -> ScottyState m -> ScottyState m
addMiddleware
setMaxRequestBodySize :: Kilobytes
-> ScottyT m ()
setMaxRequestBodySize :: forall (m :: * -> *). Port -> ScottyT m ()
setMaxRequestBodySize Port
i = Bool -> ScottyT m () -> ScottyT m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Port
i Port -> Port -> Bool
forall a. Ord a => a -> a -> Bool
> Port
0) (ScottyT m () -> ScottyT m ()) -> ScottyT m () -> ScottyT m ()
forall a b. (a -> b) -> a -> b
$ ReaderT Options (State (ScottyState m)) () -> ScottyT m ()
forall (m :: * -> *) a.
ReaderT Options (State (ScottyState m)) a -> ScottyT m a
ScottyT (ReaderT Options (State (ScottyState m)) () -> ScottyT m ())
-> (RouteOptions -> ReaderT Options (State (ScottyState m)) ())
-> RouteOptions
-> ScottyT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScottyState m -> ScottyState m)
-> ReaderT Options (State (ScottyState m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ScottyState m -> ScottyState m)
-> ReaderT Options (State (ScottyState m)) ())
-> (RouteOptions -> ScottyState m -> ScottyState m)
-> RouteOptions
-> ReaderT Options (State (ScottyState m)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RouteOptions -> ScottyState m -> ScottyState m
forall (m :: * -> *).
RouteOptions -> ScottyState m -> ScottyState m
updateMaxRequestBodySize (RouteOptions -> ScottyT m ()) -> RouteOptions -> ScottyT m ()
forall a b. (a -> b) -> a -> b
$ RouteOptions
defaultRouteOptions { maxRequestBodySize = Just i }