Safe Haskell | None |
---|---|
Language | GHC2021 |
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
- defaultConfig :: (ToJSON msg, FromJSON msg) => Key "AEAD_AES_256_GCM_SIV" -> Config Token msg
- data Config aad msg = Encryption e => Config {
- cookieName :: ByteString
- key :: Key e
- aadEncode :: aad -> ByteString
- msgEncode :: msg -> ByteString
- msgDecode :: ByteString -> Maybe msg
- data Env aad msg
- newEnv :: MonadIO m => Config aad msg -> m (Env aad msg)
- middleware :: Env aad msg -> (Maybe (aad, Maybe msg) -> Application) -> Maybe aad -> Application
- msgFromRequestCookie :: Env aad msg -> Request -> aad -> Maybe msg
- setCookie :: MonadIO m => Env aad msg -> aad -> msg -> m SetCookie
- expireCookie :: Env aad msg -> SetCookie
- class (KnownNat (KeyLength e), Eq (Key e)) => Encryption (e :: k) where
- data Key (e :: k)
- type KeyLength (e :: k) :: Natural
- data Encrypt (e :: k)
- data Decrypt (e :: k)
- randomKey :: MonadRandom m => m (Key e)
- keyFromBytes :: ByteArrayAccess raw => raw -> Either String (Key e)
- keyToBytes :: ByteArrayN (KeyLength e) raw => Key e -> raw
- initEncrypt :: MonadRandom m => Key e -> m (Encrypt e)
- initDecrypt :: Key e -> Decrypt e
- advance :: Encrypt e -> Encrypt e
- encrypt :: Encrypt e -> ByteString -> ByteString -> ByteString
- decrypt :: Decrypt e -> ByteString -> ByteString -> Either String ByteString
- autoKeyFileBase16 :: forall {k} (e :: k) m. (Encryption e, MonadIO m) => FilePath -> m (Key e)
- readKeyFileBase16 :: forall {k} (e :: k) m. (Encryption e, MonadIO m) => FilePath -> m (Key e)
- readKeyFile :: forall {k} (e :: k) m. (Encryption e, MonadIO m) => (ScrubbedBytes -> Either String ScrubbedBytes) -> FilePath -> m (Key e)
- writeKeyFile :: forall {k} (e :: k) m. (Encryption e, MonadIO m) => (SizedByteArray (KeyLength e) ScrubbedBytes -> ScrubbedBytes) -> FilePath -> Key e -> m ()
Config
Arguments
:: (ToJSON msg, FromJSON msg) | |
=> Key "AEAD_AES_256_GCM_SIV" | Consider using |
-> Config Token msg |
Default Config
:
- Cookie name is
SESSION
. - Encoding and decoding of
msg
is done throughToJSON
andFromJSON
. The
Encryption
scheme is the nonce-misuse resistantAEAD_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 composingmiddleware
and Wai.CSRF.middleware
in this way:Wai.CSRF.
middleware
myCsrfConfig . Wai.CryptoCookie.middleware
myCryptoCookieEnv :: (Maybe
(Wai.CSRF.Token
, msg) ->Application
) ->Application
Configuration for Env
.
Consider using defaultConfig
and updating desired fields only.
Constructors
Encryption e => Config | |
Fields
|
Request and responses
Arguments
:: Env aad msg | Encryption environment. Obtain with |
-> (Maybe (aad, Maybe msg) -> Application) | Underlying Also, seeing as |
-> Maybe aad | AEAD associated data of the incomming |
-> 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
'scookieName
. HttpOnly
: Yes, and you shouldn't change this.Max-Age
andExpires
: 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 insidemsg
, 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 #
Encryption
class (KnownNat (KeyLength e), Eq (Key e)) => Encryption (e :: k) where Source #
AEAD encryption method.
Associated Types
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 Encrypt
ion context for a Key
.
The Encrypt
ion context could carry for example the next
randomly generated nonce to use for encrypt
ion, the Key
itself or its derivative used during the actual encrypt
ion
process, or a deterministic random number generator.
The Decrypt
ion context could carry for example the Key
itself or its
derivative used during the decrypt
ion process.
initDecrypt :: Key e -> Decrypt e Source #
Generate initial Decrypt
ion context for a Key
.
The Decrypt
ion context could carry for example the Key
itself or its
derivative used during the decrypt
ion process.
advance :: Encrypt e -> Encrypt e Source #
After each encrypt
ion, the Encrypt
ion context will be automatically
advance
d through this function. For example, if your Encrypt
ion
context carries a nonce or a deterministic random number generator,
this is the place to update them.
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 Encrypt
ion context.
Arguments
:: Decrypt e | |
-> ByteString | AEAD associated data. |
-> ByteString | Encrypted message including AEAD tag and nonce. |
-> Either String ByteString | Decrypted message or error message. |
Instances
Encryption "AEAD_AES_128_GCM_SIV" Source # |
| ||||||||||||||||
Defined in Wai.CryptoCookie.Encryption.AEAD_AES_128_GCM_SIV Associated Types
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 # |
| ||||||||||||||||
Defined in Wai.CryptoCookie.Encryption.AEAD_AES_256_GCM_SIV Associated Types
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 #
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.
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 |
-> FilePath | |
-> m (Key e) |
Read a Key
from a file.
Arguments
:: forall {k} (e :: k) m. (Encryption e, MonadIO m) | |
=> (SizedByteArray (KeyLength e) ScrubbedBytes -> ScrubbedBytes) | Convert the raw |
-> FilePath | |
-> Key e | |
-> m () |
Save a key to a file.