| Copyright | (C) Hécate Moonlight 2024 |
|---|---|
| License | BSD-3-Clause |
| Maintainer | The Haskell Cryptography Group |
| Portability | GHC only |
| Safe Haskell | None |
| Language | Haskell2010 |
Sel.SecretKey.Stream
Description
Synopsis
- encryptList :: MonadIO m => SecretKey -> [(Maybe AdditionalData, StrictByteString)] -> m (Header, [Ciphertext])
- decryptList :: MonadIO m => SecretKey -> Header -> [(Maybe AdditionalData, Ciphertext)] -> m (Maybe [StrictByteString])
- data Multipart s
- encryptStream :: forall a m. MonadIO m => SecretKey -> (forall s. Multipart s -> m a) -> m (Header, a)
- encryptChunk :: MonadIO m => Multipart s -> MessageTag -> Maybe AdditionalData -> StrictByteString -> m Ciphertext
- decryptStream :: forall a m. MonadIO m => SecretKey -> Header -> (forall s. Multipart s -> m a) -> m (Maybe a)
- decryptChunk :: MonadIO m => Multipart s -> Maybe AdditionalData -> Ciphertext -> m StrictByteString
- data SecretKey
- newSecretKey :: IO SecretKey
- secretKeyFromHexByteString :: Base16 StrictByteString -> Either Text SecretKey
- unsafeSecretKeyToHexByteString :: SecretKey -> Base16 StrictByteString
- data Header
- headerToHexByteString :: Header -> Base16 StrictByteString
- headerFromHexByteString :: Base16 StrictByteString -> Either Text Header
- data MessageTag
- newtype AdditionalData = AdditionalData StrictByteString
- newtype AdditionalDataHexDecodingError = AdditionalDataHexDecodingError Text
- additionalDataFromHexByteString :: Base16 StrictByteString -> Either AdditionalDataHexDecodingError AdditionalData
- additionalDataToBinary :: AdditionalData -> StrictByteString
- additionalDataToHexByteString :: AdditionalData -> Base16 StrictByteString
- additionalDataToHexText :: AdditionalData -> Base16 Text
- data Ciphertext
- ciphertextFromHexByteString :: Base16 StrictByteString -> Either Text Ciphertext
- ciphertextToBinary :: Ciphertext -> StrictByteString
- ciphertextToHexByteString :: Ciphertext -> Base16 StrictByteString
- ciphertextToHexText :: Ciphertext -> Base16 Text
- data StreamInitEncryptionException
- data StreamEncryptionException
- data StreamDecryptionException
Introduction
This high-level API encrypts a sequence of messages, or a single message split into an arbitrary number of chunks, using a secret key, with the following properties:
- Messages cannot be truncated, removed, reordered, duplicated or modified without this being detected by the decryption functions.
- The same sequence encrypted twice will produce different ciphertexts.
- An authentication tag is added to each encrypted message: stream corruption will be detected early, without having to read the stream until the end.
- Each message can include additional data (ex: timestamp, protocol version) in the computation of the authentication tag.
- Messages can have different sizes.
- There are no practical limits to the total length of the stream, or to the total number of individual messages.
It uses the XChaCha20-Poly1305 algorithm.
Usage
>>>secretKey <- Stream.newSecretKey>>>(header, ciphertexts) <- Stream.encryptStream secretKey $ \multipartState -> do -- we are in MonadIO... message1 <- getMessage -- This is your way to fetch a message from outside ... encryptedChunk1 <- Stream.encryptChunk multipartState Stream.messag message1 ... message2 <- getMessage ... encryptedChunk2 <- Stream.encryptChunk multipartState Stream.Final message2 ... pure [encryptedChunk1, encryptedChunk2]>>>result <- Stream.decryptStream secretKey header $ \multipartState-> do... forM encryptedMessages $ \ciphertext -> do ... decryptChunk multipartState ciphertext
Stream operations
Linked List operations
encryptList :: MonadIO m => SecretKey -> [(Maybe AdditionalData, StrictByteString)] -> m (Header, [Ciphertext]) Source #
Perform streaming encryption of a finite list.
This function can throw StreamEncryptionException upon an error in the underlying implementation.
Since: 0.0.1.0
decryptList :: MonadIO m => SecretKey -> Header -> [(Maybe AdditionalData, Ciphertext)] -> m (Maybe [StrictByteString]) Source #
Perform streaming decryption of a finite Linked List.
This function can throw StreamDecryptionException if the chunk is invalid, incomplete, or corrupted.
Since: 0.0.1.0
Chunk operations
Multipart is the cryptographic context for stream encryption.
Since: 0.0.1.0
Arguments
| :: forall a m. MonadIO m | |
| => SecretKey | Generated with |
| -> (forall s. Multipart s -> m a) | Continuation that gives you access to a |
| -> m (Header, a) |
Perform streaming encryption with a Multipart cryptographic context.
Use encryptChunk within the continuation.
The context is safely allocated first, then the continuation is run and then it is deallocated after that.
Since: 0.0.1.0
Arguments
| :: MonadIO m | |
| => Multipart s | Cryptographic context |
| -> MessageTag | Tag that will be associated with the message. See the documentation of |
| -> Maybe AdditionalData | Additional data (AD) to be authenticated. |
| -> StrictByteString | Message to encrypt. |
| -> m Ciphertext |
Add a message portion (chunk) to be encrypted.
Use it within encryptStream.
This function can throw StreamEncryptionException upon an error in the underlying implementation.
Since: 0.0.1.0
Arguments
| :: forall a m. MonadIO m | |
| => SecretKey | |
| -> Header | Header used by the encrypting party. See its documentation |
| -> (forall s. Multipart s -> m a) | Continuation that gives you access to a |
| -> m (Maybe a) |
Perform streaming decryption with a Multipart cryptographic context.
Use decryptChunk within the continuation.
The context is safely allocated first, then the continuation is run and then it is deallocated after that.
Since: 0.0.1.0
Arguments
| :: MonadIO m | |
| => Multipart s | Cryptographic context |
| -> Maybe AdditionalData | Additional data (AD) to be authenticated. |
| -> Ciphertext | Encrypted message portion to decrypt |
| -> m StrictByteString | Decrypted message portion |
Add a message portion (chunk) to be decrypted.
Use this function within decryptStream.
This function can throw StreamDecryptionException if the chunk is invalid, incomplete, or corrupted.
Since: 0.0.1.0
Secret Key
A secret key of size cryptoSecretStreamXChaCha20Poly1305KeyBytes.
Since: 0.0.1.0
Instances
| Show SecretKey Source # | show secretKey == "[REDACTED]" Since: 0.0.1.0 |
| Eq SecretKey Source # | Since: 0.0.1.0 |
| Ord SecretKey Source # | Since: 0.0.1.0 |
| Display SecretKey Source # | display secretKey == "[REDACTED]" Since: 0.0.1.0 |
Defined in Sel.SecretKey.Stream Methods displayBuilder :: SecretKey -> Builder # displayList :: [SecretKey] -> Builder # displayPrec :: Int -> SecretKey -> Builder # | |
newSecretKey :: IO SecretKey Source #
Generate a new random secret key.
Since: 0.0.1.0
secretKeyFromHexByteString :: Base16 StrictByteString -> Either Text SecretKey Source #
Create a SecretKey from a binary StrictByteString that you have obtained on your own,
usually from the network or disk.
The input secret key, once decoded from base16, must be of length
cryptoSecretStreamXChaCha20Poly1305KeyBytes.
Since: 0.0.1.0
unsafeSecretKeyToHexByteString :: SecretKey -> Base16 StrictByteString Source #
Convert a SecretKey to a hexadecimal-encoded StrictByteString in constant time.
⚠️ Be prudent as to where you store it!
Since: 0.0.1.0
Header
An encrypted stream starts with a Header of size cryptoSecretStreamXChaCha20Poly1305HeaderBytes.
That header must be sent/stored before the sequence of encrypted messages, as it is required to decrypt the stream.
The header content doesn’t have to be secret and decryption with a different header will fail.
Since: 0.0.1.0
Instances
headerToHexByteString :: Header -> Base16 StrictByteString Source #
Convert a Header to a hexadecimal-encoded StrictByteString in constant time.
Since: 0.0.1.0
headerFromHexByteString :: Base16 StrictByteString -> Either Text Header Source #
Build a Header from a base16-encoded StrictByteString
Since: 0.0.1.0
Message Tags
data MessageTag Source #
Each encrypted message is associated with a tag.
A typical encrypted stream simply attaches Message as a tag to all messages,
except the last one which is tagged as Final.
Since: 0.0.1.0
Constructors
| Message | The most common tag, that doesn’t add any information about the nature of the message. |
| Final | Indicates that the message marks the end of the stream, and erases the secret key used to encrypt the previous sequence. |
| Push | Indicates that the message marks the end of a set of messages, but not the end of the stream. |
| Rekey | “Forget” the key used to encrypt this message and the previous ones, and derive a new secret key. |
Additional data (AD)
newtype AdditionalData Source #
Additional data (AD). Also known as "additional authenticated data" (AAD).
This refers to non-confidential data which is authenticated along with the message, but not encrypted (i.e. its integrity is protected, but it is not made confidential).
A typical use case for additional data is to authenticate protocol-specific metadata about a message, such as its length and encoding.
Constructors
| AdditionalData StrictByteString |
Instances
| Show AdditionalData Source # | |
Defined in Sel.SecretKey.Stream Methods showsPrec :: Int -> AdditionalData -> ShowS # show :: AdditionalData -> String # showList :: [AdditionalData] -> ShowS # | |
| Eq AdditionalData Source # | |
Defined in Sel.SecretKey.Stream Methods (==) :: AdditionalData -> AdditionalData -> Bool # (/=) :: AdditionalData -> AdditionalData -> Bool # | |
| Display AdditionalData Source # | |
Defined in Sel.SecretKey.Stream Methods displayBuilder :: AdditionalData -> Builder # displayList :: [AdditionalData] -> Builder # displayPrec :: Int -> AdditionalData -> Builder # | |
newtype AdditionalDataHexDecodingError Source #
Error decoding AdditionalData from hexadecimal-encoded bytes.
Constructors
| AdditionalDataHexDecodingError Text |
Instances
| Show AdditionalDataHexDecodingError Source # | |
Defined in Sel.SecretKey.Stream Methods showsPrec :: Int -> AdditionalDataHexDecodingError -> ShowS # show :: AdditionalDataHexDecodingError -> String # showList :: [AdditionalDataHexDecodingError] -> ShowS # | |
| Eq AdditionalDataHexDecodingError Source # | |
Defined in Sel.SecretKey.Stream | |
additionalDataFromHexByteString :: Base16 StrictByteString -> Either AdditionalDataHexDecodingError AdditionalData Source #
Construct an AdditionalData value from a hexadecimal-encoded
StrictByteString that you have obtained on your own, usually from the
network or disk.
additionalDataToBinary :: AdditionalData -> StrictByteString Source #
Convert an AdditionalData value to a raw binary StrictByteString.
additionalDataToHexByteString :: AdditionalData -> Base16 StrictByteString Source #
Convert an AdditionalData value to a hexadecimal-encoded
StrictByteString.
additionalDataToHexText :: AdditionalData -> Base16 Text Source #
Convert an AdditionalData value to hexadecimal-encoded Text.
Ciphertext
data Ciphertext Source #
An encrypted message. It is guaranteed to be of size:
original_message_length + cryptoSecretStreamXChaCha20Poly1305ABytes
Since: 0.0.1.0
Instances
| Show Ciphertext Source # | Since: 0.0.1.0 |
Defined in Sel.SecretKey.Stream Methods showsPrec :: Int -> Ciphertext -> ShowS # show :: Ciphertext -> String # showList :: [Ciphertext] -> ShowS # | |
| Eq Ciphertext Source # | Since: 0.0.1.0 |
Defined in Sel.SecretKey.Stream | |
| Ord Ciphertext Source # | Since: 0.0.1.0 |
Defined in Sel.SecretKey.Stream Methods compare :: Ciphertext -> Ciphertext -> Ordering # (<) :: Ciphertext -> Ciphertext -> Bool # (<=) :: Ciphertext -> Ciphertext -> Bool # (>) :: Ciphertext -> Ciphertext -> Bool # (>=) :: Ciphertext -> Ciphertext -> Bool # max :: Ciphertext -> Ciphertext -> Ciphertext # min :: Ciphertext -> Ciphertext -> Ciphertext # | |
| Display Ciphertext Source # | Since: 0.0.1.0 |
Defined in Sel.SecretKey.Stream Methods displayBuilder :: Ciphertext -> Builder # displayList :: [Ciphertext] -> Builder # displayPrec :: Int -> Ciphertext -> Builder # | |
ciphertextFromHexByteString :: Base16 StrictByteString -> Either Text Ciphertext Source #
Create a Ciphertext from a binary StrictByteString that you have obtained on your own,
usually from the network or disk. It must be a valid ciphertext built from the concatenation
of the encrypted message and the authentication tag.
The input ciphertext must at least of length cryptoSecretStreamXChaCha20Poly1305ABytes
Since: 0.0.1.0
ciphertextToBinary :: Ciphertext -> StrictByteString Source #
Convert a Ciphertext to a binary StrictByteString in constant time.
⚠️ Be prudent as to where you store it!
Since: 0.0.1.0
ciphertextToHexByteString :: Ciphertext -> Base16 StrictByteString Source #
Convert a Ciphertext to a hexadecimal-encoded StrictByteString in constant time.
⚠️ Be prudent as to where you store it!
Since: 0.0.1.0
ciphertextToHexText :: Ciphertext -> Base16 Text Source #
Convert a Ciphertext to a hexadecimal-encoded Text.
⚠️ Be prudent as to where you store it!
Since: 0.0.1.0
Exceptions
data StreamInitEncryptionException Source #
Since: 0.0.1.0
Instances
data StreamEncryptionException Source #
Since: 0.0.1.0
Instances
data StreamDecryptionException Source #
Since: 0.0.1.0