1-- |
2-- Module      : Crypto.Cipher.AESGCMSIV
3-- License     : BSD-style
4-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
5-- Stability   : experimental
6-- Portability : unknown
7--
8-- Implementation of AES-GCM-SIV, an AEAD scheme with nonce misuse resistance
9-- defined in <https://tools.ietf.org/html/rfc8452 RFC 8452>.
10--
11-- To achieve the nonce misuse-resistance property, encryption requires two
12-- passes on the plaintext, hence no streaming API is provided.  This AEAD
13-- operates on complete inputs held in memory.  For simplicity, the
14-- implementation of decryption uses a similar pattern, with performance
15-- penalty compared to an implementation which is able to merge both passes.
16--
17-- The specification allows inputs up to 2^36 bytes but this implementation
18-- requires AAD and plaintext/ciphertext to be both smaller than 2^32 bytes.
19{-# LANGUAGE ForeignFunctionInterface #-}
20{-# LANGUAGE GeneralizedNewtypeDeriving #-}
21module Crypto.Cipher.AESGCMSIV
22    ( Nonce
23    , nonce
24    , generateNonce
25    , encrypt
26    , decrypt
27    ) where
28
29import Data.Bits
30import Data.Word
31
32import Foreign.C.Types
33import Foreign.C.String
34import Foreign.Ptr (Ptr, plusPtr)
35import Foreign.Storable (peekElemOff, poke, pokeElemOff)
36
37import           Data.ByteArray
38import qualified Data.ByteArray as B
39import           Data.Memory.Endian (toLE)
40import           Data.Memory.PtrMethods (memXor)
41
42import Crypto.Cipher.AES.Primitive
43import Crypto.Cipher.Types
44import Crypto.Error
45import Crypto.Internal.Compat (unsafeDoIO)
46import Crypto.Random
47
48
49-- 12-byte nonces
50
51-- | Nonce value for AES-GCM-SIV, always 12 bytes.
52newtype Nonce = Nonce Bytes deriving (Show, Eq, ByteArrayAccess)
53
54-- | Nonce smart constructor.  Accepts only 12-byte inputs.
55nonce :: ByteArrayAccess iv => iv -> CryptoFailable Nonce
56nonce iv
57    | B.length iv == 12 = CryptoPassed (Nonce $ B.convert iv)
58    | otherwise         = CryptoFailed CryptoError_IvSizeInvalid
59
60-- | Generate a random nonce for use with AES-GCM-SIV.
61generateNonce :: MonadRandom m => m Nonce
62generateNonce = Nonce <$> getRandomBytes 12
63
64
65-- POLYVAL (mutable context)
66
67newtype Polyval = Polyval Bytes
68
69polyvalInit :: ScrubbedBytes -> IO Polyval
70polyvalInit h = Polyval <$> doInit
71  where doInit = B.alloc 272 $ \pctx -> B.withByteArray h $ \ph ->
72            c_aes_polyval_init pctx ph
73
74polyvalUpdate :: ByteArrayAccess ba => Polyval -> ba -> IO ()
75polyvalUpdate (Polyval ctx) bs = B.withByteArray ctx $ \pctx ->
76    B.withByteArray bs $ \pbs -> c_aes_polyval_update pctx pbs sz
77  where sz = fromIntegral (B.length bs)
78
79polyvalFinalize :: Polyval -> IO ScrubbedBytes
80polyvalFinalize (Polyval ctx) = B.alloc 16 $ \dst ->
81    B.withByteArray ctx $ \pctx -> c_aes_polyval_finalize pctx dst
82
83foreign import ccall unsafe "cryptonite_aes.h cryptonite_aes_polyval_init"
84    c_aes_polyval_init :: Ptr Polyval -> CString -> IO ()
85
86foreign import ccall "cryptonite_aes.h cryptonite_aes_polyval_update"
87    c_aes_polyval_update :: Ptr Polyval -> CString -> CUInt -> IO ()
88
89foreign import ccall unsafe "cryptonite_aes.h cryptonite_aes_polyval_finalize"
90    c_aes_polyval_finalize :: Ptr Polyval -> CString -> IO ()
91
92
93-- Key Generation
94
95le32iv :: Word32 -> Nonce -> Bytes
96le32iv n (Nonce iv) = B.allocAndFreeze 16 $ \ptr -> do
97    poke ptr (toLE n)
98    copyByteArrayToPtr iv (ptr `plusPtr` 4)
99
100deriveKeys :: BlockCipher128 aes => aes -> Nonce -> (ScrubbedBytes, AES)
101deriveKeys aes iv =
102    case cipherKeySize aes of
103        KeySizeFixed sz | sz `mod` 8 == 0 ->
104            let mak = buildKey [0 .. 1]
105                key = buildKey [2 .. fromIntegral (sz `div` 8) + 1]
106                mek = throwCryptoError (cipherInit key)
107             in (mak, mek)
108        _ -> error "AESGCMSIV: invalid cipher"
109  where
110    idx n = ecbEncrypt aes (le32iv n iv) `takeView` 8
111    buildKey = B.concat . map idx
112
113
114-- Encryption and decryption
115
116lengthInvalid :: ByteArrayAccess ba => ba -> Bool
117lengthInvalid bs
118    | finiteBitSize len > 32 = len >= 1 `unsafeShiftL` 32
119    | otherwise              = False
120  where len = B.length bs
121
122-- | AEAD encryption with the specified key and nonce.  The key must be given
123-- as an initialized 'Crypto.Cipher.AES.AES128' or 'Crypto.Cipher.AES.AES256'
124-- cipher.
125--
126-- Lengths of additional data and plaintext must be less than 2^32 bytes,
127-- otherwise an exception is thrown.
128encrypt :: (BlockCipher128 aes, ByteArrayAccess aad, ByteArray ba)
129        => aes -> Nonce -> aad -> ba -> (AuthTag, ba)
130encrypt aes iv aad plaintext
131    | lengthInvalid aad = error "AESGCMSIV: aad is too large"
132    | lengthInvalid plaintext = error "AESGCMSIV: plaintext is too large"
133    | otherwise = (AuthTag tag, ciphertext)
134  where
135    (mak, mek) = deriveKeys aes iv
136    ss = getSs mak aad plaintext
137    tag = buildTag mek ss iv
138    ciphertext = combineC32 mek (transformTag tag) plaintext
139
140-- | AEAD decryption with the specified key and nonce.  The key must be given
141-- as an initialized 'Crypto.Cipher.AES.AES128' or 'Crypto.Cipher.AES.AES256'
142-- cipher.
143--
144-- Lengths of additional data and ciphertext must be less than 2^32 bytes,
145-- otherwise an exception is thrown.
146decrypt :: (BlockCipher128 aes, ByteArrayAccess aad, ByteArray ba)
147        => aes -> Nonce -> aad -> ba -> AuthTag -> Maybe ba
148decrypt aes iv aad ciphertext (AuthTag tag)
149    | lengthInvalid aad = error "AESGCMSIV: aad is too large"
150    | lengthInvalid ciphertext = error "AESGCMSIV: ciphertext is too large"
151    | tag `constEq` buildTag mek ss iv = Just plaintext
152    | otherwise = Nothing
153  where
154    (mak, mek) = deriveKeys aes iv
155    ss = getSs mak aad plaintext
156    plaintext = combineC32 mek (transformTag tag) ciphertext
157
158-- Calculate S_s = POLYVAL(mak, X_1, X_2, ...).
159getSs :: (ByteArrayAccess aad, ByteArrayAccess ba)
160      => ScrubbedBytes -> aad -> ba -> ScrubbedBytes
161getSs mak aad plaintext = unsafeDoIO $ do
162    ctx <- polyvalInit mak
163    polyvalUpdate ctx aad
164    polyvalUpdate ctx plaintext
165    polyvalUpdate ctx (lb :: Bytes)  -- the "length block"
166    polyvalFinalize ctx
167  where
168    lb = B.allocAndFreeze 16 $ \ptr -> do
169            pokeElemOff ptr 0 (toLE64 $ B.length aad)
170            pokeElemOff ptr 1 (toLE64 $ B.length plaintext)
171    toLE64 x = toLE (fromIntegral x * 8 :: Word64)
172
173-- XOR the first 12 bytes of S_s with the nonce and clear the most significant
174-- bit of the last byte.
175tagInput :: ScrubbedBytes -> Nonce -> Bytes
176tagInput ss (Nonce iv) =
177    B.copyAndFreeze ss $ \ptr ->
178    B.withByteArray iv $ \ivPtr -> do
179        memXor ptr ptr ivPtr 12
180        b <- peekElemOff ptr 15
181        pokeElemOff ptr 15 (b .&. (0x7f :: Word8))
182
183-- Encrypt the result with AES using the message-encryption key to produce the
184-- tag.
185buildTag :: BlockCipher128 aes => aes -> ScrubbedBytes -> Nonce -> Bytes
186buildTag mek ss iv = ecbEncrypt mek (tagInput ss iv)
187
188-- The initial counter block is the tag with the most significant bit of the
189-- last byte set to one.
190transformTag :: Bytes -> IV AES
191transformTag tag = toIV $ B.copyAndFreeze tag $ \ptr ->
192    peekElemOff ptr 15 >>= pokeElemOff ptr 15 . (.|. (0x80 :: Word8))
193  where toIV bs = let Just iv = makeIV (bs :: Bytes) in iv
194