{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoFieldSelectors #-}
-- | This module exports tools for safely storing encrypted data on client-side
-- cookies through "Network.Wai". Consider using it in conjunction with "Wai.CSRF".
module Wai.CryptoCookie
( -- * Config
defaultConfig
, Config (..)
, Env
, newEnv
-- * Request and responses
, middleware
, msgFromRequestCookie
, setCookie
, expireCookie
-- * Encryption
, Encryption (..)
, autoKeyFileBase16
, readKeyFileBase16
, readKeyFile
, writeKeyFile
) where
import Control.Monad.IO.Class
import Data.Aeson qualified as Ae
import Data.ByteArray.Encoding qualified as BA
import Data.ByteArray.Sized qualified as BAS
import Data.ByteString qualified as B
import Data.ByteString.Lazy qualified as BL
import Data.IORef
import Data.Kind (Type)
import Data.Time.Clock.POSIX qualified as Time
import Network.Wai qualified as Wai
import Wai.CSRF qualified
import Wai.CryptoCookie.Encryption
import Wai.CryptoCookie.Encryption.AEAD_AES_128_GCM_SIV ()
import Wai.CryptoCookie.Encryption.AEAD_AES_256_GCM_SIV ()
import Web.Cookie qualified as WC
-- | Default 'Config':
--
-- * Cookie name is @SESSION@.
--
-- * Encoding and decoding of @msg@ is done through 'Ae.ToJSON' and
-- 'Ae.FromJSON'.
--
-- * The 'Encryption' scheme is the nonce-misuse resistant @AEAD_AES_256_GCM_SIV@
-- as defined in in <https://tools.ietf.org/html/rfc8452 RFC 8452>, using
-- a "Wai.CSRF".'Wai.CSRF.Token' as AEAD associated data.
--
-- As an AEAD encryption scheme, you can be confident that a successfully
-- decrypted cookie could only have been encrypted by the same
-- 'Key' known only to your server, and associated with a specific
-- "Wai.CSRF".'Wai.CSRF.Token', expected to have been sent with the
-- incoming request.
--
-- In principle, this makes this encryption scheme suitable for storing
-- server-generated user session data in the @msg@. However, you must make
-- sure that you rotate the "Wai.CSRF".'Wai.CSRF.Token' ocassionally, at
-- least each time a new user session is established, so as to avoid CSRF
-- risks.
--
-- * This 'defaultConfig' suggests you should be composing 'middleware' and
-- "Wai.CSRF".'Wai.CSRF.middleware' in this way:
--
-- @
-- "Wai.CSRF".'Wai.CSRF.middleware' /myCsrfConfig/
-- . "Wai.CryptoCookie".'middleware' /myCryptoCookieEnv/
-- :: ('Maybe' ("Wai.CSRF".'Wai.CSRF.Token', msg) -> 'Wai.Application')
-- -> 'Wai.Application'
-- @
defaultConfig
:: (Ae.ToJSON msg, Ae.FromJSON msg)
=> Key "AEAD_AES_256_GCM_SIV"
-- ^ Consider using 'autoKeyFileBase16' or
-- 'readKeyFileBase16' for safely reading a 'Key' from a
-- 'FilePath'. Alternatively, if you have the base-16 representation of the
-- 'Key' in JSON configuration, you could use
-- 'Data.Aeson.FromJSON'.
-> Config Wai.CSRF.Token msg
defaultConfig key =
Config
{ cookieName = "SESSION"
, key
, aadEncode = \(Wai.CSRF.Token t) ->
BL.fromStrict $ BAS.unSizedByteArray t
, msgEncode = Ae.encode
, msgDecode = Ae.decode
}
-- | Configuration for 'Env'.
--
-- Consider using 'defaultConfig' and updating desired fields only.
data Config (aad :: Type) (msg :: Type) = forall e.
(Encryption e) =>
Config
{ cookieName :: B.ByteString
-- ^ Consider using a @\"SESSION\"@.
, key :: Key e
-- ^ Consider using a @'Key' \"AEAD_AES_256_GCM_SIV\"@.
, aadEncode :: aad -> BL.ByteString
-- ^ These are the exact bytes that will be used as AEAD associated data.
-- Consider using the raw bytes of a "Wai.CSRF".'Wai.CSRF.Token'.
, msgEncode :: msg -> BL.ByteString
-- ^ These are the exact bytes that will be encrypted.
, msgDecode :: BL.ByteString -> Maybe msg
-- ^ Undo what @msgEncode@ did, if possible.
}
-- | Stateful encryption environment for interacting with the encrypted cookie.
--
-- It is safe to use 'Env' concurrently if necessary. Concurrency is handled
-- safely internally.
--
-- Obtain with 'newEnv'.
data Env (aad :: Type) (msg :: Type) = Env
{ cookieName :: B.ByteString
, encodeEncrypt :: aad -> msg -> IO BL.ByteString
, decryptDecode :: aad -> BL.ByteString -> Maybe msg
}
--------------------------------------------------------------------------------
-- | Obtain a new 'Env'.
newEnv :: (MonadIO m) => Config aad msg -> m (Env aad msg)
newEnv c@Config{key} = liftIO do
let dc = initDecrypt key
ecRef <- newIORef =<< initEncrypt key
pure
Env
{ encodeEncrypt = \aad0 msg0 -> do
let !aad1 :: BL.ByteString = c.aadEncode aad0
!msg1 :: BL.ByteString = c.msgEncode msg0
ec <- atomicModifyIORef' ecRef \ec -> (advance ec, ec)
pure $ encrypt ec aad1 msg1
, decryptDecode = \aad0 !cry -> do
let !aad1 = c.aadEncode aad0
case decrypt dc aad1 cry of
Right msg -> c.msgDecode msg
_ -> Nothing
, cookieName = c.cookieName
}
-- | Transform an 'Wai.Application' so that if there is an encrypted
-- message in the incoming 'Wai.Request' cookies, it will be automatically
-- decrypted and made available to the underlying 'Wai.Application'.
--
-- The @aad@ is the AEAD associated data that came with the 'Wai.Request'.
-- Consider using 'middleware' in conjunction with
-- "Wai.CSRF".'Wai.CSRF.middleware', using "Wai.CSRF".'Wai.CSRF.Token' as
-- @aad@.
middleware
:: Env aad msg
-- ^ Encryption environment. Obtain with 'newEnv'.
-> (Maybe (aad, Maybe msg) -> Wai.Application)
-- ^ Underlying 'Wai.Application' having access to the decrypted cookie
-- @msg@, if any.
--
-- Also, seeing as @msg@ being available implies @aad@ is available too, we
-- output both values together in a manner that represents this relationship.
-> Maybe aad
-- ^ AEAD associated data of the incomming 'Wai.Request', if any.
-> Wai.Application
middleware env fapp yaad req respond = do
let ymsg = msgFromRequestCookie env req =<< yaad
fapp (fmap (,ymsg) yaad) req respond
-- | Obtain the @msg@ from the 'Wai.Request' cookies.
--
-- You don't need to use this if you are using 'middleware'.
msgFromRequestCookie :: Env aad msg -> Wai.Request -> aad -> Maybe msg
msgFromRequestCookie env r aad = do
[d64] <- pure $ lookupMany env.cookieName $ requestCookies r
case BA.convertFromBase BA.Base64URLUnpadded d64 of
Right cry -> env.decryptDecode aad $ BL.fromStrict cry
Left _ -> Nothing
--------------------------------------------------------------------------------
-- | Construct a 'C.SetCookie' containing the encrypted @msg@.
--
-- The associated data @aad@ will not be included in this cookie, but it will
-- be taken into account for encryption and necessary for eventual decryption.
--
-- The 'C.SetCookie' has these settings, some of which could be overriden.
--
-- * Cookie name is 'Config'\'s @cookieName@.
--
-- * @HttpOnly@: Yes, and you shouldn't change this.
--
-- * @Max-Age@ and @Expires@: This cookie never expires. We recommend
-- relying on server-side expiration instead, as the lifetime of the
-- cookie could easily be extended by a legitimate but malicious client.
-- You can store a creation or expiration timestamp inside @msg@, and
-- make a decision based on that.
--
-- * @Path@: @\/@
--
-- * @SameSite@: @Lax@.
--
-- * @Secure@: Yes.
--
-- * @Domain@: Not set.
--
-- Note: If you are using "Wai.CSRF".'Wai.CSRF.Token' as @aad@, it is
-- recommended that you generate a new "Wai.CSRF".'Wai.CSRF.Token' at least
-- each time a new user session is established, but possibly more frequently,
-- and send it alongside this one (see "Wai.CSRF".'Wai.CSRF.setCookie').
setCookie :: (MonadIO m) => Env aad msg -> aad -> msg -> m WC.SetCookie
setCookie env aad msg = liftIO do
cry <- env.encodeEncrypt aad msg
pure $
(expireCookie env)
{ WC.setCookieExpires = Nothing
, WC.setCookieMaxAge = Nothing
, WC.setCookieValue =
BA.convertToBase BA.Base64URLUnpadded $ BL.toStrict cry
}
-- | Construct a 'C.SetCookie' expiring the cookie named 'Config'\'s
-- @cookieName@.
expireCookie :: Env aad msg -> WC.SetCookie
expireCookie env =
WC.defaultSetCookie
{ WC.setCookieDomain = Nothing
, WC.setCookieExpires = Just (Time.posixSecondsToUTCTime 0)
, WC.setCookieHttpOnly = True
, WC.setCookieMaxAge = Just (negate 1)
, WC.setCookieName = env.cookieName
, WC.setCookiePath = Just "/"
, WC.setCookieSameSite = Just WC.sameSiteLax
, WC.setCookieSecure = True
, WC.setCookieValue = ""
}
--------------------------------------------------------------------------------
requestCookies :: Wai.Request -> [(B.ByteString, B.ByteString)]
requestCookies r =
WC.parseCookies =<< lookupMany "Cookie" (Wai.requestHeaders r)
lookupMany :: (Eq k) => k -> [(k, v)] -> [v]
lookupMany k = findMany (== k)
findMany :: (Eq k) => (k -> Bool) -> [(k, v)] -> [v]
findMany f = map snd . filter (\(a, _) -> f a)