{-# LANGUAGE OverloadedStrings, RankNTypes #-}
{-# language LambdaCase #-}
-- | It should be noted that most of the code snippets below depend on the
-- OverloadedStrings language pragma.
--
-- The functions in this module allow an arbitrary monad to be embedded
-- in Scotty's monad transformer stack, e.g. for complex endpoint configuration,
-- interacting with databases etc.
--
-- Scotty is set up by default for development mode. For production servers,
-- you will likely want to modify 'settings' and the 'defaultHandler'. See
-- the comments on each of these functions for more information.
--
-- Please refer to the @examples@ directory and the @spec@ test suite for concrete use cases, e.g. constructing responses, exception handling and useful implementation details.
module Web.Scotty.Trans
    ( -- * Running 'scotty' servers
      scottyT
    , scottyOptsT
    , scottySocketT
    , Options(..), defaultOptions
      -- ** scotty-to-WAI
    , scottyAppT
      -- * Defining Middleware and Routes
      --
      -- | 'Middleware' and routes are run in the order in which they
      -- are defined. All middleware is run first, followed by the first
      -- route that matches. If no route matches, a 404 response is given.
    , middleware, get, post, put, delete, patch, options, addroute, matchAny, notFound, setMaxRequestBodySize
      -- ** Route Patterns
    , capture, regex, function, literal
      -- ** Accessing the Request and its fields
    , request, Lazy.header, Lazy.headers, body, bodyReader
    , jsonData

      -- ** Accessing Path, Form and Query Parameters
    , param, params
    , pathParam, captureParam, formParam, queryParam
    , pathParamMaybe, captureParamMaybe, formParamMaybe, queryParamMaybe
    , pathParams, captureParams, formParams, queryParams
    -- *** Files
    , files, filesOpts, ParseRequestBodyOptions
      -- ** Modifying the Response and Redirecting
    , status, Lazy.addHeader, Lazy.setHeader, Lazy.redirect
      -- ** Setting Response Body
      --
      -- | Note: only one of these should be present in any given route
      -- definition, as they completely replace the current 'Response' body.
    , Lazy.text, Lazy.html, file, json, stream, raw, nested
      -- ** Accessing the fields of the Response
    , getResponseHeaders, getResponseStatus, getResponseContent
      -- ** Exceptions
    , Lazy.raise, Lazy.raiseStatus, throw, rescue, next, finish, defaultHandler, liftAndCatchIO
    , liftIO, catch
    , StatusError(..)
    , ScottyException(..)
      -- * Parsing Parameters
    , Param, Parsable(..), readEither
      -- * Types
    , RoutePattern, File, Content(..), Kilobytes, ErrorHandler, Handler(..)
      -- * Monad Transformers
    , 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)


-- | Run a scotty application using the warp server.
-- NB: scotty p === scottyT p id
scottyT :: (Monad m, MonadIO n)
        => Port
        -> (m W.Response -> IO W.Response) -- ^ Run monad 'm' into 'IO', called at each action.
        -> 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) }

-- | Run a scotty application using the warp server, passing extra options.
-- NB: scottyOpts opts === scottyOptsT opts id
scottyOptsT :: (Monad m, MonadIO n)
            => Options
            -> (m W.Response -> IO W.Response) -- ^ Run monad 'm' into 'IO', called at each action.
            -> 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

-- | Run a scotty application using the warp server, passing extra options, and
-- listening on the provided socket.
-- NB: scottySocket opts sock === scottySocketT opts sock id
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

-- | Turn a scotty application into a WAI 'Application', which can be
-- run with any WAI handler.
-- NB: scottyApp === scottyAppT id
scottyAppT :: (Monad m, Monad n)
           => Options
           -> (m W.Response -> IO W.Response) -- ^ Run monad 'm' into 'IO', called at each action.
           -> 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)

-- | Exception handler in charge of 'ScottyException' that's not caught by 'scottyExceptionHandler'
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>"

-- | Global handler for user-defined exceptions.
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

-- | Use given middleware. Middleware is nested such that the first declared
-- is the outermost middleware (it has first dibs on the request and last action
-- on the response). Every middleware is run on each request.
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

-- | Set global size limit for the request body. Requests with body size exceeding the limit will not be
-- processed and an HTTP response 413 will be returned to the client. Size limit needs to be greater than 0,
-- otherwise the application will terminate on start.
setMaxRequestBodySize :: Kilobytes -- ^ Request size limit
                      -> 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 }