{-# 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, formData
, pathParam, captureParam, formParam, queryParam
, pathParamMaybe, captureParamMaybe, formParamMaybe, queryParamMaybe
, pathParams, captureParams, formParams, queryParams
, files, filesOpts
, status, Lazy.addHeader, Lazy.setHeader
, Lazy.redirect, Lazy.redirect300, Lazy.redirect301, Lazy.redirect302, Lazy.redirect303
, Lazy.redirect304, Lazy.redirect307, Lazy.redirect308
, Lazy.text, Lazy.html, file, json, stream, raw, nested
, getResponseHeaders, getResponseStatus, getResponseContent
, throw, next, finish, defaultHandler
, liftIO, catch
, ScottyException(..)
, Param, Parsable(..), readEither
, RoutePattern, File, Content(..), Kilobytes, ErrorHandler, Handler(..)
, ScottyT, ActionT
, ScottyState, defaultScottyState
, setSimpleCookie, getCookie, getCookies, deleteCookie, makeSimpleCookie
, Session (..), SessionId, SessionJar, createSessionJar,
createUserSession, createSession, readUserSession,
readSession, getUserSession, getSession, addSession, deleteSession, maintainSessions
) where
import Blaze.ByteString.Builder (fromByteString, fromLazyByteString)
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 qualified Data.Aeson as A
import qualified Data.Text as T
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, Content(..))
import Web.Scotty.Trans.Lazy as Lazy
import Web.Scotty.Util (socketDescription)
import Web.Scotty.Body (newBodyInfo)
import UnliftIO.Exception (Handler(..), catch)
import Web.Scotty.Cookie (setSimpleCookie,getCookie,getCookies,deleteCookie,makeSimpleCookie)
import Web.Scotty.Session (Session (..), SessionId, SessionJar, createSessionJar,
createUserSession, createSession, readUserSession,
readSession, getUserSession, getSession, addSession, deleteSession, maintainSessions)
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
opts 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
opts) 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 (Options -> Request -> m Response
forall (m :: * -> *). Monad m => Options -> Application m
notFoundApp Options
opts) ([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` Options -> ScottyException -> IO Response
forall (m :: * -> *).
MonadIO m =>
Options -> ScottyException -> m Response
unhandledExceptionHandler Options
opts
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 => Options -> ScottyException -> m W.Response
unhandledExceptionHandler :: forall (m :: * -> *).
MonadIO m =>
Options -> ScottyException -> m Response
unhandledExceptionHandler Options
opts = \case
ScottyException
RequestTooLarge ->
if Options -> Bool
jsonMode Options
opts
then 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
ctJson (Builder -> Response) -> Builder -> Response
forall a b. (a -> b) -> a -> b
$
ByteString -> Builder
fromLazyByteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
[ Key
"status" Key -> Port -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Port
413 :: Int)
, Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Text
"Request is too big Jim!" :: T.Text)
]
else 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
ctText Builder
"Request is too big Jim!"
ScottyException
e ->
if Options -> Bool
jsonMode Options
opts
then 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
ctJson (Builder -> Response) -> Builder -> Response
forall a b. (a -> b) -> a -> b
$
ByteString -> Builder
fromLazyByteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
[ Key
"status" Key -> Port -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Port
500 :: Int)
, Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Text
"Internal Server Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (ScottyException -> [Char]
forall a. Show a => a -> [Char]
show ScottyException
e))
]
else 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
ctText (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
ctText :: ResponseHeaders
ctText = [(HeaderName
"Content-Type", ByteString
"text/plain")]
ctJson :: ResponseHeaders
ctJson = [(HeaderName
"Content-Type", ByteString
"application/json; charset=utf-8")]
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 => Options -> Application m
notFoundApp :: forall (m :: * -> *). Monad m => Options -> Application m
notFoundApp Options
opts Request
_ =
if Options -> Bool
jsonMode Options
opts
then 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
"application/json; charset=utf-8")]
(Builder -> Response) -> Builder -> Response
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
fromLazyByteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
[ Key
"status" Key -> Port -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Port
404 :: Int)
, Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Text
"File Not Found!" :: T.Text)
]
else 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 }