{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

module Simplex.Messaging.Crypto.Lazy
  ( sha256Hash,
    sha512Hash,
    pad,
    unPad,
    splitLen,
    sbEncrypt,
    sbDecrypt,
    sbEncryptTailTag,
    kcbEncryptTailTag,
    sbDecryptTailTag,
    kcbDecryptTailTag,
    sbEncryptTailTagNoPad,
    sbDecryptTailTagNoPad,
    fastReplicate,
    secretBox,
    secretBoxTailTag,
    SbState,
    cbInit,
    sbInit,
    kcbInit,
    sbEncryptChunk,
    sbDecryptChunk,
    sbEncryptChunkLazy,
    sbDecryptChunkLazy,
    sbAuth,
    LazyByteString,
  )
where

import qualified Crypto.Cipher.XSalsa as XSalsa
import qualified Crypto.Error as CE
import Crypto.Hash (Digest, hashlazy)
import Crypto.Hash.Algorithms (SHA256, SHA512)
import qualified Crypto.MAC.Poly1305 as Poly1305
import Data.Bifunctor (first)
import Data.ByteArray (ByteArrayAccess)
import qualified Data.ByteArray as BA
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import qualified Data.ByteString.Lazy.Internal as LB
import Data.Composition ((.:.))
import Data.Int (Int64)
import Data.List.NonEmpty (NonEmpty (..))
import Foreign (sizeOf)
import Simplex.Messaging.Crypto (CbNonce, CryptoError (..), DhSecret (..), DhSecretX25519, SbKey, SbKeyNonce, pattern CbNonce, pattern SbKey)
import Simplex.Messaging.Crypto.SNTRUP761 (KEMHybridSecret (..))
import Simplex.Messaging.Encoding

type LazyByteString = LB.ByteString

-- | SHA512 digest of a lazy bytestring.
sha256Hash :: LazyByteString -> ByteString
sha256Hash :: LazyByteString -> ByteString
sha256Hash = Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Digest SHA256 -> ByteString)
-> (LazyByteString -> Digest SHA256)
-> LazyByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LazyByteString -> Digest SHA256
forall a. HashAlgorithm a => LazyByteString -> Digest a
hashlazy :: LazyByteString -> Digest SHA256)

-- | SHA512 digest of a lazy bytestring.
sha512Hash :: LazyByteString -> ByteString
sha512Hash :: LazyByteString -> ByteString
sha512Hash = Digest SHA512 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Digest SHA512 -> ByteString)
-> (LazyByteString -> Digest SHA512)
-> LazyByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LazyByteString -> Digest SHA512
forall a. HashAlgorithm a => LazyByteString -> Digest a
hashlazy :: LazyByteString -> Digest SHA512)

-- this function does not validate the length of the message to avoid consuming all chunks,
-- but if the passed string is longer it will truncate it to specified length
pad :: LazyByteString -> Int64 -> Int64 -> Either CryptoError LazyByteString
pad :: LazyByteString
-> Int64 -> Int64 -> Either CryptoError LazyByteString
pad LazyByteString
msg Int64
len Int64
paddedLen
  | Int64
padLen Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
0 = LazyByteString -> Either CryptoError LazyByteString
forall a b. b -> Either a b
Right (LazyByteString -> Either CryptoError LazyByteString)
-> LazyByteString -> Either CryptoError LazyByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> LazyByteString
LB.fromStrict ByteString
encodedLen LazyByteString -> LazyByteString -> LazyByteString
forall a. Semigroup a => a -> a -> a
<> Int64 -> LazyByteString -> LazyByteString
LB.take Int64
len LazyByteString
msg LazyByteString -> LazyByteString -> LazyByteString
forall a. Semigroup a => a -> a -> a
<> Int64 -> Char -> LazyByteString
fastReplicate Int64
padLen Char
'#'
  | Bool
otherwise = CryptoError -> Either CryptoError LazyByteString
forall a b. a -> Either a b
Left CryptoError
CryptoLargeMsgError
  where
    encodedLen :: ByteString
encodedLen = Int64 -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode Int64
len -- 8 bytes Int64 encoded length
    padLen :: Int64
padLen = Int64
paddedLen Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
len Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
8

fastReplicate :: Int64 -> Char -> LazyByteString
fastReplicate :: Int64 -> Char -> LazyByteString
fastReplicate Int64
n Char
c
  | Int64
n Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0 = LazyByteString
LB.empty
  | Int64
n Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
chSize' = ByteString -> LazyByteString
LB.fromStrict (ByteString -> LazyByteString) -> ByteString -> LazyByteString
forall a b. (a -> b) -> a -> b
$ Int -> Char -> ByteString
B.replicate (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n) Char
c
  | Bool
otherwise = [ByteString] -> LazyByteString
LB.fromChunks ([ByteString] -> LazyByteString) -> [ByteString] -> LazyByteString
forall a b. (a -> b) -> a -> b
$ Int -> Char -> ByteString
B.replicate (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
r) Char
c ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Int -> ByteString -> [ByteString]
forall a. Int -> a -> [a]
replicate (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
q) ByteString
chPad
  where
    chSize :: Int
chSize = Int
65536 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a. Storable a => a -> Int
sizeOf (Int
forall a. HasCallStack => a
undefined :: Int)
    chPad :: ByteString
chPad = Int -> Char -> ByteString
B.replicate Int
chSize Char
c
    chSize' :: Int64
chSize' = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
chSize
    (Int64
q, Int64
r) = Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
quotRem Int64
n Int64
chSize'

-- this function does not validate the length of the message to avoid consuming all chunks,
-- so it can return a shorter string than expected
unPad :: LazyByteString -> Either CryptoError LazyByteString
unPad :: LazyByteString -> Either CryptoError LazyByteString
unPad = ((Int64, LazyByteString) -> LazyByteString)
-> Either CryptoError (Int64, LazyByteString)
-> Either CryptoError LazyByteString
forall a b.
(a -> b) -> Either CryptoError a -> Either CryptoError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int64, LazyByteString) -> LazyByteString
forall a b. (a, b) -> b
snd (Either CryptoError (Int64, LazyByteString)
 -> Either CryptoError LazyByteString)
-> (LazyByteString -> Either CryptoError (Int64, LazyByteString))
-> LazyByteString
-> Either CryptoError LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> Either CryptoError (Int64, LazyByteString)
splitLen

splitLen :: LazyByteString -> Either CryptoError (Int64, LazyByteString)
splitLen :: LazyByteString -> Either CryptoError (Int64, LazyByteString)
splitLen LazyByteString
padded
  | LazyByteString -> Int64
LB.length LazyByteString
lenStr Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
8 = case ByteString -> Either String Int64
forall a. Encoding a => ByteString -> Either String a
smpDecode (ByteString -> Either String Int64)
-> ByteString -> Either String Int64
forall a b. (a -> b) -> a -> b
$ LazyByteString -> ByteString
LB.toStrict LazyByteString
lenStr of
      Right Int64
len
        | Int64
len Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0 -> CryptoError -> Either CryptoError (Int64, LazyByteString)
forall a b. a -> Either a b
Left CryptoError
CryptoInvalidMsgError
        | Bool
otherwise -> (Int64, LazyByteString)
-> Either CryptoError (Int64, LazyByteString)
forall a b. b -> Either a b
Right (Int64
len, Int64 -> LazyByteString -> LazyByteString
LB.take Int64
len LazyByteString
rest)
      Left String
_ -> CryptoError -> Either CryptoError (Int64, LazyByteString)
forall a b. a -> Either a b
Left CryptoError
CryptoInvalidMsgError
  | Bool
otherwise = CryptoError -> Either CryptoError (Int64, LazyByteString)
forall a b. a -> Either a b
Left CryptoError
CryptoInvalidMsgError
  where
    (LazyByteString
lenStr, LazyByteString
rest) = Int64 -> LazyByteString -> (LazyByteString, LazyByteString)
LB.splitAt Int64
8 LazyByteString
padded

-- | NaCl @secret_box@ lazy encrypt with a symmetric 256-bit key and 192-bit nonce.
-- The resulting string will be bigger than paddedLen by the size of the auth tag (16 bytes).
sbEncrypt :: SbKey -> CbNonce -> LazyByteString -> Int64 -> Int64 -> Either CryptoError LazyByteString
sbEncrypt :: SbKey
-> CbNonce
-> LazyByteString
-> Int64
-> Int64
-> Either CryptoError LazyByteString
sbEncrypt (SbKey ByteString
key) (CbNonce ByteString
nonce) LazyByteString
msg Int64
len Int64
paddedLen =
  NonEmpty ByteString -> LazyByteString
prependTag (NonEmpty ByteString -> LazyByteString)
-> Either CryptoError (NonEmpty ByteString)
-> Either CryptoError LazyByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((SbState -> ByteString -> (ByteString, SbState))
-> ByteString
-> ByteString
-> LazyByteString
-> Either CryptoError (NonEmpty ByteString)
forall key.
ByteArrayAccess key =>
(SbState -> ByteString -> (ByteString, SbState))
-> key
-> ByteString
-> LazyByteString
-> Either CryptoError (NonEmpty ByteString)
secretBox SbState -> ByteString -> (ByteString, SbState)
sbEncryptChunk ByteString
key ByteString
nonce (LazyByteString -> Either CryptoError (NonEmpty ByteString))
-> Either CryptoError LazyByteString
-> Either CryptoError (NonEmpty ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LazyByteString
-> Int64 -> Int64 -> Either CryptoError LazyByteString
pad LazyByteString
msg Int64
len Int64
paddedLen)
  where
    prependTag :: NonEmpty ByteString -> LazyByteString
prependTag (ByteString
tag :| [ByteString]
cs) = ByteString -> LazyByteString -> LazyByteString
LB.Chunk ByteString
tag (LazyByteString -> LazyByteString)
-> LazyByteString -> LazyByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> LazyByteString
LB.fromChunks [ByteString]
cs

-- | NaCl @secret_box@ decrypt with a symmetric 256-bit key and 192-bit nonce.
-- The resulting string will be smaller than packet size by the size of the auth tag (16 bytes).
sbDecrypt :: SbKey -> CbNonce -> LazyByteString -> Either CryptoError LazyByteString
sbDecrypt :: SbKey
-> CbNonce -> LazyByteString -> Either CryptoError LazyByteString
sbDecrypt (SbKey ByteString
key) (CbNonce ByteString
nonce) LazyByteString
packet
  | LazyByteString -> Int64
LB.length LazyByteString
tag' Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
16 = CryptoError -> Either CryptoError LazyByteString
forall a b. a -> Either a b
Left CryptoError
CBDecryptError
  | Bool
otherwise = case (SbState -> ByteString -> (ByteString, SbState))
-> ByteString
-> ByteString
-> LazyByteString
-> Either CryptoError (NonEmpty ByteString)
forall key.
ByteArrayAccess key =>
(SbState -> ByteString -> (ByteString, SbState))
-> key
-> ByteString
-> LazyByteString
-> Either CryptoError (NonEmpty ByteString)
secretBox SbState -> ByteString -> (ByteString, SbState)
sbDecryptChunk ByteString
key ByteString
nonce LazyByteString
c of
      Right (ByteString
tag :| [ByteString]
cs)
        | ByteString -> ByteString -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
BA.constEq (LazyByteString -> ByteString
LB.toStrict LazyByteString
tag') ByteString
tag -> LazyByteString -> Either CryptoError LazyByteString
unPad (LazyByteString -> Either CryptoError LazyByteString)
-> LazyByteString -> Either CryptoError LazyByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> LazyByteString
LB.fromChunks [ByteString]
cs
        | Bool
otherwise -> CryptoError -> Either CryptoError LazyByteString
forall a b. a -> Either a b
Left CryptoError
CBDecryptError
      Left CryptoError
e -> CryptoError -> Either CryptoError LazyByteString
forall a b. a -> Either a b
Left CryptoError
e
  where
    (LazyByteString
tag', LazyByteString
c) = Int64 -> LazyByteString -> (LazyByteString, LazyByteString)
LB.splitAt Int64
16 LazyByteString
packet

secretBox :: ByteArrayAccess key => (SbState -> ByteString -> (ByteString, SbState)) -> key -> ByteString -> LazyByteString -> Either CryptoError (NonEmpty ByteString)
secretBox :: forall key.
ByteArrayAccess key =>
(SbState -> ByteString -> (ByteString, SbState))
-> key
-> ByteString
-> LazyByteString
-> Either CryptoError (NonEmpty ByteString)
secretBox SbState -> ByteString -> (ByteString, SbState)
sbProcess key
secret ByteString
nonce LazyByteString
msg = SbState -> NonEmpty ByteString
run (SbState -> NonEmpty ByteString)
-> Either CryptoError SbState
-> Either CryptoError (NonEmpty ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> key -> ByteString -> Either CryptoError SbState
forall key.
ByteArrayAccess key =>
key -> ByteString -> Either CryptoError SbState
sbInit_ key
secret ByteString
nonce
  where
    run :: SbState -> NonEmpty ByteString
run SbState
state =
      let (![ByteString]
cs, !SbState
state') = (SbState -> ByteString -> (ByteString, SbState))
-> SbState -> LazyByteString -> ([ByteString], SbState)
secretBoxLazy_ SbState -> ByteString -> (ByteString, SbState)
sbProcess SbState
state LazyByteString
msg
       in Auth -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SbState -> Auth
sbAuth SbState
state') ByteString -> [ByteString] -> NonEmpty ByteString
forall a. a -> [a] -> NonEmpty a
:| [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
cs

-- | NaCl @secret_box@ lazy encrypt with a symmetric 256-bit key and 192-bit nonce with appended auth tag (more efficient with large files).
sbEncryptTailTag :: SbKey -> CbNonce -> LazyByteString -> Int64 -> Int64 -> Either CryptoError LazyByteString
sbEncryptTailTag :: SbKey
-> CbNonce
-> LazyByteString
-> Int64
-> Int64
-> Either CryptoError LazyByteString
sbEncryptTailTag (SbKey ByteString
key) = ByteString
-> CbNonce
-> LazyByteString
-> Int64
-> Int64
-> Either CryptoError LazyByteString
forall key.
ByteArrayAccess key =>
key
-> CbNonce
-> LazyByteString
-> Int64
-> Int64
-> Either CryptoError LazyByteString
sbEncryptTailTag_ ByteString
key
{-# INLINE sbEncryptTailTag #-}

-- | NaCl @crypto_box@ lazy encrypt with with a shared hybrid KEM+DH 256-bit secret and 192-bit nonce with appended auth tag (more efficient with large strings/files).
kcbEncryptTailTag :: KEMHybridSecret -> CbNonce -> LazyByteString -> Int64 -> Int64 -> Either CryptoError LazyByteString
kcbEncryptTailTag :: KEMHybridSecret
-> CbNonce
-> LazyByteString
-> Int64
-> Int64
-> Either CryptoError LazyByteString
kcbEncryptTailTag (KEMHybridSecret ScrubbedBytes
key) = ScrubbedBytes
-> CbNonce
-> LazyByteString
-> Int64
-> Int64
-> Either CryptoError LazyByteString
forall key.
ByteArrayAccess key =>
key
-> CbNonce
-> LazyByteString
-> Int64
-> Int64
-> Either CryptoError LazyByteString
sbEncryptTailTag_ ScrubbedBytes
key
{-# INLINE kcbEncryptTailTag #-}

sbEncryptTailTag_ :: ByteArrayAccess key => key -> CbNonce -> LazyByteString -> Int64 -> Int64 -> Either CryptoError LazyByteString
sbEncryptTailTag_ :: forall key.
ByteArrayAccess key =>
key
-> CbNonce
-> LazyByteString
-> Int64
-> Int64
-> Either CryptoError LazyByteString
sbEncryptTailTag_ key
key (CbNonce ByteString
nonce) LazyByteString
msg Int64
len Int64
paddedLen =
  [ByteString] -> LazyByteString
LB.fromChunks ([ByteString] -> LazyByteString)
-> Either CryptoError [ByteString]
-> Either CryptoError LazyByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((SbState -> ByteString -> (ByteString, SbState))
-> key
-> ByteString
-> LazyByteString
-> Either CryptoError [ByteString]
forall key.
ByteArrayAccess key =>
(SbState -> ByteString -> (ByteString, SbState))
-> key
-> ByteString
-> LazyByteString
-> Either CryptoError [ByteString]
secretBoxTailTag SbState -> ByteString -> (ByteString, SbState)
sbEncryptChunk key
key ByteString
nonce (LazyByteString -> Either CryptoError [ByteString])
-> Either CryptoError LazyByteString
-> Either CryptoError [ByteString]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LazyByteString
-> Int64 -> Int64 -> Either CryptoError LazyByteString
pad LazyByteString
msg Int64
len Int64
paddedLen)

sbEncryptTailTagNoPad :: SbKeyNonce -> LazyByteString -> Either CryptoError LazyByteString
sbEncryptTailTagNoPad :: SbKeyNonce -> LazyByteString -> Either CryptoError LazyByteString
sbEncryptTailTagNoPad (SbKey ByteString
key, CbNonce ByteString
nonce) LazyByteString
msg =
  [ByteString] -> LazyByteString
LB.fromChunks ([ByteString] -> LazyByteString)
-> Either CryptoError [ByteString]
-> Either CryptoError LazyByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SbState -> ByteString -> (ByteString, SbState))
-> ByteString
-> ByteString
-> LazyByteString
-> Either CryptoError [ByteString]
forall key.
ByteArrayAccess key =>
(SbState -> ByteString -> (ByteString, SbState))
-> key
-> ByteString
-> LazyByteString
-> Either CryptoError [ByteString]
secretBoxTailTag SbState -> ByteString -> (ByteString, SbState)
sbEncryptChunk ByteString
key ByteString
nonce LazyByteString
msg

-- | NaCl @secret_box@ decrypt with a symmetric 256-bit key and 192-bit nonce with appended auth tag (more efficient with large files).
-- paddedLen should NOT include the tag length, it should be the same number that is passed to sbEncrypt / sbEncryptTailTag.
sbDecryptTailTag :: SbKey -> CbNonce -> Int64 -> LazyByteString -> Either CryptoError (Bool, LazyByteString)
sbDecryptTailTag :: SbKey
-> CbNonce
-> Int64
-> LazyByteString
-> Either CryptoError (Bool, LazyByteString)
sbDecryptTailTag (SbKey ByteString
key) = ByteString
-> CbNonce
-> Int64
-> LazyByteString
-> Either CryptoError (Bool, LazyByteString)
forall key.
ByteArrayAccess key =>
key
-> CbNonce
-> Int64
-> LazyByteString
-> Either CryptoError (Bool, LazyByteString)
sbDecryptTailTag_ ByteString
key
{-# INLINE sbDecryptTailTag #-}

-- | NaCl @crypto_box@ lazy decrypt with a shared hybrid KEM+DH 256-bit secret and 192-bit nonce with appended auth tag (more efficient with large strings/files).
-- paddedLen should NOT include the tag length, it should be the same number that is passed to sbEncrypt / sbEncryptTailTag.
kcbDecryptTailTag :: KEMHybridSecret -> CbNonce -> Int64 -> LazyByteString -> Either CryptoError (Bool, LazyByteString)
kcbDecryptTailTag :: KEMHybridSecret
-> CbNonce
-> Int64
-> LazyByteString
-> Either CryptoError (Bool, LazyByteString)
kcbDecryptTailTag (KEMHybridSecret ScrubbedBytes
key) = ScrubbedBytes
-> CbNonce
-> Int64
-> LazyByteString
-> Either CryptoError (Bool, LazyByteString)
forall key.
ByteArrayAccess key =>
key
-> CbNonce
-> Int64
-> LazyByteString
-> Either CryptoError (Bool, LazyByteString)
sbDecryptTailTag_ ScrubbedBytes
key
{-# INLINE kcbDecryptTailTag #-}

-- paddedLen should NOT include the tag length, it should be the same number that is passed to sbEncrypt / sbEncryptTailTag.
sbDecryptTailTag_ :: ByteArrayAccess key => key -> CbNonce -> Int64 -> LazyByteString -> Either CryptoError (Bool, LazyByteString)
sbDecryptTailTag_ :: forall key.
ByteArrayAccess key =>
key
-> CbNonce
-> Int64
-> LazyByteString
-> Either CryptoError (Bool, LazyByteString)
sbDecryptTailTag_ key
key (CbNonce ByteString
nonce) Int64
paddedLen LazyByteString
packet =
  case (SbState -> ByteString -> (ByteString, SbState))
-> key
-> ByteString
-> LazyByteString
-> Either CryptoError (NonEmpty ByteString)
forall key.
ByteArrayAccess key =>
(SbState -> ByteString -> (ByteString, SbState))
-> key
-> ByteString
-> LazyByteString
-> Either CryptoError (NonEmpty ByteString)
secretBox SbState -> ByteString -> (ByteString, SbState)
sbDecryptChunk key
key ByteString
nonce LazyByteString
c of
    Right (ByteString
tag :| [ByteString]
cs) ->
      let valid :: Bool
valid = LazyByteString -> Int64
LB.length LazyByteString
tag' Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
16 Bool -> Bool -> Bool
&& ByteString -> ByteString -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
BA.constEq (LazyByteString -> ByteString
LB.toStrict LazyByteString
tag') ByteString
tag
       in (Bool
valid,) (LazyByteString -> (Bool, LazyByteString))
-> Either CryptoError LazyByteString
-> Either CryptoError (Bool, LazyByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LazyByteString -> Either CryptoError LazyByteString
unPad ([ByteString] -> LazyByteString
LB.fromChunks [ByteString]
cs)
    Left CryptoError
e -> CryptoError -> Either CryptoError (Bool, LazyByteString)
forall a b. a -> Either a b
Left CryptoError
e
  where
    (LazyByteString
c, LazyByteString
tag') = Int64 -> LazyByteString -> (LazyByteString, LazyByteString)
LB.splitAt Int64
paddedLen LazyByteString
packet

sbDecryptTailTagNoPad :: SbKeyNonce -> Int64 -> LazyByteString -> Either CryptoError (Bool, LazyByteString)
sbDecryptTailTagNoPad :: SbKeyNonce
-> Int64
-> LazyByteString
-> Either CryptoError (Bool, LazyByteString)
sbDecryptTailTagNoPad (SbKey ByteString
key, CbNonce ByteString
nonce) Int64
paddedLen LazyByteString
packet =
  NonEmpty ByteString -> (Bool, LazyByteString)
result (NonEmpty ByteString -> (Bool, LazyByteString))
-> Either CryptoError (NonEmpty ByteString)
-> Either CryptoError (Bool, LazyByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SbState -> ByteString -> (ByteString, SbState))
-> ByteString
-> ByteString
-> LazyByteString
-> Either CryptoError (NonEmpty ByteString)
forall key.
ByteArrayAccess key =>
(SbState -> ByteString -> (ByteString, SbState))
-> key
-> ByteString
-> LazyByteString
-> Either CryptoError (NonEmpty ByteString)
secretBox SbState -> ByteString -> (ByteString, SbState)
sbDecryptChunk ByteString
key ByteString
nonce LazyByteString
c
  where
    result :: NonEmpty ByteString -> (Bool, LazyByteString)
result (ByteString
tag :| [ByteString]
cs) =
      let valid :: Bool
valid = LazyByteString -> Int64
LB.length LazyByteString
tag' Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
16 Bool -> Bool -> Bool
&& ByteString -> ByteString -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
BA.constEq (LazyByteString -> ByteString
LB.toStrict LazyByteString
tag') ByteString
tag
       in (Bool
valid, [ByteString] -> LazyByteString
LB.fromChunks [ByteString]
cs)
    (LazyByteString
c, LazyByteString
tag') = Int64 -> LazyByteString -> (LazyByteString, LazyByteString)
LB.splitAt Int64
paddedLen LazyByteString
packet

secretBoxTailTag :: ByteArrayAccess key => (SbState -> ByteString -> (ByteString, SbState)) -> key -> ByteString -> LazyByteString -> Either CryptoError [ByteString]
secretBoxTailTag :: forall key.
ByteArrayAccess key =>
(SbState -> ByteString -> (ByteString, SbState))
-> key
-> ByteString
-> LazyByteString
-> Either CryptoError [ByteString]
secretBoxTailTag SbState -> ByteString -> (ByteString, SbState)
sbProcess key
secret ByteString
nonce LazyByteString
msg = SbState -> [ByteString]
run (SbState -> [ByteString])
-> Either CryptoError SbState -> Either CryptoError [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> key -> ByteString -> Either CryptoError SbState
forall key.
ByteArrayAccess key =>
key -> ByteString -> Either CryptoError SbState
sbInit_ key
secret ByteString
nonce
  where
    run :: SbState -> [ByteString]
run SbState
state =
      let ([ByteString]
cs, SbState
state') = (SbState -> ByteString -> (ByteString, SbState))
-> SbState -> LazyByteString -> ([ByteString], SbState)
secretBoxLazy_ SbState -> ByteString -> (ByteString, SbState)
sbProcess SbState
state LazyByteString
msg
       in [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Auth -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (SbState -> Auth
sbAuth SbState
state') ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
cs

-- passes lazy bytestring via initialized secret box returning the reversed list of chunks
secretBoxLazy_ :: (SbState -> ByteString -> (ByteString, SbState)) -> SbState -> LazyByteString -> ([ByteString], SbState)
secretBoxLazy_ :: (SbState -> ByteString -> (ByteString, SbState))
-> SbState -> LazyByteString -> ([ByteString], SbState)
secretBoxLazy_ SbState -> ByteString -> (ByteString, SbState)
sbProcess SbState
state = (([ByteString], SbState) -> ByteString -> ([ByteString], SbState))
-> ([ByteString], SbState)
-> LazyByteString
-> ([ByteString], SbState)
forall a. (a -> ByteString -> a) -> a -> LazyByteString -> a
LB.foldlChunks ([ByteString], SbState) -> ByteString -> ([ByteString], SbState)
update ([], SbState
state)
  where
    update :: ([ByteString], SbState) -> ByteString -> ([ByteString], SbState)
update ([ByteString]
cs, SbState
st) ByteString
chunk = let (!ByteString
c, !SbState
st') = SbState -> ByteString -> (ByteString, SbState)
sbProcess SbState
st ByteString
chunk in (ByteString
c ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
cs, SbState
st')

type SbState = (XSalsa.State, Poly1305.State)

cbInit :: DhSecretX25519 -> CbNonce -> Either CryptoError SbState
cbInit :: DhSecretX25519 -> CbNonce -> Either CryptoError SbState
cbInit (DhSecretX25519 DhSecret
secret) (CbNonce ByteString
nonce) = DhSecret -> ByteString -> Either CryptoError SbState
forall key.
ByteArrayAccess key =>
key -> ByteString -> Either CryptoError SbState
sbInit_ DhSecret
secret ByteString
nonce
{-# INLINE cbInit #-}

sbInit :: SbKey -> CbNonce -> Either CryptoError SbState
sbInit :: SbKey -> CbNonce -> Either CryptoError SbState
sbInit (SbKey ByteString
secret) (CbNonce ByteString
nonce) = ByteString -> ByteString -> Either CryptoError SbState
forall key.
ByteArrayAccess key =>
key -> ByteString -> Either CryptoError SbState
sbInit_ ByteString
secret ByteString
nonce
{-# INLINE sbInit #-}

kcbInit :: KEMHybridSecret -> CbNonce -> Either CryptoError SbState
kcbInit :: KEMHybridSecret -> CbNonce -> Either CryptoError SbState
kcbInit (KEMHybridSecret ScrubbedBytes
k) (CbNonce ByteString
nonce) = ScrubbedBytes -> ByteString -> Either CryptoError SbState
forall key.
ByteArrayAccess key =>
key -> ByteString -> Either CryptoError SbState
sbInit_ ScrubbedBytes
k ByteString
nonce
{-# INLINE kcbInit #-}

sbInit_ :: ByteArrayAccess key => key -> ByteString -> Either CryptoError SbState
sbInit_ :: forall key.
ByteArrayAccess key =>
key -> ByteString -> Either CryptoError SbState
sbInit_ key
secret ByteString
nonce = (State
state2,) (State -> SbState)
-> Either CryptoError State -> Either CryptoError SbState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CryptoFailable State -> Either CryptoError State
forall b. CryptoFailable b -> Either CryptoError b
cryptoPassed (ByteString -> CryptoFailable State
forall key. ByteArrayAccess key => key -> CryptoFailable State
Poly1305.initialize ByteString
rs)
  where
    zero :: ByteString
zero = Int -> Char -> ByteString
B.replicate Int
16 (Char -> ByteString) -> Char -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Char
forall a. Enum a => Int -> a
toEnum Int
0
    (ByteString
iv0, ByteString
iv1) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
8 ByteString
nonce
    state0 :: State
state0 = Int -> key -> ByteString -> State
forall key nonce.
(ByteArrayAccess key, ByteArrayAccess nonce) =>
Int -> key -> nonce -> State
XSalsa.initialize Int
20 key
secret (ByteString
zero ByteString -> ByteString -> ByteString
`B.append` ByteString
iv0)
    state1 :: State
state1 = State -> ByteString -> State
forall nonce. ByteArrayAccess nonce => State -> nonce -> State
XSalsa.derive State
state0 ByteString
iv1
    (ByteString
rs :: ByteString, State
state2) = State -> Int -> (ByteString, State)
forall ba. ByteArray ba => State -> Int -> (ba, State)
XSalsa.generate State
state1 Int
32

sbEncryptChunkLazy :: SbState -> LazyByteString -> (LazyByteString, SbState)
sbEncryptChunkLazy :: SbState -> LazyByteString -> (LazyByteString, SbState)
sbEncryptChunkLazy = (SbState -> ByteString -> (ByteString, SbState))
-> SbState -> LazyByteString -> (LazyByteString, SbState)
sbProcessChunkLazy_ SbState -> ByteString -> (ByteString, SbState)
sbEncryptChunk

sbDecryptChunkLazy :: SbState -> LazyByteString -> (LazyByteString, SbState)
sbDecryptChunkLazy :: SbState -> LazyByteString -> (LazyByteString, SbState)
sbDecryptChunkLazy = (SbState -> ByteString -> (ByteString, SbState))
-> SbState -> LazyByteString -> (LazyByteString, SbState)
sbProcessChunkLazy_ SbState -> ByteString -> (ByteString, SbState)
sbDecryptChunk

sbProcessChunkLazy_ :: (SbState -> ByteString -> (ByteString, SbState)) -> SbState -> LazyByteString -> (LazyByteString, SbState)
sbProcessChunkLazy_ :: (SbState -> ByteString -> (ByteString, SbState))
-> SbState -> LazyByteString -> (LazyByteString, SbState)
sbProcessChunkLazy_ = ([ByteString] -> LazyByteString)
-> ([ByteString], SbState) -> (LazyByteString, SbState)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([ByteString] -> LazyByteString
LB.fromChunks ([ByteString] -> LazyByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse) (([ByteString], SbState) -> (LazyByteString, SbState))
-> ((SbState -> ByteString -> (ByteString, SbState))
    -> SbState -> LazyByteString -> ([ByteString], SbState))
-> (SbState -> ByteString -> (ByteString, SbState))
-> SbState
-> LazyByteString
-> (LazyByteString, SbState)
forall d e a b c.
(d -> e) -> (a -> b -> c -> d) -> a -> b -> c -> e
.:. (SbState -> ByteString -> (ByteString, SbState))
-> SbState -> LazyByteString -> ([ByteString], SbState)
secretBoxLazy_
{-# INLINE sbProcessChunkLazy_ #-}

sbEncryptChunk :: SbState -> ByteString -> (ByteString, SbState)
sbEncryptChunk :: SbState -> ByteString -> (ByteString, SbState)
sbEncryptChunk (State
st, State
authSt) ByteString
chunk =
  let (!ByteString
c, !State
st') = State -> ByteString -> (ByteString, State)
forall ba. ByteArray ba => State -> ba -> (ba, State)
XSalsa.combine State
st ByteString
chunk
      !authSt' :: State
authSt' = State -> ByteString -> State
forall ba. ByteArrayAccess ba => State -> ba -> State
Poly1305.update State
authSt ByteString
c
   in (ByteString
c, (State
st', State
authSt'))

sbDecryptChunk :: SbState -> ByteString -> (ByteString, SbState)
sbDecryptChunk :: SbState -> ByteString -> (ByteString, SbState)
sbDecryptChunk (State
st, State
authSt) ByteString
chunk =
  let (!ByteString
s, !State
st') = State -> ByteString -> (ByteString, State)
forall ba. ByteArray ba => State -> ba -> (ba, State)
XSalsa.combine State
st ByteString
chunk
      !authSt' :: State
authSt' = State -> ByteString -> State
forall ba. ByteArrayAccess ba => State -> ba -> State
Poly1305.update State
authSt ByteString
chunk
   in (ByteString
s, (State
st', State
authSt'))

sbAuth :: SbState -> Poly1305.Auth
sbAuth :: SbState -> Auth
sbAuth = State -> Auth
Poly1305.finalize (State -> Auth) -> (SbState -> State) -> SbState -> Auth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SbState -> State
forall a b. (a, b) -> b
snd

cryptoPassed :: CE.CryptoFailable b -> Either CryptoError b
cryptoPassed :: forall b. CryptoFailable b -> Either CryptoError b
cryptoPassed = \case
  CE.CryptoPassed b
a -> b -> Either CryptoError b
forall a b. b -> Either a b
Right b
a
  CE.CryptoFailed CryptoError
e -> CryptoError -> Either CryptoError b
forall a b. a -> Either a b
Left (CryptoError -> Either CryptoError b)
-> CryptoError -> Either CryptoError b
forall a b. (a -> b) -> a -> b
$ CryptoError -> CryptoError
CryptoPoly1305Error CryptoError
e