Spock-0.7.7.0: Another Haskell web framework for rapid development

Safe HaskellNone
LanguageHaskell98

Web.Spock.Shared

Contents

Synopsis

Helpers for running Spock

runSpock :: Port -> IO Middleware -> IO () Source

Run a Spock application. Basically just a wrapper aroung Warp.run.

spockAsApp :: IO Middleware -> IO Application Source

Convert a middleware to an application. All failing requests will result in a 404 page

Action types

type SpockAction conn sess st = ActionT (WebStateM conn sess st) Source

The SpockAction is the monad of all route-actions. You have access to the database, session and state of your application.

data ActionT m a Source

Handeling requests

request :: MonadIO m => ActionT m Request Source

Get the original Wai Request object

header :: MonadIO m => Text -> ActionT m (Maybe Text) Source

Read a header

cookie :: MonadIO m => Text -> ActionT m (Maybe Text) Source

Read a cookie

preferredFormat :: MonadIO m => ActionT m ClientPreferredFormat Source

Tries to dected the preferred format of the response using the Accept header

body :: MonadIO m => ActionT m ByteString Source

Get the raw request body

jsonBody :: (MonadIO m, FromJSON a) => ActionT m (Maybe a) Source

Parse the request body as json

jsonBody' :: (MonadIO m, FromJSON a) => ActionT m a Source

Parse the request body as json and fails with 500 status code on error

files :: MonadIO m => ActionT m (HashMap Text UploadedFile) Source

Get uploaded files

params :: MonadIO m => ActionT m [(Text, Text)] Source

Get all request params

param :: (PathPiece p, MonadIO m) => Text -> ActionT m (Maybe p) Source

Read a request param. Spock looks in route captures first, then in POST variables and at last in GET variables

param' :: (PathPiece p, MonadIO m) => Text -> ActionT m p Source

Like param, but outputs an error when a param is missing

Sending responses

setStatus :: MonadIO m => Status -> ActionT m () Source

Set a response status

setHeader :: MonadIO m => Text -> Text -> ActionT m () Source

Set a response header. Overwrites already defined headers

redirect :: MonadIO m => Text -> ActionT m a Source

Redirect to a given url

jumpNext :: MonadIO m => ActionT m a Source

Abort the current action and jump the next one matching the route

setCookie :: MonadIO m => Text -> Text -> NominalDiffTime -> ActionT m () Source

Set a cookie living for a given number of seconds

setCookie' :: MonadIO m => Text -> Text -> UTCTime -> ActionT m () Source

Set a cookie living until a specific UTCTime

bytes :: MonadIO m => ByteString -> ActionT m a Source

Send a ByteString as response body. Provide your own Content-Type

lazyBytes :: MonadIO m => ByteString -> ActionT m a Source

Send a lazy ByteString as response body. Provide your own Content-Type

text :: MonadIO m => Text -> ActionT m a Source

Send text as a response body. Content-Type will be "text/plain"

html :: MonadIO m => Text -> ActionT m a Source

Send a text as response body. Content-Type will be "text/html"

file :: MonadIO m => Text -> FilePath -> ActionT m a Source

Send a file as response

json :: (ToJSON a, MonadIO m) => a -> ActionT m b Source

Send json as response. Content-Type will be "application/json"

stream :: MonadIO m => StreamingBody -> ActionT m a Source

Use a StreamingBody to generate a response.

response :: MonadIO m => (Status -> ResponseHeaders -> Response) -> ActionT m a Source

Use a custom Response generator as response body.

Middleware helpers

middlewarePass :: MonadIO m => ActionT m a Source

If the Spock application is used as a middleware, you can use this to pass request handeling to the underlying application. If Spock is not uses as a middleware, or there is no underlying application this will result in 404 error.

modifyVault :: MonadIO m => (Vault -> Vault) -> ActionT m () Source

Modify the vault (useful for sharing data between middleware and app)

queryVault :: MonadIO m => Key a -> ActionT m (Maybe a) Source

Query the vault

Database

data PoolOrConn a Source

You can feed Spock with either a connection pool, or instructions on how to build a connection pool. See ConnBuilder

Constructors

PCPool (Pool a) 
PCConn (ConnBuilder a) 

data ConnBuilder a Source

The ConnBuilder instructs Spock how to create or close a database connection.

Constructors

ConnBuilder 

data PoolCfg Source

If Spock should take care of connection pooling, you need to configure it depending on what you need.

Accessing Database and State

class HasSpock m where Source

Minimal complete definition

runQuery, getState, getSessMgr

Associated Types

type SpockConn m :: * Source

type SpockState m :: * Source

type SpockSession m :: * Source

Methods

runQuery :: (SpockConn m -> IO a) -> m a Source

Give you access to a database connectin from the connection pool. The connection is released back to the pool once the function terminates.

getState :: m (SpockState m) Source

Read the application's state. If you wish to have mutable state, you could use a TVar from the STM packge.

Instances

MonadTrans t => HasSpock (t (WebStateM conn sess st)) 
HasSpock (WebStateM conn sess st) 

Basic HTTP-Auth

requireBasicAuth :: MonadIO m => Text -> (Text -> Text -> m Bool) -> ActionT m a -> ActionT m a Source

Basic authentification provide a title for the prompt and a function to validate user and password. Usage example:

get "/my-secret-page" $
  requireBasicAuth "Secret Page" (\user pass -> return (user == "admin" && pass == "1234")) $
  do html "This is top secret content. Login using that secret code I provided ;-)"

Sessions

data SessionCfg a Source

Configuration for the session manager

data SessionPersistCfg a Source

Constructors

SessionPersistCfg 

Fields

spc_load :: IO [(SessionId, UTCTime, a)]
 
spc_store :: [(SessionId, UTCTime, a)] -> IO ()
 

readShowSessionPersist :: (Read a, Show a) => FilePath -> SessionPersistCfg a Source

Simple session persisting configuration. DO NOT USE IN PRODUCTION

getSessionId :: SpockAction conn sess st SessionId Source

Get the current users sessionId. Note that this ID should only be shown to it's owner as otherwise sessions can be hijacked.

readSession :: SpockAction conn sess st sess Source

Read the stored session

writeSession :: sess -> SpockAction conn sess st () Source

Write to the current session. Note that all data is stored on the server. The user only reciedes a sessionId to be identified.

modifySession :: (sess -> sess) -> SpockAction conn sess st () Source

Modify the stored session

clearAllSessions :: SpockAction conn sess st () Source

Globally delete all existing sessions. This is useful for example if you want to require all users to relogin

Internals for extending Spock

getSpockHeart :: MonadTrans t => t (WebStateM conn sess st) (WebState conn sess st) Source

Read the heart of Spock. This is useful if you want to construct your own monads that work with runQuery and getState using "runSpockIO"

runSpockIO :: WebState conn sess st -> WebStateM conn sess st a -> IO a Source

Run an action inside of Spocks core monad. This allows you to use runQuery and getState

data WebStateM conn sess st a Source

Instances

MonadBase IO (WebStateM conn sess st) 
MonadBaseControl IO (WebStateM conn sess st) 
MonadTrans t => HasSpock (t (WebStateM conn sess st)) 
Monad (WebStateM conn sess st) 
Functor (WebStateM conn sess st) 
Applicative (WebStateM conn sess st) 
MonadIO (WebStateM conn sess st) 
HasSpock (WebStateM conn sess st) 
MonadReader (WebState conn sess st) (WebStateM conn sess st) 
type SpockConn (t (WebStateM conn sess st)) = conn 
type SpockState (t (WebStateM conn sess st)) = st 
type SpockSession (t (WebStateM conn sess st)) = sess 
type SpockConn (WebStateM conn sess st) = conn 
type SpockState (WebStateM conn sess st) = st 
type SpockSession (WebStateM conn sess st) = sess 
type StM (WebStateM conn sess st) a 

data WebState conn sess st Source

Instances

MonadReader (WebState conn sess st) (WebStateM conn sess st)