-- |
-- Module      : Crypto.Cipher.ChaCha.Poly1305
-- License     : BSD-style
-- Maintainer  : Kazu Yamamoto <kazu@iij.ad.jp>
-- Stability   : experimental
-- Portability : Good
--
-- ChaCha20-Poly1305 (RFC 8439) a message at a time.
--
-- "Crypto.Cipher.ChaChaPoly1305" takes a message in pieces: a state is
-- started, the additional data appended, the body encrypted and the tag
-- taken, each a step of its own.  That is what a protocol wants when the
-- message arrives in pieces, and it is eight foreign calls and the
-- allocations between them when the message was already whole.
--
-- Here the whole message goes in one call.
--
-- The functions are the same shape as "Crypto.Cipher.AES.GCM", so a protocol
-- that offers both ciphers can hold them the same way.
module Crypto.Cipher.ChaCha.Poly1305 (
    Context,
    newContext,
    encrypt,
    decrypt,
    decryptWithTag,
) where

import Crypto.Cipher.Types (AuthTag (..))
import Crypto.Error
import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess)
import qualified Crypto.Internal.ByteArray as B
import Crypto.Internal.Compat (unsafeDoIO)
import Crypto.Internal.Imports
import Foreign.C.Types (CInt (..), CUInt (..))
import Foreign.Ptr (Ptr, plusPtr)

-- | A key, checked once.
--
-- ChaCha20-Poly1305 has nothing to precompute from a key: the one-time
-- Poly1305 key comes from the nonce, so it differs for every message.  This
-- holds the thirty-two bytes and the knowledge that they are thirty-two, and
-- exists so that the interface is the one "Crypto.Cipher.AES.GCM" has.
newtype Context = Context B.ScrubbedBytes

instance NFData Context where
    rnf :: Context -> ()
rnf (Context ScrubbedBytes
k) = ScrubbedBytes
k ScrubbedBytes -> () -> ()
forall a b. a -> b -> b
`seq` ()

-- | Take a key of 32 bytes.  Any other length is reported as
-- 'CryptoError_KeySizeInvalid'.
newContext :: ByteArrayAccess key => key -> CryptoFailable Context
newContext :: forall key. ByteArrayAccess key => key -> CryptoFailable Context
newContext key
k
    | key -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length key
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
32 = CryptoError -> CryptoFailable Context
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_KeySizeInvalid
    | Bool
otherwise = Context -> CryptoFailable Context
forall a. a -> CryptoFailable a
CryptoPassed (Context -> CryptoFailable Context)
-> Context -> CryptoFailable Context
forall a b. (a -> b) -> a -> b
$ ScrubbedBytes -> Context
Context (key -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert key
k)
{-# INLINABLE newContext #-}

-- | Encrypt one message.  The result is the ciphertext with the tag after it,
-- which is the shape 'decrypt' expects.
--
-- The nonce is the twelve bytes RFC 8439 defines; any other length gives
-- 'CryptoError_IvSizeInvalid'.  RFC 8439 requires a 16-byte tag.
{-# INLINABLE encrypt #-}
encrypt
    :: ( ByteArrayAccess nonce
       , ByteArrayAccess aad
       , ByteArrayAccess ba
       , ByteArray output
       )
    => Context
    -> nonce
    -> aad
    -> ba
    -> Int
    -> CryptoFailable output
encrypt :: forall nonce aad ba output.
(ByteArrayAccess nonce, ByteArrayAccess aad, ByteArrayAccess ba,
 ByteArray output) =>
Context -> nonce -> aad -> ba -> Int -> CryptoFailable output
encrypt (Context ScrubbedBytes
k) nonce
nonce aad
aad ba
input Int
taglen
    | aad -> ba -> Bool
forall aad ba.
(ByteArrayAccess aad, ByteArrayAccess ba) =>
aad -> ba -> Bool
tooLongForC aad
aad ba
input = CryptoError -> CryptoFailable output
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_ParameterInvalid
    | Bool -> Bool
not (nonce -> Bool
forall nonce. ByteArrayAccess nonce => nonce -> Bool
validNonce nonce
nonce) = CryptoError -> CryptoFailable output
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_IvSizeInvalid
    | Int -> Bool
badTag Int
taglen = CryptoError -> CryptoFailable output
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_AuthenticationTagSizeInvalid
    | Bool
otherwise =
        output -> CryptoFailable output
forall a. a -> CryptoFailable a
CryptoPassed (output -> CryptoFailable output)
-> output -> CryptoFailable output
forall a b. (a -> b) -> a -> b
$
            IO output -> output
forall a. IO a -> a
unsafeDoIO (IO output -> output) -> IO output -> output
forall a b. (a -> b) -> a -> b
$
                Int -> (Ptr Word8 -> IO ()) -> IO output
forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
B.alloc (ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
input Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
taglen) ((Ptr Word8 -> IO ()) -> IO output)
-> (Ptr Word8 -> IO ()) -> IO output
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
out ->
                    ScrubbedBytes -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ScrubbedBytes -> (Ptr p -> IO a) -> IO a
B.withByteArray ScrubbedBytes
k ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
kp ->
                        nonce -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. nonce -> (Ptr p -> IO a) -> IO a
B.withByteArray nonce
nonce ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
np ->
                            aad -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. aad -> (Ptr p -> IO a) -> IO a
B.withByteArray aad
aad ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ap ->
                                ba -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ba -> (Ptr p -> IO a) -> IO a
B.withByteArray ba
input ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ip ->
                                    (Int -> CEncrypt
callE (ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
input))
                                        Ptr Word8
out
                                        (Ptr Word8
out Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
input)
                                        (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
taglen)
                                        Ptr Word8
kp
                                        Ptr Word8
np
                                        (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ nonce -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length nonce
nonce)
                                        Ptr Word8
ap
                                        (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ aad -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length aad
aad)
                                        Ptr Word8
ip
                                        (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
input)

-- | Decrypt one message, in the shape 'encrypt' produced: the ciphertext with
-- its tag after it.  The tag is compared here, every byte of it whatever the
-- answer, and a message whose tag does not match gives 'Nothing' rather than
-- the plaintext.
--
-- 'Nothing' also comes back when the input is shorter than the tag, or the
-- nonce is not twelve bytes.
{-# INLINABLE decrypt #-}
decrypt
    :: (ByteArrayAccess nonce, ByteArrayAccess aad, ByteArray ba)
    => Context
    -> nonce
    -> aad
    -> ba
    -> Int
    -> Maybe ba
decrypt :: forall nonce aad ba.
(ByteArrayAccess nonce, ByteArrayAccess aad, ByteArray ba) =>
Context -> nonce -> aad -> ba -> Int -> Maybe ba
decrypt (Context ScrubbedBytes
k) nonce
nonce aad
aad ba
input Int
taglen
    | aad -> ba -> Bool
forall aad ba.
(ByteArrayAccess aad, ByteArrayAccess ba) =>
aad -> ba -> Bool
tooLongForC aad
aad ba
input = Maybe ba
forall a. Maybe a
Nothing
    | Bool -> Bool
not (nonce -> Bool
forall nonce. ByteArrayAccess nonce => nonce -> Bool
validNonce nonce
nonce) = Maybe ba
forall a. Maybe a
Nothing
    | Int -> Bool
badTag Int
taglen Bool -> Bool -> Bool
|| ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
input Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
taglen = Maybe ba
forall a. Maybe a
Nothing
    | Bool
otherwise = IO (Maybe ba) -> Maybe ba
forall a. IO a -> a
unsafeDoIO (IO (Maybe ba) -> Maybe ba) -> IO (Maybe ba) -> Maybe ba
forall a b. (a -> b) -> a -> b
$ do
        (CInt
r, ba
out) <- Int -> (Ptr Word8 -> IO CInt) -> IO (CInt, ba)
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
forall p a. Int -> (Ptr p -> IO a) -> IO (a, ba)
B.allocRet Int
bodylen ((Ptr Word8 -> IO CInt) -> IO (CInt, ba))
-> (Ptr Word8 -> IO CInt) -> IO (CInt, ba)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outp ->
            ScrubbedBytes -> (Ptr Word8 -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ScrubbedBytes -> (Ptr p -> IO a) -> IO a
B.withByteArray ScrubbedBytes
k ((Ptr Word8 -> IO CInt) -> IO CInt)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
kp ->
                nonce -> (Ptr Word8 -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. nonce -> (Ptr p -> IO a) -> IO a
B.withByteArray nonce
nonce ((Ptr Word8 -> IO CInt) -> IO CInt)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
np ->
                    aad -> (Ptr Word8 -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. aad -> (Ptr p -> IO a) -> IO a
B.withByteArray aad
aad ((Ptr Word8 -> IO CInt) -> IO CInt)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ap ->
                        ba -> (Ptr Word8 -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ba -> (Ptr p -> IO a) -> IO a
B.withByteArray ba
body ((Ptr Word8 -> IO CInt) -> IO CInt)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ip ->
                            ba -> (Ptr Word8 -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ba -> (Ptr p -> IO a) -> IO a
B.withByteArray ba
tag ((Ptr Word8 -> IO CInt) -> IO CInt)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
tp ->
                                (Int -> CDecrypt
callD Int
bodylen)
                                    Ptr Word8
outp
                                    Ptr Word8
tp
                                    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
taglen)
                                    Ptr Word8
kp
                                    Ptr Word8
np
                                    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ nonce -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length nonce
nonce)
                                    Ptr Word8
ap
                                    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ aad -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length aad
aad)
                                    Ptr Word8
ip
                                    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bodylen)
        Maybe ba -> IO (Maybe ba)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ba -> IO (Maybe ba)) -> Maybe ba -> IO (Maybe ba)
forall a b. (a -> b) -> a -> b
$ if CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0 then ba -> Maybe ba
forall a. a -> Maybe a
Just ba
out else Maybe ba
forall a. Maybe a
Nothing
  where
    bodylen :: Int
bodylen = ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
input Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
taglen
    (ba
body, ba
tag) = Int -> ba -> (ba, ba)
forall bs. ByteArray bs => Int -> bs -> (bs, bs)
B.splitAt Int
bodylen ba
input

-- | Decrypt one message, the tag kept apart, and hand back the tag this end
-- computed.
--
-- For a caller whose protocol carries the tag separately from the ciphertext,
-- so that 'decrypt' -- which wants the two together and compares them itself
-- -- does not fit.  Compare the two tags with '=='; the 'Eq' instance of
-- t'AuthTag' is a constant-time comparison, and taking them apart to compare
-- the bytes is how this goes wrong.
--
-- Nothing here says whether the message is authentic.  Until the comparison
-- is made and has come out equal, what this returns is not plaintext, it is
-- what the ciphertext turns into, and a caller must not act on it.
{-# INLINABLE decryptWithTag #-}
decryptWithTag
    :: (ByteArrayAccess nonce, ByteArrayAccess aad, ByteArray ba)
    => Context
    -> nonce
    -> aad
    -> ba
    -> Int
    -> CryptoFailable (ba, AuthTag)
decryptWithTag :: forall nonce aad ba.
(ByteArrayAccess nonce, ByteArrayAccess aad, ByteArray ba) =>
Context
-> nonce -> aad -> ba -> Int -> CryptoFailable (ba, AuthTag)
decryptWithTag (Context ScrubbedBytes
k) nonce
nonce aad
aad ba
input Int
taglen
    | aad -> ba -> Bool
forall aad ba.
(ByteArrayAccess aad, ByteArrayAccess ba) =>
aad -> ba -> Bool
tooLongForC aad
aad ba
input = CryptoError -> CryptoFailable (ba, AuthTag)
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_ParameterInvalid
    | Bool -> Bool
not (nonce -> Bool
forall nonce. ByteArrayAccess nonce => nonce -> Bool
validNonce nonce
nonce) = CryptoError -> CryptoFailable (ba, AuthTag)
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_IvSizeInvalid
    | Int -> Bool
badTag Int
taglen = CryptoError -> CryptoFailable (ba, AuthTag)
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_AuthenticationTagSizeInvalid
    | Bool
otherwise = (ba, AuthTag) -> CryptoFailable (ba, AuthTag)
forall a. a -> CryptoFailable a
CryptoPassed ((ba, AuthTag) -> CryptoFailable (ba, AuthTag))
-> (ba, AuthTag) -> CryptoFailable (ba, AuthTag)
forall a b. (a -> b) -> a -> b
$ IO (ba, AuthTag) -> (ba, AuthTag)
forall a. IO a -> a
unsafeDoIO (IO (ba, AuthTag) -> (ba, AuthTag))
-> IO (ba, AuthTag) -> (ba, AuthTag)
forall a b. (a -> b) -> a -> b
$ do
        (Bytes
tagbs, ba
out) <- Int -> (Ptr Word8 -> IO Bytes) -> IO (Bytes, ba)
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
forall p a. Int -> (Ptr p -> IO a) -> IO (a, ba)
B.allocRet (ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
input) ((Ptr Word8 -> IO Bytes) -> IO (Bytes, ba))
-> (Ptr Word8 -> IO Bytes) -> IO (Bytes, ba)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outp ->
            Int -> (Ptr Word8 -> IO ()) -> IO Bytes
forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
B.alloc Int
taglen ((Ptr Word8 -> IO ()) -> IO Bytes)
-> (Ptr Word8 -> IO ()) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
tagp ->
                ScrubbedBytes -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ScrubbedBytes -> (Ptr p -> IO a) -> IO a
B.withByteArray ScrubbedBytes
k ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
kp ->
                    nonce -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. nonce -> (Ptr p -> IO a) -> IO a
B.withByteArray nonce
nonce ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
np ->
                        aad -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. aad -> (Ptr p -> IO a) -> IO a
B.withByteArray aad
aad ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ap ->
                            ba -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ba -> (Ptr p -> IO a) -> IO a
B.withByteArray ba
input ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ip ->
                                (Int -> CEncrypt
callT (ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
input))
                                    Ptr Word8
outp
                                    Ptr Word8
tagp
                                    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
taglen)
                                    Ptr Word8
kp
                                    Ptr Word8
np
                                    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ nonce -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length nonce
nonce)
                                    Ptr Word8
ap
                                    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ aad -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length aad
aad)
                                    Ptr Word8
ip
                                    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
input)
        (ba, AuthTag) -> IO (ba, AuthTag)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ba
out, Bytes -> AuthTag
AuthTag (Bytes -> AuthTag) -> Bytes -> AuthTag
forall a b. (a -> b) -> a -> b
$ Bytes -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Bytes
tagbs :: B.Bytes))

-- | The C takes its lengths as @uint32_t@, so a message or its additional
-- data from 2^32 bytes up cannot be handed to it: the length would be
-- truncated and most of the buffer left untouched, with nothing to say so.
-- The C does the whole message in one call, so there is no splitting it.
tooLongForC
    :: (ByteArrayAccess aad, ByteArrayAccess ba) => aad -> ba -> Bool
tooLongForC :: forall aad ba.
(ByteArrayAccess aad, ByteArrayAccess ba) =>
aad -> ba -> Bool
tooLongForC aad
aad ba
input =
    Int -> Bool
B.overCLength (aad -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length aad
aad) Bool -> Bool -> Bool
|| Int -> Bool
B.overCLength (ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
input)

-- RFC 8439 is the twelve-byte nonce.  ChaCha20 will take eight, but that is
-- the other construction, with a 64-bit block counter, and it is not what
-- this AEAD is defined over -- so it is refused here rather than quietly
-- encrypting under a scheme nobody asked for.
validNonce :: ByteArrayAccess nonce => nonce -> Bool
validNonce :: forall nonce. ByteArrayAccess nonce => nonce -> Bool
validNonce nonce
n = nonce -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length nonce
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
12

badTag :: Int -> Bool
badTag :: Int -> Bool
badTag Int
t = Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
16

-- | An unsafe call keeps a capability for as long as it runs, so it is only
-- for a message short enough that the run is short.  Four kibibytes is what
-- the AES side uses, and it takes in a datagram of any size a network will
-- carry.
shortMessage :: Int
shortMessage :: Int
shortMessage = Int
4096

callE :: Int -> CEncrypt
callE :: Int -> CEncrypt
callE Int
n
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
shortMessage = CEncrypt
c_chachapoly_encrypt_unsafe
    | Bool
otherwise = CEncrypt
c_chachapoly_encrypt

callD :: Int -> CDecrypt
callD :: Int -> CDecrypt
callD Int
n
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
shortMessage = CDecrypt
c_chachapoly_decrypt_unsafe
    | Bool
otherwise = CDecrypt
c_chachapoly_decrypt

callT :: Int -> CEncrypt
callT :: Int -> CEncrypt
callT Int
n
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
shortMessage = CEncrypt
c_chachapoly_decrypt_tag_unsafe
    | Bool
otherwise = CEncrypt
c_chachapoly_decrypt_tag

type CEncrypt =
    Ptr Word8
    -> Ptr Word8
    -> CUInt
    -> Ptr Word8
    -> Ptr Word8
    -> CUInt
    -> Ptr Word8
    -> CUInt
    -> Ptr Word8
    -> CUInt
    -> IO ()

type CDecrypt =
    Ptr Word8
    -> Ptr Word8
    -> CUInt
    -> Ptr Word8
    -> Ptr Word8
    -> CUInt
    -> Ptr Word8
    -> CUInt
    -> Ptr Word8
    -> CUInt
    -> IO CInt

foreign import ccall "crypton_chachapoly.h crypton_chachapoly_encrypt"
    c_chachapoly_encrypt
        :: Ptr Word8
        -> Ptr Word8
        -> CUInt
        -> Ptr Word8
        -> Ptr Word8
        -> CUInt
        -> Ptr Word8
        -> CUInt
        -> Ptr Word8
        -> CUInt
        -> IO ()

foreign import ccall unsafe "crypton_chachapoly.h crypton_chachapoly_encrypt"
    c_chachapoly_encrypt_unsafe
        :: Ptr Word8
        -> Ptr Word8
        -> CUInt
        -> Ptr Word8
        -> Ptr Word8
        -> CUInt
        -> Ptr Word8
        -> CUInt
        -> Ptr Word8
        -> CUInt
        -> IO ()

foreign import ccall "crypton_chachapoly.h crypton_chachapoly_decrypt"
    c_chachapoly_decrypt
        :: Ptr Word8
        -> Ptr Word8
        -> CUInt
        -> Ptr Word8
        -> Ptr Word8
        -> CUInt
        -> Ptr Word8
        -> CUInt
        -> Ptr Word8
        -> CUInt
        -> IO CInt

foreign import ccall unsafe "crypton_chachapoly.h crypton_chachapoly_decrypt"
    c_chachapoly_decrypt_unsafe
        :: Ptr Word8
        -> Ptr Word8
        -> CUInt
        -> Ptr Word8
        -> Ptr Word8
        -> CUInt
        -> Ptr Word8
        -> CUInt
        -> Ptr Word8
        -> CUInt
        -> IO CInt

foreign import ccall "crypton_chachapoly.h crypton_chachapoly_decrypt_tag"
    c_chachapoly_decrypt_tag
        :: Ptr Word8
        -> Ptr Word8
        -> CUInt
        -> Ptr Word8
        -> Ptr Word8
        -> CUInt
        -> Ptr Word8
        -> CUInt
        -> Ptr Word8
        -> CUInt
        -> IO ()

foreign import ccall unsafe "crypton_chachapoly.h crypton_chachapoly_decrypt_tag"
    c_chachapoly_decrypt_tag_unsafe
        :: Ptr Word8
        -> Ptr Word8
        -> CUInt
        -> Ptr Word8
        -> Ptr Word8
        -> CUInt
        -> Ptr Word8
        -> CUInt
        -> Ptr Word8
        -> CUInt
        -> IO ()