{-# LANGUAGE OverloadedStrings, RankNTypes #-}
{-# language LambdaCase #-}
module Web.Scotty.Trans
(
scottyT, scottyAppT, scottyOptsT, scottySocketT, Options(..), defaultOptions
, middleware, get, post, put, delete, patch, options, addroute, matchAny, notFound, setMaxRequestBodySize
, capture, regex, function, literal
, request, header, headers, body, bodyReader
, param, params
, captureParam, formParam, queryParam
, captureParams, formParams, queryParams
, jsonData, files
, status, addHeader, setHeader, redirect
, text, html, file, json, stream, raw, nested
, raise, raiseStatus, throw, rescue, next, finish, defaultHandler, liftAndCatchIO
, StatusError(..)
, Param, Parsable(..), readEither
, RoutePattern, File, Kilobytes, ErrorHandler, Handler(..)
, ScottyT, ActionT
, ScottyState, defaultScottyState
) where
import Blaze.ByteString.Builder (fromByteString)
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)
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 (ActionT(..), ScottyT(..), defaultScottyState, Application, RoutePattern, Options(..), defaultOptions, RouteOptions(..), defaultRouteOptions, ErrorHandler, Kilobytes, File, addMiddleware, setHandler, updateMaxRequestBodySize, routes, middlewares, ScottyException(..), ScottyState, defaultScottyState, StatusError(..))
import Web.Scotty.Util (socketDescription)
import Web.Scotty.Body (newBodyInfo)
import Web.Scotty.Exceptions (Handler(..), catches)
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 :: * -> *) a.
MonadUnliftIO m =>
m a -> [Handler m a] -> m a
`catches` [forall (m :: * -> *). MonadIO m => Handler m Response
scottyExceptionHandler]
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)
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
scottyExceptionHandler :: MonadIO m => Handler m W.Response
scottyExceptionHandler :: forall (m :: * -> *). MonadIO m => Handler m Response
scottyExceptionHandler = forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler forall a b. (a -> b) -> a -> b
$ \case
RequestException ByteString
ebody Status
s -> do
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> Builder -> Response
W.responseBuilder Status
s [(HeaderName
"Content-Type", ByteString
"text/plain")] (ByteString -> Builder
fromByteString ByteString
ebody)
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 }