Skip to content

Commit 2d7b8bf

Browse files
committed
Rename Sel.SecretKey.Stream.CipherText to Ciphertext
1 parent 4f62075 commit 2d7b8bf

File tree

2 files changed

+66
-66
lines changed

2 files changed

+66
-66
lines changed

sel/src/Sel/SecretKey/Stream.hs

Lines changed: 59 additions & 59 deletions
Original file line numberDiff line numberDiff line change
@@ -51,8 +51,8 @@ module Sel.SecretKey.Stream
5151
-- ** Message Tags
5252
, MessageTag (..)
5353

54-
-- ** CipherText
55-
, CipherText
54+
-- ** Ciphertext
55+
, Ciphertext
5656
, ciphertextFromHexByteString
5757
, ciphertextToBinary
5858
, ciphertextToHexByteString
@@ -121,15 +121,15 @@ import Sel.Internal.Sodium (binaryToHex)
121121
-- $usage
122122
--
123123
-- >>> 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
125125
-- ... message1 <- getMessage -- This is your way to fetch a message from outside
126126
-- ... encryptedChunk1 <- Stream.encryptChunk multipartState Stream.messag message1
127127
-- ... message2 <- getMessage
128128
-- ... encryptedChunk2 <- Stream.encryptChunk multipartState Stream.Final message2
129129
-- ... pure [encryptedChunk1, encryptedChunk2]
130130
-- >>> 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
133133

134134
-- | 'Multipart' is the cryptographic context for stream encryption.
135135
--
@@ -138,7 +138,7 @@ newtype Multipart s = Multipart (Ptr CryptoSecretStreamXChaCha20Poly1305State)
138138

139139
type role Multipart nominal
140140

141-
-- | Perform streaming hashing with a 'Multipart' cryptographic context.
141+
-- | Perform streaming encryption with a 'Multipart' cryptographic context.
142142
--
143143
-- Use 'Stream.encryptChunk' within the continuation.
144144
--
@@ -186,34 +186,34 @@ encryptChunk
186186
-- ^ Tag that will be associated with the message. See the documentation of 'MessageTag' to know which to choose when.
187187
-> StrictByteString
188188
-- ^ Message to encrypt.
189-
-> m CipherText
189+
-> m Ciphertext
190190
encryptChunk (Multipart statePtr) messageTag message = liftIO $ BSU.unsafeUseAsCStringLen message $ \(cString, cStringLen) -> do
191191
let messagePtr = Foreign.castPtr @CChar @CUChar cString
192192
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
195195
result <-
196196
cryptoSecretStreamXChaCha20Poly1305Push
197197
statePtr
198-
cipherTextBuffer
198+
ciphertextBuffer
199199
Foreign.nullPtr -- default size of messageLen + 'cryptoSecretStreamXChaCha20Poly1305ABytes'
200200
messagePtr
201201
messageLen
202202
Foreign.nullPtr -- No additional data
203203
0 -- No additional data size
204204
(messageTagToConstant messageTag)
205205
when (result /= 0) $ throw StreamEncryptionException
206-
pure $ CipherText (fromIntegral cStringLen) cipherTextFPtr
206+
pure $ Ciphertext (fromIntegral cStringLen) ciphertextFPtr
207207

208208
-- | Perform streaming encryption of a finite list.
209209
--
210210
-- This function can throw 'StreamEncryptionException' upon an error in the underlying implementation.
211211
--
212212
-- @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])
214214
encryptList secretKey messages = encryptStream secretKey $ \multipart -> go multipart messages []
215215
where
216-
go :: Multipart s -> [StrictByteString] -> [CipherText] -> m [CipherText]
216+
go :: Multipart s -> [StrictByteString] -> [Ciphertext] -> m [Ciphertext]
217217
go multipart [lastMsg] acc = do
218218
encryptedChunk <- encryptChunk multipart Final lastMsg
219219
pure $ List.reverse $ encryptedChunk : acc
@@ -264,14 +264,14 @@ decryptChunk
264264
. MonadIO m
265265
=> Multipart s
266266
-- ^ Cryptographic context
267-
-> CipherText
267+
-> Ciphertext
268268
-- ^ Encrypted message portion to decrypt
269269
-> m StrictByteString
270270
-- ^ Decrypted message portion
271-
decryptChunk (Multipart statePtr) CipherText{messageLength, cipherTextForeignPtr} = do
271+
decryptChunk (Multipart statePtr) Ciphertext{messageLength, ciphertextForeignPtr} = do
272272
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
275275
liftIO $ Foreign.withForeignPtr clearTextForeignPtr $ \clearTextBuffer -> do
276276
tagBuffer <- sodiumMalloc 1
277277
result <-
@@ -280,8 +280,8 @@ decryptChunk (Multipart statePtr) CipherText{messageLength, cipherTextForeignPtr
280280
clearTextBuffer
281281
Foreign.nullPtr
282282
tagBuffer
283-
cipherTextBuffer
284-
cipherTextLen
283+
ciphertextBuffer
284+
ciphertextLen
285285
Foreign.nullPtr
286286
0
287287
when (result /= 0) $ throw StreamDecryptionException
@@ -294,11 +294,11 @@ decryptChunk (Multipart statePtr) CipherText{messageLength, cipherTextForeignPtr
294294
-- This function can throw 'StreamDecryptionException' if the chunk is invalid, incomplete, or corrupted.
295295
--
296296
-- @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])
298298
decryptList secretKey header encryptedMessages =
299299
decryptStream secretKey header $ \multipart -> do
300-
forM encryptedMessages $ \cipherText -> do
301-
decryptChunk multipart cipherText
300+
forM encryptedMessages $ \ciphertext -> do
301+
decryptChunk multipart ciphertext
302302

303303
-- | A secret key of size 'cryptoSecretStreamXChaCha20Poly1305KeyBytes'.
304304
--
@@ -465,99 +465,99 @@ messageTagToConstant = \case
465465
-- @original_message_length + 'cryptoSecretStreamXChaCha20Poly1305ABytes'@
466466
--
467467
-- @since 0.0.1.0
468-
data CipherText = CipherText
468+
data Ciphertext = Ciphertext
469469
{ messageLength :: CULLong
470-
, cipherTextForeignPtr :: ForeignPtr CUChar
470+
, ciphertextForeignPtr :: ForeignPtr CUChar
471471
}
472472

473473
-- |
474474
--
475475
-- @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) =
478478
let
479-
textLength = cipherTextLength1 == cipherTextLength2
479+
textLength = ciphertextLength1 == ciphertextLength2
480480
content =
481481
foreignPtrEq
482482
h1
483483
h2
484-
(fromIntegral cipherTextLength1 + cryptoSecretStreamXChaCha20Poly1305ABytes)
484+
(fromIntegral ciphertextLength1 + cryptoSecretStreamXChaCha20Poly1305ABytes)
485485
in
486486
textLength && content
487487

488488
-- | @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) =
491491
let
492-
textLength = compare cipherTextLength1 cipherTextLength2
492+
textLength = compare ciphertextLength1 ciphertextLength2
493493
content =
494494
foreignPtrOrd
495495
c1
496496
c2
497-
(fromIntegral cipherTextLength1 + cryptoSecretStreamXChaCha20Poly1305ABytes)
497+
(fromIntegral ciphertextLength1 + cryptoSecretStreamXChaCha20Poly1305ABytes)
498498
in
499499
textLength <> content
500500

501501
-- | @since 0.0.1.0
502-
instance Display CipherText where
502+
instance Display Ciphertext where
503503
displayBuilder = Builder.fromText . Base16.extractBase16 . ciphertextToHexText
504504

505505
-- | @since 0.0.1.0
506-
instance Show CipherText where
506+
instance Show Ciphertext where
507507
show = BSI.unpackChars . Base16.extractBase16 . ciphertextToHexByteString
508508

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
511511
-- of the encrypted message and the authentication tag.
512512
--
513-
-- The input hash must at least of length 'cryptoSecretStreamXChaCha20Poly1305ABytes'
513+
-- The input ciphertext must at least of length 'cryptoSecretStreamXChaCha20Poly1305ABytes'
514514
--
515515
-- @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
519519
Right bytestring ->
520520
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
526526
pure $
527527
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"
532532
Left msg -> pure $ Left msg
533533

534-
-- | Convert a 'CipherText' to a hexadecimal-encoded 'Text'.
534+
-- | Convert a 'Ciphertext' to a hexadecimal-encoded 'Text'.
535535
--
536536
-- ⚠️ Be prudent as to where you store it!
537537
--
538538
-- @since 0.0.1.0
539-
ciphertextToHexText :: CipherText -> Base16 Text
539+
ciphertextToHexText :: Ciphertext -> Base16 Text
540540
ciphertextToHexText = Base16.encodeBase16 . ciphertextToBinary
541541

542-
-- | Convert a 'CipherText' to a hexadecimal-encoded 'StrictByteString' in constant time.
542+
-- | Convert a 'Ciphertext' to a hexadecimal-encoded 'StrictByteString' in constant time.
543543
--
544544
-- ⚠️ Be prudent as to where you store it!
545545
--
546546
-- @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)
550550

551-
-- | Convert a 'CipherText' to a binary 'StrictByteString' in constant time.
551+
-- | Convert a 'Ciphertext' to a binary 'StrictByteString' in constant time.
552552
--
553553
-- ⚠️ Be prudent as to where you store it!
554554
--
555555
-- @since 0.0.1.0
556-
ciphertextToBinary :: CipherText -> StrictByteString
557-
ciphertextToBinary (CipherText cipherTextLength fPtr) =
556+
ciphertextToBinary :: Ciphertext -> StrictByteString
557+
ciphertextToBinary (Ciphertext ciphertextLength fPtr) =
558558
BSI.fromForeignPtr0
559559
(Foreign.castForeignPtr fPtr)
560-
(fromIntegral cipherTextLength + fromIntegral cryptoSecretStreamXChaCha20Poly1305ABytes)
560+
(fromIntegral ciphertextLength + fromIntegral cryptoSecretStreamXChaCha20Poly1305ABytes)
561561

562562
-- | @since 0.0.1.0
563563
data StreamEncryptionException = StreamEncryptionException

sel/test/Test/SecretKey/Stream.hs

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -15,16 +15,16 @@ spec =
1515
"Secret Key Encrypted Stream tests"
1616
[ testCase "Encrypt a stream with a secret key" testEncryptStream
1717
, testCase "Round-trip secret key serialisation" testSecretKeySerdeRoundtrip
18-
, testCase "Round-trip ciphertext serialisation" testCipherTextSerdeRoundtrip
18+
, testCase "Round-trip ciphertext serialisation" testCiphertextSerdeRoundtrip
1919
-- , testCase "Round-trip header serialisation" testHeaderSerdeRoundtrip
2020
]
2121

2222
testEncryptStream :: Assertion
2323
testEncryptStream = do
2424
secretKey <- Stream.newSecretKey
2525
let messages = ["Hello", "abcdf", "world"]
26-
(header, cipherTexts) <- Stream.encryptList secretKey messages
27-
mResult <- Stream.decryptList secretKey header cipherTexts
26+
(header, ciphertexts) <- Stream.encryptList secretKey messages
27+
mResult <- Stream.decryptList secretKey header ciphertexts
2828
result <- assertJust mResult
2929

3030
assertEqual
@@ -43,15 +43,15 @@ testSecretKeySerdeRoundtrip = do
4343
secretKey1
4444
secretKey2
4545

46-
testCipherTextSerdeRoundtrip :: Assertion
47-
testCipherTextSerdeRoundtrip = do
46+
testCiphertextSerdeRoundtrip :: Assertion
47+
testCiphertextSerdeRoundtrip = do
4848
secretKey <- Stream.newSecretKey
4949
let message = "hello" :: StrictByteString
5050
(_, encryptedPayload1) <- Stream.encryptStream secretKey $ \multipart -> do
5151
Stream.encryptChunk multipart Stream.Final message
5252

53-
let hexCipherText = Stream.ciphertextToHexByteString encryptedPayload1
54-
encryptedPayload2 <- assertRight $ Stream.ciphertextFromHexByteString hexCipherText
53+
let hexCiphertext = Stream.ciphertextToHexByteString encryptedPayload1
54+
encryptedPayload2 <- assertRight $ Stream.ciphertextFromHexByteString hexCiphertext
5555

5656
assertEqual
5757
"The ciphertexts remain equal"

0 commit comments

Comments
 (0)