scotty-0.30: Haskell web framework inspired by Ruby's Sinatra, using WAI and Warp
Safe HaskellNone
LanguageHaskell2010

Web.Scotty

Description

It should be noted that most of the code snippets below depend on the OverloadedStrings language pragma.

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

Running scotty servers

scotty :: Port -> ScottyM () -> IO () Source #

Run a scotty application using the warp server.

scottyOpts :: Options -> ScottyM () -> IO () Source #

Run a scotty application using the warp server, passing extra options.

scottySocket :: Options -> Socket -> ScottyM () -> IO () Source #

Run a scotty application using the warp server, passing extra options, and listening on the provided socket. This allows the user to provide, for example, a Unix named socket, which can be used when reverse HTTP proxying into your application.

data Options Source #

Constructors

Options 

Fields

  • verbose :: Int

    0 = silent, 1(def) = startup banner

  • settings :: Settings

    Warp Settings Note: to work around an issue in warp, the default FD cache duration is set to 0 so changes to static files are always picked up. This likely has performance implications, so you may want to modify this for production servers using setFdCacheDuration.

  • jsonMode :: Bool

    If True, return JSON error responses instead of HTML

scotty-to-WAI

scottyApp :: ScottyM () -> IO Application Source #

Turn a scotty application into a WAI Application, which can be run with any WAI handler.

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 :: Middleware -> ScottyM () 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 :: RoutePattern -> ActionM () -> ScottyM () Source #

get = addroute GET

post :: RoutePattern -> ActionM () -> ScottyM () Source #

post = addroute POST

put :: RoutePattern -> ActionM () -> ScottyM () Source #

put = addroute PUT

delete :: RoutePattern -> ActionM () -> ScottyM () Source #

delete = addroute DELETE

patch :: RoutePattern -> ActionM () -> ScottyM () Source #

patch = addroute PATCH

options :: RoutePattern -> ActionM () -> ScottyM () Source #

options = addroute OPTIONS

addroute :: StdMethod -> RoutePattern -> ActionM () -> ScottyM () 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 :: RoutePattern -> ActionM () -> ScottyM () Source #

Add a route that matches regardless of the HTTP verb.

notFound :: ActionM () -> ScottyM () Source #

Specify an action to take if nothing else is found. Note: this _always_ matches, so should generally be the last route specified.

nested :: Application -> ActionM () Source #

Nest a whole WAI application inside a Scotty handler. Note: You will want to ensure that this route fully handles the response, as there is no easy delegation as per normal Scotty actions. Also, you will have to carefully ensure that you are expecting the correct routes, this could require stripping the current prefix, or adding the prefix to your application's handlers if it depends on them. One potential use-case for this is hosting a web-socket handler under a specific route.

setMaxRequestBodySize :: Kilobytes -> ScottyM () 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 :: Text -> ActionM (Maybe Text) Source #

Get a request header. Header name is case-insensitive.

headers :: ActionM [(Text, Text)] Source #

Get all the request headers. Header names are case-insensitive.

body :: ActionM ByteString Source #

Get the request body.

NB: loads the entire request body in memory

bodyReader :: ActionM (IO ByteString) Source #

Get an IO action that reads body chunks

  • This is incompatible with body since body consumes all chunks.

jsonData :: FromJSON a => ActionM a Source #

Parse the request body as a JSON object and return it. Raises an exception if parse is unsuccessful.

NB: uses body internally

formData :: FromForm a => ActionM a Source #

Parse the request body as x-www-form-urlencoded form data and return it. Raises an exception if parse is unsuccessful.

NB: uses body internally

Accessing Path, Form and Query Parameters

pathParam :: Parsable a => Text -> ActionM a Source #

Get a path parameter.

  • Raises an exception which can be caught by catch if 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 parseParam fails to parse to the correct type, next is called.

Since: 0.21

captureParam :: Parsable a => Text -> ActionM a Source #

Synonym for pathParam

Since: 0.20

formParam :: Parsable a => Text -> ActionM a Source #

Get a form parameter.

  • Raises an exception which can be caught by catch if 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 parseParam fails to parse to the correct type.

Since: 0.20

queryParam :: Parsable a => Text -> ActionM a Source #

Get a query parameter.

  • Raises an exception which can be caught by catch if 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 parseParam fails to parse to the correct type.

Since: 0.20

pathParamMaybe :: Parsable a => Text -> ActionM (Maybe a) Source #

Look up a path parameter. Returns Nothing if the parameter is not found or cannot be parsed at the right type.

NB : Doesn't throw exceptions. In particular, route pattern matching will not continue, so developers must raiseStatus or throw to signal something went wrong.

Since: 0.21

captureParamMaybe :: Parsable a => Text -> ActionM (Maybe a) Source #

Synonym for pathParamMaybe

Since: 0.21

formParamMaybe :: Parsable a => Text -> ActionM (Maybe a) Source #

Look up a form parameter. Returns Nothing if the parameter is not found or cannot be parsed at the right type.

NB : Doesn't throw exceptions, so developers must raiseStatus or throw to signal something went wrong.

Since: 0.21

queryParamMaybe :: Parsable a => Text -> ActionM (Maybe a) Source #

Look up a query parameter. Returns Nothing if the parameter is not found or cannot be parsed at the right type.

NB : Doesn't throw exceptions, so developers must raiseStatus or throw to signal something went wrong.

Since: 0.21

pathParams :: ActionM [Param] Source #

Get path parameters

formParams :: ActionM [Param] Source #

Get form parameters

queryParams :: ActionM [Param] Source #

Get query parameters

Files

files :: ActionM [File ByteString] Source #

Get list of uploaded files.

NB: Loads all file contents in memory with options defaultParseRequestBodyOptions

filesOpts Source #

Arguments

:: ParseRequestBodyOptions 
-> ([Param] -> [File FilePath] -> ActionM a)

temp files validation, storage etc

-> ActionM a 

Get list of temp files and form parameters decoded from multipart payloads.

NB the temp files are deleted when the continuation exits

Modifying the Response

status :: Status -> ActionM () Source #

Set the HTTP response status. Default is 200.

addHeader :: Text -> Text -> ActionM () Source #

Add to the response headers. Header names are case-insensitive.

setHeader :: Text -> Text -> ActionM () Source #

Set one of the response headers. Will override any previously set value for that header. Header names are case-insensitive.

Redirecting

redirect :: Text -> ActionM 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 :: Text -> ActionM 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 :: Text -> ActionM 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 :: Text -> ActionM 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 :: Text -> ActionM 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 :: Text -> ActionM 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 :: Text -> ActionM 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 :: Text -> ActionM 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.

text :: Text -> ActionM () Source #

Set the body of the response to the given Text value. Also sets "Content-Type" header to "text/plain; charset=utf-8" if it has not already been set.

html :: Text -> ActionM () Source #

Set the body of the response to the given Text value. Also sets "Content-Type" header to "text/html; charset=utf-8" if it has not already been set.

file :: FilePath -> ActionM () 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.

json :: ToJSON a => a -> ActionM () 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 :: StreamingBody -> ActionM () Source #

Set the body of the response to a StreamingBody. Doesn't set the "Content-Type" header, so you probably want to do that on your own with setHeader.

raw :: ByteString -> ActionM () 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.

Accessing the fields of the Response

getResponseHeaders :: ActionM ResponseHeaders Source #

Access the HTTP headers of the Response

Since: 0.21

getResponseStatus :: ActionM Status Source #

Access the HTTP Status of the Response

Since: 0.21

getResponseContent :: ActionM Content Source #

Access the content of the Response

Since: 0.21

Exceptions

throw :: Exception e => e -> ActionM 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 :: ActionM () 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 :: ActionM a Source #

Abort execution of this action. Like an exception, any code after finish is not executed.

As an example only requests to /foo/special will include in the response content the text message.

get "/foo/:bar" $ do
  w :: Text <- pathParam "bar"
  unless (w == "special") finish
  text "You made a request to /foo/special"

Since: 0.10.3

defaultHandler :: ErrorHandler IO -> ScottyM () 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

Expand
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 liftIO, we would have ended up with this error:

• 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 IO a and returns an (m a): liftIO, enabling us to run the program and see the expected results:

> evalStateT printState "hello"
"hello"

> evalStateT printState 3
3

catch #

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

Parsing Parameters

type Param = (Text, Text) Source #

class Parsable a where Source #

Minimum implemention: parseParam

Minimal complete definition

parseParam

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

Instances details
Parsable Int16 Source # 
Instance details

Defined in Web.Scotty.Action

Parsable Int32 Source # 
Instance details

Defined in Web.Scotty.Action

Parsable Int64 Source # 
Instance details

Defined in Web.Scotty.Action

Parsable Int8 Source # 
Instance details

Defined in Web.Scotty.Action

Parsable Word16 Source # 
Instance details

Defined in Web.Scotty.Action

Parsable Word32 Source # 
Instance details

Defined in Web.Scotty.Action

Parsable Word64 Source # 
Instance details

Defined in Web.Scotty.Action

Parsable Word8 Source # 
Instance details

Defined in Web.Scotty.Action

Parsable ByteString Source # 
Instance details

Defined in Web.Scotty.Action

Parsable ByteString Source # 
Instance details

Defined in Web.Scotty.Action

Parsable Text Source # 
Instance details

Defined in Web.Scotty.Action

Parsable Text Source # 
Instance details

Defined in Web.Scotty.Action

Parsable UTCTime Source #

parse a UTCTime timestamp formatted as a ISO 8601 timestamp:

yyyy-mm-ddThh:mm:ssZ , where the seconds can have a decimal part with up to 12 digits and no trailing zeros.

Instance details

Defined in Web.Scotty.Action

Parsable Integer Source # 
Instance details

Defined in Web.Scotty.Action

Parsable Natural Source # 
Instance details

Defined in Web.Scotty.Action

Parsable () Source #

Checks if parameter is present and is null-valued, not a literal (). If the URI requested is: '/foo?bar=()&baz' then baz will parse as (), where bar will not.

Instance details

Defined in Web.Scotty.Action

Parsable Bool Source # 
Instance details

Defined in Web.Scotty.Action

Parsable Char Source #

Overrides default parseParamList to parse String.

Instance details

Defined in Web.Scotty.Action

Parsable Double Source # 
Instance details

Defined in Web.Scotty.Action

Parsable Float Source # 
Instance details

Defined in Web.Scotty.Action

Parsable Int Source # 
Instance details

Defined in Web.Scotty.Action

Parsable Word Source # 
Instance details

Defined in Web.Scotty.Action

Parsable a => Parsable [a] Source # 
Instance details

Defined in Web.Scotty.Action

readEither :: Read a => Text -> Either Text a Source #

Useful for creating Parsable instances for things that already implement Read. Ex:

instance Parsable Int where parseParam = readEither

Types

data RoutePattern Source #

Instances

Instances details
IsString RoutePattern Source # 
Instance details

Defined in Web.Scotty.Internal.Types

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.

type ErrorHandler (m :: Type -> Type) = Handler (ActionT m) () Source #

Specializes a Handler to the ActionT monad

data Handler (m :: Type -> Type) a #

Generalized version of Handler

Constructors

Exception e => Handler (e -> m a) 

Instances

Instances details
Monad m => Functor (Handler m) 
Instance details

Defined in Control.Monad.Catch

Methods

fmap :: (a -> b) -> Handler m a -> Handler m b #

(<$) :: a -> Handler m b -> Handler m a #

data ScottyState (m :: Type -> Type) Source #

Cookie functions

setCookie :: SetCookie -> ActionM () Source #

Set a cookie, with full access to its options (see SetCookie)

setSimpleCookie Source #

Arguments

:: Text

name

-> Text

value

-> ActionM () 

makeSimpleCookie and setCookie combined.

getCookie Source #

Arguments

:: Text

name

-> ActionM (Maybe Text) 

Lookup one cookie name

getCookies :: ActionM CookiesText Source #

Returns all cookies

deleteCookie Source #

Arguments

:: Text

name

-> ActionM () 

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).

makeSimpleCookie Source #

Arguments

:: Text

name

-> Text

value

-> SetCookie 

Construct a simple cookie (an UTF-8 string pair with default cookie options)

Session Management

data Session a Source #

Represents a session containing an ID, expiration time, and content.

Constructors

Session 

Fields

Instances

Instances details
Show a => Show (Session a) Source # 
Instance details

Defined in Web.Scotty.Session

Methods

showsPrec :: Int -> Session a -> ShowS #

show :: Session a -> String #

showList :: [Session a] -> ShowS #

Eq a => Eq (Session a) Source # 
Instance details

Defined in Web.Scotty.Session

Methods

(==) :: Session a -> Session a -> Bool #

(/=) :: Session a -> Session a -> Bool #

type SessionId = Text Source #

Type alias for session identifiers.

type SessionJar a = TVar (HashMap SessionId (Session a)) Source #

Type for session storage, a transactional variable containing a map of session IDs to sessions.

data SessionStatus Source #

Status of a session lookup.

Instances

Instances details
Show SessionStatus Source # 
Instance details

Defined in Web.Scotty.Session

Eq SessionStatus Source # 
Instance details

Defined in Web.Scotty.Session

createSessionJar :: IO (SessionJar a) Source #

Creates a new session jar and starts a background thread to maintain it.

createUserSession Source #

Arguments

:: SessionJar a

SessionJar, which can be created by createSessionJar

-> Maybe Int

Optional expiration time (in seconds)

-> a

Content

-> ActionM (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.

addSession :: SessionJar a -> Session a -> IO () Source #

Adds or overwrites a new session to the session jar.

readSession :: SessionJar a -> SessionId -> ActionM (Either SessionStatus a) Source #

Reads the content of a session by its ID.

getUserSession :: SessionJar a -> ActionM (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 :: SessionJar a -> SessionId -> ActionM (Either SessionStatus (Session a)) Source #

Retrieves a session by its ID from the session jar.

readUserSession :: SessionJar a -> ActionM (Either SessionStatus a) Source #

Reads the content of the current user's session.

deleteSession :: SessionJar a -> SessionId -> ActionM () Source #

Deletes a session by its ID from the session jar.

maintainSessions :: SessionJar a -> IO () Source #

Continuously removes expired sessions from the session jar.