{-# 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, files
, param, params
, pathParam, captureParam, formParam, queryParam
, pathParamMaybe, captureParamMaybe, formParamMaybe, queryParamMaybe
, pathParams, captureParams, formParams, queryParams
, 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.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 = forall (m :: * -> *) (n :: * -> *).
(Monad m, MonadIO n) =>
Options -> (m Response -> IO Response) -> ScottyT m () -> n ()
scottyOptsT forall a b. (a -> b) -> a -> b
$ Options
defaultOptions { settings :: Settings
settings = Port -> Settings -> Settings
setPort Port
p (Options -> Settings
settings Options
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
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Port
verbose Options
opts forall a. Ord a => a -> a -> Bool
> Port
0) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"Setting phasers to stun... (port " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Settings -> Port
getPort (Options -> Settings
settings Options
opts)) forall a. [a] -> [a] -> [a]
++ [Char]
") (ctrl-c to quit)"
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> Application -> IO ()
runSettings (Options -> Settings
settings Options
opts) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) (n :: * -> *).
(Monad m, Monad n) =>
(m Response -> IO Response) -> ScottyT m () -> n Application
scottyAppT 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
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Port
verbose Options
opts forall a. Ord a => a -> a -> Bool
> Port
0) forall a b. (a -> b) -> a -> b
$ do
[Char]
d <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Socket -> IO [Char]
socketDescription Socket
sock
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"Setting phasers to stun... (" forall a. [a] -> [a] -> [a]
++ [Char]
d forall a. [a] -> [a] -> [a]
++ [Char]
") (ctrl-c to quit)"
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> Socket -> Application -> IO ()
runSettingsSocket (Options -> Settings
settings Options
opts) Socket
sock forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) (n :: * -> *).
(Monad m, Monad n) =>
(m Response -> IO Response) -> ScottyT m () -> n Application
scottyAppT m Response -> IO Response
runActionToIO ScottyT m ()
s
scottyAppT :: (Monad m, Monad n)
=> (m W.Response -> IO W.Response)
-> ScottyT m ()
-> n W.Application
scottyAppT :: forall (m :: * -> *) (n :: * -> *).
(Monad m, Monad n) =>
(m Response -> IO Response) -> ScottyT m () -> n Application
scottyAppT m Response -> IO Response
runActionToIO ScottyT m ()
defs = do
let s :: ScottyState m
s = forall s a. State s a -> s -> s
execState (forall (m :: * -> *) a. ScottyT m a -> State (ScottyState m) a
runS ScottyT m ()
defs) forall (m :: * -> *). ScottyState m
defaultScottyState
let rapp :: Request -> (Response -> IO b) -> IO b
rapp Request
req Response -> IO b
callback = do
BodyInfo
bodyInfo <- forall (m :: * -> *). MonadIO m => Request -> m BodyInfo
newBodyInfo Request
req
Response
resp <- m Response -> IO Response
runActionToIO (forall (t :: * -> *) a. Foldable t => a -> t (a -> a) -> a
applyAll 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 <- forall (m :: * -> *). ScottyState m -> [BodyInfo -> Middleware m]
routes ScottyState m
s]) Request
req)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` forall (m :: * -> *). MonadIO m => ScottyException -> m Response
unhandledExceptionHandler
Response -> IO b
callback Response
resp
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => a -> t (a -> a) -> a
applyAll forall {b}. Request -> (Response -> IO b) -> IO b
rapp (forall (m :: * -> *). ScottyState m -> [Middleware]
middlewares ScottyState m
s)
unhandledExceptionHandler :: MonadIO m => ScottyException -> m W.Response
unhandledExceptionHandler :: forall (m :: * -> *). MonadIO m => ScottyException -> m Response
unhandledExceptionHandler = \case
ScottyException
RequestTooLarge -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> Builder -> Response
W.responseBuilder Status
status500 ResponseHeaders
ct forall a b. (a -> b) -> a -> b
$ Builder
"Internal Server Error: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
fromString (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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
($))
notFoundApp :: Monad m => Application m
notFoundApp :: forall (m :: * -> *). Monad m => Application m
notFoundApp Request
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> Builder -> Response
W.responseBuilder Status
status404 [(HeaderName
"Content-Type",ByteString
"text/html")]
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 = forall (m :: * -> *) a. State (ScottyState m) a -> ScottyT m a
ScottyT forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Maybe (ErrorHandler m) -> ScottyState m -> ScottyState m
setHandler forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ErrorHandler m
f
middleware :: W.Middleware -> ScottyT m ()
middleware :: forall (m :: * -> *). Middleware -> ScottyT m ()
middleware = forall (m :: * -> *) a. State (ScottyState m) a -> ScottyT m a
ScottyT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Middleware -> ScottyState m -> ScottyState m
addMiddleware
setMaxRequestBodySize :: Kilobytes
-> ScottyT m ()
setMaxRequestBodySize :: forall (m :: * -> *). Port -> ScottyT m ()
setMaxRequestBodySize Port
i = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Port
i forall a. Ord a => a -> a -> Bool
> Port
0) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. State (ScottyState m) a -> ScottyT m a
ScottyT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
RouteOptions -> ScottyState m -> ScottyState m
updateMaxRequestBodySize forall a b. (a -> b) -> a -> b
$ RouteOptions
defaultRouteOptions { maxRequestBodySize :: Maybe Port
maxRequestBodySize = forall a. a -> Maybe a
Just Port
i }