{-# LANGUAGE OverloadedStrings, RankNTypes #-}
-- | 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 in order that Scotty be combined
-- with other DSLs.
--
-- 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.
module Web.Scotty.Trans
    ( -- * scotty-to-WAI
      scottyT, scottyAppT, scottyOptsT, scottySocketT, Options(..)
      -- * 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
      -- ** Route Patterns
    , capture, regex, function, literal
      -- ** Accessing the Request, Captures, and Query Parameters
    , request, header, headers, body, bodyReader, param, params, jsonData, files
      -- ** Modifying the Response and Redirecting
    , status, addHeader, setHeader, 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.
    , text, html, file, json, stream, raw
      -- ** Exceptions
    , raise, raiseStatus, rescue, next, finish, defaultHandler, ScottyError(..), liftAndCatchIO
      -- * Parsing Parameters
    , Param, Parsable(..), readEither
      -- * Types
    , RoutePattern, File
      -- * Monad Transformers
    , ScottyT, ActionT
    ) where

import Blaze.ByteString.Builder (fromByteString)

import Control.Monad (when)
import Control.Monad.State.Strict (execState, modify)
import Control.Monad.IO.Class

import Data.Default.Class (def)

import Network.HTTP.Types (status404, status500)
import Network.Socket (Socket)
import Network.Wai
import Network.Wai.Handler.Warp (Port, runSettings, runSettingsSocket, setPort, getPort)

import Web.Scotty.Action
import Web.Scotty.Route
import Web.Scotty.Internal.Types hiding (Application, Middleware)
import Web.Scotty.Util (socketDescription)
import qualified Web.Scotty.Internal.Types as Scotty

-- | Run a scotty application using the warp server.
-- NB: scotty p === scottyT p id
scottyT :: (Monad m, MonadIO n)
        => Port
        -> (m Response -> IO Response) -- ^ Run monad 'm' into 'IO', called at each action.
        -> ScottyT e m ()
        -> n ()
scottyT :: Port -> (m Response -> IO Response) -> ScottyT e m () -> n ()
scottyT p :: Port
p = Options -> (m Response -> IO Response) -> ScottyT e m () -> n ()
forall (m :: * -> *) (n :: * -> *) e.
(Monad m, MonadIO n) =>
Options -> (m Response -> IO Response) -> ScottyT e m () -> n ()
scottyOptsT (Options -> (m Response -> IO Response) -> ScottyT e m () -> n ())
-> Options -> (m Response -> IO Response) -> ScottyT e m () -> n ()
forall a b. (a -> b) -> a -> b
$ Options
forall a. Default a => a
def { settings :: Settings
settings = Port -> Settings -> Settings
setPort Port
p (Options -> Settings
settings Options
forall a. Default a => a
def) }

-- | Run a scotty application using the warp server, passing extra options.
-- NB: scottyOpts opts === scottyOptsT opts id
scottyOptsT :: (Monad m, MonadIO n)
            => Options
            -> (m Response -> IO Response) -- ^ Run monad 'm' into 'IO', called at each action.
            -> ScottyT e m ()
            -> n ()
scottyOptsT :: Options -> (m Response -> IO Response) -> ScottyT e m () -> n ()
scottyOptsT opts :: Options
opts runActionToIO :: m Response -> IO Response
runActionToIO s :: ScottyT e 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
> 0) (n () -> n ()) -> n () -> n ()
forall a b. (a -> b) -> a -> b
$
        IO () -> n ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> n ()) -> IO () -> n ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Setting phasers to stun... (port " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Port -> String
forall a. Show a => a -> String
show (Settings -> Port
getPort (Options -> Settings
settings Options
opts)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ ") (ctrl-c to quit)"
    IO () -> n ()
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 e m () -> n Application
forall (m :: * -> *) (n :: * -> *) e.
(Monad m, Monad n) =>
(m Response -> IO Response) -> ScottyT e m () -> n Application
scottyAppT m Response -> IO Response
runActionToIO ScottyT e 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 Response -> IO Response)
              -> ScottyT e m ()
              -> n ()
scottySocketT :: Options
-> Socket -> (m Response -> IO Response) -> ScottyT e m () -> n ()
scottySocketT opts :: Options
opts sock :: Socket
sock runActionToIO :: m Response -> IO Response
runActionToIO s :: ScottyT e 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
> 0) (n () -> n ()) -> n () -> n ()
forall a b. (a -> b) -> a -> b
$ do
        String
d <- IO String -> n String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> n String) -> IO String -> n String
forall a b. (a -> b) -> a -> b
$ Socket -> IO String
socketDescription Socket
sock
        IO () -> n ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> n ()) -> IO () -> n ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Setting phasers to stun... (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ ") (ctrl-c to quit)"
    IO () -> n ()
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 e m () -> n Application
forall (m :: * -> *) (n :: * -> *) e.
(Monad m, Monad n) =>
(m Response -> IO Response) -> ScottyT e m () -> n Application
scottyAppT m Response -> IO Response
runActionToIO ScottyT e 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)
           => (m Response -> IO Response) -- ^ Run monad 'm' into 'IO', called at each action.
           -> ScottyT e m ()
           -> n Application
scottyAppT :: (m Response -> IO Response) -> ScottyT e m () -> n Application
scottyAppT runActionToIO :: m Response -> IO Response
runActionToIO defs :: ScottyT e m ()
defs = do
    let s :: ScottyState e m
s = State (ScottyState e m) () -> ScottyState e m -> ScottyState e m
forall s a. State s a -> s -> s
execState (ScottyT e m () -> State (ScottyState e m) ()
forall e (m :: * -> *) a.
ScottyT e m a -> State (ScottyState e m) a
runS ScottyT e m ()
defs) ScottyState e m
forall a. Default a => a
def
    let rapp :: Request -> (Response -> IO b) -> IO b
rapp req :: Request
req callback :: Response -> IO b
callback = m Response -> IO Response
runActionToIO ((Application m
 -> (Application m -> Application m) -> Application m)
-> Application m
-> [Application m -> Application m]
-> Application m
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((Application m -> Application m)
 -> Application m -> Application m)
-> Application m
-> (Application m -> Application m)
-> Application m
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Application m -> Application m) -> Application m -> Application m
forall a b. (a -> b) -> a -> b
($)) Application m
forall (m :: * -> *). Monad m => Application m
notFoundApp (ScottyState e m -> [Application m -> Application m]
forall e (m :: * -> *). ScottyState e m -> [Middleware m]
routes ScottyState e m
s) Request
req) IO Response -> (Response -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Response -> IO b
callback
    Application -> n Application
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)
-> Application -> [Application -> Application] -> Application
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((Application -> Application) -> Application -> Application)
-> Application -> (Application -> Application) -> Application
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Application -> Application) -> Application -> Application
forall a b. (a -> b) -> a -> b
($)) Application
forall b. Request -> (Response -> IO b) -> IO b
rapp (ScottyState e m -> [Application -> Application]
forall e (m :: * -> *).
ScottyState e m -> [Application -> Application]
middlewares ScottyState e m
s)

notFoundApp :: Monad m => Scotty.Application m
notFoundApp :: Application m
notFoundApp _ = Response -> m Response
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
responseBuilder Status
status404 [("Content-Type","text/html")]
                       (Builder -> Response) -> Builder -> Response
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
fromByteString "<h1>404: File Not Found!</h1>"

-- | Global handler for uncaught exceptions.
--
-- Uncaught exceptions normally become 500 responses.
-- You can use this to selectively override that behavior.
--
-- Note: IO exceptions are lifted into 'ScottyError's by 'stringError'.
-- This has security implications, so you probably want to provide your
-- own defaultHandler in production which does not send out the error
-- strings as 500 responses.
defaultHandler :: (ScottyError e, Monad m) => (e -> ActionT e m ()) -> ScottyT e m ()
defaultHandler :: (e -> ActionT e m ()) -> ScottyT e m ()
defaultHandler f :: e -> ActionT e m ()
f = State (ScottyState e m) () -> ScottyT e m ()
forall e (m :: * -> *) a.
State (ScottyState e m) a -> ScottyT e m a
ScottyT (State (ScottyState e m) () -> ScottyT e m ())
-> State (ScottyState e m) () -> ScottyT e m ()
forall a b. (a -> b) -> a -> b
$ (ScottyState e m -> ScottyState e m) -> State (ScottyState e m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ScottyState e m -> ScottyState e m)
 -> State (ScottyState e m) ())
-> (ScottyState e m -> ScottyState e m)
-> State (ScottyState e m) ()
forall a b. (a -> b) -> a -> b
$ ErrorHandler e m -> ScottyState e m -> ScottyState e m
forall e (m :: * -> *).
ErrorHandler e m -> ScottyState e m -> ScottyState e m
addHandler (ErrorHandler e m -> ScottyState e m -> ScottyState e m)
-> ErrorHandler e m -> ScottyState e m -> ScottyState e m
forall a b. (a -> b) -> a -> b
$ (e -> ActionT e m ()) -> ErrorHandler e m
forall a. a -> Maybe a
Just (\e :: e
e -> Status -> ActionT e m ()
forall (m :: * -> *) e. Monad m => Status -> ActionT e m ()
status Status
status500 ActionT e m () -> ActionT e m () -> ActionT e m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> e -> ActionT e m ()
f e
e)

-- | 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 :: Middleware -> ScottyT e m ()
middleware :: (Application -> Application) -> ScottyT e m ()
middleware = State (ScottyState e m) () -> ScottyT e m ()
forall e (m :: * -> *) a.
State (ScottyState e m) a -> ScottyT e m a
ScottyT (State (ScottyState e m) () -> ScottyT e m ())
-> ((Application -> Application) -> State (ScottyState e m) ())
-> (Application -> Application)
-> ScottyT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScottyState e m -> ScottyState e m) -> State (ScottyState e m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ScottyState e m -> ScottyState e m)
 -> State (ScottyState e m) ())
-> ((Application -> Application)
    -> ScottyState e m -> ScottyState e m)
-> (Application -> Application)
-> State (ScottyState e m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Application -> Application) -> ScottyState e m -> ScottyState e m
forall e (m :: * -> *).
(Application -> Application) -> ScottyState e m -> ScottyState e m
addMiddleware