{-# LANGUAGE OverloadedStrings, RankNTypes #-}
module Web.Scotty
(
scotty
, scottyOpts
, scottySocket
, Options(..), defaultOptions
, scottyApp
, middleware, get, post, put, delete, patch, options, addroute, matchAny, notFound, nested, setMaxRequestBodySize
, capture, regex, function, literal
, request, header, headers, body, bodyReader
, jsonData
, param, params
, pathParam, captureParam, formParam, queryParam
, pathParamMaybe, captureParamMaybe, formParamMaybe, queryParamMaybe
, pathParams, captureParams, formParams, queryParams
, files, filesOpts, Trans.ParseRequestBodyOptions
, status, addHeader, setHeader, redirect
, text, html, file, json, stream, raw
, getResponseHeaders, getResponseStatus, getResponseContent
, raise, raiseStatus, throw, rescue, next, finish, defaultHandler, liftAndCatchIO
, liftIO, catch
, StatusError(..)
, ScottyException(..)
, Param, Trans.Parsable(..), Trans.readEither
, ScottyM, ActionM, RoutePattern, File, Content(..), Kilobytes, ErrorHandler, Handler(..)
, ScottyState, defaultScottyState
) where
import qualified Web.Scotty.Trans as Trans
import qualified Control.Exception as E
import Control.Monad.IO.Class
import Data.Aeson (FromJSON, ToJSON)
import qualified Data.ByteString as BS
import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Text.Lazy (Text, toStrict)
import Network.HTTP.Types (Status, StdMethod, ResponseHeaders)
import Network.Socket (Socket)
import Network.Wai (Application, Middleware, Request, StreamingBody)
import Network.Wai.Handler.Warp (Port)
import qualified Network.Wai.Parse as W (defaultParseRequestBodyOptions)
import Web.Scotty.Internal.Types (ScottyT, ActionT, ErrorHandler, Param, RoutePattern, Options, defaultOptions, File, Kilobytes, ScottyState, defaultScottyState, ScottyException, StatusError(..), Content(..))
import UnliftIO.Exception (Handler(..), catch)
type ScottyM = ScottyT IO
type ActionM = ActionT IO
scotty :: Port -> ScottyM () -> IO ()
scotty :: Port -> ScottyM () -> IO ()
scotty Port
p = Port -> (IO Response -> IO Response) -> ScottyM () -> IO ()
forall (m :: * -> *) (n :: * -> *).
(Monad m, MonadIO n) =>
Port -> (m Response -> IO Response) -> ScottyT m () -> n ()
Trans.scottyT Port
p IO Response -> IO Response
forall a. a -> a
id
scottyOpts :: Options -> ScottyM () -> IO ()
scottyOpts :: Options -> ScottyM () -> IO ()
scottyOpts Options
opts = Options -> (IO Response -> IO Response) -> ScottyM () -> IO ()
forall (m :: * -> *) (n :: * -> *).
(Monad m, MonadIO n) =>
Options -> (m Response -> IO Response) -> ScottyT m () -> n ()
Trans.scottyOptsT Options
opts IO Response -> IO Response
forall a. a -> a
id
scottySocket :: Options -> Socket -> ScottyM () -> IO ()
scottySocket :: Options -> Socket -> ScottyM () -> IO ()
scottySocket Options
opts Socket
sock = Options
-> Socket -> (IO Response -> IO Response) -> ScottyM () -> IO ()
forall (m :: * -> *) (n :: * -> *).
(Monad m, MonadIO n) =>
Options
-> Socket -> (m Response -> IO Response) -> ScottyT m () -> n ()
Trans.scottySocketT Options
opts Socket
sock IO Response -> IO Response
forall a. a -> a
id
scottyApp :: ScottyM () -> IO Application
scottyApp :: ScottyM () -> IO Application
scottyApp = Options
-> (IO Response -> IO Response) -> ScottyM () -> IO Application
forall (m :: * -> *) (n :: * -> *).
(Monad m, Monad n) =>
Options
-> (m Response -> IO Response) -> ScottyT m () -> n Application
Trans.scottyAppT Options
defaultOptions IO Response -> IO Response
forall a. a -> a
id
defaultHandler :: ErrorHandler IO -> ScottyM ()
defaultHandler :: ErrorHandler IO -> ScottyM ()
defaultHandler = ErrorHandler IO -> ScottyM ()
forall (m :: * -> *). Monad m => ErrorHandler m -> ScottyT m ()
Trans.defaultHandler
middleware :: Middleware -> ScottyM ()
middleware :: Middleware -> ScottyM ()
middleware = Middleware -> ScottyM ()
forall (m :: * -> *). Middleware -> ScottyT m ()
Trans.middleware
nested :: Application -> ActionM ()
nested :: Application -> ActionM ()
nested = Application -> ActionM ()
forall (m :: * -> *). MonadIO m => Application -> ActionT m ()
Trans.nested
setMaxRequestBodySize :: Kilobytes -> ScottyM ()
setMaxRequestBodySize :: Port -> ScottyM ()
setMaxRequestBodySize = Port -> ScottyM ()
forall (m :: * -> *). Port -> ScottyT m ()
Trans.setMaxRequestBodySize
raise :: Text -> ActionM a
raise :: forall a. Text -> ActionM a
raise = Text -> ActionT IO a
forall (m :: * -> *) a. MonadIO m => Text -> ActionT m a
Trans.raise
{-# DEPRECATED raise "Throw an exception instead" #-}
raiseStatus :: Status -> Text -> ActionM a
raiseStatus :: forall a. Status -> Text -> ActionM a
raiseStatus = Status -> Text -> ActionT IO a
forall (m :: * -> *) a. Monad m => Status -> Text -> ActionT m a
Trans.raiseStatus
{-# DEPRECATED raiseStatus "Use status, text, and finish instead" #-}
throw :: (E.Exception e) => e -> ActionM a
throw :: forall e a. Exception e => e -> ActionM a
throw = e -> ActionT IO a
forall (m :: * -> *) e a.
(MonadIO m, Exception e) =>
e -> ActionT m a
Trans.throw
next :: ActionM ()
next :: ActionM ()
next = ActionM ()
forall (m :: * -> *) a. Monad m => ActionT m a
Trans.next
finish :: ActionM a
finish :: forall a. ActionM a
finish = ActionT IO a
forall (m :: * -> *) a. Monad m => ActionT m a
Trans.finish
rescue :: E.Exception e => ActionM a -> (e -> ActionM a) -> ActionM a
rescue :: forall e a.
Exception e =>
ActionM a -> (e -> ActionM a) -> ActionM a
rescue = ActionT IO a -> (e -> ActionT IO a) -> ActionT IO a
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
ActionT m a -> (e -> ActionT m a) -> ActionT m a
Trans.rescue
{-# DEPRECATED rescue "Use catch instead" #-}
liftAndCatchIO :: IO a -> ActionM a
liftAndCatchIO :: forall a. IO a -> ActionM a
liftAndCatchIO = IO a -> ActionT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> ActionT m a
Trans.liftAndCatchIO
{-# DEPRECATED liftAndCatchIO "Use liftIO instead" #-}
redirect :: Text -> ActionM a
redirect :: forall a. Text -> ActionM a
redirect = Text -> ActionT IO a
forall (m :: * -> *) a. Monad m => Text -> ActionT m a
Trans.redirect
request :: ActionM Request
request :: ActionM Request
request = ActionM Request
forall (m :: * -> *). Monad m => ActionT m Request
Trans.request
files :: ActionM [File ByteString]
files :: ActionM [File ByteString]
files = ActionM [File ByteString]
forall (m :: * -> *).
MonadUnliftIO m =>
ActionT m [File ByteString]
Trans.files
filesOpts :: Trans.ParseRequestBodyOptions
-> ([Param] -> [File FilePath] -> ActionM a)
-> ActionM a
filesOpts :: forall a.
ParseRequestBodyOptions
-> ([Param] -> [File FilePath] -> ActionM a) -> ActionM a
filesOpts = ParseRequestBodyOptions
-> ([Param] -> [File FilePath] -> ActionT IO a) -> ActionT IO a
forall (m :: * -> *) a.
MonadUnliftIO m =>
ParseRequestBodyOptions
-> ([Param] -> [File FilePath] -> ActionT m a) -> ActionT m a
Trans.filesOpts
header :: Text -> ActionM (Maybe Text)
= Text -> ActionM (Maybe Text)
forall (m :: * -> *). Monad m => Text -> ActionT m (Maybe Text)
Trans.header
headers :: ActionM [(Text, Text)]
= ActionM [(Text, Text)]
forall (m :: * -> *). Monad m => ActionT m [(Text, Text)]
Trans.headers
body :: ActionM ByteString
body :: ActionM ByteString
body = ActionM ByteString
forall (m :: * -> *). MonadIO m => ActionT m ByteString
Trans.body
bodyReader :: ActionM (IO BS.ByteString)
bodyReader :: ActionM (IO ByteString)
bodyReader = ActionM (IO ByteString)
forall (m :: * -> *). Monad m => ActionT m (IO ByteString)
Trans.bodyReader
jsonData :: FromJSON a => ActionM a
jsonData :: forall a. FromJSON a => ActionM a
jsonData = ActionT IO a
forall a (m :: * -> *). (FromJSON a, MonadIO m) => ActionT m a
Trans.jsonData
param :: Trans.Parsable a => Text -> ActionM a
param :: forall a. Parsable a => Text -> ActionM a
param = Text -> ActionT IO a
forall a (m :: * -> *).
(Parsable a, MonadIO m) =>
Text -> ActionT m a
Trans.param (Text -> ActionT IO a) -> (Text -> Text) -> Text -> ActionT IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toStrict
{-# DEPRECATED param "(#204) Not a good idea to treat all parameters identically. Use pathParam, formParam and queryParam instead. "#-}
captureParam :: Trans.Parsable a => Text -> ActionM a
captureParam :: forall a. Parsable a => Text -> ActionM a
captureParam = Text -> ActionT IO a
forall a (m :: * -> *).
(Parsable a, MonadIO m) =>
Text -> ActionT m a
Trans.captureParam (Text -> ActionT IO a) -> (Text -> Text) -> Text -> ActionT IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toStrict
pathParam :: Trans.Parsable a => Text -> ActionM a
pathParam :: forall a. Parsable a => Text -> ActionM a
pathParam = Text -> ActionT IO a
forall a (m :: * -> *).
(Parsable a, MonadIO m) =>
Text -> ActionT m a
Trans.pathParam (Text -> ActionT IO a) -> (Text -> Text) -> Text -> ActionT IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toStrict
formParam :: Trans.Parsable a => Text -> ActionM a
formParam :: forall a. Parsable a => Text -> ActionM a
formParam = Text -> ActionT IO a
forall (m :: * -> *) b.
(MonadUnliftIO m, Parsable b) =>
Text -> ActionT m b
Trans.formParam (Text -> ActionT IO a) -> (Text -> Text) -> Text -> ActionT IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toStrict
queryParam :: Trans.Parsable a => Text -> ActionM a
queryParam :: forall a. Parsable a => Text -> ActionM a
queryParam = Text -> ActionT IO a
forall a (m :: * -> *).
(Parsable a, MonadIO m) =>
Text -> ActionT m a
Trans.queryParam (Text -> ActionT IO a) -> (Text -> Text) -> Text -> ActionT IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toStrict
pathParamMaybe :: (Trans.Parsable a) => Text -> ActionM (Maybe a)
pathParamMaybe :: forall a. Parsable a => Text -> ActionM (Maybe a)
pathParamMaybe = Text -> ActionT IO (Maybe a)
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m (Maybe a)
Trans.pathParamMaybe (Text -> ActionT IO (Maybe a))
-> (Text -> Text) -> Text -> ActionT IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toStrict
captureParamMaybe :: (Trans.Parsable a) => Text -> ActionM (Maybe a)
captureParamMaybe :: forall a. Parsable a => Text -> ActionM (Maybe a)
captureParamMaybe = Text -> ActionT IO (Maybe a)
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m (Maybe a)
Trans.pathParamMaybe (Text -> ActionT IO (Maybe a))
-> (Text -> Text) -> Text -> ActionT IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toStrict
formParamMaybe :: (Trans.Parsable a) => Text -> ActionM (Maybe a)
formParamMaybe :: forall a. Parsable a => Text -> ActionM (Maybe a)
formParamMaybe = Text -> ActionT IO (Maybe a)
forall (m :: * -> *) a.
(MonadUnliftIO m, Parsable a) =>
Text -> ActionT m (Maybe a)
Trans.formParamMaybe (Text -> ActionT IO (Maybe a))
-> (Text -> Text) -> Text -> ActionT IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toStrict
queryParamMaybe :: (Trans.Parsable a) => Text -> ActionM (Maybe a)
queryParamMaybe :: forall a. Parsable a => Text -> ActionM (Maybe a)
queryParamMaybe = Text -> ActionT IO (Maybe a)
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m (Maybe a)
Trans.queryParamMaybe (Text -> ActionT IO (Maybe a))
-> (Text -> Text) -> Text -> ActionT IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toStrict
params :: ActionM [Param]
params :: ActionM [Param]
params = ActionM [Param]
forall (m :: * -> *). Monad m => ActionT m [Param]
Trans.params
{-# DEPRECATED params "(#204) Not a good idea to treat all parameters identically. Use pathParams, formParams and queryParams instead. "#-}
captureParams :: ActionM [Param]
captureParams :: ActionM [Param]
captureParams = ActionM [Param]
forall (m :: * -> *). Monad m => ActionT m [Param]
Trans.captureParams
pathParams :: ActionM [Param]
pathParams :: ActionM [Param]
pathParams = ActionM [Param]
forall (m :: * -> *). Monad m => ActionT m [Param]
Trans.pathParams
formParams :: ActionM [Param]
formParams :: ActionM [Param]
formParams = ActionM [Param]
forall (m :: * -> *). MonadUnliftIO m => ActionT m [Param]
Trans.formParams
queryParams :: ActionM [Param]
queryParams :: ActionM [Param]
queryParams = ActionM [Param]
forall (m :: * -> *). Monad m => ActionT m [Param]
Trans.queryParams
status :: Status -> ActionM ()
status :: Status -> ActionM ()
status = Status -> ActionM ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
Trans.status
addHeader :: Text -> Text -> ActionM ()
= Text -> Text -> ActionM ()
forall (m :: * -> *). MonadIO m => Text -> Text -> ActionT m ()
Trans.addHeader
setHeader :: Text -> Text -> ActionM ()
= Text -> Text -> ActionM ()
forall (m :: * -> *). MonadIO m => Text -> Text -> ActionT m ()
Trans.setHeader
text :: Text -> ActionM ()
text :: Text -> ActionM ()
text = Text -> ActionM ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
Trans.text
html :: Text -> ActionM ()
html :: Text -> ActionM ()
html = Text -> ActionM ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
Trans.html
file :: FilePath -> ActionM ()
file :: FilePath -> ActionM ()
file = FilePath -> ActionM ()
forall (m :: * -> *). MonadIO m => FilePath -> ActionT m ()
Trans.file
json :: ToJSON a => a -> ActionM ()
json :: forall a. ToJSON a => a -> ActionM ()
json = a -> ActionM ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
Trans.json
stream :: StreamingBody -> ActionM ()
stream :: StreamingBody -> ActionM ()
stream = StreamingBody -> ActionM ()
forall (m :: * -> *). MonadIO m => StreamingBody -> ActionT m ()
Trans.stream
raw :: ByteString -> ActionM ()
raw :: ByteString -> ActionM ()
raw = ByteString -> ActionM ()
forall (m :: * -> *). MonadIO m => ByteString -> ActionT m ()
Trans.raw
getResponseStatus :: ActionM Status
getResponseStatus :: ActionM Status
getResponseStatus = ActionM Status
forall (m :: * -> *). MonadIO m => ActionT m Status
Trans.getResponseStatus
getResponseHeaders :: ActionM ResponseHeaders
= ActionM ResponseHeaders
forall (m :: * -> *). MonadIO m => ActionT m ResponseHeaders
Trans.getResponseHeaders
getResponseContent :: ActionM Content
getResponseContent :: ActionM Content
getResponseContent = ActionM Content
forall (m :: * -> *). MonadIO m => ActionT m Content
Trans.getResponseContent
get :: RoutePattern -> ActionM () -> ScottyM ()
get :: RoutePattern -> ActionM () -> ScottyM ()
get = RoutePattern -> ActionM () -> ScottyM ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
Trans.get
post :: RoutePattern -> ActionM () -> ScottyM ()
post :: RoutePattern -> ActionM () -> ScottyM ()
post = RoutePattern -> ActionM () -> ScottyM ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
Trans.post
put :: RoutePattern -> ActionM () -> ScottyM ()
put :: RoutePattern -> ActionM () -> ScottyM ()
put = RoutePattern -> ActionM () -> ScottyM ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
Trans.put
delete :: RoutePattern -> ActionM () -> ScottyM ()
delete :: RoutePattern -> ActionM () -> ScottyM ()
delete = RoutePattern -> ActionM () -> ScottyM ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
Trans.delete
patch :: RoutePattern -> ActionM () -> ScottyM ()
patch :: RoutePattern -> ActionM () -> ScottyM ()
patch = RoutePattern -> ActionM () -> ScottyM ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
Trans.patch
options :: RoutePattern -> ActionM () -> ScottyM ()
options :: RoutePattern -> ActionM () -> ScottyM ()
options = RoutePattern -> ActionM () -> ScottyM ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
Trans.options
matchAny :: RoutePattern -> ActionM () -> ScottyM ()
matchAny :: RoutePattern -> ActionM () -> ScottyM ()
matchAny = RoutePattern -> ActionM () -> ScottyM ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
Trans.matchAny
notFound :: ActionM () -> ScottyM ()
notFound :: ActionM () -> ScottyM ()
notFound = ActionM () -> ScottyM ()
forall (m :: * -> *).
MonadUnliftIO m =>
ActionT m () -> ScottyT m ()
Trans.notFound
addroute :: StdMethod -> RoutePattern -> ActionM () -> ScottyM ()
addroute :: StdMethod -> RoutePattern -> ActionM () -> ScottyM ()
addroute = StdMethod -> RoutePattern -> ActionM () -> ScottyM ()
forall (m :: * -> *).
MonadUnliftIO m =>
StdMethod -> RoutePattern -> ActionT m () -> ScottyT m ()
Trans.addroute
regex :: String -> RoutePattern
regex :: FilePath -> RoutePattern
regex = FilePath -> RoutePattern
Trans.regex
capture :: String -> RoutePattern
capture :: FilePath -> RoutePattern
capture = FilePath -> RoutePattern
Trans.capture
function :: (Request -> Maybe [Param]) -> RoutePattern
function :: (Request -> Maybe [Param]) -> RoutePattern
function = (Request -> Maybe [Param]) -> RoutePattern
Trans.function
literal :: String -> RoutePattern
literal :: FilePath -> RoutePattern
literal = FilePath -> RoutePattern
Trans.literal