{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Sel.SecretKey.Stream
(
encryptList
, decryptList
, Multipart
, encryptStream
, encryptChunk
, decryptStream
, decryptChunk
, SecretKey
, newSecretKey
, secretKeyFromHexByteString
, unsafeSecretKeyToHexByteString
, Header
, headerToHexByteString
, headerFromHexByteString
, MessageTag (..)
, AdditionalData (..)
, AdditionalDataHexDecodingError (..)
, additionalDataFromHexByteString
, additionalDataToBinary
, additionalDataToHexByteString
, additionalDataToHexText
, Ciphertext
, ciphertextFromHexByteString
, ciphertextToBinary
, ciphertextToHexByteString
, ciphertextToHexText
, StreamInitEncryptionException
, StreamEncryptionException
, StreamDecryptionException
) where
import Control.Exception (Exception, throw)
import Control.Monad (forM, when)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Base16.Types (Base16)
import qualified Data.Base16.Types as Base16
import Data.ByteString (StrictByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Internal as BSI
import qualified Data.ByteString.Unsafe as BSU
import Data.Kind (Type)
import qualified Data.List as List
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Builder.Linear as Builder
import Data.Text.Display (Display (..), OpaqueInstance (..), ShowInstance (..))
import Foreign (ForeignPtr, Ptr)
import qualified Foreign
import Foreign.C (CChar, CSize, CUChar, CULLong)
import Foreign.C.Error (throwErrno)
import LibSodium.Bindings.SecretStream
( CryptoSecretStreamXChaCha20Poly1305State
, cryptoSecretStreamXChaCha20Poly1305ABytes
, cryptoSecretStreamXChaCha20Poly1305HeaderBytes
, cryptoSecretStreamXChaCha20Poly1305InitPull
, cryptoSecretStreamXChaCha20Poly1305InitPush
, cryptoSecretStreamXChaCha20Poly1305KeyBytes
, cryptoSecretStreamXChaCha20Poly1305KeyGen
, cryptoSecretStreamXChaCha20Poly1305Pull
, cryptoSecretStreamXChaCha20Poly1305Push
, cryptoSecretStreamXChaCha20Poly1305StateBytes
, cryptoSecretStreamXChaCha20Poly1305TagFinal
, cryptoSecretStreamXChaCha20Poly1305TagMessage
, cryptoSecretStreamXChaCha20Poly1305TagPush
, cryptoSecretStreamXChaCha20Poly1305TagRekey
)
import LibSodium.Bindings.SecureMemory (finalizerSodiumFree, sodiumMalloc)
import System.IO.Unsafe (unsafeDupablePerformIO)
import Sel.Internal (allocateWith, foreignPtrEq, foreignPtrOrd)
import Sel.Internal.Sodium (binaryToHex)
newtype Multipart s = Multipart (Ptr CryptoSecretStreamXChaCha20Poly1305State)
type role Multipart nominal
encryptStream
:: forall (a :: Type) (m :: Type -> Type)
. MonadIO m
=> SecretKey
-> (forall s. Multipart s -> m a)
-> m (Header, a)
encryptStream :: forall a (m :: * -> *).
MonadIO m =>
SecretKey -> (forall s. Multipart s -> m a) -> m (Header, a)
encryptStream (SecretKey ForeignPtr CUChar
secretKeyForeignPtr) forall s. Multipart s -> m a
actions = CSize
-> (Ptr CryptoSecretStreamXChaCha20Poly1305State -> m (Header, a))
-> m (Header, a)
forall a b (m :: * -> *).
MonadIO m =>
CSize -> (Ptr a -> m b) -> m b
allocateWith CSize
cryptoSecretStreamXChaCha20Poly1305StateBytes ((Ptr CryptoSecretStreamXChaCha20Poly1305State -> m (Header, a))
-> m (Header, a))
-> (Ptr CryptoSecretStreamXChaCha20Poly1305State -> m (Header, a))
-> m (Header, a)
forall a b. (a -> b) -> a -> b
$ \Ptr CryptoSecretStreamXChaCha20Poly1305State
statePtr -> do
headerPtr <- IO (Ptr CUChar) -> m (Ptr CUChar)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr CUChar) -> m (Ptr CUChar))
-> IO (Ptr CUChar) -> m (Ptr CUChar)
forall a b. (a -> b) -> a -> b
$ CSize -> IO (Ptr CUChar)
forall a. CSize -> IO (Ptr a)
sodiumMalloc CSize
cryptoSecretStreamXChaCha20Poly1305HeaderBytes
headerForeignPtr <- liftIO $ Foreign.newForeignPtr finalizerSodiumFree headerPtr
when (headerPtr == Foreign.nullPtr) $ liftIO (throwErrno "sodium_malloc")
liftIO $ Foreign.withForeignPtr secretKeyForeignPtr $ \Ptr CUChar
secretKeyPtr -> do
result <-
Ptr CryptoSecretStreamXChaCha20Poly1305State
-> Ptr CUChar -> Ptr CUChar -> IO CInt
cryptoSecretStreamXChaCha20Poly1305InitPush
Ptr CryptoSecretStreamXChaCha20Poly1305State
statePtr
Ptr CUChar
headerPtr
Ptr CUChar
secretKeyPtr
when (result /= 0) $ throw StreamInitEncryptionException
let part = Ptr CryptoSecretStreamXChaCha20Poly1305State -> Multipart s
forall s.
Ptr CryptoSecretStreamXChaCha20Poly1305State -> Multipart s
Multipart Ptr CryptoSecretStreamXChaCha20Poly1305State
statePtr
let header = ForeignPtr CUChar -> Header
Header ForeignPtr CUChar
headerForeignPtr
result <- actions part
pure (header, result)
encryptChunk
:: forall m s
. MonadIO m
=> Multipart s
-> MessageTag
-> Maybe AdditionalData
-> StrictByteString
-> m Ciphertext
encryptChunk :: forall (m :: * -> *) s.
MonadIO m =>
Multipart s
-> MessageTag
-> Maybe AdditionalData
-> StrictByteString
-> m Ciphertext
encryptChunk (Multipart Ptr CryptoSecretStreamXChaCha20Poly1305State
statePtr) MessageTag
messageTag Maybe AdditionalData
mbAd StrictByteString
message = IO Ciphertext -> m Ciphertext
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Ciphertext -> m Ciphertext) -> IO Ciphertext -> m Ciphertext
forall a b. (a -> b) -> a -> b
$
StrictByteString -> (CStringLen -> IO Ciphertext) -> IO Ciphertext
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen StrictByteString
message ((CStringLen -> IO Ciphertext) -> IO Ciphertext)
-> (CStringLen -> IO Ciphertext) -> IO Ciphertext
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
messageCString, Int
messageCStringLen) ->
StrictByteString -> (CStringLen -> IO Ciphertext) -> IO Ciphertext
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen (StrictByteString
-> (AdditionalData -> StrictByteString)
-> Maybe AdditionalData
-> StrictByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StrictByteString
BS.empty AdditionalData -> StrictByteString
additionalDataToBinary Maybe AdditionalData
mbAd) ((CStringLen -> IO Ciphertext) -> IO Ciphertext)
-> (CStringLen -> IO Ciphertext) -> IO Ciphertext
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
adCString, Int
adCStringLen) -> do
let messagePtr :: Ptr CUChar
messagePtr = forall a b. Ptr a -> Ptr b
Foreign.castPtr @CChar @CUChar Ptr CChar
messageCString
messageLen :: CULLong
messageLen = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong Int
messageCStringLen
adPtr :: Ptr CUChar
adPtr = forall a b. Ptr a -> Ptr b
Foreign.castPtr @CChar @CUChar Ptr CChar
adCString
adLen :: CULLong
adLen = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong Int
adCStringLen
ciphertextFPtr <- Int -> IO (ForeignPtr CUChar)
forall a. Int -> IO (ForeignPtr a)
Foreign.mallocForeignPtrBytes (Int
messageCStringLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSecretStreamXChaCha20Poly1305ABytes)
Foreign.withForeignPtr ciphertextFPtr $ \Ptr CUChar
ciphertextBuffer -> do
result <-
Ptr CryptoSecretStreamXChaCha20Poly1305State
-> Ptr CUChar
-> Ptr CULLong
-> Ptr CUChar
-> CULLong
-> Ptr CUChar
-> CULLong
-> CUChar
-> IO CInt
cryptoSecretStreamXChaCha20Poly1305Push
Ptr CryptoSecretStreamXChaCha20Poly1305State
statePtr
Ptr CUChar
ciphertextBuffer
Ptr CULLong
forall a. Ptr a
Foreign.nullPtr
Ptr CUChar
messagePtr
CULLong
messageLen
Ptr CUChar
adPtr
CULLong
adLen
(MessageTag -> CUChar
messageTagToConstant MessageTag
messageTag)
when (result /= 0) $ throw StreamEncryptionException
pure $ Ciphertext (fromIntegral messageCStringLen) ciphertextFPtr
encryptList :: forall m. MonadIO m => SecretKey -> [(Maybe AdditionalData, StrictByteString)] -> m (Header, [Ciphertext])
encryptList :: forall (m :: * -> *).
MonadIO m =>
SecretKey
-> [(Maybe AdditionalData, StrictByteString)]
-> m (Header, [Ciphertext])
encryptList SecretKey
secretKey [(Maybe AdditionalData, StrictByteString)]
messages = SecretKey
-> (forall s. Multipart s -> m [Ciphertext])
-> m (Header, [Ciphertext])
forall a (m :: * -> *).
MonadIO m =>
SecretKey -> (forall s. Multipart s -> m a) -> m (Header, a)
encryptStream SecretKey
secretKey ((forall s. Multipart s -> m [Ciphertext])
-> m (Header, [Ciphertext]))
-> (forall s. Multipart s -> m [Ciphertext])
-> m (Header, [Ciphertext])
forall a b. (a -> b) -> a -> b
$ \Multipart s
multipart -> Multipart s
-> [(Maybe AdditionalData, StrictByteString)]
-> [Ciphertext]
-> m [Ciphertext]
forall s.
Multipart s
-> [(Maybe AdditionalData, StrictByteString)]
-> [Ciphertext]
-> m [Ciphertext]
go Multipart s
multipart [(Maybe AdditionalData, StrictByteString)]
messages []
where
go :: Multipart s -> [(Maybe AdditionalData, StrictByteString)] -> [Ciphertext] -> m [Ciphertext]
go :: forall s.
Multipart s
-> [(Maybe AdditionalData, StrictByteString)]
-> [Ciphertext]
-> m [Ciphertext]
go Multipart s
multipart [(Maybe AdditionalData
mbLastAd, StrictByteString
lastMsg)] [Ciphertext]
acc = do
encryptedChunk <- Multipart s
-> MessageTag
-> Maybe AdditionalData
-> StrictByteString
-> m Ciphertext
forall (m :: * -> *) s.
MonadIO m =>
Multipart s
-> MessageTag
-> Maybe AdditionalData
-> StrictByteString
-> m Ciphertext
encryptChunk Multipart s
multipart MessageTag
Final Maybe AdditionalData
mbLastAd StrictByteString
lastMsg
pure $ List.reverse $ encryptedChunk : acc
go Multipart s
multipart ((Maybe AdditionalData
mbAd, StrictByteString
msg) : [(Maybe AdditionalData, StrictByteString)]
rest) [Ciphertext]
acc = do
encryptedChunk <- Multipart s
-> MessageTag
-> Maybe AdditionalData
-> StrictByteString
-> m Ciphertext
forall (m :: * -> *) s.
MonadIO m =>
Multipart s
-> MessageTag
-> Maybe AdditionalData
-> StrictByteString
-> m Ciphertext
encryptChunk Multipart s
multipart MessageTag
Message Maybe AdditionalData
mbAd StrictByteString
msg
go multipart rest (encryptedChunk : acc)
go Multipart s
_ [] [Ciphertext]
acc = [Ciphertext] -> m [Ciphertext]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Ciphertext]
acc
decryptStream
:: forall (a :: Type) (m :: Type -> Type)
. MonadIO m
=> SecretKey
-> Header
-> (forall s. Multipart s -> m a)
-> m (Maybe a)
decryptStream :: forall a (m :: * -> *).
MonadIO m =>
SecretKey
-> Header -> (forall s. Multipart s -> m a) -> m (Maybe a)
decryptStream (SecretKey ForeignPtr CUChar
secretKeyForeignPtr) (Header ForeignPtr CUChar
headerForeignPtr) forall s. Multipart s -> m a
actions = CSize
-> (Ptr CryptoSecretStreamXChaCha20Poly1305State -> m (Maybe a))
-> m (Maybe a)
forall a b (m :: * -> *).
MonadIO m =>
CSize -> (Ptr a -> m b) -> m b
allocateWith CSize
cryptoSecretStreamXChaCha20Poly1305StateBytes ((Ptr CryptoSecretStreamXChaCha20Poly1305State -> m (Maybe a))
-> m (Maybe a))
-> (Ptr CryptoSecretStreamXChaCha20Poly1305State -> m (Maybe a))
-> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \Ptr CryptoSecretStreamXChaCha20Poly1305State
statePtr -> do
result <- IO CInt -> m CInt
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> m CInt) -> IO CInt -> m CInt
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
secretKeyForeignPtr ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
secretKeyPtr -> do
ForeignPtr CUChar -> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
headerForeignPtr ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
headerPtr -> do
Ptr CryptoSecretStreamXChaCha20Poly1305State
-> Ptr CUChar -> Ptr CUChar -> IO CInt
cryptoSecretStreamXChaCha20Poly1305InitPull
Ptr CryptoSecretStreamXChaCha20Poly1305State
statePtr
Ptr CUChar
headerPtr
Ptr CUChar
secretKeyPtr
if result /= 0
then pure Nothing
else do
let part = Ptr CryptoSecretStreamXChaCha20Poly1305State -> Multipart s
forall s.
Ptr CryptoSecretStreamXChaCha20Poly1305State -> Multipart s
Multipart Ptr CryptoSecretStreamXChaCha20Poly1305State
statePtr
Just <$> actions part
decryptChunk
:: forall m s
. MonadIO m
=> Multipart s
-> Maybe AdditionalData
-> Ciphertext
-> m StrictByteString
decryptChunk :: forall (m :: * -> *) s.
MonadIO m =>
Multipart s
-> Maybe AdditionalData -> Ciphertext -> m StrictByteString
decryptChunk (Multipart Ptr CryptoSecretStreamXChaCha20Poly1305State
statePtr) Maybe AdditionalData
mbAd Ciphertext{CULLong
messageLength :: CULLong
messageLength :: Ciphertext -> CULLong
messageLength, ForeignPtr CUChar
ciphertextForeignPtr :: ForeignPtr CUChar
ciphertextForeignPtr :: Ciphertext -> ForeignPtr CUChar
ciphertextForeignPtr} = do
clearTextForeignPtr <- IO (ForeignPtr CUChar) -> m (ForeignPtr CUChar)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ForeignPtr CUChar) -> m (ForeignPtr CUChar))
-> IO (ForeignPtr CUChar) -> m (ForeignPtr CUChar)
forall a b. (a -> b) -> a -> b
$ Int -> IO (ForeignPtr CUChar)
forall a. Int -> IO (ForeignPtr a)
Foreign.mallocForeignPtrBytes (CULLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULLong
messageLength)
let ciphertextLen = CULLong
messageLength CULLong -> CULLong -> CULLong
forall a. Num a => a -> a -> a
+ CSize -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSecretStreamXChaCha20Poly1305ABytes
liftIO $ Foreign.withForeignPtr ciphertextForeignPtr $ \Ptr CUChar
ciphertextBuffer -> do
StrictByteString
-> (CStringLen -> IO StrictByteString) -> IO StrictByteString
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen (StrictByteString
-> (AdditionalData -> StrictByteString)
-> Maybe AdditionalData
-> StrictByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StrictByteString
BS.empty AdditionalData -> StrictByteString
additionalDataToBinary Maybe AdditionalData
mbAd) ((CStringLen -> IO StrictByteString) -> IO StrictByteString)
-> (CStringLen -> IO StrictByteString) -> IO StrictByteString
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
adCString, Int
adCStringLen) -> do
let adPtr :: Ptr CUChar
adPtr = forall a b. Ptr a -> Ptr b
Foreign.castPtr @CChar @CUChar Ptr CChar
adCString
adLen :: CULLong
adLen = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong Int
adCStringLen
IO StrictByteString -> IO StrictByteString
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StrictByteString -> IO StrictByteString)
-> IO StrictByteString -> IO StrictByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar
-> (Ptr CUChar -> IO StrictByteString) -> IO StrictByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
clearTextForeignPtr ((Ptr CUChar -> IO StrictByteString) -> IO StrictByteString)
-> (Ptr CUChar -> IO StrictByteString) -> IO StrictByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
clearTextBuffer -> do
tagBuffer <- CSize -> IO (Ptr CUChar)
forall a. CSize -> IO (Ptr a)
sodiumMalloc CSize
1
result <-
cryptoSecretStreamXChaCha20Poly1305Pull
statePtr
clearTextBuffer
Foreign.nullPtr
tagBuffer
ciphertextBuffer
ciphertextLen
adPtr
adLen
when (result /= 0) $ throw StreamDecryptionException
bsPtr <- Foreign.mallocBytes (fromIntegral messageLength)
Foreign.copyBytes bsPtr (Foreign.castPtr clearTextBuffer) (fromIntegral messageLength)
BSU.unsafePackMallocCStringLen (bsPtr, fromIntegral messageLength)
decryptList :: forall m. MonadIO m => SecretKey -> Header -> [(Maybe AdditionalData, Ciphertext)] -> m (Maybe [StrictByteString])
decryptList :: forall (m :: * -> *).
MonadIO m =>
SecretKey
-> Header
-> [(Maybe AdditionalData, Ciphertext)]
-> m (Maybe [StrictByteString])
decryptList SecretKey
secretKey Header
header [(Maybe AdditionalData, Ciphertext)]
encryptedMessages =
SecretKey
-> Header
-> (forall s. Multipart s -> m [StrictByteString])
-> m (Maybe [StrictByteString])
forall a (m :: * -> *).
MonadIO m =>
SecretKey
-> Header -> (forall s. Multipart s -> m a) -> m (Maybe a)
decryptStream SecretKey
secretKey Header
header ((forall s. Multipart s -> m [StrictByteString])
-> m (Maybe [StrictByteString]))
-> (forall s. Multipart s -> m [StrictByteString])
-> m (Maybe [StrictByteString])
forall a b. (a -> b) -> a -> b
$ \Multipart s
multipart -> do
[(Maybe AdditionalData, Ciphertext)]
-> ((Maybe AdditionalData, Ciphertext) -> m StrictByteString)
-> m [StrictByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Maybe AdditionalData, Ciphertext)]
encryptedMessages (((Maybe AdditionalData, Ciphertext) -> m StrictByteString)
-> m [StrictByteString])
-> ((Maybe AdditionalData, Ciphertext) -> m StrictByteString)
-> m [StrictByteString]
forall a b. (a -> b) -> a -> b
$ \(Maybe AdditionalData
mbAd, Ciphertext
ciphertext) -> do
Multipart s
-> Maybe AdditionalData -> Ciphertext -> m StrictByteString
forall (m :: * -> *) s.
MonadIO m =>
Multipart s
-> Maybe AdditionalData -> Ciphertext -> m StrictByteString
decryptChunk Multipart s
multipart Maybe AdditionalData
mbAd Ciphertext
ciphertext
newtype SecretKey = SecretKey (ForeignPtr CUChar)
deriving
( Int -> SecretKey -> Builder
[SecretKey] -> Builder
SecretKey -> Builder
(SecretKey -> Builder)
-> ([SecretKey] -> Builder)
-> (Int -> SecretKey -> Builder)
-> Display SecretKey
forall a.
(a -> Builder)
-> ([a] -> Builder) -> (Int -> a -> Builder) -> Display a
$cdisplayBuilder :: SecretKey -> Builder
displayBuilder :: SecretKey -> Builder
$cdisplayList :: [SecretKey] -> Builder
displayList :: [SecretKey] -> Builder
$cdisplayPrec :: Int -> SecretKey -> Builder
displayPrec :: Int -> SecretKey -> Builder
Display
)
via (OpaqueInstance "[REDACTED]" SecretKey)
instance Eq SecretKey where
(SecretKey ForeignPtr CUChar
hk1) == :: SecretKey -> SecretKey -> Bool
== (SecretKey ForeignPtr CUChar
hk2) =
ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> Bool
foreignPtrEq ForeignPtr CUChar
hk1 ForeignPtr CUChar
hk2 CSize
cryptoSecretStreamXChaCha20Poly1305KeyBytes
instance Ord SecretKey where
compare :: SecretKey -> SecretKey -> Ordering
compare (SecretKey ForeignPtr CUChar
hk1) (SecretKey ForeignPtr CUChar
hk2) =
ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> Ordering
foreignPtrOrd ForeignPtr CUChar
hk1 ForeignPtr CUChar
hk2 CSize
cryptoSecretStreamXChaCha20Poly1305KeyBytes
instance Show SecretKey where
show :: SecretKey -> String
show SecretKey
_ = String
"[REDACTED]"
newSecretKey :: IO SecretKey
newSecretKey :: IO SecretKey
newSecretKey = (Ptr CUChar -> IO ()) -> IO SecretKey
newSecretKeyWith Ptr CUChar -> IO ()
cryptoSecretStreamXChaCha20Poly1305KeyGen
secretKeyFromHexByteString :: Base16 StrictByteString -> Either Text SecretKey
secretKeyFromHexByteString :: Base16 StrictByteString -> Either Text SecretKey
secretKeyFromHexByteString Base16 StrictByteString
hexSecretKey = IO (Either Text SecretKey) -> Either Text SecretKey
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either Text SecretKey) -> Either Text SecretKey)
-> IO (Either Text SecretKey) -> Either Text SecretKey
forall a b. (a -> b) -> a -> b
$
case StrictByteString -> Either Text StrictByteString
Base16.decodeBase16Untyped (Base16 StrictByteString -> StrictByteString
forall a. Base16 a -> a
Base16.extractBase16 Base16 StrictByteString
hexSecretKey) of
Right StrictByteString
bytestring ->
if StrictByteString -> Int
BS.length StrictByteString
bytestring Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSecretStreamXChaCha20Poly1305KeyBytes
then StrictByteString
-> (CStringLen -> IO (Either Text SecretKey))
-> IO (Either Text SecretKey)
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen StrictByteString
bytestring ((CStringLen -> IO (Either Text SecretKey))
-> IO (Either Text SecretKey))
-> (CStringLen -> IO (Either Text SecretKey))
-> IO (Either Text SecretKey)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
outsideSecretKeyPtr, Int
_) -> do
secretKey <- (Ptr CUChar -> IO ()) -> IO SecretKey
newSecretKeyWith ((Ptr CUChar -> IO ()) -> IO SecretKey)
-> (Ptr CUChar -> IO ()) -> IO SecretKey
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
secretKeyPtr ->
Ptr CChar -> Ptr CChar -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
Foreign.copyArray
(forall a b. Ptr a -> Ptr b
Foreign.castPtr @CUChar @CChar Ptr CUChar
secretKeyPtr)
Ptr CChar
outsideSecretKeyPtr
(CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSecretStreamXChaCha20Poly1305KeyBytes)
pure $ Right secretKey
else Either Text SecretKey -> IO (Either Text SecretKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text SecretKey -> IO (Either Text SecretKey))
-> Either Text SecretKey -> IO (Either Text SecretKey)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text SecretKey
forall a b. a -> Either a b
Left (Text -> Either Text SecretKey) -> Text -> Either Text SecretKey
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String
"Secret Key is not of size " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CSize -> String
forall a. Show a => a -> String
show CSize
cryptoSecretStreamXChaCha20Poly1305KeyBytes)
Left Text
msg -> Either Text SecretKey -> IO (Either Text SecretKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text SecretKey -> IO (Either Text SecretKey))
-> Either Text SecretKey -> IO (Either Text SecretKey)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text SecretKey
forall a b. a -> Either a b
Left Text
msg
unsafeSecretKeyToHexByteString :: SecretKey -> Base16 StrictByteString
unsafeSecretKeyToHexByteString :: SecretKey -> Base16 StrictByteString
unsafeSecretKeyToHexByteString (SecretKey ForeignPtr CUChar
secretKeyForeignPtr) =
StrictByteString -> Base16 StrictByteString
forall a. a -> Base16 a
Base16.assertBase16 (StrictByteString -> Base16 StrictByteString)
-> StrictByteString -> Base16 StrictByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> CSize -> StrictByteString
binaryToHex ForeignPtr CUChar
secretKeyForeignPtr CSize
cryptoSecretStreamXChaCha20Poly1305KeyBytes
newSecretKeyWith :: (Ptr CUChar -> IO ()) -> IO SecretKey
newSecretKeyWith :: (Ptr CUChar -> IO ()) -> IO SecretKey
newSecretKeyWith Ptr CUChar -> IO ()
action = do
ptr <- CSize -> IO (Ptr CUChar)
forall a. CSize -> IO (Ptr a)
sodiumMalloc CSize
cryptoSecretStreamXChaCha20Poly1305KeyBytes
when (ptr == Foreign.nullPtr) $ throwErrno "sodium_malloc"
fPtr <- Foreign.newForeignPtr finalizerSodiumFree ptr
action ptr
pure $ SecretKey fPtr
newtype = (ForeignPtr CUChar)
instance Show Header where
show :: Header -> String
show = StrictByteString -> String
BSI.unpackChars (StrictByteString -> String)
-> (Header -> StrictByteString) -> Header -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base16 StrictByteString -> StrictByteString
forall a. Base16 a -> a
Base16.extractBase16 (Base16 StrictByteString -> StrictByteString)
-> (Header -> Base16 StrictByteString)
-> Header
-> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header -> Base16 StrictByteString
headerToHexByteString
instance Display Header where
displayBuilder :: Header -> Builder
displayBuilder = Text -> Builder
Builder.fromText (Text -> Builder) -> (Header -> Text) -> Header -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base16 Text -> Text
forall a. Base16 a -> a
Base16.extractBase16 (Base16 Text -> Text) -> (Header -> Base16 Text) -> Header -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header -> Base16 Text
headerToHexText
instance Eq Header where
(Header ForeignPtr CUChar
header1) == :: Header -> Header -> Bool
== (Header ForeignPtr CUChar
header2) =
ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> Bool
foreignPtrEq ForeignPtr CUChar
header1 ForeignPtr CUChar
header2 CSize
cryptoSecretStreamXChaCha20Poly1305HeaderBytes
instance Ord Header where
compare :: Header -> Header -> Ordering
compare (Header ForeignPtr CUChar
header1) (Header ForeignPtr CUChar
header2) =
ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> Ordering
foreignPtrOrd ForeignPtr CUChar
header1 ForeignPtr CUChar
header2 CSize
cryptoSecretStreamXChaCha20Poly1305HeaderBytes
headerToHexByteString :: Header -> Base16 StrictByteString
(Header ForeignPtr CUChar
headerForeignPtr) =
StrictByteString -> Base16 StrictByteString
forall a. a -> Base16 a
Base16.assertBase16 (StrictByteString -> Base16 StrictByteString)
-> StrictByteString -> Base16 StrictByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> CSize -> StrictByteString
binaryToHex ForeignPtr CUChar
headerForeignPtr CSize
cryptoSecretStreamXChaCha20Poly1305HeaderBytes
headerFromHexByteString :: Base16 StrictByteString -> Either Text Header
Base16 StrictByteString
hexHeader = IO (Either Text Header) -> Either Text Header
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either Text Header) -> Either Text Header)
-> IO (Either Text Header) -> Either Text Header
forall a b. (a -> b) -> a -> b
$
case StrictByteString -> Either Text StrictByteString
Base16.decodeBase16Untyped (Base16 StrictByteString -> StrictByteString
forall a. Base16 a -> a
Base16.extractBase16 Base16 StrictByteString
hexHeader) of
Right StrictByteString
bytestring ->
if StrictByteString -> Int
BS.length StrictByteString
bytestring Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSecretStreamXChaCha20Poly1305HeaderBytes
then StrictByteString
-> (CStringLen -> IO (Either Text Header))
-> IO (Either Text Header)
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen StrictByteString
bytestring ((CStringLen -> IO (Either Text Header))
-> IO (Either Text Header))
-> (CStringLen -> IO (Either Text Header))
-> IO (Either Text Header)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
outsideHeaderPtr, Int
_) -> do
let headerLength :: Int
headerLength = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSecretStreamXChaCha20Poly1305HeaderBytes
headerForeignPtr <- Int -> IO (ForeignPtr CUChar)
forall a. Int -> IO (ForeignPtr a)
Foreign.mallocForeignPtrBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSecretStreamXChaCha20Poly1305HeaderBytes)
Foreign.withForeignPtr headerForeignPtr $ \Ptr CUChar
headerPtr -> do
Ptr CUChar -> Ptr CUChar -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
Foreign.copyBytes Ptr CUChar
headerPtr (Ptr CChar -> Ptr CUChar
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr CChar
outsideHeaderPtr) Int
headerLength
Either Text Header -> IO (Either Text Header)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Header -> IO (Either Text Header))
-> Either Text Header -> IO (Either Text Header)
forall a b. (a -> b) -> a -> b
$ Header -> Either Text Header
forall a b. b -> Either a b
Right (Header -> Either Text Header) -> Header -> Either Text Header
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> Header
Header ForeignPtr CUChar
headerForeignPtr
else Either Text Header -> IO (Either Text Header)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Header -> IO (Either Text Header))
-> Either Text Header -> IO (Either Text Header)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Header
forall a b. a -> Either a b
Left (Text -> Either Text Header) -> Text -> Either Text Header
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String
"Secret Key is not of size " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CSize -> String
forall a. Show a => a -> String
show CSize
cryptoSecretStreamXChaCha20Poly1305HeaderBytes)
Left Text
msg -> Either Text Header -> IO (Either Text Header)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Header -> IO (Either Text Header))
-> Either Text Header -> IO (Either Text Header)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Header
forall a b. a -> Either a b
Left Text
msg
headerToHexText :: Header -> Base16 Text
= StrictByteString -> Base16 Text
Base16.encodeBase16 (StrictByteString -> Base16 Text)
-> (Header -> StrictByteString) -> Header -> Base16 Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base16 StrictByteString -> StrictByteString
forall a. Base16 a -> a
Base16.extractBase16 (Base16 StrictByteString -> StrictByteString)
-> (Header -> Base16 StrictByteString)
-> Header
-> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header -> Base16 StrictByteString
headerToHexByteString
data MessageTag
=
Message
|
Final
|
Push
|
Rekey
messageTagToConstant :: MessageTag -> CUChar
messageTagToConstant :: MessageTag -> CUChar
messageTagToConstant = \case
MessageTag
Message -> CSize -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSecretStreamXChaCha20Poly1305TagMessage
MessageTag
Final -> CSize -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSecretStreamXChaCha20Poly1305TagFinal
MessageTag
Push -> CSize -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSecretStreamXChaCha20Poly1305TagPush
MessageTag
Rekey -> CSize -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSecretStreamXChaCha20Poly1305TagRekey
newtype AdditionalData = AdditionalData StrictByteString
deriving stock (AdditionalData -> AdditionalData -> Bool
(AdditionalData -> AdditionalData -> Bool)
-> (AdditionalData -> AdditionalData -> Bool) -> Eq AdditionalData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AdditionalData -> AdditionalData -> Bool
== :: AdditionalData -> AdditionalData -> Bool
$c/= :: AdditionalData -> AdditionalData -> Bool
/= :: AdditionalData -> AdditionalData -> Bool
Eq, Int -> AdditionalData -> ShowS
[AdditionalData] -> ShowS
AdditionalData -> String
(Int -> AdditionalData -> ShowS)
-> (AdditionalData -> String)
-> ([AdditionalData] -> ShowS)
-> Show AdditionalData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AdditionalData -> ShowS
showsPrec :: Int -> AdditionalData -> ShowS
$cshow :: AdditionalData -> String
show :: AdditionalData -> String
$cshowList :: [AdditionalData] -> ShowS
showList :: [AdditionalData] -> ShowS
Show)
deriving (Int -> AdditionalData -> Builder
[AdditionalData] -> Builder
AdditionalData -> Builder
(AdditionalData -> Builder)
-> ([AdditionalData] -> Builder)
-> (Int -> AdditionalData -> Builder)
-> Display AdditionalData
forall a.
(a -> Builder)
-> ([a] -> Builder) -> (Int -> a -> Builder) -> Display a
$cdisplayBuilder :: AdditionalData -> Builder
displayBuilder :: AdditionalData -> Builder
$cdisplayList :: [AdditionalData] -> Builder
displayList :: [AdditionalData] -> Builder
$cdisplayPrec :: Int -> AdditionalData -> Builder
displayPrec :: Int -> AdditionalData -> Builder
Display) via (ShowInstance AdditionalData)
additionalDataToHexText :: AdditionalData -> Base16 Text
additionalDataToHexText :: AdditionalData -> Base16 Text
additionalDataToHexText = StrictByteString -> Base16 Text
Base16.encodeBase16 (StrictByteString -> Base16 Text)
-> (AdditionalData -> StrictByteString)
-> AdditionalData
-> Base16 Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdditionalData -> StrictByteString
additionalDataToBinary
additionalDataToHexByteString :: AdditionalData -> Base16 StrictByteString
additionalDataToHexByteString :: AdditionalData -> Base16 StrictByteString
additionalDataToHexByteString = StrictByteString -> Base16 StrictByteString
Base16.encodeBase16' (StrictByteString -> Base16 StrictByteString)
-> (AdditionalData -> StrictByteString)
-> AdditionalData
-> Base16 StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdditionalData -> StrictByteString
additionalDataToBinary
additionalDataToBinary :: AdditionalData -> StrictByteString
additionalDataToBinary :: AdditionalData -> StrictByteString
additionalDataToBinary (AdditionalData StrictByteString
bs) = StrictByteString
bs
newtype AdditionalDataHexDecodingError = AdditionalDataHexDecodingError Text
deriving stock (AdditionalDataHexDecodingError
-> AdditionalDataHexDecodingError -> Bool
(AdditionalDataHexDecodingError
-> AdditionalDataHexDecodingError -> Bool)
-> (AdditionalDataHexDecodingError
-> AdditionalDataHexDecodingError -> Bool)
-> Eq AdditionalDataHexDecodingError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AdditionalDataHexDecodingError
-> AdditionalDataHexDecodingError -> Bool
== :: AdditionalDataHexDecodingError
-> AdditionalDataHexDecodingError -> Bool
$c/= :: AdditionalDataHexDecodingError
-> AdditionalDataHexDecodingError -> Bool
/= :: AdditionalDataHexDecodingError
-> AdditionalDataHexDecodingError -> Bool
Eq, Int -> AdditionalDataHexDecodingError -> ShowS
[AdditionalDataHexDecodingError] -> ShowS
AdditionalDataHexDecodingError -> String
(Int -> AdditionalDataHexDecodingError -> ShowS)
-> (AdditionalDataHexDecodingError -> String)
-> ([AdditionalDataHexDecodingError] -> ShowS)
-> Show AdditionalDataHexDecodingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AdditionalDataHexDecodingError -> ShowS
showsPrec :: Int -> AdditionalDataHexDecodingError -> ShowS
$cshow :: AdditionalDataHexDecodingError -> String
show :: AdditionalDataHexDecodingError -> String
$cshowList :: [AdditionalDataHexDecodingError] -> ShowS
showList :: [AdditionalDataHexDecodingError] -> ShowS
Show)
additionalDataFromHexByteString
:: Base16 StrictByteString
-> Either AdditionalDataHexDecodingError AdditionalData
additionalDataFromHexByteString :: Base16 StrictByteString
-> Either AdditionalDataHexDecodingError AdditionalData
additionalDataFromHexByteString Base16 StrictByteString
hexBs =
case StrictByteString -> Either Text StrictByteString
Base16.decodeBase16Untyped (Base16 StrictByteString -> StrictByteString
forall a. Base16 a -> a
Base16.extractBase16 Base16 StrictByteString
hexBs) of
Left Text
err -> AdditionalDataHexDecodingError
-> Either AdditionalDataHexDecodingError AdditionalData
forall a b. a -> Either a b
Left (Text -> AdditionalDataHexDecodingError
AdditionalDataHexDecodingError Text
err)
Right StrictByteString
bs -> AdditionalData
-> Either AdditionalDataHexDecodingError AdditionalData
forall a b. b -> Either a b
Right (StrictByteString -> AdditionalData
AdditionalData StrictByteString
bs)
data Ciphertext = Ciphertext
{ Ciphertext -> CULLong
messageLength :: CULLong
, Ciphertext -> ForeignPtr CUChar
ciphertextForeignPtr :: ForeignPtr CUChar
}
instance Eq Ciphertext where
(Ciphertext CULLong
ciphertextLength1 ForeignPtr CUChar
h1) == :: Ciphertext -> Ciphertext -> Bool
== (Ciphertext CULLong
ciphertextLength2 ForeignPtr CUChar
h2) =
let
textLength :: Bool
textLength = CULLong
ciphertextLength1 CULLong -> CULLong -> Bool
forall a. Eq a => a -> a -> Bool
== CULLong
ciphertextLength2
content :: Bool
content =
ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> Bool
foreignPtrEq
ForeignPtr CUChar
h1
ForeignPtr CUChar
h2
(CULLong -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULLong
ciphertextLength1 CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
+ CSize
cryptoSecretStreamXChaCha20Poly1305ABytes)
in
Bool
textLength Bool -> Bool -> Bool
&& Bool
content
instance Ord Ciphertext where
compare :: Ciphertext -> Ciphertext -> Ordering
compare (Ciphertext CULLong
ciphertextLength1 ForeignPtr CUChar
c1) (Ciphertext CULLong
ciphertextLength2 ForeignPtr CUChar
c2) =
let
textLength :: Ordering
textLength = CULLong -> CULLong -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CULLong
ciphertextLength1 CULLong
ciphertextLength2
content :: Ordering
content =
ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> Ordering
foreignPtrOrd
ForeignPtr CUChar
c1
ForeignPtr CUChar
c2
(CULLong -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULLong
ciphertextLength1 CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
+ CSize
cryptoSecretStreamXChaCha20Poly1305ABytes)
in
Ordering
textLength Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Ordering
content
instance Display Ciphertext where
displayBuilder :: Ciphertext -> Builder
displayBuilder = Text -> Builder
Builder.fromText (Text -> Builder) -> (Ciphertext -> Text) -> Ciphertext -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base16 Text -> Text
forall a. Base16 a -> a
Base16.extractBase16 (Base16 Text -> Text)
-> (Ciphertext -> Base16 Text) -> Ciphertext -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ciphertext -> Base16 Text
ciphertextToHexText
instance Show Ciphertext where
show :: Ciphertext -> String
show = StrictByteString -> String
BSI.unpackChars (StrictByteString -> String)
-> (Ciphertext -> StrictByteString) -> Ciphertext -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base16 StrictByteString -> StrictByteString
forall a. Base16 a -> a
Base16.extractBase16 (Base16 StrictByteString -> StrictByteString)
-> (Ciphertext -> Base16 StrictByteString)
-> Ciphertext
-> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ciphertext -> Base16 StrictByteString
ciphertextToHexByteString
ciphertextFromHexByteString :: Base16 StrictByteString -> Either Text Ciphertext
ciphertextFromHexByteString :: Base16 StrictByteString -> Either Text Ciphertext
ciphertextFromHexByteString Base16 StrictByteString
hexCiphertext = IO (Either Text Ciphertext) -> Either Text Ciphertext
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either Text Ciphertext) -> Either Text Ciphertext)
-> IO (Either Text Ciphertext) -> Either Text Ciphertext
forall a b. (a -> b) -> a -> b
$
case StrictByteString -> Either Text StrictByteString
Base16.decodeBase16Untyped (Base16 StrictByteString -> StrictByteString
forall a. Base16 a -> a
Base16.extractBase16 Base16 StrictByteString
hexCiphertext) of
Right StrictByteString
bytestring ->
if StrictByteString -> Int
BS.length StrictByteString
bytestring Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSecretStreamXChaCha20Poly1305ABytes
then StrictByteString
-> (CStringLen -> IO (Either Text Ciphertext))
-> IO (Either Text Ciphertext)
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen StrictByteString
bytestring ((CStringLen -> IO (Either Text Ciphertext))
-> IO (Either Text Ciphertext))
-> (CStringLen -> IO (Either Text Ciphertext))
-> IO (Either Text Ciphertext)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
outsideCiphertextPtr, Int
outsideCiphertextLength) -> do
ciphertextFPtr <- forall a. Int -> IO (ForeignPtr a)
BSI.mallocByteString @CChar Int
outsideCiphertextLength
Foreign.withForeignPtr ciphertextFPtr $ \Ptr CChar
ciphertextPtr ->
Ptr CChar -> Ptr CChar -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
Foreign.copyArray Ptr CChar
ciphertextPtr Ptr CChar
outsideCiphertextPtr Int
outsideCiphertextLength
pure $
Right $
Ciphertext
(fromIntegral @Int @CULLong outsideCiphertextLength - fromIntegral @CSize @CULLong cryptoSecretStreamXChaCha20Poly1305ABytes)
(Foreign.castForeignPtr @CChar @CUChar ciphertextFPtr)
else Either Text Ciphertext -> IO (Either Text Ciphertext)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Ciphertext -> IO (Either Text Ciphertext))
-> Either Text Ciphertext -> IO (Either Text Ciphertext)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Ciphertext
forall a b. a -> Either a b
Left (Text -> Either Text Ciphertext) -> Text -> Either Text Ciphertext
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"Ciphertext is too short"
Left Text
msg -> Either Text Ciphertext -> IO (Either Text Ciphertext)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Ciphertext -> IO (Either Text Ciphertext))
-> Either Text Ciphertext -> IO (Either Text Ciphertext)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Ciphertext
forall a b. a -> Either a b
Left Text
msg
ciphertextToHexText :: Ciphertext -> Base16 Text
ciphertextToHexText :: Ciphertext -> Base16 Text
ciphertextToHexText = StrictByteString -> Base16 Text
Base16.encodeBase16 (StrictByteString -> Base16 Text)
-> (Ciphertext -> StrictByteString) -> Ciphertext -> Base16 Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ciphertext -> StrictByteString
ciphertextToBinary
ciphertextToHexByteString :: Ciphertext -> Base16 StrictByteString
ciphertextToHexByteString :: Ciphertext -> Base16 StrictByteString
ciphertextToHexByteString (Ciphertext CULLong
ciphertextLength ForeignPtr CUChar
fPtr) =
StrictByteString -> Base16 StrictByteString
forall a. a -> Base16 a
Base16.assertBase16 (StrictByteString -> Base16 StrictByteString)
-> StrictByteString -> Base16 StrictByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> CSize -> StrictByteString
binaryToHex ForeignPtr CUChar
fPtr (CSize
cryptoSecretStreamXChaCha20Poly1305ABytes CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
+ CULLong -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULLong
ciphertextLength)
ciphertextToBinary :: Ciphertext -> StrictByteString
ciphertextToBinary :: Ciphertext -> StrictByteString
ciphertextToBinary (Ciphertext CULLong
ciphertextLength ForeignPtr CUChar
fPtr) =
ForeignPtr Word8 -> Int -> StrictByteString
BSI.fromForeignPtr0
(ForeignPtr CUChar -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
Foreign.castForeignPtr ForeignPtr CUChar
fPtr)
(CULLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULLong
ciphertextLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSecretStreamXChaCha20Poly1305ABytes)
data StreamEncryptionException = StreamEncryptionException
deriving stock (StreamEncryptionException -> StreamEncryptionException -> Bool
(StreamEncryptionException -> StreamEncryptionException -> Bool)
-> (StreamEncryptionException -> StreamEncryptionException -> Bool)
-> Eq StreamEncryptionException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StreamEncryptionException -> StreamEncryptionException -> Bool
== :: StreamEncryptionException -> StreamEncryptionException -> Bool
$c/= :: StreamEncryptionException -> StreamEncryptionException -> Bool
/= :: StreamEncryptionException -> StreamEncryptionException -> Bool
Eq, Eq StreamEncryptionException
Eq StreamEncryptionException =>
(StreamEncryptionException
-> StreamEncryptionException -> Ordering)
-> (StreamEncryptionException -> StreamEncryptionException -> Bool)
-> (StreamEncryptionException -> StreamEncryptionException -> Bool)
-> (StreamEncryptionException -> StreamEncryptionException -> Bool)
-> (StreamEncryptionException -> StreamEncryptionException -> Bool)
-> (StreamEncryptionException
-> StreamEncryptionException -> StreamEncryptionException)
-> (StreamEncryptionException
-> StreamEncryptionException -> StreamEncryptionException)
-> Ord StreamEncryptionException
StreamEncryptionException -> StreamEncryptionException -> Bool
StreamEncryptionException -> StreamEncryptionException -> Ordering
StreamEncryptionException
-> StreamEncryptionException -> StreamEncryptionException
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StreamEncryptionException -> StreamEncryptionException -> Ordering
compare :: StreamEncryptionException -> StreamEncryptionException -> Ordering
$c< :: StreamEncryptionException -> StreamEncryptionException -> Bool
< :: StreamEncryptionException -> StreamEncryptionException -> Bool
$c<= :: StreamEncryptionException -> StreamEncryptionException -> Bool
<= :: StreamEncryptionException -> StreamEncryptionException -> Bool
$c> :: StreamEncryptionException -> StreamEncryptionException -> Bool
> :: StreamEncryptionException -> StreamEncryptionException -> Bool
$c>= :: StreamEncryptionException -> StreamEncryptionException -> Bool
>= :: StreamEncryptionException -> StreamEncryptionException -> Bool
$cmax :: StreamEncryptionException
-> StreamEncryptionException -> StreamEncryptionException
max :: StreamEncryptionException
-> StreamEncryptionException -> StreamEncryptionException
$cmin :: StreamEncryptionException
-> StreamEncryptionException -> StreamEncryptionException
min :: StreamEncryptionException
-> StreamEncryptionException -> StreamEncryptionException
Ord, Int -> StreamEncryptionException -> ShowS
[StreamEncryptionException] -> ShowS
StreamEncryptionException -> String
(Int -> StreamEncryptionException -> ShowS)
-> (StreamEncryptionException -> String)
-> ([StreamEncryptionException] -> ShowS)
-> Show StreamEncryptionException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StreamEncryptionException -> ShowS
showsPrec :: Int -> StreamEncryptionException -> ShowS
$cshow :: StreamEncryptionException -> String
show :: StreamEncryptionException -> String
$cshowList :: [StreamEncryptionException] -> ShowS
showList :: [StreamEncryptionException] -> ShowS
Show)
deriving anyclass (Show StreamEncryptionException
Typeable StreamEncryptionException
(Typeable StreamEncryptionException,
Show StreamEncryptionException) =>
(StreamEncryptionException -> SomeException)
-> (SomeException -> Maybe StreamEncryptionException)
-> (StreamEncryptionException -> String)
-> (StreamEncryptionException -> Bool)
-> Exception StreamEncryptionException
SomeException -> Maybe StreamEncryptionException
StreamEncryptionException -> Bool
StreamEncryptionException -> String
StreamEncryptionException -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> (e -> Bool)
-> Exception e
$ctoException :: StreamEncryptionException -> SomeException
toException :: StreamEncryptionException -> SomeException
$cfromException :: SomeException -> Maybe StreamEncryptionException
fromException :: SomeException -> Maybe StreamEncryptionException
$cdisplayException :: StreamEncryptionException -> String
displayException :: StreamEncryptionException -> String
$cbacktraceDesired :: StreamEncryptionException -> Bool
backtraceDesired :: StreamEncryptionException -> Bool
Exception)
data StreamInitEncryptionException = StreamInitEncryptionException
deriving stock (StreamInitEncryptionException
-> StreamInitEncryptionException -> Bool
(StreamInitEncryptionException
-> StreamInitEncryptionException -> Bool)
-> (StreamInitEncryptionException
-> StreamInitEncryptionException -> Bool)
-> Eq StreamInitEncryptionException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StreamInitEncryptionException
-> StreamInitEncryptionException -> Bool
== :: StreamInitEncryptionException
-> StreamInitEncryptionException -> Bool
$c/= :: StreamInitEncryptionException
-> StreamInitEncryptionException -> Bool
/= :: StreamInitEncryptionException
-> StreamInitEncryptionException -> Bool
Eq, Eq StreamInitEncryptionException
Eq StreamInitEncryptionException =>
(StreamInitEncryptionException
-> StreamInitEncryptionException -> Ordering)
-> (StreamInitEncryptionException
-> StreamInitEncryptionException -> Bool)
-> (StreamInitEncryptionException
-> StreamInitEncryptionException -> Bool)
-> (StreamInitEncryptionException
-> StreamInitEncryptionException -> Bool)
-> (StreamInitEncryptionException
-> StreamInitEncryptionException -> Bool)
-> (StreamInitEncryptionException
-> StreamInitEncryptionException -> StreamInitEncryptionException)
-> (StreamInitEncryptionException
-> StreamInitEncryptionException -> StreamInitEncryptionException)
-> Ord StreamInitEncryptionException
StreamInitEncryptionException
-> StreamInitEncryptionException -> Bool
StreamInitEncryptionException
-> StreamInitEncryptionException -> Ordering
StreamInitEncryptionException
-> StreamInitEncryptionException -> StreamInitEncryptionException
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StreamInitEncryptionException
-> StreamInitEncryptionException -> Ordering
compare :: StreamInitEncryptionException
-> StreamInitEncryptionException -> Ordering
$c< :: StreamInitEncryptionException
-> StreamInitEncryptionException -> Bool
< :: StreamInitEncryptionException
-> StreamInitEncryptionException -> Bool
$c<= :: StreamInitEncryptionException
-> StreamInitEncryptionException -> Bool
<= :: StreamInitEncryptionException
-> StreamInitEncryptionException -> Bool
$c> :: StreamInitEncryptionException
-> StreamInitEncryptionException -> Bool
> :: StreamInitEncryptionException
-> StreamInitEncryptionException -> Bool
$c>= :: StreamInitEncryptionException
-> StreamInitEncryptionException -> Bool
>= :: StreamInitEncryptionException
-> StreamInitEncryptionException -> Bool
$cmax :: StreamInitEncryptionException
-> StreamInitEncryptionException -> StreamInitEncryptionException
max :: StreamInitEncryptionException
-> StreamInitEncryptionException -> StreamInitEncryptionException
$cmin :: StreamInitEncryptionException
-> StreamInitEncryptionException -> StreamInitEncryptionException
min :: StreamInitEncryptionException
-> StreamInitEncryptionException -> StreamInitEncryptionException
Ord, Int -> StreamInitEncryptionException -> ShowS
[StreamInitEncryptionException] -> ShowS
StreamInitEncryptionException -> String
(Int -> StreamInitEncryptionException -> ShowS)
-> (StreamInitEncryptionException -> String)
-> ([StreamInitEncryptionException] -> ShowS)
-> Show StreamInitEncryptionException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StreamInitEncryptionException -> ShowS
showsPrec :: Int -> StreamInitEncryptionException -> ShowS
$cshow :: StreamInitEncryptionException -> String
show :: StreamInitEncryptionException -> String
$cshowList :: [StreamInitEncryptionException] -> ShowS
showList :: [StreamInitEncryptionException] -> ShowS
Show)
deriving anyclass (Show StreamInitEncryptionException
Typeable StreamInitEncryptionException
(Typeable StreamInitEncryptionException,
Show StreamInitEncryptionException) =>
(StreamInitEncryptionException -> SomeException)
-> (SomeException -> Maybe StreamInitEncryptionException)
-> (StreamInitEncryptionException -> String)
-> (StreamInitEncryptionException -> Bool)
-> Exception StreamInitEncryptionException
SomeException -> Maybe StreamInitEncryptionException
StreamInitEncryptionException -> Bool
StreamInitEncryptionException -> String
StreamInitEncryptionException -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> (e -> Bool)
-> Exception e
$ctoException :: StreamInitEncryptionException -> SomeException
toException :: StreamInitEncryptionException -> SomeException
$cfromException :: SomeException -> Maybe StreamInitEncryptionException
fromException :: SomeException -> Maybe StreamInitEncryptionException
$cdisplayException :: StreamInitEncryptionException -> String
displayException :: StreamInitEncryptionException -> String
$cbacktraceDesired :: StreamInitEncryptionException -> Bool
backtraceDesired :: StreamInitEncryptionException -> Bool
Exception)
data StreamDecryptionException = StreamDecryptionException
deriving stock (StreamDecryptionException -> StreamDecryptionException -> Bool
(StreamDecryptionException -> StreamDecryptionException -> Bool)
-> (StreamDecryptionException -> StreamDecryptionException -> Bool)
-> Eq StreamDecryptionException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StreamDecryptionException -> StreamDecryptionException -> Bool
== :: StreamDecryptionException -> StreamDecryptionException -> Bool
$c/= :: StreamDecryptionException -> StreamDecryptionException -> Bool
/= :: StreamDecryptionException -> StreamDecryptionException -> Bool
Eq, Eq StreamDecryptionException
Eq StreamDecryptionException =>
(StreamDecryptionException
-> StreamDecryptionException -> Ordering)
-> (StreamDecryptionException -> StreamDecryptionException -> Bool)
-> (StreamDecryptionException -> StreamDecryptionException -> Bool)
-> (StreamDecryptionException -> StreamDecryptionException -> Bool)
-> (StreamDecryptionException -> StreamDecryptionException -> Bool)
-> (StreamDecryptionException
-> StreamDecryptionException -> StreamDecryptionException)
-> (StreamDecryptionException
-> StreamDecryptionException -> StreamDecryptionException)
-> Ord StreamDecryptionException
StreamDecryptionException -> StreamDecryptionException -> Bool
StreamDecryptionException -> StreamDecryptionException -> Ordering
StreamDecryptionException
-> StreamDecryptionException -> StreamDecryptionException
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StreamDecryptionException -> StreamDecryptionException -> Ordering
compare :: StreamDecryptionException -> StreamDecryptionException -> Ordering
$c< :: StreamDecryptionException -> StreamDecryptionException -> Bool
< :: StreamDecryptionException -> StreamDecryptionException -> Bool
$c<= :: StreamDecryptionException -> StreamDecryptionException -> Bool
<= :: StreamDecryptionException -> StreamDecryptionException -> Bool
$c> :: StreamDecryptionException -> StreamDecryptionException -> Bool
> :: StreamDecryptionException -> StreamDecryptionException -> Bool
$c>= :: StreamDecryptionException -> StreamDecryptionException -> Bool
>= :: StreamDecryptionException -> StreamDecryptionException -> Bool
$cmax :: StreamDecryptionException
-> StreamDecryptionException -> StreamDecryptionException
max :: StreamDecryptionException
-> StreamDecryptionException -> StreamDecryptionException
$cmin :: StreamDecryptionException
-> StreamDecryptionException -> StreamDecryptionException
min :: StreamDecryptionException
-> StreamDecryptionException -> StreamDecryptionException
Ord, Int -> StreamDecryptionException -> ShowS
[StreamDecryptionException] -> ShowS
StreamDecryptionException -> String
(Int -> StreamDecryptionException -> ShowS)
-> (StreamDecryptionException -> String)
-> ([StreamDecryptionException] -> ShowS)
-> Show StreamDecryptionException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StreamDecryptionException -> ShowS
showsPrec :: Int -> StreamDecryptionException -> ShowS
$cshow :: StreamDecryptionException -> String
show :: StreamDecryptionException -> String
$cshowList :: [StreamDecryptionException] -> ShowS
showList :: [StreamDecryptionException] -> ShowS
Show)
deriving anyclass (Show StreamDecryptionException
Typeable StreamDecryptionException
(Typeable StreamDecryptionException,
Show StreamDecryptionException) =>
(StreamDecryptionException -> SomeException)
-> (SomeException -> Maybe StreamDecryptionException)
-> (StreamDecryptionException -> String)
-> (StreamDecryptionException -> Bool)
-> Exception StreamDecryptionException
SomeException -> Maybe StreamDecryptionException
StreamDecryptionException -> Bool
StreamDecryptionException -> String
StreamDecryptionException -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> (e -> Bool)
-> Exception e
$ctoException :: StreamDecryptionException -> SomeException
toException :: StreamDecryptionException -> SomeException
$cfromException :: SomeException -> Maybe StreamDecryptionException
fromException :: SomeException -> Maybe StreamDecryptionException
$cdisplayException :: StreamDecryptionException -> String
displayException :: StreamDecryptionException -> String
$cbacktraceDesired :: StreamDecryptionException -> Bool
backtraceDesired :: StreamDecryptionException -> Bool
Exception)