aveltras / sessionula

:smiling_imp: Server-side sessions for your haskell web applications

Sessionula

This library intends to provide server-side session functionality for your web applications.

🚧 Not ready for production use yet. 🚧

API is still highly subject to changes
Feedback welcome

{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}
{-# LANGUAGE TypeOperators     #-}

import           Control.Monad (void)
import           Data.ByteString.Lazy.Char8 (pack)
import qualified Database.Redis as Hedis
import qualified Sessionula as Session
import           Sessionula.Backend.File
import           Sessionula.Backend.Hasql
import           Sessionula.Backend.Hedis
import           Sessionula.Backend.Map
import           Network.HTTP.Types
import           Network.Wai
import           Network.Wai.Handler.Warp (run)
import           Servant
import           Sessionula.Frontend.Servant.Server

Define a user type to be used with the session authentication logic

data User = User String

Backends

Choose your backend among the provided ones:

• InMemory Map ⚠️ sessions will be lost when server process quit, use this for testing / development only ⚠️
• Filesystem - sessionula-file
• PostgreSQL via hasql - sessionula-hasql
• Redis via hedis - sessionula-hedis

initManager :: Session.Config -> IO Session.Manager
initManager config = 
  Session.setup config =<< mapStorage
  -- Session.setup config =<< fileStorage "/var/sessions"
  -- Session.setup config =<< hasqlStorage "postgres://postgres@localhost:5432/sessionula"
  -- Session.setup config =<< hedisStorage Hedis.defaultConnectInfo "sessions:" (Session.cfgTokenTTL config)

Frontends

You can then use this with one of the provided frontends

WAI

sessionula-wai

waiApp :: Application
waiApp request respond = do
  Session.lookup @Bool handle >>= \case
    Nothing  -> Session.set True handle
    Just _ -> void $ Session.modify not handle
  boolSession <- Session.lookup @Bool handle
  respond $ responseLBS ok200 [(hContentType, "text/plain")] $ pack $ show boolSession
  where
    handle = extractSession request

mainWithWai :: IO ()
mainWithWai = do
  manager <- initManager Session.defaultConfig
  run 8080 $ middleware manager defaultSessionCookie { setCookieSecure = False } defaultCsrfSettings waiApp

Servant

sessionula-servant
sessionula-servant-server

type API = Session User :> Get '[PlainText] String

servantApp :: Application
servantApp = serve (Proxy @API) server

server :: Server API
server = handler
  where
    handler :: Session.Handle User -> Handler String
    handler handle = do
      Session.lookup @Bool handle >>= \case
        Nothing  -> Session.set True handle
        Just _ -> void $ Session.modify not handle
      boolSession <- Session.lookup @Bool handle
      pure $ show boolSession

mainWithServant :: IO ()
mainWithServant = do
  manager <- initManager Session.defaultConfig
  run 8080 $ middleware manager defaultSessionCookie { setCookieSecure = False } defaultCsrfSettings servantApp

Todos

• More comprehensive test suite
• Benchmarking

See also

• wai-session
• serversession