@@ -51,8 +51,8 @@ module Sel.SecretKey.Stream
51
51
-- ** Message Tags
52
52
, MessageTag (.. )
53
53
54
- -- ** CipherText
55
- , CipherText
54
+ -- ** Ciphertext
55
+ , Ciphertext
56
56
, ciphertextFromHexByteString
57
57
, ciphertextToBinary
58
58
, ciphertextToHexByteString
@@ -121,15 +121,15 @@ import Sel.Internal.Sodium (binaryToHex)
121
121
-- $usage
122
122
--
123
123
-- >>> secretKey <- Stream.newSecretKey
124
- -- >>> (header, cipherTexts ) <- Stream.encryptStream secretKey $ \multipartState -> do -- we are in MonadIO
124
+ -- >>> (header, ciphertexts ) <- Stream.encryptStream secretKey $ \multipartState -> do -- we are in MonadIO
125
125
-- ... message1 <- getMessage -- This is your way to fetch a message from outside
126
126
-- ... encryptedChunk1 <- Stream.encryptChunk multipartState Stream.messag message1
127
127
-- ... message2 <- getMessage
128
128
-- ... encryptedChunk2 <- Stream.encryptChunk multipartState Stream.Final message2
129
129
-- ... pure [encryptedChunk1, encryptedChunk2]
130
130
-- >>> result <- Stream.decryptStream secretKey header $ \multipartState-> do
131
- -- ... forM encryptedMessages $ \cipherText -> do
132
- -- ... decryptChunk multipartState cipherText
131
+ -- ... forM encryptedMessages $ \ciphertext -> do
132
+ -- ... decryptChunk multipartState ciphertext
133
133
134
134
-- | 'Multipart' is the cryptographic context for stream encryption.
135
135
--
@@ -138,7 +138,7 @@ newtype Multipart s = Multipart (Ptr CryptoSecretStreamXChaCha20Poly1305State)
138
138
139
139
type role Multipart nominal
140
140
141
- -- | Perform streaming hashing with a 'Multipart' cryptographic context.
141
+ -- | Perform streaming encryption with a 'Multipart' cryptographic context.
142
142
--
143
143
-- Use 'Stream.encryptChunk' within the continuation.
144
144
--
@@ -186,34 +186,34 @@ encryptChunk
186
186
-- ^ Tag that will be associated with the message. See the documentation of 'MessageTag' to know which to choose when.
187
187
-> StrictByteString
188
188
-- ^ Message to encrypt.
189
- -> m CipherText
189
+ -> m Ciphertext
190
190
encryptChunk (Multipart statePtr) messageTag message = liftIO $ BSU. unsafeUseAsCStringLen message $ \ (cString, cStringLen) -> do
191
191
let messagePtr = Foreign. castPtr @ CChar @ CUChar cString
192
192
let messageLen = fromIntegral @ Int @ CULLong cStringLen
193
- cipherTextFPtr <- Foreign. mallocForeignPtrBytes (cStringLen + fromIntegral cryptoSecretStreamXChaCha20Poly1305ABytes)
194
- Foreign. withForeignPtr cipherTextFPtr $ \ cipherTextBuffer -> do
193
+ ciphertextFPtr <- Foreign. mallocForeignPtrBytes (cStringLen + fromIntegral cryptoSecretStreamXChaCha20Poly1305ABytes)
194
+ Foreign. withForeignPtr ciphertextFPtr $ \ ciphertextBuffer -> do
195
195
result <-
196
196
cryptoSecretStreamXChaCha20Poly1305Push
197
197
statePtr
198
- cipherTextBuffer
198
+ ciphertextBuffer
199
199
Foreign. nullPtr -- default size of messageLen + 'cryptoSecretStreamXChaCha20Poly1305ABytes'
200
200
messagePtr
201
201
messageLen
202
202
Foreign. nullPtr -- No additional data
203
203
0 -- No additional data size
204
204
(messageTagToConstant messageTag)
205
205
when (result /= 0 ) $ throw StreamEncryptionException
206
- pure $ CipherText (fromIntegral cStringLen) cipherTextFPtr
206
+ pure $ Ciphertext (fromIntegral cStringLen) ciphertextFPtr
207
207
208
208
-- | Perform streaming encryption of a finite list.
209
209
--
210
210
-- This function can throw 'StreamEncryptionException' upon an error in the underlying implementation.
211
211
--
212
212
-- @since 0.0.1.0
213
- encryptList :: forall m . MonadIO m => SecretKey -> [StrictByteString ] -> m (Header , [CipherText ])
213
+ encryptList :: forall m . MonadIO m => SecretKey -> [StrictByteString ] -> m (Header , [Ciphertext ])
214
214
encryptList secretKey messages = encryptStream secretKey $ \ multipart -> go multipart messages []
215
215
where
216
- go :: Multipart s -> [StrictByteString ] -> [CipherText ] -> m [CipherText ]
216
+ go :: Multipart s -> [StrictByteString ] -> [Ciphertext ] -> m [Ciphertext ]
217
217
go multipart [lastMsg] acc = do
218
218
encryptedChunk <- encryptChunk multipart Final lastMsg
219
219
pure $ List. reverse $ encryptedChunk : acc
@@ -264,14 +264,14 @@ decryptChunk
264
264
. MonadIO m
265
265
=> Multipart s
266
266
-- ^ Cryptographic context
267
- -> CipherText
267
+ -> Ciphertext
268
268
-- ^ Encrypted message portion to decrypt
269
269
-> m StrictByteString
270
270
-- ^ Decrypted message portion
271
- decryptChunk (Multipart statePtr) CipherText {messageLength, cipherTextForeignPtr } = do
271
+ decryptChunk (Multipart statePtr) Ciphertext {messageLength, ciphertextForeignPtr } = do
272
272
clearTextForeignPtr <- liftIO $ Foreign. mallocForeignPtrBytes (fromIntegral messageLength)
273
- let cipherTextLen = messageLength + fromIntegral cryptoSecretStreamXChaCha20Poly1305ABytes
274
- liftIO $ Foreign. withForeignPtr cipherTextForeignPtr $ \ cipherTextBuffer -> do
273
+ let ciphertextLen = messageLength + fromIntegral cryptoSecretStreamXChaCha20Poly1305ABytes
274
+ liftIO $ Foreign. withForeignPtr ciphertextForeignPtr $ \ ciphertextBuffer -> do
275
275
liftIO $ Foreign. withForeignPtr clearTextForeignPtr $ \ clearTextBuffer -> do
276
276
tagBuffer <- sodiumMalloc 1
277
277
result <-
@@ -280,8 +280,8 @@ decryptChunk (Multipart statePtr) CipherText{messageLength, cipherTextForeignPtr
280
280
clearTextBuffer
281
281
Foreign. nullPtr
282
282
tagBuffer
283
- cipherTextBuffer
284
- cipherTextLen
283
+ ciphertextBuffer
284
+ ciphertextLen
285
285
Foreign. nullPtr
286
286
0
287
287
when (result /= 0 ) $ throw StreamDecryptionException
@@ -294,11 +294,11 @@ decryptChunk (Multipart statePtr) CipherText{messageLength, cipherTextForeignPtr
294
294
-- This function can throw 'StreamDecryptionException' if the chunk is invalid, incomplete, or corrupted.
295
295
--
296
296
-- @since 0.0.1.0
297
- decryptList :: forall m . MonadIO m => SecretKey -> Header -> [CipherText ] -> m (Maybe [StrictByteString ])
297
+ decryptList :: forall m . MonadIO m => SecretKey -> Header -> [Ciphertext ] -> m (Maybe [StrictByteString ])
298
298
decryptList secretKey header encryptedMessages =
299
299
decryptStream secretKey header $ \ multipart -> do
300
- forM encryptedMessages $ \ cipherText -> do
301
- decryptChunk multipart cipherText
300
+ forM encryptedMessages $ \ ciphertext -> do
301
+ decryptChunk multipart ciphertext
302
302
303
303
-- | A secret key of size 'cryptoSecretStreamXChaCha20Poly1305KeyBytes'.
304
304
--
@@ -465,99 +465,99 @@ messageTagToConstant = \case
465
465
-- @original_message_length + 'cryptoSecretStreamXChaCha20Poly1305ABytes'@
466
466
--
467
467
-- @since 0.0.1.0
468
- data CipherText = CipherText
468
+ data Ciphertext = Ciphertext
469
469
{ messageLength :: CULLong
470
- , cipherTextForeignPtr :: ForeignPtr CUChar
470
+ , ciphertextForeignPtr :: ForeignPtr CUChar
471
471
}
472
472
473
473
-- |
474
474
--
475
475
-- @since 0.0.1.0
476
- instance Eq CipherText where
477
- (CipherText cipherTextLength1 h1) == (CipherText cipherTextLength2 h2) =
476
+ instance Eq Ciphertext where
477
+ (Ciphertext ciphertextLength1 h1) == (Ciphertext ciphertextLength2 h2) =
478
478
let
479
- textLength = cipherTextLength1 == cipherTextLength2
479
+ textLength = ciphertextLength1 == ciphertextLength2
480
480
content =
481
481
foreignPtrEq
482
482
h1
483
483
h2
484
- (fromIntegral cipherTextLength1 + cryptoSecretStreamXChaCha20Poly1305ABytes)
484
+ (fromIntegral ciphertextLength1 + cryptoSecretStreamXChaCha20Poly1305ABytes)
485
485
in
486
486
textLength && content
487
487
488
488
-- | @since 0.0.1.0
489
- instance Ord CipherText where
490
- compare (CipherText cipherTextLength1 c1) (CipherText cipherTextLength2 c2) =
489
+ instance Ord Ciphertext where
490
+ compare (Ciphertext ciphertextLength1 c1) (Ciphertext ciphertextLength2 c2) =
491
491
let
492
- textLength = compare cipherTextLength1 cipherTextLength2
492
+ textLength = compare ciphertextLength1 ciphertextLength2
493
493
content =
494
494
foreignPtrOrd
495
495
c1
496
496
c2
497
- (fromIntegral cipherTextLength1 + cryptoSecretStreamXChaCha20Poly1305ABytes)
497
+ (fromIntegral ciphertextLength1 + cryptoSecretStreamXChaCha20Poly1305ABytes)
498
498
in
499
499
textLength <> content
500
500
501
501
-- | @since 0.0.1.0
502
- instance Display CipherText where
502
+ instance Display Ciphertext where
503
503
displayBuilder = Builder. fromText . Base16. extractBase16 . ciphertextToHexText
504
504
505
505
-- | @since 0.0.1.0
506
- instance Show CipherText where
506
+ instance Show Ciphertext where
507
507
show = BSI. unpackChars . Base16. extractBase16 . ciphertextToHexByteString
508
508
509
- -- | Create a 'CipherText ' from a binary 'StrictByteString' that you have obtained on your own,
510
- -- usually from the network or disk. It must be a valid hash built from the concatenation
509
+ -- | Create a 'Ciphertext ' from a binary 'StrictByteString' that you have obtained on your own,
510
+ -- usually from the network or disk. It must be a valid ciphertext built from the concatenation
511
511
-- of the encrypted message and the authentication tag.
512
512
--
513
- -- The input hash must at least of length 'cryptoSecretStreamXChaCha20Poly1305ABytes'
513
+ -- The input ciphertext must at least of length 'cryptoSecretStreamXChaCha20Poly1305ABytes'
514
514
--
515
515
-- @since 0.0.1.0
516
- ciphertextFromHexByteString :: Base16 StrictByteString -> Either Text CipherText
517
- ciphertextFromHexByteString hexCipherText = unsafeDupablePerformIO $
518
- case Base16. decodeBase16Untyped (Base16. extractBase16 hexCipherText ) of
516
+ ciphertextFromHexByteString :: Base16 StrictByteString -> Either Text Ciphertext
517
+ ciphertextFromHexByteString hexCiphertext = unsafeDupablePerformIO $
518
+ case Base16. decodeBase16Untyped (Base16. extractBase16 hexCiphertext ) of
519
519
Right bytestring ->
520
520
if BS. length bytestring >= fromIntegral cryptoSecretStreamXChaCha20Poly1305ABytes
521
- then BSU. unsafeUseAsCStringLen bytestring $ \ (outsideCipherTextPtr, outsideCipherTextLength ) -> do
522
- cipherTextFPtr <- BSI. mallocByteString @ CChar outsideCipherTextLength -- The foreign pointer that will receive the hash data.
523
- Foreign. withForeignPtr cipherTextFPtr $ \ cipherTextPtr ->
524
- -- We copy bytes from 'outsideCipherTextPtr ' to 'cipherTextPtr .
525
- Foreign. copyArray cipherTextPtr outsideCipherTextPtr outsideCipherTextLength
521
+ then BSU. unsafeUseAsCStringLen bytestring $ \ (outsideCiphertextPtr, outsideCiphertextLength ) -> do
522
+ ciphertextFPtr <- BSI. mallocByteString @ CChar outsideCiphertextLength -- The foreign pointer that will receive the ciphertext data.
523
+ Foreign. withForeignPtr ciphertextFPtr $ \ ciphertextPtr ->
524
+ -- We copy bytes from 'outsideCiphertextPtr ' to 'ciphertextPtr .
525
+ Foreign. copyArray ciphertextPtr outsideCiphertextPtr outsideCiphertextLength
526
526
pure $
527
527
Right $
528
- CipherText
529
- (fromIntegral @ Int @ CULLong outsideCipherTextLength - fromIntegral @ CSize @ CULLong cryptoSecretStreamXChaCha20Poly1305ABytes)
530
- (Foreign. castForeignPtr @ CChar @ CUChar cipherTextFPtr )
531
- else pure $ Left $ Text. pack " CipherText is too short"
528
+ Ciphertext
529
+ (fromIntegral @ Int @ CULLong outsideCiphertextLength - fromIntegral @ CSize @ CULLong cryptoSecretStreamXChaCha20Poly1305ABytes)
530
+ (Foreign. castForeignPtr @ CChar @ CUChar ciphertextFPtr )
531
+ else pure $ Left $ Text. pack " Ciphertext is too short"
532
532
Left msg -> pure $ Left msg
533
533
534
- -- | Convert a 'CipherText ' to a hexadecimal-encoded 'Text'.
534
+ -- | Convert a 'Ciphertext ' to a hexadecimal-encoded 'Text'.
535
535
--
536
536
-- ⚠️ Be prudent as to where you store it!
537
537
--
538
538
-- @since 0.0.1.0
539
- ciphertextToHexText :: CipherText -> Base16 Text
539
+ ciphertextToHexText :: Ciphertext -> Base16 Text
540
540
ciphertextToHexText = Base16. encodeBase16 . ciphertextToBinary
541
541
542
- -- | Convert a 'CipherText ' to a hexadecimal-encoded 'StrictByteString' in constant time.
542
+ -- | Convert a 'Ciphertext ' to a hexadecimal-encoded 'StrictByteString' in constant time.
543
543
--
544
544
-- ⚠️ Be prudent as to where you store it!
545
545
--
546
546
-- @since 0.0.1.0
547
- ciphertextToHexByteString :: CipherText -> Base16 StrictByteString
548
- ciphertextToHexByteString (CipherText cipherTextLength fPtr) =
549
- Base16. assertBase16 $ binaryToHex fPtr (cryptoSecretStreamXChaCha20Poly1305ABytes + fromIntegral cipherTextLength )
547
+ ciphertextToHexByteString :: Ciphertext -> Base16 StrictByteString
548
+ ciphertextToHexByteString (Ciphertext ciphertextLength fPtr) =
549
+ Base16. assertBase16 $ binaryToHex fPtr (cryptoSecretStreamXChaCha20Poly1305ABytes + fromIntegral ciphertextLength )
550
550
551
- -- | Convert a 'CipherText ' to a binary 'StrictByteString' in constant time.
551
+ -- | Convert a 'Ciphertext ' to a binary 'StrictByteString' in constant time.
552
552
--
553
553
-- ⚠️ Be prudent as to where you store it!
554
554
--
555
555
-- @since 0.0.1.0
556
- ciphertextToBinary :: CipherText -> StrictByteString
557
- ciphertextToBinary (CipherText cipherTextLength fPtr) =
556
+ ciphertextToBinary :: Ciphertext -> StrictByteString
557
+ ciphertextToBinary (Ciphertext ciphertextLength fPtr) =
558
558
BSI. fromForeignPtr0
559
559
(Foreign. castForeignPtr fPtr)
560
- (fromIntegral cipherTextLength + fromIntegral cryptoSecretStreamXChaCha20Poly1305ABytes)
560
+ (fromIntegral ciphertextLength + fromIntegral cryptoSecretStreamXChaCha20Poly1305ABytes)
561
561
562
562
-- | @since 0.0.1.0
563
563
data StreamEncryptionException = StreamEncryptionException
0 commit comments