    {-# LANGUAGE ForeignFunctionInterface #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}

    -- |
    -- Module      : Crypto.Cipher.AESGCMSIV
    -- License     : BSD-style
    -- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
    -- Stability   : experimental
    -- Portability : unknown
    --
    -- Implementation of AES-GCM-SIV, an AEAD scheme with nonce misuse resistance
    -- defined in <https://tools.ietf.org/html/rfc8452 RFC 8452>.
    --
    -- To achieve the nonce misuse-resistance property, encryption requires two
    -- passes on the plaintext, hence no streaming API is provided.  This AEAD
    -- operates on complete inputs held in memory.  For simplicity, the
    -- implementation of decryption uses a similar pattern, with performance
    -- penalty compared to an implementation which is able to merge both passes.
    --
    -- The specification allows inputs up to 2^36 bytes but this implementation
    -- requires AAD and plaintext/ciphertext to be both smaller than 2^32 bytes.
    module Crypto.Cipher.AESGCMSIV (
        Nonce,
        nonce,
        generateNonce,
        encrypt,
        decrypt,
    ) where

    import Data.Bits
    import Data.Maybe
    import Data.Word

    import Foreign.C.String
    import Foreign.C.Types
    import Foreign.Ptr (Ptr, plusPtr)
    import Foreign.Storable (peekElemOff, poke, pokeElemOff)

    import Data.ByteArray
    import qualified Data.ByteArray as B
    import Data.Memory.Endian (toLE)
    import Data.Memory.PtrMethods (memXor)

    import Crypto.Cipher.AES.Primitive
    import Crypto.Cipher.Types
    import Crypto.Error
    import Crypto.Internal.Compat (unsafeDoIO)
    import Crypto.Random

    -- 12-byte nonces

    -- | Nonce value for AES-GCM-SIV, always 12 bytes.
    newtype Nonce = Nonce Bytes deriving (Int -> Nonce -> ShowS
    [Nonce] -> ShowS
    Nonce -> String
    (Int -> Nonce -> ShowS)
    -> (Nonce -> String) -> ([Nonce] -> ShowS) -> Show Nonce
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Nonce -> ShowS
    showsPrec :: Int -> Nonce -> ShowS
    $cshow :: Nonce -> String
    show :: Nonce -> String
    $cshowList :: [Nonce] -> ShowS
    showList :: [Nonce] -> ShowS
    Show, Nonce -> Nonce -> Bool
    (Nonce -> Nonce -> Bool) -> (Nonce -> Nonce -> Bool) -> Eq Nonce
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Nonce -> Nonce -> Bool
    == :: Nonce -> Nonce -> Bool
    $c/= :: Nonce -> Nonce -> Bool
    /= :: Nonce -> Nonce -> Bool
    Eq, Nonce -> Int
    (Nonce -> Int)
    -> (forall p a. Nonce -> (Ptr p -> IO a) -> IO a)
    -> (forall p. Nonce -> Ptr p -> IO ())
    -> ByteArrayAccess Nonce
    forall p. Nonce -> Ptr p -> IO ()
    forall ba.
    (ba -> Int)
    -> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
    -> (forall p. ba -> Ptr p -> IO ())
    -> ByteArrayAccess ba
    forall p a. Nonce -> (Ptr p -> IO a) -> IO a
    $clength :: Nonce -> Int
    length :: Nonce -> Int
    $cwithByteArray :: forall p a. Nonce -> (Ptr p -> IO a) -> IO a
    withByteArray :: forall p a. Nonce -> (Ptr p -> IO a) -> IO a
    $ccopyByteArrayToPtr :: forall p. Nonce -> Ptr p -> IO ()
    copyByteArrayToPtr :: forall p. Nonce -> Ptr p -> IO ()
    ByteArrayAccess)

    -- | Nonce smart constructor.  Accepts only 12-byte inputs.
    nonce :: ByteArrayAccess iv => iv -> CryptoFailable Nonce
    nonce :: forall iv. ByteArrayAccess iv => iv -> CryptoFailable Nonce
    nonce iv
    iv
        | iv -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length iv
    iv Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    12 = Nonce -> CryptoFailable Nonce
    forall a. a -> CryptoFailable a
    CryptoPassed (Bytes -> Nonce
    Nonce (Bytes -> Nonce) -> Bytes -> Nonce
    forall a b. (a -> b) -> a -> b
    $ iv -> Bytes
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    B.convert iv
    iv)
        | Bool
    otherwise = CryptoError -> CryptoFailable Nonce
    forall a. CryptoError -> CryptoFailable a
    CryptoFailed CryptoError
    CryptoError_IvSizeInvalid

    -- | Generate a random nonce for use with AES-GCM-SIV.
    generateNonce :: MonadRandom m => m Nonce
    generateNonce :: forall (m :: * -> *). MonadRandom m => m Nonce
    generateNonce = Bytes -> Nonce
    Nonce (Bytes -> Nonce) -> m Bytes -> m Nonce
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> m Bytes
    forall byteArray. ByteArray byteArray => Int -> m byteArray
    forall (m :: * -> *) byteArray.
    (MonadRandom m, ByteArray byteArray) =>
    Int -> m byteArray
    getRandomBytes Int
    12

    -- POLYVAL (mutable context)

    newtype Polyval = Polyval Bytes

    polyvalInit :: ScrubbedBytes -> IO Polyval
    polyvalInit :: ScrubbedBytes -> IO Polyval
    polyvalInit ScrubbedBytes
    h = Bytes -> Polyval
    Polyval (Bytes -> Polyval) -> IO Bytes -> IO Polyval
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO Bytes
    doInit
      where
        doInit :: IO Bytes
    doInit = Int -> (Ptr Polyval -> IO ()) -> IO Bytes
    forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
    B.alloc Int
    272 ((Ptr Polyval -> IO ()) -> IO Bytes)
    -> (Ptr Polyval -> IO ()) -> IO Bytes
    forall a b. (a -> b) -> a -> b
    $ \Ptr Polyval
    pctx -> ScrubbedBytes -> (Ptr CChar -> 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
    h ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr CChar
    ph ->
            Ptr Polyval -> Ptr CChar -> IO ()
    c_aes_polyval_init Ptr Polyval
    pctx Ptr CChar
    ph

    polyvalUpdate :: ByteArrayAccess ba => Polyval -> ba -> IO ()
    polyvalUpdate :: forall ba. ByteArrayAccess ba => Polyval -> ba -> IO ()
    polyvalUpdate (Polyval Bytes
    ctx) ba
    bs = Bytes -> (Ptr Polyval -> IO ()) -> IO ()
    forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
    forall p a. Bytes -> (Ptr p -> IO a) -> IO a
    B.withByteArray Bytes
    ctx ((Ptr Polyval -> IO ()) -> IO ())
    -> (Ptr Polyval -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Polyval
    pctx ->
        ba -> (Ptr CChar -> 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
    bs ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr CChar
    pbs -> Ptr Polyval -> Ptr CChar -> CUInt -> IO ()
    c_aes_polyval_update Ptr Polyval
    pctx Ptr CChar
    pbs CUInt
    sz
      where
        sz :: CUInt
    sz = Int -> CUInt
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ba -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length ba
    bs)

    polyvalFinalize :: Polyval -> IO ScrubbedBytes
    polyvalFinalize :: Polyval -> IO ScrubbedBytes
    polyvalFinalize (Polyval Bytes
    ctx) = Int -> (Ptr CChar -> IO ()) -> IO ScrubbedBytes
    forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
    B.alloc Int
    16 ((Ptr CChar -> IO ()) -> IO ScrubbedBytes)
    -> (Ptr CChar -> IO ()) -> IO ScrubbedBytes
    forall a b. (a -> b) -> a -> b
    $ \Ptr CChar
    dst ->
        Bytes -> (Ptr Polyval -> IO ()) -> IO ()
    forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
    forall p a. Bytes -> (Ptr p -> IO a) -> IO a
    B.withByteArray Bytes
    ctx ((Ptr Polyval -> IO ()) -> IO ())
    -> (Ptr Polyval -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Polyval
    pctx -> Ptr Polyval -> Ptr CChar -> IO ()
    c_aes_polyval_finalize Ptr Polyval
    pctx Ptr CChar
    dst

    foreign import ccall unsafe "crypton_aes.h crypton_aes_polyval_init"
        c_aes_polyval_init :: Ptr Polyval -> CString -> IO ()

    foreign import ccall "crypton_aes.h crypton_aes_polyval_update"
        c_aes_polyval_update :: Ptr Polyval -> CString -> CUInt -> IO ()

    foreign import ccall unsafe "crypton_aes.h crypton_aes_polyval_finalize"
        c_aes_polyval_finalize :: Ptr Polyval -> CString -> IO ()

    -- Key Generation

    le32iv :: Word32 -> Nonce -> Bytes
    le32iv :: Word32 -> Nonce -> Bytes
    le32iv Word32
    n (Nonce Bytes
    iv) = Int -> (Ptr (LE Word32) -> IO ()) -> Bytes
    forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
    B.allocAndFreeze Int
    16 ((Ptr (LE Word32) -> IO ()) -> Bytes)
    -> (Ptr (LE Word32) -> IO ()) -> Bytes
    forall a b. (a -> b) -> a -> b
    $ \Ptr (LE Word32)
    ptr -> do
        Ptr (LE Word32) -> LE Word32 -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr (LE Word32)
    ptr (Word32 -> LE Word32
    forall a. ByteSwap a => a -> LE a
    toLE Word32
    n)
        Bytes -> Ptr (ZonkAny 0) -> IO ()
    forall ba p. ByteArrayAccess ba => ba -> Ptr p -> IO ()
    forall p. Bytes -> Ptr p -> IO ()
    copyByteArrayToPtr Bytes
    iv (Ptr (LE Word32)
    ptr Ptr (LE Word32) -> Int -> Ptr (ZonkAny 0)
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    4)

    deriveKeys :: BlockCipher128 aes => aes -> Nonce -> (ScrubbedBytes, AES)
    deriveKeys :: forall aes.
    BlockCipher128 aes =>
    aes -> Nonce -> (ScrubbedBytes, AES)
    deriveKeys aes
    aes Nonce
    iv =
        case aes -> KeySizeSpecifier
    forall cipher. Cipher cipher => cipher -> KeySizeSpecifier
    cipherKeySize aes
    aes of
            KeySizeFixed Int
    sz
                | Int
    sz Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    8 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 ->
                    let mak :: ScrubbedBytes
    mak = [Word32] -> ScrubbedBytes
    buildKey [Word32
    0 .. Word32
    1]
                        key :: ScrubbedBytes
    key = [Word32] -> ScrubbedBytes
    buildKey [Word32
    2 .. Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int
    sz Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    8) Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    1]
                        mek :: AES
    mek = CryptoFailable AES -> AES
    forall a. CryptoFailable a -> a
    throwCryptoError (ScrubbedBytes -> CryptoFailable AES
    forall key. ByteArray key => key -> CryptoFailable AES
    forall cipher key.
    (Cipher cipher, ByteArray key) =>
    key -> CryptoFailable cipher
    cipherInit ScrubbedBytes
    key)
                     in (ScrubbedBytes
    mak, AES
    mek)
            KeySizeSpecifier
    _ -> String -> (ScrubbedBytes, AES)
    forall a. HasCallStack => String -> a
    error String
    "AESGCMSIV: invalid cipher"
      where
        idx :: Word32 -> View Bytes
    idx Word32
    n = aes -> Bytes -> Bytes
    forall ba. ByteArray ba => aes -> ba -> ba
    forall cipher ba.
    (BlockCipher cipher, ByteArray ba) =>
    cipher -> ba -> ba
    ecbEncrypt aes
    aes (Word32 -> Nonce -> Bytes
    le32iv Word32
    n Nonce
    iv) Bytes -> Int -> View Bytes
    forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
    `takeView` Int
    8
        buildKey :: [Word32] -> ScrubbedBytes
    buildKey = [View Bytes] -> ScrubbedBytes
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    [bin] -> bout
    B.concat ([View Bytes] -> ScrubbedBytes)
    -> ([Word32] -> [View Bytes]) -> [Word32] -> ScrubbedBytes
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Word32 -> View Bytes) -> [Word32] -> [View Bytes]
    forall a b. (a -> b) -> [a] -> [b]
    map Word32 -> View Bytes
    idx

    -- Encryption and decryption

    lengthInvalid :: ByteArrayAccess ba => ba -> Bool
    lengthInvalid :: forall ba. ByteArrayAccess ba => ba -> Bool
    lengthInvalid ba
    bs
        | Int -> Int
    forall b. FiniteBits b => b -> Int
    finiteBitSize Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    32 = Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    1 Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `unsafeShiftL` Int
    32
        | Bool
    otherwise = Bool
    False
      where
        len :: Int
    len = ba -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length ba
    bs

    -- | AEAD encryption with the specified key and nonce.  The key must be given
    -- as an initialized 'Crypto.Cipher.AES.AES128' or 'Crypto.Cipher.AES.AES256'
    -- cipher.
    --
    -- Lengths of additional data and plaintext must be less than 2^32 bytes,
    -- otherwise an exception is thrown.
    encrypt
        :: (BlockCipher128 aes, ByteArrayAccess aad, ByteArray ba)
        => aes -> Nonce -> aad -> ba -> (AuthTag, ba)
    encrypt :: forall aes aad ba.
    (BlockCipher128 aes, ByteArrayAccess aad, ByteArray ba) =>
    aes -> Nonce -> aad -> ba -> (AuthTag, ba)
    encrypt aes
    aes Nonce
    iv aad
    aad ba
    plaintext
        | aad -> Bool
    forall ba. ByteArrayAccess ba => ba -> Bool
    lengthInvalid aad
    aad = String -> (AuthTag, ba)
    forall a. HasCallStack => String -> a
    error String
    "AESGCMSIV: aad is too large"
        | ba -> Bool
    forall ba. ByteArrayAccess ba => ba -> Bool
    lengthInvalid ba
    plaintext = String -> (AuthTag, ba)
    forall a. HasCallStack => String -> a
    error String
    "AESGCMSIV: plaintext is too large"
        | Bool
    otherwise = (Bytes -> AuthTag
    AuthTag Bytes
    tag, ba
    ciphertext)
      where
        (ScrubbedBytes
    mak, AES
    mek) = aes -> Nonce -> (ScrubbedBytes, AES)
    forall aes.
    BlockCipher128 aes =>
    aes -> Nonce -> (ScrubbedBytes, AES)
    deriveKeys aes
    aes Nonce
    iv
        ss :: ScrubbedBytes
    ss = ScrubbedBytes -> aad -> ba -> ScrubbedBytes
    forall aad ba.
    (ByteArrayAccess aad, ByteArrayAccess ba) =>
    ScrubbedBytes -> aad -> ba -> ScrubbedBytes
    getSs ScrubbedBytes
    mak aad
    aad ba
    plaintext
        tag :: Bytes
    tag = AES -> ScrubbedBytes -> Nonce -> Bytes
    forall aes.
    BlockCipher128 aes =>
    aes -> ScrubbedBytes -> Nonce -> Bytes
    buildTag AES
    mek ScrubbedBytes
    ss Nonce
    iv
        ciphertext :: ba
    ciphertext = AES -> IV AES -> ba -> ba
    forall ba. ByteArray ba => AES -> IV AES -> ba -> ba
    combineC32 AES
    mek (Bytes -> IV AES
    transformTag Bytes
    tag) ba
    plaintext

    -- | AEAD decryption with the specified key and nonce.  The key must be given
    -- as an initialized 'Crypto.Cipher.AES.AES128' or 'Crypto.Cipher.AES.AES256'
    -- cipher.
    --
    -- Lengths of additional data and ciphertext must be less than 2^32 bytes,
    -- otherwise an exception is thrown.
    decrypt
        :: (BlockCipher128 aes, ByteArrayAccess aad, ByteArray ba)
        => aes -> Nonce -> aad -> ba -> AuthTag -> Maybe ba
    decrypt :: forall aes aad ba.
    (BlockCipher128 aes, ByteArrayAccess aad, ByteArray ba) =>
    aes -> Nonce -> aad -> ba -> AuthTag -> Maybe ba
    decrypt aes
    aes Nonce
    iv aad
    aad ba
    ciphertext (AuthTag Bytes
    tag)
        | aad -> Bool
    forall ba. ByteArrayAccess ba => ba -> Bool
    lengthInvalid aad
    aad = String -> Maybe ba
    forall a. HasCallStack => String -> a
    error String
    "AESGCMSIV: aad is too large"
        | ba -> Bool
    forall ba. ByteArrayAccess ba => ba -> Bool
    lengthInvalid ba
    ciphertext = String -> Maybe ba
    forall a. HasCallStack => String -> a
    error String
    "AESGCMSIV: ciphertext is too large"
        | Bytes
    tag Bytes -> Bytes -> Bool
    forall bs1 bs2.
    (ByteArrayAccess bs1, ByteArrayAccess bs2) =>
    bs1 -> bs2 -> Bool
    `constEq` AES -> ScrubbedBytes -> Nonce -> Bytes
    forall aes.
    BlockCipher128 aes =>
    aes -> ScrubbedBytes -> Nonce -> Bytes
    buildTag AES
    mek ScrubbedBytes
    ss Nonce
    iv = ba -> Maybe ba
    forall a. a -> Maybe a
    Just ba
    plaintext
        | Bool
    otherwise = Maybe ba
    forall a. Maybe a
    Nothing
      where
        (ScrubbedBytes
    mak, AES
    mek) = aes -> Nonce -> (ScrubbedBytes, AES)
    forall aes.
    BlockCipher128 aes =>
    aes -> Nonce -> (ScrubbedBytes, AES)
    deriveKeys aes
    aes Nonce
    iv
        ss :: ScrubbedBytes
    ss = ScrubbedBytes -> aad -> ba -> ScrubbedBytes
    forall aad ba.
    (ByteArrayAccess aad, ByteArrayAccess ba) =>
    ScrubbedBytes -> aad -> ba -> ScrubbedBytes
    getSs ScrubbedBytes
    mak aad
    aad ba
    plaintext
        plaintext :: ba
    plaintext = AES -> IV AES -> ba -> ba
    forall ba. ByteArray ba => AES -> IV AES -> ba -> ba
    combineC32 AES
    mek (Bytes -> IV AES
    transformTag Bytes
    tag) ba
    ciphertext

    -- Calculate S_s = POLYVAL(mak, X_1, X_2, ...).
    getSs
        :: (ByteArrayAccess aad, ByteArrayAccess ba)
        => ScrubbedBytes -> aad -> ba -> ScrubbedBytes
    getSs :: forall aad ba.
    (ByteArrayAccess aad, ByteArrayAccess ba) =>
    ScrubbedBytes -> aad -> ba -> ScrubbedBytes
    getSs ScrubbedBytes
    mak aad
    aad ba
    plaintext = IO ScrubbedBytes -> ScrubbedBytes
    forall a. IO a -> a
    unsafeDoIO (IO ScrubbedBytes -> ScrubbedBytes)
    -> IO ScrubbedBytes -> ScrubbedBytes
    forall a b. (a -> b) -> a -> b
    $ do
        ctx <- ScrubbedBytes -> IO Polyval
    polyvalInit ScrubbedBytes
    mak
        polyvalUpdate ctx aad
        polyvalUpdate ctx plaintext
        polyvalUpdate ctx (lb :: Bytes) -- the "length block"
        polyvalFinalize ctx
      where
        lb :: Bytes
    lb = Int -> (Ptr (LE Word64) -> IO ()) -> Bytes
    forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
    B.allocAndFreeze Int
    16 ((Ptr (LE Word64) -> IO ()) -> Bytes)
    -> (Ptr (LE Word64) -> IO ()) -> Bytes
    forall a b. (a -> b) -> a -> b
    $ \Ptr (LE Word64)
    ptr -> do
            Ptr (LE Word64) -> Int -> LE Word64 -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr (LE Word64)
    ptr Int
    0 (Int -> LE Word64
    forall {a}. Integral a => a -> LE Word64
    toLE64 (Int -> LE Word64) -> Int -> LE Word64
    forall a b. (a -> b) -> a -> b
    $ aad -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length aad
    aad)
            Ptr (LE Word64) -> Int -> LE Word64 -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr (LE Word64)
    ptr Int
    1 (Int -> LE Word64
    forall {a}. Integral a => a -> LE Word64
    toLE64 (Int -> LE Word64) -> Int -> LE Word64
    forall a b. (a -> b) -> a -> b
    $ ba -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length ba
    plaintext)
        toLE64 :: a -> LE Word64
    toLE64 a
    x = Word64 -> LE Word64
    forall a. ByteSwap a => a -> LE a
    toLE (a -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    * Word64
    8 :: Word64)

    -- XOR the first 12 bytes of S_s with the nonce and clear the most significant
    -- bit of the last byte.
    tagInput :: ScrubbedBytes -> Nonce -> Bytes
    tagInput :: ScrubbedBytes -> Nonce -> Bytes
    tagInput ScrubbedBytes
    ss (Nonce Bytes
    iv) =
        ScrubbedBytes -> (Ptr Word8 -> IO ()) -> Bytes
    forall bs1 bs2 p.
    (ByteArrayAccess bs1, ByteArray bs2) =>
    bs1 -> (Ptr p -> IO ()) -> bs2
    B.copyAndFreeze ScrubbedBytes
    ss ((Ptr Word8 -> IO ()) -> Bytes) -> (Ptr Word8 -> IO ()) -> Bytes
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    ptr ->
            Bytes -> (Ptr Word8 -> IO ()) -> IO ()
    forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
    forall p a. Bytes -> (Ptr p -> IO a) -> IO a
    B.withByteArray Bytes
    iv ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    ivPtr -> do
                Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
    memXor Ptr Word8
    ptr Ptr Word8
    ptr Ptr Word8
    ivPtr Int
    12
                b <- Ptr Word8 -> Int -> IO Word8
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr Word8
    ptr Int
    15
                pokeElemOff ptr 15 (b .&. (0x7f :: Word8))

    -- Encrypt the result with AES using the message-encryption key to produce the
    -- tag.
    buildTag :: BlockCipher128 aes => aes -> ScrubbedBytes -> Nonce -> Bytes
    buildTag :: forall aes.
    BlockCipher128 aes =>
    aes -> ScrubbedBytes -> Nonce -> Bytes
    buildTag aes
    mek ScrubbedBytes
    ss Nonce
    iv = aes -> Bytes -> Bytes
    forall ba. ByteArray ba => aes -> ba -> ba
    forall cipher ba.
    (BlockCipher cipher, ByteArray ba) =>
    cipher -> ba -> ba
    ecbEncrypt aes
    mek (ScrubbedBytes -> Nonce -> Bytes
    tagInput ScrubbedBytes
    ss Nonce
    iv)

    -- The initial counter block is the tag with the most significant bit of the
    -- last byte set to one.
    transformTag :: Bytes -> IV AES
    transformTag :: Bytes -> IV AES
    transformTag Bytes
    tag = Bytes -> IV AES
    forall {c}. BlockCipher c => Bytes -> IV c
    toIV (Bytes -> IV AES) -> Bytes -> IV AES
    forall a b. (a -> b) -> a -> b
    $ Bytes -> (Ptr Word8 -> IO ()) -> Bytes
    forall bs1 bs2 p.
    (ByteArrayAccess bs1, ByteArray bs2) =>
    bs1 -> (Ptr p -> IO ()) -> bs2
    B.copyAndFreeze Bytes
    tag ((Ptr Word8 -> IO ()) -> Bytes) -> (Ptr Word8 -> IO ()) -> Bytes
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    ptr ->
        Ptr Word8 -> Int -> IO Word8
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr Word8
    ptr Int
    15 IO Word8 -> (Word8 -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Ptr Word8 -> Int -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr Word8
    ptr Int
    15 (Word8 -> IO ()) -> (Word8 -> Word8) -> Word8 -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .|. (Word8
    0x80 :: Word8))
      where
        toIV :: Bytes -> IV c
    toIV Bytes
    bs = Maybe (IV c) -> IV c
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe (IV c) -> IV c) -> Maybe (IV c) -> IV c
    forall a b. (a -> b) -> a -> b
    $ Bytes -> Maybe (IV c)
    forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
    makeIV (Bytes
    bs :: Bytes)