wai-cryptocookie-0.3: Encrypted cookies for WAI
Safe HaskellNone
LanguageGHC2021

Wai.CryptoCookie

Description

This module exports tools for safely storing encrypted data on client-side cookies through Network.Wai. Consider using it in conjunction with Wai.CSRF.

Synopsis

Config

defaultConfig Source #

Arguments

:: (ToJSON msg, 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 FromJSON.

-> Config Token msg 

Default Config:

  • Cookie name is SESSION.
  • Encoding and decoding of msg is done through ToJSON and FromJSON.
  • The Encryption scheme is the nonce-misuse resistant AEAD_AES_256_GCM_SIV as defined in in RFC 8452, using a 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.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.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.middleware in this way:

    Wai.CSRF.middleware myCsrfConfig
       . Wai.CryptoCookie.middleware myCryptoCookieEnv
            :: (Maybe (Wai.CSRF.Token, msg) -> Application)
            -> Application
    

data Config aad msg Source #

Configuration for Env.

Consider using defaultConfig and updating desired fields only.

Constructors

Encryption e => Config 

Fields

data Env aad msg Source #

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.

newEnv :: MonadIO m => Config aad msg -> m (Env aad msg) Source #

Obtain a new Env.

Request and responses

middleware Source #

Arguments

:: Env aad msg

Encryption environment. Obtain with newEnv.

-> (Maybe (aad, Maybe msg) -> Application)

Underlying 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 Request, if any.

-> Application 

Transform an Application so that if there is an encrypted message in the incoming Request cookies, it will be automatically decrypted and made available to the underlying Application.

The aad is the AEAD associated data that came with the Request. Consider using middleware in conjunction with Wai.CSRF.middleware, using Wai.CSRF.Token as aad.

msgFromRequestCookie :: Env aad msg -> Request -> aad -> Maybe msg Source #

Obtain the msg from the Request cookies.

You don't need to use this if you are using middleware.

setCookie :: MonadIO m => Env aad msg -> aad -> msg -> m SetCookie Source #

Construct a 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 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.Token as aad, it is recommended that you generate a new 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.setCookie).

expireCookie :: Env aad msg -> SetCookie Source #

Construct a SetCookie expiring the cookie named Config's cookieName.

Encryption

class (KnownNat (KeyLength e), Eq (Key e)) => Encryption (e :: k) where Source #

AEAD encryption method.

Associated Types

data Key (e :: k) Source #

Key used for encryption. You can obtain an initial random Key using genKey. As long as you have access to said Key, you will be able to decrypt data previously encrypted with it. For this reason, be sure to save and load the key using keyToBytes and keyFromBytes.

type KeyLength (e :: k) :: Natural Source #

Statically known Key length.

data Encrypt (e :: k) Source #

Encryption context used by encrypt.

data Decrypt (e :: k) Source #

Decryption context used by decrypt.

Methods

randomKey :: MonadRandom m => m (Key e) Source #

Generate a random encryption Key.

keyFromBytes :: ByteArrayAccess raw => raw -> Either String (Key e) Source #

Load a Key from its bytes representation, if possible.

keyToBytes :: ByteArrayN (KeyLength e) raw => Key e -> raw Source #

Dump the bytes representation of a Key.

initEncrypt :: MonadRandom m => Key e -> m (Encrypt e) Source #

Generate initial Encryption context for a Key.

The Encryption context could carry for example the next randomly generated nonce to use for encryption, the Key itself or its derivative used during the actual encryption process, or a deterministic random number generator.

The Decryption context could carry for example the Key itself or its derivative used during the decryption process.

initDecrypt :: Key e -> Decrypt e Source #

Generate initial Decryption context for a Key.

The Decryption context could carry for example the Key itself or its derivative used during the decryption process.

advance :: Encrypt e -> Encrypt e Source #

After each encryption, the Encryption context will be automatically advanced through this function. For example, if your Encryption context carries a nonce or a deterministic random number generator, this is the place to update them.

encrypt Source #

Arguments

:: Encrypt e 
-> ByteString

AEAD associated data.

-> ByteString

Message to encrypt.

-> ByteString

Encrypted message including AEAD tag and nonce.

Encrypt a plaintext message according to the Encryption context.

decrypt Source #

Arguments

:: Decrypt e 
-> ByteString

AEAD associated data.

-> ByteString

Encrypted message including AEAD tag and nonce.

-> Either String ByteString

Decrypted message or error message.

Decrypt a message according to the Decryption context.

The String is for internal debugging purposes only.

Instances

Instances details
Encryption "AEAD_AES_128_GCM_SIV" Source #

AEAD_AES_128_GCM_SIV is a nonce-misuse resistant AEAD encryption scheme defined in RFC 8452.

Instance details

Defined in Wai.CryptoCookie.Encryption.AEAD_AES_128_GCM_SIV

Associated Types

newtype Key "AEAD_AES_128_GCM_SIV" 
Instance details

Defined in Wai.CryptoCookie.Encryption.AEAD_AES_128_GCM_SIV

newtype Key "AEAD_AES_128_GCM_SIV" = Key (SizedByteArray 16 ScrubbedBytes)
type KeyLength "AEAD_AES_128_GCM_SIV" 
Instance details

Defined in Wai.CryptoCookie.Encryption.AEAD_AES_128_GCM_SIV

type KeyLength "AEAD_AES_128_GCM_SIV" = 16
data Encrypt "AEAD_AES_128_GCM_SIV" 
Instance details

Defined in Wai.CryptoCookie.Encryption.AEAD_AES_128_GCM_SIV

data Encrypt "AEAD_AES_128_GCM_SIV" = Encrypt AES128 ChaChaDRG Nonce
newtype Decrypt "AEAD_AES_128_GCM_SIV" 
Instance details

Defined in Wai.CryptoCookie.Encryption.AEAD_AES_128_GCM_SIV

newtype Decrypt "AEAD_AES_128_GCM_SIV" = Decrypt AES128

Methods

randomKey :: MonadRandom m => m (Key "AEAD_AES_128_GCM_SIV") Source #

keyFromBytes :: ByteArrayAccess raw => raw -> Either String (Key "AEAD_AES_128_GCM_SIV") Source #

keyToBytes :: ByteArrayN (KeyLength "AEAD_AES_128_GCM_SIV") raw => Key "AEAD_AES_128_GCM_SIV" -> raw Source #

initEncrypt :: MonadRandom m => Key "AEAD_AES_128_GCM_SIV" -> m (Encrypt "AEAD_AES_128_GCM_SIV") Source #

initDecrypt :: Key "AEAD_AES_128_GCM_SIV" -> Decrypt "AEAD_AES_128_GCM_SIV" Source #

advance :: Encrypt "AEAD_AES_128_GCM_SIV" -> Encrypt "AEAD_AES_128_GCM_SIV" Source #

encrypt :: Encrypt "AEAD_AES_128_GCM_SIV" -> ByteString -> ByteString -> ByteString Source #

decrypt :: Decrypt "AEAD_AES_128_GCM_SIV" -> ByteString -> ByteString -> Either String ByteString Source #

Encryption "AEAD_AES_256_GCM_SIV" Source #

AEAD_AES_256_GCM_SIV is a nonce-misuse resistant AEAD encryption scheme defined in RFC 8452.

Instance details

Defined in Wai.CryptoCookie.Encryption.AEAD_AES_256_GCM_SIV

Associated Types

newtype Key "AEAD_AES_256_GCM_SIV" 
Instance details

Defined in Wai.CryptoCookie.Encryption.AEAD_AES_256_GCM_SIV

newtype Key "AEAD_AES_256_GCM_SIV" = Key (SizedByteArray 32 ScrubbedBytes)
type KeyLength "AEAD_AES_256_GCM_SIV" 
Instance details

Defined in Wai.CryptoCookie.Encryption.AEAD_AES_256_GCM_SIV

type KeyLength "AEAD_AES_256_GCM_SIV" = 32
data Encrypt "AEAD_AES_256_GCM_SIV" 
Instance details

Defined in Wai.CryptoCookie.Encryption.AEAD_AES_256_GCM_SIV

data Encrypt "AEAD_AES_256_GCM_SIV" = Encrypt AES256 ChaChaDRG Nonce
newtype Decrypt "AEAD_AES_256_GCM_SIV" 
Instance details

Defined in Wai.CryptoCookie.Encryption.AEAD_AES_256_GCM_SIV

newtype Decrypt "AEAD_AES_256_GCM_SIV" = Decrypt AES256

Methods

randomKey :: MonadRandom m => m (Key "AEAD_AES_256_GCM_SIV") Source #

keyFromBytes :: ByteArrayAccess raw => raw -> Either String (Key "AEAD_AES_256_GCM_SIV") Source #

keyToBytes :: ByteArrayN (KeyLength "AEAD_AES_256_GCM_SIV") raw => Key "AEAD_AES_256_GCM_SIV" -> raw Source #

initEncrypt :: MonadRandom m => Key "AEAD_AES_256_GCM_SIV" -> m (Encrypt "AEAD_AES_256_GCM_SIV") Source #

initDecrypt :: Key "AEAD_AES_256_GCM_SIV" -> Decrypt "AEAD_AES_256_GCM_SIV" Source #

advance :: Encrypt "AEAD_AES_256_GCM_SIV" -> Encrypt "AEAD_AES_256_GCM_SIV" Source #

encrypt :: Encrypt "AEAD_AES_256_GCM_SIV" -> ByteString -> ByteString -> ByteString Source #

decrypt :: Decrypt "AEAD_AES_256_GCM_SIV" -> ByteString -> ByteString -> Either String ByteString Source #

autoKeyFileBase16 :: forall {k} (e :: k) m. (Encryption e, MonadIO m) => FilePath -> m (Key e) Source #

If the FilePath exists, then read the base-16 representation of a Key from it. Ignores trailing newlines.

Otherwise, generate a random new Key and write its base-16 representation in the FilePath.

Finally, return the Key.

readKeyFileBase16 :: forall {k} (e :: k) m. (Encryption e, MonadIO m) => FilePath -> m (Key e) Source #

Read a base-16 encoded Key from a file. Ignores trailing newlines.

readKeyFile Source #

Arguments

:: forall {k} (e :: k) m. (Encryption e, MonadIO m) 
=> (ScrubbedBytes -> Either String ScrubbedBytes)

Convert the raw content of the file into input suitable for keyFromBytes.

-> FilePath 
-> m (Key e) 

Read a Key from a file.

writeKeyFile Source #

Arguments

:: forall {k} (e :: k) m. (Encryption e, MonadIO m) 
=> (SizedByteArray (KeyLength e) ScrubbedBytes -> ScrubbedBytes)

Convert the raw keyToBytes bytes to file contents.

-> FilePath 
-> Key e 
-> m () 

Save a key to a file.