scotty and wai-cryptocookie

Example.hs

module Example (getWaiApp) where

import BasePrelude -- Eh, I had BasePrelude and MTLPrelude at hand.
import MTLPrelude  -- Ignore them :)

import Network.Wai qualified as Wai
import Wai.CryptoCookie qualified as WC
import Wai.CryptoCookie.Encryption qualified as WC
import Web.Scotty.Trans qualified as S

getWaiApp :: IO Wai.Application
getWaiApp = do
   -- Load a previous encryption key if we have one, otherwise create a
   -- random new one. The handy `autoKeyFileBase16` is often sufficient.
   key :: WC.Key "AEAD_AES_256_GCM_SIV" <-
      WC.autoKeyFileBase16 "/tmp/secret.key"

   -- Configure the encoding and encryption for our payload, as well as the HTTP
   -- cookie settings. In this example, our payload is an `Integer`, the
   -- encryption is `AEAD_AES_256_GCM_SIV` using `key`, data is encoded as JSON
   -- before encryption, and some sane HTTP cookie settings are used.
   -- See `defaultConfig` for more details.
   let conf :: WC.Config Integer
       conf = WC.defaultConfig key

   -- Get something which is very similar to a WAI `Middleware`, but also gives
   -- us access to a `CryptoCookie` with which to interact.
   --
   -- This code is intended to be run just once while constructing the
   -- `Application`. Nothing bad happens if you run this code within an
   -- `Application`, it will just be a bit slower because of the intitial
   -- setup.  If necessary, `WC.middleware` can be used more than once (for
   -- example, if you want to have two different encrypted cookies).
   f :: ((WC.CryptoCookie Integer -> Wai.Application) -> Wai.Application) <-
      WC.middleware conf

   -- Make the `CryptoCookie` during construction of the Wai `Application`.
   -- The same `f` can be used for the construction of multiple
   -- `Applications` if necessary without any security compromise.
   pure $ f mkWaiApp

-- | `Application` version of `myScottyApp`.
mkWaiApp :: WC.CryptoCookie Integer -> Wai.Application
mkWaiApp cc =
   runIdentity $
      S.scottyAppT S.defaultOptions (flip runReaderT cc) myScottyApp

-- | Our Scotty-specific app.
--
-- This needs to use `ScottyT` to have access to the `CryptoCookie`
-- through an underlying `ReaderT`. 
--
-- If `ScottyT` were to adopt`wai-cryptocookie` internally, this extra 
-- layer could be avoided and `WC.CryptoCookie` could be fully hidden
-- from the user, being replaced by actions in `ScottyM`/`ScottyT`. 
-- I can try to submit an example of what the changes would look like.
myScottyApp :: S.ScottyT (ReaderT (WC.CryptoCookie Integer) IO) ()
myScottyApp =
   S.get "/" do
      -- We interact with the decrypted and decoded cookie
      -- contents through a value of type `CryptoCookie`.
      cc :: WC.CryptoCookie Integer <- lift ask

      -- Incoming decrypted and decoded cookie content.
      -- It will be `Nothing` if absent or malformed.
      let yi :: Maybe Integer
          yi = WC.get cc

      -- Let's set a new value for the cookie.
      --
      -- Note: `set` runs in `STM` because it doesn't need to
      -- run in anything more demanding than that, and `STM` is
      -- more flexible than `IO`, so...
      --
      -- There are also `WC.delete` and `WC.keep`.
      liftIO $ atomically $ WC.set cc $ maybe 0 (+ 1) yi

      -- Keep refreshing your browser to see how this changes.
      S.text $ "Request cookie value: " <> fromString (show yi)

      -- Reload the page to see the changes