| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Web.Scotty.Trans
Description
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.
Synopsis
- scottyT :: (Monad m, MonadIO n) => Port -> (m Response -> IO Response) -> ScottyT m () -> n ()
- scottyOptsT :: (Monad m, MonadIO n) => Options -> (m Response -> IO Response) -> ScottyT m () -> n ()
- scottySocketT :: (Monad m, MonadIO n) => Options -> Socket -> (m Response -> IO Response) -> ScottyT m () -> n ()
- data Options = Options {}
- defaultOptions :: Options
- scottyAppT :: (Monad m, Monad n) => Options -> (m Response -> IO Response) -> ScottyT m () -> n Application
- middleware :: forall (m :: Type -> Type). Middleware -> ScottyT m ()
- get :: forall (m :: Type -> Type). MonadUnliftIO m => RoutePattern -> ActionT m () -> ScottyT m ()
- post :: forall (m :: Type -> Type). MonadUnliftIO m => RoutePattern -> ActionT m () -> ScottyT m ()
- put :: forall (m :: Type -> Type). MonadUnliftIO m => RoutePattern -> ActionT m () -> ScottyT m ()
- delete :: forall (m :: Type -> Type). MonadUnliftIO m => RoutePattern -> ActionT m () -> ScottyT m ()
- patch :: forall (m :: Type -> Type). MonadUnliftIO m => RoutePattern -> ActionT m () -> ScottyT m ()
- options :: forall (m :: Type -> Type). MonadUnliftIO m => RoutePattern -> ActionT m () -> ScottyT m ()
- addroute :: forall (m :: Type -> Type). MonadUnliftIO m => StdMethod -> RoutePattern -> ActionT m () -> ScottyT m ()
- matchAny :: forall (m :: Type -> Type). MonadUnliftIO m => RoutePattern -> ActionT m () -> ScottyT m ()
- notFound :: forall (m :: Type -> Type). MonadUnliftIO m => ActionT m () -> ScottyT m ()
- setMaxRequestBodySize :: forall (m :: Type -> Type). Kilobytes -> ScottyT m ()
- capture :: String -> RoutePattern
- regex :: String -> RoutePattern
- function :: (Request -> Maybe [Param]) -> RoutePattern
- literal :: String -> RoutePattern
- request :: forall (m :: Type -> Type). Monad m => ActionT m Request
- header :: forall (m :: Type -> Type). Monad m => Text -> ActionT m (Maybe Text)
- headers :: forall (m :: Type -> Type). Monad m => ActionT m [(Text, Text)]
- body :: forall (m :: Type -> Type). MonadIO m => ActionT m ByteString
- bodyReader :: forall (m :: Type -> Type). Monad m => ActionT m (IO ByteString)
- jsonData :: forall a (m :: Type -> Type). (FromJSON a, MonadIO m) => ActionT m a
- formData :: forall a (m :: Type -> Type). (FromForm a, MonadUnliftIO m) => ActionT m a
- pathParam :: forall a (m :: Type -> Type). (Parsable a, MonadIO m) => Text -> ActionT m a
- captureParam :: forall a (m :: Type -> Type). (Parsable a, MonadIO m) => Text -> ActionT m a
- formParam :: forall (m :: Type -> Type) b. (MonadUnliftIO m, Parsable b) => Text -> ActionT m b
- queryParam :: forall a (m :: Type -> Type). (Parsable a, MonadIO m) => Text -> ActionT m a
- pathParamMaybe :: forall a (m :: Type -> Type). (Parsable a, Monad m) => Text -> ActionT m (Maybe a)
- captureParamMaybe :: forall a (m :: Type -> Type). (Parsable a, Monad m) => Text -> ActionT m (Maybe a)
- formParamMaybe :: forall (m :: Type -> Type) a. (MonadUnliftIO m, Parsable a) => Text -> ActionT m (Maybe a)
- queryParamMaybe :: forall a (m :: Type -> Type). (Parsable a, Monad m) => Text -> ActionT m (Maybe a)
- pathParams :: forall (m :: Type -> Type). Monad m => ActionT m [Param]
- captureParams :: forall (m :: Type -> Type). Monad m => ActionT m [Param]
- formParams :: forall (m :: Type -> Type). MonadUnliftIO m => ActionT m [Param]
- queryParams :: forall (m :: Type -> Type). Monad m => ActionT m [Param]
- files :: forall (m :: Type -> Type). MonadUnliftIO m => ActionT m [File ByteString]
- filesOpts :: forall (m :: Type -> Type) a. MonadUnliftIO m => ParseRequestBodyOptions -> ([Param] -> [File FilePath] -> ActionT m a) -> ActionT m a
- status :: forall (m :: Type -> Type). MonadIO m => Status -> ActionT m ()
- addHeader :: forall (m :: Type -> Type). MonadIO m => Text -> Text -> ActionT m ()
- setHeader :: forall (m :: Type -> Type). MonadIO m => Text -> Text -> ActionT m ()
- redirect :: forall (m :: Type -> Type) a. Monad m => Text -> ActionT m a
- redirect300 :: forall (m :: Type -> Type) a. Monad m => Text -> ActionT m a
- redirect301 :: forall (m :: Type -> Type) a. Monad m => Text -> ActionT m a
- redirect302 :: forall (m :: Type -> Type) a. Monad m => Text -> ActionT m a
- redirect303 :: forall (m :: Type -> Type) a. Monad m => Text -> ActionT m a
- redirect304 :: forall (m :: Type -> Type) a. Monad m => Text -> ActionT m a
- redirect307 :: forall (m :: Type -> Type) a. Monad m => Text -> ActionT m a
- redirect308 :: forall (m :: Type -> Type) a. Monad m => Text -> ActionT m a
- text :: forall (m :: Type -> Type). MonadIO m => Text -> ActionT m ()
- html :: forall (m :: Type -> Type). MonadIO m => Text -> ActionT m ()
- file :: forall (m :: Type -> Type). MonadIO m => FilePath -> ActionT m ()
- json :: forall a (m :: Type -> Type). (ToJSON a, MonadIO m) => a -> ActionT m ()
- stream :: forall (m :: Type -> Type). MonadIO m => StreamingBody -> ActionT m ()
- raw :: forall (m :: Type -> Type). MonadIO m => ByteString -> ActionT m ()
- nested :: forall (m :: Type -> Type). MonadIO m => Application -> ActionT m ()
- getResponseHeaders :: forall (m :: Type -> Type). MonadIO m => ActionT m ResponseHeaders
- getResponseStatus :: forall (m :: Type -> Type). MonadIO m => ActionT m Status
- getResponseContent :: forall (m :: Type -> Type). MonadIO m => ActionT m Content
- throw :: forall (m :: Type -> Type) e a. (MonadIO m, Exception e) => e -> ActionT m a
- next :: forall (m :: Type -> Type) a. Monad m => ActionT m a
- finish :: forall (m :: Type -> Type) a. Monad m => ActionT m a
- defaultHandler :: forall (m :: Type -> Type). Monad m => ErrorHandler m -> ScottyT m ()
- liftIO :: MonadIO m => IO a -> m a
- catch :: (MonadUnliftIO m, Exception e) => m a -> (e -> m a) -> m a
- data ScottyException
- = RequestTooLarge
- | MalformedJSON ByteString Text
- | FailedToParseJSON ByteString Text
- | MalformedForm Text
- | PathParameterNotFound Text
- | QueryParameterNotFound Text
- | FormFieldNotFound Text
- | FailedToParseParameter Text Text Text
- | WarpRequestException InvalidRequest
- | WaiRequestParseException RequestParseException
- | ResourceTException InvalidAccess
- type Param = (Text, Text)
- class Parsable a where
- parseParam :: Text -> Either Text a
- parseParamList :: Text -> Either Text [a]
- readEither :: Read a => Text -> Either Text a
- data RoutePattern
- type File t = (Text, FileInfo t)
- data Content
- type Kilobytes = Int
- type ErrorHandler (m :: Type -> Type) = Handler (ActionT m) ()
- data Handler (m :: Type -> Type) a = Exception e => Handler (e -> m a)
- data ScottyT (m :: Type -> Type) a
- data ActionT (m :: Type -> Type) a
- data ScottyState (m :: Type -> Type)
- defaultScottyState :: forall (m :: Type -> Type). ScottyState m
- setSimpleCookie :: forall (m :: Type -> Type). MonadIO m => Text -> Text -> ActionT m ()
- getCookie :: forall (m :: Type -> Type). Monad m => Text -> ActionT m (Maybe Text)
- getCookies :: forall (m :: Type -> Type). Monad m => ActionT m CookiesText
- deleteCookie :: forall (m :: Type -> Type). MonadIO m => Text -> ActionT m ()
- makeSimpleCookie :: Text -> Text -> SetCookie
- data Session a = Session {
- sessId :: SessionId
- sessExpiresAt :: UTCTime
- sessContent :: a
- type SessionId = Text
- type SessionJar a = TVar (HashMap SessionId (Session a))
- createSessionJar :: IO (SessionJar a)
- createUserSession :: forall (m :: Type -> Type) a. MonadIO m => SessionJar a -> Maybe Int -> a -> ActionT m (Session a)
- createSession :: SessionJar a -> Maybe Int -> a -> IO (Session a)
- readUserSession :: forall (m :: Type -> Type) a. MonadIO m => SessionJar a -> ActionT m (Either SessionStatus a)
- readSession :: forall (m :: Type -> Type) a. MonadIO m => SessionJar a -> SessionId -> ActionT m (Either SessionStatus a)
- getUserSession :: forall (m :: Type -> Type) a. MonadIO m => SessionJar a -> ActionT m (Either SessionStatus (Session a))
- getSession :: forall (m :: Type -> Type) a. MonadIO m => SessionJar a -> SessionId -> ActionT m (Either SessionStatus (Session a))
- addSession :: SessionJar a -> Session a -> IO ()
- deleteSession :: forall (m :: Type -> Type) a. MonadIO m => SessionJar a -> SessionId -> ActionT m ()
- maintainSessions :: SessionJar a -> IO ()
Running scotty servers
Arguments
| :: (Monad m, MonadIO n) | |
| => Port | |
| -> (m Response -> IO Response) | Run monad |
| -> ScottyT m () | |
| -> n () |
Run a scotty application using the warp server. NB: scotty p === scottyT p id
Arguments
| :: (Monad m, MonadIO n) | |
| => Options | |
| -> (m Response -> IO Response) | Run monad |
| -> ScottyT m () | |
| -> n () |
Run a scotty application using the warp server, passing extra options. NB: scottyOpts opts === scottyOptsT opts id
scottySocketT :: (Monad m, MonadIO n) => Options -> Socket -> (m Response -> IO Response) -> ScottyT m () -> n () Source #
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
Constructors
| Options | |
Fields
| |
scotty-to-WAI
Arguments
| :: (Monad m, Monad n) | |
| => Options | |
| -> (m Response -> IO Response) | Run monad |
| -> ScottyT m () | |
| -> n Application |
Turn a scotty application into a WAI Application, which can be
run with any WAI handler.
NB: scottyApp === scottyAppT id
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 :: forall (m :: Type -> Type). Middleware -> ScottyT m () Source #
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.
get :: forall (m :: Type -> Type). MonadUnliftIO m => RoutePattern -> ActionT m () -> ScottyT m () Source #
post :: forall (m :: Type -> Type). MonadUnliftIO m => RoutePattern -> ActionT m () -> ScottyT m () Source #
put :: forall (m :: Type -> Type). MonadUnliftIO m => RoutePattern -> ActionT m () -> ScottyT m () Source #
delete :: forall (m :: Type -> Type). MonadUnliftIO m => RoutePattern -> ActionT m () -> ScottyT m () Source #
patch :: forall (m :: Type -> Type). MonadUnliftIO m => RoutePattern -> ActionT m () -> ScottyT m () Source #
options :: forall (m :: Type -> Type). MonadUnliftIO m => RoutePattern -> ActionT m () -> ScottyT m () Source #
addroute :: forall (m :: Type -> Type). MonadUnliftIO m => StdMethod -> RoutePattern -> ActionT m () -> ScottyT m () Source #
Define a route with a StdMethod, a route pattern representing the path spec,
and an Action which may modify the response.
get "/" $ text "beam me up!"
The path spec can include values starting with a colon, which are interpreted
as captures. These are parameters that can be looked up with pathParam.
>>>:{let server = S.get "/foo/:bar" (S.pathParam "bar" >>= S.text) in do withScotty server $ curl "http://localhost:3000/foo/something" :} "something"
matchAny :: forall (m :: Type -> Type). MonadUnliftIO m => RoutePattern -> ActionT m () -> ScottyT m () Source #
Add a route that matches regardless of the HTTP verb.
notFound :: forall (m :: Type -> Type). MonadUnliftIO m => ActionT m () -> ScottyT m () Source #
Specify an action to take if nothing else is found. Note: this _always_ matches, so should generally be the last route specified.
setMaxRequestBodySize Source #
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.
Route Patterns
capture :: String -> RoutePattern Source #
Standard Sinatra-style route. Named captures are prepended with colons. This is the default route type generated by OverloadedString routes. i.e.
get (capture "/foo/:bar") $ ...
and
{-# LANGUAGE OverloadedStrings #-}
...
get "/foo/:bar" $ ...are equivalent.
regex :: String -> RoutePattern Source #
Match requests using a regular expression. Named captures are not yet supported.
>>>:{let server = S.get (S.regex "^/f(.*)r$") $ do cap <- S.pathParam "1" S.text cap in do withScotty server $ curl "http://localhost:3000/foo/bar" :} "oo/ba"
function :: (Request -> Maybe [Param]) -> RoutePattern Source #
Build a route based on a function which can match using the entire Request object.
Nothing indicates the route does not match. A Just value indicates
a successful match, optionally returning a list of key-value pairs accessible by param.
>>>:{let server = S.get (function $ \req -> Just [("version", T.pack $ show $ W.httpVersion req)]) $ do v <- S.pathParam "version" S.text v in do withScotty server $ curl "http://localhost:3000/" :} "HTTP/1.1"
literal :: String -> RoutePattern Source #
Build a route that requires the requested path match exactly, without captures.
Accessing the Request and its fields
header :: forall (m :: Type -> Type). Monad m => Text -> ActionT m (Maybe Text) Source #
Get a request header. Header name is case-insensitive.
headers :: forall (m :: Type -> Type). Monad m => ActionT m [(Text, Text)] Source #
Get all the request headers. Header names are case-insensitive.
body :: forall (m :: Type -> Type). MonadIO m => ActionT m ByteString Source #
Get the request body.
NB This loads the whole request body in memory at once.
bodyReader :: forall (m :: Type -> Type). Monad m => ActionT m (IO ByteString) Source #
jsonData :: forall a (m :: Type -> Type). (FromJSON a, MonadIO m) => ActionT m a Source #
Parse the request body as a JSON object and return it.
If the JSON object is malformed, this sets the status to 400 Bad Request, and throws an exception.
If the JSON fails to parse, this sets the status to 422 Unprocessable Entity.
These status codes are as per https://www.restapitutorial.com/httpstatuscodes.html.
NB : Internally this uses body.
formData :: forall a (m :: Type -> Type). (FromForm a, MonadUnliftIO m) => ActionT m a Source #
Parse the request body as x-www-form-urlencoded form data and return it.
The form is parsed using urlDecodeAsForm. If that returns Left, the
status is set to 400 and an exception is thrown.
Accessing Path, Form and Query Parameters
pathParam :: forall a (m :: Type -> Type). (Parsable a, MonadIO m) => Text -> ActionT m a Source #
Look up a path parameter.
- Raises an exception which can be caught by
catchif parameter is not found. If the exception is not caught, scotty will return a HTTP error code 500 ("Internal Server Error") to the client. - If the parameter is found, but
parseParamfails to parse to the correct type,nextis called.
Since: 0.20
captureParam :: forall a (m :: Type -> Type). (Parsable a, MonadIO m) => Text -> ActionT m a Source #
Synonym for pathParam
formParam :: forall (m :: Type -> Type) b. (MonadUnliftIO m, Parsable b) => Text -> ActionT m b Source #
Look up a form parameter.
- Raises an exception which can be caught by
catchif parameter is not found. If the exception is not caught, scotty will return a HTTP error code 400 ("Bad Request") to the client. - This function raises a code 400 also if the parameter is found, but
parseParamfails to parse to the correct type.
Since: 0.20
queryParam :: forall a (m :: Type -> Type). (Parsable a, MonadIO m) => Text -> ActionT m a Source #
Look up a query parameter.
- Raises an exception which can be caught by
catchif parameter is not found. If the exception is not caught, scotty will return a HTTP error code 400 ("Bad Request") to the client. - This function raises a code 400 also if the parameter is found, but
parseParamfails to parse to the correct type.
Since: 0.20
pathParamMaybe :: forall a (m :: Type -> Type). (Parsable a, Monad m) => Text -> ActionT m (Maybe a) Source #
captureParamMaybe :: forall a (m :: Type -> Type). (Parsable a, Monad m) => Text -> ActionT m (Maybe a) Source #
formParamMaybe :: forall (m :: Type -> Type) a. (MonadUnliftIO m, Parsable a) => Text -> ActionT m (Maybe a) Source #
queryParamMaybe :: forall a (m :: Type -> Type). (Parsable a, Monad m) => Text -> ActionT m (Maybe a) Source #
captureParams :: forall (m :: Type -> Type). Monad m => ActionT m [Param] Source #
Get path parameters
formParams :: forall (m :: Type -> Type). MonadUnliftIO m => ActionT m [Param] Source #
Get form parameters
queryParams :: forall (m :: Type -> Type). Monad m => ActionT m [Param] Source #
Get query parameters
Files
files :: forall (m :: Type -> Type). MonadUnliftIO m => ActionT m [File ByteString] Source #
Get list of uploaded files.
NB: Loads all file contents in memory with options defaultParseRequestBodyOptions
Arguments
| :: forall (m :: Type -> Type) a. MonadUnliftIO m | |
| => ParseRequestBodyOptions | |
| -> ([Param] -> [File FilePath] -> ActionT m a) | temp files validation, storage etc |
| -> ActionT m a |
Get list of uploaded temp files and form parameters decoded from multipart payloads.
NB the temp files are deleted when the continuation exits.
Modifying the Response
status :: forall (m :: Type -> Type). MonadIO m => Status -> ActionT m () Source #
Set the HTTP response status.
addHeader :: forall (m :: Type -> Type). MonadIO m => Text -> Text -> ActionT m () Source #
Add to the response headers. Header names are case-insensitive.
setHeader :: forall (m :: Type -> Type). MonadIO m => Text -> Text -> ActionT m () Source #
Set one of the response headers. Will override any previously set value for that header. Header names are case-insensitive.
Redirecting
redirect :: forall (m :: Type -> Type) a. Monad m => Text -> ActionT m a Source #
Synonym for redirect302.
If you are unsure which redirect to use, you probably want this one.
redirect "http://www.google.com"
OR
redirect "/foo/bar"
redirect300 :: forall (m :: Type -> Type) a. Monad m => Text -> ActionT m a Source #
Redirect to given URL with status 300 (Multiple Choices). Like throwing an uncatchable exception. Any code after the call to redirect will not be run.
redirect301 :: forall (m :: Type -> Type) a. Monad m => Text -> ActionT m a Source #
Redirect to given URL with status 301 (Moved Permanently). Like throwing an uncatchable exception. Any code after the call to redirect will not be run.
redirect302 :: forall (m :: Type -> Type) a. Monad m => Text -> ActionT m a Source #
Redirect to given URL with status 302 (Found). Like throwing an uncatchable exception. Any code after the call to redirect will not be run.
redirect303 :: forall (m :: Type -> Type) a. Monad m => Text -> ActionT m a Source #
Redirect to given URL with status 303 (See Other). Like throwing an uncatchable exception. Any code after the call to redirect will not be run.
redirect304 :: forall (m :: Type -> Type) a. Monad m => Text -> ActionT m a Source #
Redirect to given URL with status 304 (Not Modified). Like throwing an uncatchable exception. Any code after the call to redirect will not be run.
redirect307 :: forall (m :: Type -> Type) a. Monad m => Text -> ActionT m a Source #
Redirect to given URL with status 307 (Temporary Redirect). Like throwing an uncatchable exception. Any code after the call to redirect will not be run.
redirect308 :: forall (m :: Type -> Type) a. Monad m => Text -> ActionT m a Source #
Redirect to given URL with status 308 (Permanent Redirect). Like throwing an uncatchable exception. Any code after the call to redirect will not be run.
Setting Response Body
Note: only one of these should be present in any given route
definition, as they completely replace the current Response body.
file :: forall (m :: Type -> Type). MonadIO m => FilePath -> ActionT m () Source #
Send a file as the response. Doesn't set the "Content-Type" header, so you probably
want to do that on your own with setHeader. Setting a status code will have no effect
because Warp will overwrite that to 200 (see sendResponse).
json :: forall a (m :: Type -> Type). (ToJSON a, MonadIO m) => a -> ActionT m () Source #
Set the body of the response to the JSON encoding of the given value. Also sets "Content-Type" header to "application/json; charset=utf-8" if it has not already been set.
stream :: forall (m :: Type -> Type). MonadIO m => StreamingBody -> ActionT m () Source #
Set the body of the response to a Source. Doesn't set the
"Content-Type" header, so you probably want to do that on your
own with setHeader.
raw :: forall (m :: Type -> Type). MonadIO m => ByteString -> ActionT m () Source #
Set the body of the response to the given ByteString value. Doesn't set the
"Content-Type" header, so you probably want to do that on your
own with setHeader.
nested :: forall (m :: Type -> Type). MonadIO m => Application -> ActionT m () Source #
Nest a whole WAI application inside a Scotty handler. See Web.Scotty for further documentation
Accessing the fields of the Response
getResponseHeaders :: forall (m :: Type -> Type). MonadIO m => ActionT m ResponseHeaders Source #
Access the HTTP headers of the Response
SINCE 0.21
getResponseStatus :: forall (m :: Type -> Type). MonadIO m => ActionT m Status Source #
Access the HTTP Status of the Response
SINCE 0.21
getResponseContent :: forall (m :: Type -> Type). MonadIO m => ActionT m Content Source #
Access the content of the Response
SINCE 0.21
Exceptions
throw :: forall (m :: Type -> Type) e a. (MonadIO m, Exception e) => e -> ActionT m a Source #
Throw an exception which can be caught within the scope of the current Action with catch.
If the exception is not caught locally, another option is to implement a global Handler (with defaultHandler) that defines its interpretation and a translation to HTTP error codes.
Uncaught exceptions turn into HTTP 500 responses.
next :: forall (m :: Type -> Type) a. Monad m => ActionT m a Source #
Abort execution of this action and continue pattern matching routes.
Like an exception, any code after next is not executed.
NB : Internally, this is implemented with an exception that can only be caught by the library, but not by the user.
As an example, these two routes overlap. The only way the second one will
ever run is if the first one calls next.
get "/foo/:bar" $ do w :: Text <- pathParam "bar" unless (w == "special") next text "You made a request to /foo/special" get "/foo/:baz" $ do w <- pathParam "baz" text $ "You made a request to: " <> w
finish :: forall (m :: Type -> Type) a. Monad m => ActionT m a Source #
Finish the execution of the current action. Like throwing an uncatchable exception. Any code after the call to finish will not be run.
Since: 0.10.3
defaultHandler :: forall (m :: Type -> Type). Monad m => ErrorHandler m -> ScottyT m () Source #
Global handler for user-defined exceptions.
liftIO :: MonadIO m => IO a -> m a #
Lift a computation from the IO monad.
This allows us to run IO computations in any monadic stack, so long as it supports these kinds of operations
(i.e. IO is the base monad for the stack).
Example
import Control.Monad.Trans.State -- from the "transformers" library printState :: Show s => StateT s IO () printState = do state <- get liftIO $ print state
Had we omitted , we would have ended up with this error:liftIO
• Couldn't match type ‘IO’ with ‘StateT s IO’ Expected type: StateT s IO () Actual type: IO ()
The important part here is the mismatch between StateT s IO () and .IO ()
Luckily, we know of a function that takes an and returns an IO a(m a): ,
enabling us to run the program and see the expected results:liftIO
> evalStateT printState "hello" "hello" > evalStateT printState 3 3
Arguments
| :: (MonadUnliftIO m, Exception e) | |
| => m a | action |
| -> (e -> m a) | handler |
| -> m a |
Catch a synchronous (but not asynchronous) exception and recover from it.
This is parameterized on the exception type. To catch all synchronous exceptions,
use catchAny.
Since: unliftio-0.1.0.0
data ScottyException Source #
Thrown e.g. when a request is too large
Constructors
Instances
| Exception ScottyException Source # | |
Defined in Web.Scotty.Internal.Types Methods toException :: ScottyException -> SomeException # | |
| Show ScottyException Source # | |
Defined in Web.Scotty.Internal.Types Methods showsPrec :: Int -> ScottyException -> ShowS # show :: ScottyException -> String # showList :: [ScottyException] -> ShowS # | |
Parsing Parameters
class Parsable a where Source #
Minimum implemention: parseParam
Minimal complete definition
Methods
parseParam :: Text -> Either Text a Source #
Take a Text value and parse it as a, or fail with a message.
parseParamList :: Text -> Either Text [a] Source #
Default implementation parses comma-delimited lists.
parseParamList t = mapM parseParam (T.split (== ',') t)
Instances
Types
data RoutePattern Source #
Instances
| IsString RoutePattern Source # | |
Defined in Web.Scotty.Internal.Types Methods fromString :: String -> RoutePattern # | |
type File t = (Text, FileInfo t) Source #
Type parameter t is the file content. Could be () when not needed or a FilePath for temp files instead.
Monad Transformers
data ActionT (m :: Type -> Type) a Source #
Instances
data ScottyState (m :: Type -> Type) Source #
defaultScottyState :: forall (m :: Type -> Type). ScottyState m Source #
Functions from Cookie module
makeSimpleCookie and setCookie combined.
Lookup one cookie name
getCookies :: forall (m :: Type -> Type). Monad m => ActionT m CookiesText Source #
Returns all cookies
Browsers don't directly delete a cookie, but setting its expiry to a past date (e.g. the UNIX epoch) ensures that the cookie will be invalidated (whether and when it will be actually deleted by the browser seems to be browser-dependent).
Construct a simple cookie (an UTF-8 string pair with default cookie options)
Session Management
Represents a session containing an ID, expiration time, and content.
Constructors
| Session | |
Fields
| |
type SessionJar a = TVar (HashMap SessionId (Session a)) Source #
Type for session storage, a transactional variable containing a map of session IDs to sessions.
createSessionJar :: IO (SessionJar a) Source #
Creates a new session jar and starts a background thread to maintain it.
Arguments
| :: forall (m :: Type -> Type) a. MonadIO m | |
| => SessionJar a | SessionJar, which can be created by createSessionJar |
| -> Maybe Int | Optional expiration time (in seconds) |
| -> a | Content |
| -> ActionT m (Session a) |
Creates a new session for a user, storing the content and setting a cookie.
createSession :: SessionJar a -> Maybe Int -> a -> IO (Session a) Source #
Creates a new session with a generated ID, sets its expiration, | and adds it to the session jar.
readUserSession :: forall (m :: Type -> Type) a. MonadIO m => SessionJar a -> ActionT m (Either SessionStatus a) Source #
Reads the content of the current user's session.
readSession :: forall (m :: Type -> Type) a. MonadIO m => SessionJar a -> SessionId -> ActionT m (Either SessionStatus a) Source #
Reads the content of a session by its ID.
getUserSession :: forall (m :: Type -> Type) a. MonadIO m => SessionJar a -> ActionT m (Either SessionStatus (Session a)) Source #
Retrieves the current user's session based on the "sess_id" cookie. | Returns `Left SessionStatus` if the session is expired or does not exist.
getSession :: forall (m :: Type -> Type) a. MonadIO m => SessionJar a -> SessionId -> ActionT m (Either SessionStatus (Session a)) Source #
Retrieves a session by its ID from the session jar.
addSession :: SessionJar a -> Session a -> IO () Source #
Adds or overwrites a new session to the session jar.
deleteSession :: forall (m :: Type -> Type) a. MonadIO m => SessionJar a -> SessionId -> ActionT m () Source #
Deletes a session by its ID from the session jar.
maintainSessions :: SessionJar a -> IO () Source #
Continuously removes expired sessions from the session jar.