-- |
-- 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.
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Crypto.Cipher.AESGCMSIV
    ( Nonce
    , nonce
    , generateNonce
    , encrypt
    , decrypt
    ) where

import Data.Bits
import Data.Word

import Foreign.C.Types
import Foreign.C.String
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
showList :: [Nonce] -> ShowS
$cshowList :: [Nonce] -> ShowS
show :: Nonce -> String
$cshow :: Nonce -> String
showsPrec :: Int -> Nonce -> ShowS
$cshowsPrec :: Int -> Nonce -> ShowS
Show, Nonce -> Nonce -> Bool
(Nonce -> Nonce -> Bool) -> (Nonce -> Nonce -> Bool) -> Eq Nonce
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Nonce -> Nonce -> Bool
$c/= :: Nonce -> Nonce -> Bool
== :: Nonce -> Nonce -> Bool
$c== :: Nonce -> Nonce -> Bool
Eq, Nonce -> Int
Nonce -> Ptr p -> IO ()
Nonce -> (Ptr p -> IO a) -> IO a
(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
copyByteArrayToPtr :: Nonce -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. Nonce -> Ptr p -> IO ()
withByteArray :: Nonce -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall p a. Nonce -> (Ptr p -> IO a) -> IO a
length :: Nonce -> Int
$clength :: Nonce -> Int
ByteArrayAccess)

-- | Nonce smart constructor.  Accepts only 12-byte inputs.
nonce :: ByteArrayAccess iv => iv -> CryptoFailable Nonce
nonce :: 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 :: 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 (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
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 :: 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
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
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
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 "cryptonite_aes.h cryptonite_aes_polyval_init"
    c_aes_polyval_init :: Ptr Polyval -> CString -> IO ()

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

foreign import ccall unsafe "cryptonite_aes.h cryptonite_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 Any -> IO ()
forall ba p. ByteArrayAccess ba => ba -> Ptr p -> IO ()
copyByteArrayToPtr Bytes
iv (Ptr (LE Word32)
ptr Ptr (LE Word32) -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4)

deriveKeys :: BlockCipher128 aes => aes -> Nonce -> (ScrubbedBytes, AES)
deriveKeys :: 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 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 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 :: 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 :: 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 :: 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 :: 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
    Polyval
ctx <- ScrubbedBytes -> IO Polyval
polyvalInit ScrubbedBytes
mak
    Polyval -> aad -> IO ()
forall ba. ByteArrayAccess ba => Polyval -> ba -> IO ()
polyvalUpdate Polyval
ctx aad
aad
    Polyval -> ba -> IO ()
forall ba. ByteArrayAccess ba => Polyval -> ba -> IO ()
polyvalUpdate Polyval
ctx ba
plaintext
    Polyval -> Bytes -> IO ()
forall ba. ByteArrayAccess ba => Polyval -> ba -> IO ()
polyvalUpdate Polyval
ctx (Bytes
lb :: Bytes)  -- the "length block"
    Polyval -> IO ScrubbedBytes
polyvalFinalize Polyval
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
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
        Word8
b <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
ptr Int
15
        Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
ptr Int
15 (Word8
b Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. (Word8
0x7f :: Word8))

-- Encrypt the result with AES using the message-encryption key to produce the
-- tag.
buildTag :: BlockCipher128 aes => aes -> ScrubbedBytes -> Nonce -> Bytes
buildTag :: aes -> ScrubbedBytes -> Nonce -> Bytes
buildTag aes
mek ScrubbedBytes
ss Nonce
iv = aes -> Bytes -> Bytes
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 (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 = let Just IV c
iv = Bytes -> Maybe (IV c)
forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV (Bytes
bs :: Bytes) in IV c
iv