{-# 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 = 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
=<< (m Response -> IO Response) -> ScottyT m () -> n Application
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
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
=<< (m Response -> IO Response) -> ScottyT m () -> n Application
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 = State (ScottyState m) () -> ScottyState m -> ScottyState m
forall s a. State s a -> s -> s
execState (ScottyT m () -> State (ScottyState m) ()
forall (m :: * -> *) a. ScottyT m a -> State (ScottyState m) a
runS ScottyT m ()
defs) 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 -> [Handler IO Response] -> IO Response
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> [Handler m a] -> m a
`catches` [Handler IO Response
forall (m :: * -> *). MonadIO m => Handler m Response
scottyExceptionHandler]
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)
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 = State (ScottyState m) () -> ScottyT m ()
forall (m :: * -> *) a. State (ScottyState m) a -> ScottyT m a
ScottyT (State (ScottyState m) () -> ScottyT m ())
-> State (ScottyState m) () -> ScottyT m ()
forall a b. (a -> b) -> a -> b
$ (ScottyState m -> ScottyState m) -> State (ScottyState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ScottyState m -> ScottyState m) -> State (ScottyState m) ())
-> (ScottyState m -> ScottyState m) -> 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
scottyExceptionHandler :: MonadIO m => Handler m W.Response
scottyExceptionHandler :: forall (m :: * -> *). MonadIO m => Handler m Response
scottyExceptionHandler = (ScottyException -> m Response) -> Handler m Response
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((ScottyException -> m Response) -> Handler m Response)
-> (ScottyException -> m Response) -> Handler m Response
forall a b. (a -> b) -> a -> b
$ \case
RequestException ByteString
ebody Status
s -> do
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
s [(HeaderName
"Content-Type", ByteString
"text/plain")] (ByteString -> Builder
fromByteString ByteString
ebody)
middleware :: W.Middleware -> ScottyT m ()
middleware :: forall (m :: * -> *). (Application -> Application) -> ScottyT m ()
middleware = State (ScottyState m) () -> ScottyT m ()
forall (m :: * -> *) a. State (ScottyState m) a -> ScottyT m a
ScottyT (State (ScottyState m) () -> ScottyT m ())
-> ((Application -> Application) -> State (ScottyState m) ())
-> (Application -> Application)
-> ScottyT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScottyState m -> ScottyState m) -> State (ScottyState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ScottyState m -> ScottyState m) -> State (ScottyState m) ())
-> ((Application -> Application) -> ScottyState m -> ScottyState m)
-> (Application -> Application)
-> 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
$ State (ScottyState m) () -> ScottyT m ()
forall (m :: * -> *) a. State (ScottyState m) a -> ScottyT m a
ScottyT (State (ScottyState m) () -> ScottyT m ())
-> (RouteOptions -> State (ScottyState m) ())
-> RouteOptions
-> ScottyT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScottyState m -> ScottyState m) -> State (ScottyState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ScottyState m -> ScottyState m) -> State (ScottyState m) ())
-> (RouteOptions -> ScottyState m -> ScottyState m)
-> RouteOptions
-> 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 }