crypton 2.0.1 → 2.1.0

raw patch · 23 files changed

+2935/−157 lines, 23 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +223/−1
• Crypto/Cipher/AES/GCM.hs +168/−0
• Crypto/Cipher/AES/Primitive.hs +252/−2
• Crypto/Cipher/ChaChaPoly1305.hs +30/−30
• Crypto/Hash/Algorithms.hs +2/−0
• Crypto/Hash/Skein256.hs +39/−0
• Crypto/Hash/Skein512.hs +39/−0
• Crypto/Internal/Poly1305.hs +37/−0
• Crypto/MAC/Poly1305.hs +1/−14
• README.md +41/−0
• benchs/Bench.hs +3/−1
• cbits/aes/armv8.c +55/−0
• cbits/aes/armv8_impl.c +218/−0
• cbits/aes/gcm_fused_x86.c +988/−0
• cbits/aes/gcm_fused_x86.h +54/−0
• cbits/crypton_aes.c +198/−6
• cbits/crypton_aes.h +64/−0
• cbits/p256/p256_ec.c +322/−76
• crypton.cabal +13/−4
• tests/BlockCipher/AESSpec.hs +73/−3
• tests/HashSpec.hs +52/−14
• tests/PubKey/P256Spec.hs +20/−0
• tests/StreamCipher/ChaChaPoly1305Spec.hs +43/−6

@@ -1,7 +1,166 @@ # CHANGELOG for crypton -## 2.0.1+## 2.1.0 +* perf(p256): a signed five-bit window for the variable-point scalar+  multiplication, which is what ECDH and ECDSA signing spend their time in.+  The scalar is recoded into 52 digits, every one of them odd, so the table+  holds only the odd multiples P, 3P, ..., 31P and a negative digit costs a+  negation of y, which is free.  The main loop goes from 252 doublings and 64+  additions to 255 and 51, and -- because no digit is zero and no partial sum+  is the infinity -- it drops the masks that stood in for infinity on every+  iteration.  The table is built so that each pair of neighbouring odd+  multiples comes out of one doubling and one addition that shares everything+  but a squaring and a multiplication between X+P and X-P.  Counted exactly,+  the field multiplications and squarings go 3477 -> 3326.  Measured on an+  idle Intel Haswell, thirty runs each, ECDH is 158.5 -> 153.3 microseconds,+  about 4%; on an Apple M4 under desktop load the difference did not come out+  of the noise.  One scalar, 30, would have reached the last addition with+  the accumulator equal to the point being added, which these formulas cannot+  do; the recoder detects that from the scalar and the last iteration doubles+  instead.  Suggested by Kyle Butt++* perf(gcm): GHASH takes the ciphertext from the output buffer.  A group's+  multiplies are issued between the rounds of the group after it, and the+  blocks were copied into six registers' worth of scratch to wait there --+  six stores a group for bytes that had just been written to the output+  anyway.  The multiplies read the output instead, which is what picotls's+  fusion does.  On an Intel Haswell this is worth two to three points against+  fusion between 400 and 1440 bytes, and it removes the queue from the+  AES-128 path++* perf(gcm): decryption takes the fused path too, on both x86-64 and+  AArch64.  It had been left on the generic framing, so a received packet+  cost what a sent one did before any of this: measured at 100 bytes, three+  times what encrypting the same packet cost on either.  It is the simpler of+  the two -- what GHASH absorbs is the ciphertext, and the ciphertext is the+  input, so the multiplies need not wait on the AES and nothing is carried+  between groups.  On an Intel Haswell, 100 bytes goes 0.165 -> 0.050+  microseconds and 1440 bytes 0.362 -> 0.290; on an Apple M4, 0.230 -> 0.077+  and 0.396 -> 0.321.  Decrypting is now about what encrypting is rather than+  three times it.  The tag is still compared a byte at a time over its whole+  length whichever way the answer goes++* perf(gcm): let the one-call interface specialise.  `gcmFullEncrypt`,+  `gcmFullDecrypt` and `gcmFullEncryptMask` take three `ByteArrayAccess`+  arguments and were marked `NOINLINE`, which is this module's habit and is+  right for a wrapper that is called once; these are called once a packet.+  With no specialisation every `withByteArray` and every `length` went through+  a dictionary, and on an Apple M4 that measured **0.15 of the 0.265+  microseconds** a 100-byte packet cost through the Haskell interface -- more+  than the encryption it wrapped.  Marked `INLINABLE` so the caller can+  specialise them, 100 bytes falls to 0.128, where the same work measured in C+  is 0.114: the Haskell layer costs 0.014 rather than 0.15++* perf(gcm): build the length block and the initial counter in registers.+  The length block -- the two bit counts GHASH ends on -- was assembled by+  sixteen byte stores to the stack and read back, which measured about 9 of+  the 58 nanoseconds a 100-byte packet cost.  Reversed the way every block is+  on its way to GHASH, that block is just the two counts as little endian+  words with the message's in the low half, so one `_mm_set_epi64x` makes it+  and no shuffle is needed.  The initial counter likewise: the nonce is read+  where it lies and masked, rather than in three pieces of four bytes.  On an+  Intel Haswell a 100-byte packet goes from 0.058 to 0.049 microseconds.  With+  this every length measured is at 90 per cent of fusion's speed or better --+  100 bytes 90 and 95 with the header protection mask, 200 bytes 96, 1440+  bytes 94, 16 KiB 95 -- where the series began at 31 per cent for 100 bytes++* perf(gcm): read a short block without going through the stack.  Zeroing+  sixteen bytes, copying the block in and loading them back is three trips to+  memory with a store the load must wait for, and at packet lengths that was a+  tenth of the call.  The sixteen bytes are read where they lie and what is+  above the length masked off, which is safe everywhere except at the end of a+  page -- and a block near the end of a page whose own bytes stop short of it+  is read aligned, which cannot leave the page, and shuffled down.  This is+  how picotls's fusion does it.  On an Intel Haswell a 100-byte packet goes+  from 0.0625 to 0.058 microseconds, 79 per cent of fusion's speed against 73,+  and with the header protection mask 83+* perf(gcm): the tail of a message gets what the groups already had.  The+  six-wide pass that finishes a message was still running its rounds from a+  loop over a count held in the key, so the compiler could not place the+  waiting multiplies between them, and the blocks it produced went through an+  array indexed by a loop variable, which it cannot see through -- each block+  then reloaded its own keystream from memory.  Written out for the ten rounds+  of AES-128, with the multiplies at slots named at compile time, and the+  blocks taken from the registers the pass left them in.  The pass itself+  falls from about 29 to 6 nanoseconds; on an Intel Haswell 112 bytes is 13+  per cent faster and 400 bytes goes from 81 to 86 per cent of fusion's speed++* perf(gcm): give E(K,Y0) a lane that would otherwise sit idle, and stop+  copying the last short block through the stack.  Six blocks are in flight+  whatever the message length, so a message leaving a tail of four blocks or+  fewer has lanes to spare; the block that masks the tag rides in one of them+  instead of taking ten rounds nothing overlaps, which at 100 bytes measured+  9.3 of 78.9 nanoseconds.  And the last short block was stored to the stack+  and copied back, when the tag that follows it is about to overwrite the+  bytes above it anyway -- where there are sixteen to spare, one store does.+  On an Intel Haswell, 100 bytes goes from 60 to 69 per cent of fusion's speed+  and 200 bytes from 68 to 82++* perf(gcm): build the counter block without leaving the vector registers,+  and keep each power of H beside its Karatsuba term.  Both came from reading+  what picotls's `fusion` does differently.  The counter was being stepped in+  a general register, byte swapped there and inserted into a vector one, which+  is a move across register files for every lane and six to a group; held+  byte reversed in a vector register instead, `_mm_add_epi32` steps the low+  thirty-two bits and wraps them where GCM wants, and a shuffle puts the bytes+  back.  The powers were in two arrays 256 bytes apart, so a multiply touched+  two cache lines for operands it always wants together; they are now+  adjacent.  On an Intel Haswell a 1200-byte message goes from 0.311 to 0.281+  microseconds and 1440 bytes from 79 to 90 per cent of fusion's speed.  The+  multiplies are also now genuinely issued between the AES rounds, which the+  comment claimed and the generated code did not do: a test before each one+  ended the basic block the scheduler works inside, and the first group is+  peeled so that there is nothing to test++* perf(gcm): the same for AArch64, where what costs is the framing rather+  than a missing fast path.  `armv8_impl.c` already encrypts eight blocks at a+  time and folds their GHASH into one reduction; what sat outside it was the+  additional data, the tag and the counter, each reached through the branch+  table so that the running state went back to memory between them and a+  one-block header paid a reduction of its own.  Measured on an Apple M4, that+  framing was 0.07 of the 0.112 microseconds a 100-byte packet cost -- more+  than the encryption of the packet itself.  Taking the whole message in one+  call, with the tag and the counter in registers from end to end and the+  additional data and the length block riding in the same batches as the+  ciphertext: a 100-byte packet 3.0x, 200 bytes 2.6x, 400 bytes 1.6x, 1200+  bytes 1.30x, 1440 bytes 1.23x, and level from about 6 KB up.  With the QUIC+  header protection mask, 100 bytes is 3.3x.  Unlike x86-64 there is no length+  above which something else is faster, because there is no vendored assembly+  on this side to hand a long message to, so every length goes this way.  Held+  against the interface it replaces on two key sizes, seven lengths of+  additional data, fifteen message lengths up to 16 KB, three tag lengths and+  every sample offset that fits++* perf(gcm): a fused AES-GCM for x86-64, for messages short enough that the+  stitched assembly will not take them.  That assembly refuses anything under+  288 bytes, so until now a QUIC packet paid for the AES key schedule and the+  GHASH one block at a time, through a branch table that put the 128-bit state+  back in memory at every step: a 100-byte packet cost 0.153 us of which the+  encryption was a small part.  This is the design Kazuho Oku sets out for+  picotls's `fusion` -- keep AES-NI issuing every clock, six blocks in flight,+  and fit the additional data, the tag and the QUIC header protection mask+  into the gaps between the rounds -- written in C with intrinsics, for the+  reason he gives: what is complicated here is the scheduling, and it has to+  stay readable to stay correct.  On an Intel Haswell a 100-byte packet goes+  from 0.153 to 0.082 us and a 1200-byte one from 0.373 to 0.317, and the+  header protection mask becomes **free** wherever it can be taken: 400 bytes+  is 0.131 with it and 0.131 without, against 0.181 and 0.177, because it+  rides in a lane of the AES pipeline that the message length leaves idle+  rather than taking a block of its own.  It can be taken there only when the+  sample lies in output already written and the two key schedules are the same+  length, which is what TLS and QUIC do; otherwise it is computed after the+  tag, where everything it may cover exists.  Above+  1536 bytes the assembly is faster -- by 12 per cent at 3 KB and 20 at 16 KB+  -- so longer messages still go there and nothing about TLS-sized records+  changes.  The powers of H are built once per key, sixteen of them, which+  adds 512 bytes to what a key holds and no parameter to any interface: a+  power per block of the message would fold the whole GHASH into one reduction+  but would make that state grow with the longest message a caller might send.+  Held against the incremental interface on every combination of three key+  sizes, seven lengths of additional data, twelve message lengths and three+  tag lengths+ * fix(cpu): stop reading Intel's SDBG bit as AMD's XOP, which crashed SHA-512   and ChaCha20 on Broadwell and later.  The vendored assembly dispatches on a   capability word this library fills, and reads bit 11 of its second dword as@@ -18,6 +177,69 @@   beside it are cleared as well.  Reported by @lucasdicioccio, who   disassembled the trap   [#202](https://github.com/kazu-yamamoto/crypton/issues/202)++* feat(aes): `encryptWithMask`, for the QUIC header protection mask.  QUIC+  takes the sample for its header protection from the ciphertext, so the mask+  cannot be had before the encryption -- but it can be had before coming back.+  `newHeaderKey` builds the second key schedule once, where `quic` builds it+  per packet, and `encryptWithMask` seals the message and writes the sixteen+  bytes of mask, both into buffers the caller already has, so that nothing is+  allocated for either.  On an Apple M4 the mask then costs about 0.02 us+  against 0.09 to 0.11 asked for separately: a 1440-byte packet goes from+  0.473 to 0.382 us and a 100-byte one from 0.343 to 0.260.  Most of that is+  the allocations rather than the crossing -- a version returning the two as+  bytearrays was measured at 0.419 and 0.299, so it recovered less than a+  third of it -- and the AES block itself is under two nanoseconds++* feat(aes): `Crypto.Cipher.AES.GCM`, for many short messages under one key.+  The interface in `Crypto.Cipher.Types` builds a state from the key *and* the+  nonce and then walks it through appending the additional data, encrypting+  and finalizing, copying the 320-byte state at each step.  For a stream that+  is nothing next to the encryption; for a datagram it is most of the work.+  Measured on an Apple M4, a 1440-byte packet with a 20-byte header took+  1.30 us, of which 0.17 us was the encryption: the AES key schedule and the+  table of multiples of `H` were rebuilt for every nonce although both depend+  on the key alone, and three state copies and four foreign calls carried the+  rest.  A `Context` now holds what the key determines and is built once, and+  `encrypt` takes a nonce and a whole message and answers in one call, giving+  the ciphertext with the tag after it -- the shape a packet wants.  `decrypt`+  takes that shape back and compares the tag itself, in C, looking at every+  byte either way.  1440 bytes: 1.30 to 0.37 us, 3.5x; 100 bytes 0.83 to 0.23;+  a 16 KiB TLS record 2.86 to 2.20, where the saving is the setup rather than+  the call.  A message of 4 KiB or less goes through an unsafe foreign call,+  which is worth 0.075 us and is only right because such a call is over+  quickly; anything longer keeps the safe one.  This computes what the general+  interface computes, which the tests hold it to on the same vectors+* Breaking change: fix(chachapoly1305): take a checked key, so that+  initializing cannot fail.  The nonce was already a checked type, built by+  `nonce8`, `nonce12` or `nonce24`, so the key length was the only way+  `initialize` and `initializeX` could fail -- and callers answered that with+  `throwCryptoError`, `tls` among them, where+  `noFail (ChaChaPoly1305.nonce12 nonce >>= ChaChaPoly1305.initialize key)`+  re-checked a length once per record for a key fixed for the connection.+  There is now a `Key` with `key` to build one, and+  `initialize :: Key -> Nonce -> State` and+  `initializeX :: Key -> XNonce -> State` are total.+  `aeadChacha20poly1305Init` is unchanged and still reports a bad key length.+  This also closes the last of #28: `initFromRootState` wrapped a+  `throwCryptoError` around a `B.take 32`, and the Poly1305 key type now has a+  home in a hidden module so the modules here that know the length can say so+  [#193](https://github.com/kazu-yamamoto/crypton/issues/193)++* feat(hash): Skein with the digest size as a type parameter.  Skein is+  defined for any digest size and the C here has always taken one -- the+  length goes to `crypton_skein512_init` and `crypton_skein512_finalize`, and+  the output is produced in counter mode for as many blocks as are asked for+  -- but Haskell could only reach the four sizes that had a type of their own.+  `Skein256 (bitlen :: Nat)` and `Skein512 (bitlen :: Nat)` take any, in the+  manner `SHAKE128` and `SHAKE256` already did; `Skein512 512` is+  `Skein512_512`, which the tests hold it to, and the named types are+  untouched.  This also brought back the `Skein256-160` and `Skein512-160`+  known-answer vectors, which had been commented out of the test suite for+  want of a type to run them against.  One large digest is a good deal cheaper+  than the same bytes from repeated small ones: 512 KiB at 947 MB/s in one+  digest against 172 MB/s as 8192 separate `Skein512_512` ones, on an M4+  [#56](https://github.com/kazu-yamamoto/crypton/issues/56)  ## 2.0.0 

@@ -0,0 +1,168 @@+-- |+-- Module      : Crypto.Cipher.AES.GCM+-- License     : BSD-style+-- Maintainer  : Kazu Yamamoto <kazu@iij.ad.jp>+-- Stability   : experimental+-- Portability : unknown+--+-- AES-GCM for callers that send many short messages under one key, which is+-- what a datagram transport does.+--+-- The interface in "Crypto.Cipher.Types" builds a state from the key /and/+-- the nonce and then walks it through appending the additional data,+-- encrypting and finalizing, copying the state at each step.  For a stream+-- that is nothing next to the encryption.  For a QUIC packet it is most of+-- the work: the key schedule and the table of multiples of @H@ depend on the+-- key alone, and rebuilding them for every nonce costs more than encrypting+-- 1440 bytes.+--+-- So here a t'Context' is built from the key once and holds both, and+-- 'encrypt' takes a nonce and a whole message and answers in one call.+--+-- > ctx <- throwCryptoError <$> pure (newContext key)+-- > let packet = encrypt ctx nonce header plaintext 16+--+-- This runs on AES-NI and carry-less multiply, or on the ARMv8 cryptographic+-- extension, and makes no branch and no memory access that depends on the key+-- or on the data.  Where the processor has neither, AES falls back to a table+-- driven implementation that is /not/ constant time; see the side channels+-- section of the README, and 'Crypto.System.CPU.processorOptions' for which is+-- in use.+--+-- The result is the ciphertext with the tag after it, which is the shape a+-- packet wants.  'decrypt' takes that shape back, compares the tag itself and+-- answers 'Nothing' when it does not match.+--+-- This computes the same thing as the general interface; the tests hold it to+-- that on the same vectors.+module Crypto.Cipher.AES.GCM (+    Context,+    newContext,+    encrypt,+    decrypt,++    -- * Header protection+    HeaderKey,+    newHeaderKey,+    encryptWithMask,+) where++import Crypto.Cipher.AES.Primitive (+    AES,+    AESGCMKey,+    gcmFullDecrypt,+    gcmFullEncrypt,+    gcmFullEncryptMask,+    gcmKeyInit,+    initAES,+ )+import Crypto.Error+import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess)+import qualified Crypto.Internal.ByteArray as B+import Data.Word (Word8)+import Foreign.Ptr (Ptr)++-- | Everything a key determines: the AES key schedule and the table of+-- multiples of @H@.  Build it once and encrypt as many messages under it as+-- the key is good for.+data Context = Context !AES !AESGCMKey++-- | Take a key of 16, 24 or 32 bytes.  Any other length is reported as+-- 'CryptoError_KeySizeInvalid'.+newContext :: ByteArrayAccess key => key -> CryptoFailable Context+newContext k = do+    aes <- initAES k+    return $ Context aes (gcmKeyInit aes)++-- | Encrypt one message: the nonce, the additional data that is+-- authenticated but not encrypted, the plaintext, and how many bytes of tag+-- to produce, which GCM allows between 4 and 16.+--+-- The answer is the ciphertext followed by the tag.+--+-- A nonce must not be used twice with the same t'Context'.  Twelve bytes is+-- the size GCM is defined for and the only one that does not cost a further+-- pass.+{-# INLINABLE encrypt #-}+encrypt+    :: ( ByteArrayAccess nonce+       , ByteArrayAccess aad+       , ByteArrayAccess ba+       , ByteArray output+       )+    => Context+    -> nonce+    -> aad+    -> ba+    -> Int+    -> output+encrypt (Context aes gk) nonce aad input taglen =+    gcmFullEncrypt aes gk nonce aad input taglen++-- | 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.+{-# INLINABLE decrypt #-}+decrypt+    :: (ByteArrayAccess nonce, ByteArrayAccess aad, ByteArray ba)+    => Context+    -> nonce+    -> aad+    -> ba+    -> Int+    -> Maybe ba+decrypt (Context aes gk) nonce aad input taglen+    | taglen < 0 || B.length input < taglen = Nothing+    | otherwise = gcmFullDecrypt aes gk nonce aad body tag+  where+    (body, tag) = B.splitAt (B.length input - taglen) input++----------------------------------------------------------------++-- | The key schedule for header protection, which QUIC keeps separately from+-- the one it encrypts with.  Built once, like a t'Context'.+newtype HeaderKey = HeaderKey AES++-- | Take a header protection key of 16, 24 or 32 bytes.+newHeaderKey :: ByteArrayAccess key => key -> CryptoFailable HeaderKey+newHeaderKey k = HeaderKey <$> initAES k++-- | Encrypt one message and, from a sample of the ciphertext it just+-- produced, make the header protection mask -- in one call, into two buffers+-- the caller already has.+--+-- QUIC takes its sample from the ciphertext, so the mask cannot be had before+-- the encryption.  It can be had before coming back, and with the buffers+-- already there nothing is allocated for either.  On an Apple M4 the mask+-- then costs about 0.02 us, where asking for it separately costs 0.11.+--+-- The sealed message wants @length input + taglen@ bytes and the mask+-- sixteen.  @sampleOffset@ says where the sixteen bytes of sample begin in+-- the sealed message, counting the tag as part of it.+--+-- 'False' comes back, and nothing is written, when the sample would not fit.+{-# INLINABLE encryptWithMask #-}+encryptWithMask+    :: (ByteArrayAccess nonce, ByteArrayAccess aad, ByteArrayAccess ba)+    => Context+    -> HeaderKey+    -> nonce+    -> aad+    -> ba+    -> Int+    -- ^ tag length+    -> Int+    -- ^ sample offset+    -> Ptr Word8+    -- ^ where the sealed message goes+    -> Ptr Word8+    -- ^ where the sixteen bytes of mask go+    -> IO Bool+encryptWithMask (Context aes gk) (HeaderKey hp) nonce aad input taglen off outp maskp+    | off < 0 || taglen < 0 || off + 16 > B.length input + taglen = return False+    | otherwise = do+        gcmFullEncryptMask aes gk hp nonce aad input taglen off outp maskp+        return True

@@ -40,6 +40,11 @@     -- * Incremental GCM     gcmMode,     gcmInit,+    AESGCMKey,+    gcmKeyInit,+    gcmFullEncrypt,+    gcmFullEncryptMask,+    gcmFullDecrypt,     gcmAeadInit,      -- * Incremental OCB@@ -158,6 +163,14 @@ sizeGCM :: Int sizeGCM = 320 +-- | The size of what a key determines, which is the 320 bytes above and the+-- powers of H the fused path reads: sixteen of them, and sixteen more for+-- the term the Karatsuba multiplication would otherwise work out every time.+-- The same on every platform, so that this is one number rather than one per+-- architecture; the powers are filled only where that path is compiled in.+sizeGCMKey :: Int+sizeGCMKey = 832+ sizeOCB :: Int sizeOCB = 160 @@ -429,6 +442,146 @@             c_aes_gcm_init (castPtr gcmStPtr) k v (fromIntegral $ B.length iv)     return $ AESGCM sm +-- | How long a message may be and still be handed to an unsafe foreign call.+-- Four kibibytes is about half a microsecond of work, and it takes in a+-- datagram of any size a network will carry.+shortMessage :: Int+shortMessage = 4096++-- | The part of a GCM state the key alone determines: H, which is the key+-- applied to a block of zeroes, and the table of its multiples.  That is 256+-- of the 320 bytes of a GCM state, and it is the same for every message sent+-- under one key, so a caller that keeps a key can build this once rather than+-- once for every message.+newtype AESGCMKey = AESGCMKey ScrubbedBytes++-- | Build the key part of a GCM state.+{-# NOINLINE gcmKeyInit #-}+gcmKeyInit :: AES -> AESGCMKey+gcmKeyInit ctx = AESGCMKey $ B.allocAndFreeze sizeGCMKey $ \p ->+    keyToPtr ctx $ \k -> c_aes_gcm_key_init (castPtr p) k++-- | Authenticate and encrypt one message in a single call: the nonce, the+-- additional data, the plaintext and the tag, with no state crossing back+-- into Haskell in between.  The result is the ciphertext followed by the tag.+{-# INLINABLE gcmFullEncrypt #-}+gcmFullEncrypt+    :: (ByteArrayAccess iv, ByteArrayAccess aad, ByteArrayAccess ba, ByteArray output)+    => AES -> AESGCMKey -> iv -> aad -> ba -> Int -> output+gcmFullEncrypt ctx (AESGCMKey gk) iv aad input taglen =+    B.allocAndFreeze (B.length input + taglen) $ \out ->+        B.withByteArray gk $ \gkp ->+            keyToPtr ctx $ \k ->+                B.withByteArray iv $ \ivp ->+                    B.withByteArray aad $ \aadp ->+                        B.withByteArray input $ \inp ->+                            call+                                out+                                (castPtr gkp)+                                k+                                ivp+                                (fromIntegral $ B.length iv)+                                aadp+                                (fromIntegral $ B.length aad)+                                inp+                                (fromIntegral $ B.length input)+                                (fromIntegral taglen)+  where+    -- An unsafe call keeps a capability for as long as it runs, so it is only+    -- right for work that is over quickly.  A message this side of+    -- 'shortMessage' is, and it is the short ones the saving matters for: a+    -- safe call costs about 0.075 us whatever the length, which is a fifth of+    -- a 1440-byte packet and a percent of a 16 KiB record.+    call+        | B.length input <= shortMessage = c_aes_gcm_full_encrypt_unsafe+        | otherwise = c_aes_gcm_full_encrypt++-- | Encrypt, and from a sample of the ciphertext just produced make the+-- header protection mask, into buffers the caller owns.  QUIC takes its+-- sample from the ciphertext, so the mask cannot be had before the+-- encryption; it can be had before coming back, and with the buffers already+-- there nothing is allocated for either.+--+-- @sampleoff@ is where the sixteen bytes of sample begin in the output.+{-# INLINABLE gcmFullEncryptMask #-}+gcmFullEncryptMask+    :: (ByteArrayAccess iv, ByteArrayAccess aad, ByteArrayAccess ba)+    => AES+    -> AESGCMKey+    -> AES+    -> iv+    -> aad+    -> ba+    -> Int+    -> Int+    -> Ptr Word8+    -> Ptr Word8+    -> IO ()+gcmFullEncryptMask ctx (AESGCMKey gk) hpctx iv aad input taglen sampleoff outp maskp =+    B.withByteArray gk $ \gkp ->+        keyToPtr ctx $ \k ->+            keyToPtr hpctx $ \hk ->+                B.withByteArray iv $ \ivp ->+                    B.withByteArray aad $ \aadp ->+                        B.withByteArray input $ \inp ->+                            call+                                outp+                                (castPtr gkp)+                                k+                                ivp+                                (fromIntegral $ B.length iv)+                                aadp+                                (fromIntegral $ B.length aad)+                                inp+                                (fromIntegral $ B.length input)+                                (fromIntegral taglen)+                                hk+                                (fromIntegral sampleoff)+                                maskp+  where+    call+        | B.length input <= shortMessage = c_aes_gcm_full_encrypt_mask_unsafe+        | otherwise = c_aes_gcm_full_encrypt_mask++-- | The same the other way, with the tag compared here rather than by the+-- caller: 'Nothing' when it does not match, and every byte of it is looked at+-- either way.  The ciphertext comes in without its tag, which is given+-- separately.+{-# INLINABLE gcmFullDecrypt #-}+gcmFullDecrypt+    :: ( ByteArrayAccess iv+       , ByteArrayAccess aad+       , ByteArrayAccess ba+       , ByteArrayAccess tag+       , ByteArray output+       )+    => AES -> AESGCMKey -> iv -> aad -> ba -> tag -> Maybe output+gcmFullDecrypt ctx (AESGCMKey gk) iv aad input tag = unsafeDoIO $ do+    (r, out) <- B.allocRet (B.length input) $ \outp ->+        B.withByteArray gk $ \gkp ->+            keyToPtr ctx $ \k ->+                B.withByteArray iv $ \ivp ->+                    B.withByteArray aad $ \aadp ->+                        B.withByteArray input $ \inp ->+                            B.withByteArray tag $ \tagp ->+                                call+                                    outp+                                    (castPtr gkp)+                                    k+                                    ivp+                                    (fromIntegral $ B.length iv)+                                    aadp+                                    (fromIntegral $ B.length aad)+                                    inp+                                    (fromIntegral $ B.length input)+                                    tagp+                                    (fromIntegral $ B.length tag)+    return $ if r /= 0 then Just out else Nothing+  where+    call+        | B.length input <= shortMessage = c_aes_gcm_full_decrypt_unsafe+        | otherwise = c_aes_gcm_full_decrypt+ -- | append data which is only going to be authenticated to the GCM context. -- -- needs to happen after initialization and before appending encryption/decryption data.@@ -500,9 +653,11 @@ -- The tag length is expressed in bytes and must be in [0..16]. -- The IV length must be in [1..15] bytes per RFC 7253. {-# NOINLINE ocbInitWithTagLength #-}-ocbInitWithTagLength :: ByteArrayAccess iv => AES -> iv -> Int -> CryptoFailable AESOCB+ocbInitWithTagLength+    :: ByteArrayAccess iv => AES -> iv -> Int -> CryptoFailable AESOCB ocbInitWithTagLength ctx iv taglen-    | taglen < 0 || taglen > 16 = CryptoFailed CryptoError_AuthenticationTagSizeInvalid+    | taglen < 0 || taglen > 16 =+        CryptoFailed CryptoError_AuthenticationTagSizeInvalid     | ivlen < 1 || ivlen > 15 = CryptoFailed CryptoError_IvSizeInvalid     | otherwise = CryptoPassed $ unsafeDoIO $ do         sm <- B.alloc sizeOCB $ \ocbStPtr ->@@ -682,6 +837,101 @@ foreign import ccall "crypton_aes.h crypton_aes_encrypt_c32"     c_aes_encrypt_c32         :: CString -> Ptr AES -> Ptr Word8 -> CString -> CUInt -> IO ()++foreign import ccall unsafe "crypton_aes.h crypton_aes_gcm_key_init"+    c_aes_gcm_key_init :: Ptr AESGCM -> Ptr AES -> IO ()++foreign import ccall "crypton_aes.h crypton_aes_gcm_full_encrypt"+    c_aes_gcm_full_encrypt+        :: Ptr Word8+        -> Ptr AESGCM+        -> Ptr AES+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> CUInt+        -> IO ()++foreign import ccall "crypton_aes.h crypton_aes_gcm_full_decrypt"+    c_aes_gcm_full_decrypt+        :: Ptr Word8+        -> Ptr AESGCM+        -> Ptr AES+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> IO CInt++foreign import ccall unsafe "crypton_aes.h crypton_aes_gcm_full_encrypt"+    c_aes_gcm_full_encrypt_unsafe+        :: Ptr Word8+        -> Ptr AESGCM+        -> Ptr AES+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> CUInt+        -> IO ()++foreign import ccall unsafe "crypton_aes.h crypton_aes_gcm_full_decrypt"+    c_aes_gcm_full_decrypt_unsafe+        :: Ptr Word8+        -> Ptr AESGCM+        -> Ptr AES+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> IO CInt++foreign import ccall "crypton_aes.h crypton_aes_gcm_full_encrypt_mask"+    c_aes_gcm_full_encrypt_mask+        :: Ptr Word8+        -> Ptr AESGCM+        -> Ptr AES+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> CUInt+        -> Ptr AES+        -> CUInt+        -> Ptr Word8+        -> IO ()++foreign import ccall unsafe "crypton_aes.h crypton_aes_gcm_full_encrypt_mask"+    c_aes_gcm_full_encrypt_mask_unsafe+        :: Ptr Word8+        -> Ptr AESGCM+        -> Ptr AES+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> CUInt+        -> Ptr AES+        -> CUInt+        -> Ptr Word8+        -> IO ()  foreign import ccall "crypton_aes.h crypton_aes_gcm_init"     c_aes_gcm_init :: Ptr AESGCM -> Ptr AES -> Ptr Word8 -> CUInt -> IO ()

@@ -1,3 +1,5 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ -- | -- Module      : Crypto.Cipher.ChaChaPoly1305 -- License     : BSD-style@@ -28,7 +30,7 @@ -- >    -> ByteString -- input plaintext to be encrypted -- >    -> CryptoFailable ByteString -- ciphertext with a 128-bit tag attached -- >encrypt nonce key header plaintext = do--- >    st1 <- C.nonce12 nonce >>= C.initialize key+-- >    st1 <- C.initialize <$> C.key key <*> C.nonce12 nonce -- >    let -- >        st2 = C.finalizeAAD $ C.appendAAD header st1 -- >        (out, st3) = C.encrypt plaintext st2@@ -41,6 +43,8 @@      -- * Low level     State,+    Key,+    key,     Nonce,     XNonce,     nonce12,@@ -68,6 +72,7 @@  ) import qualified Crypto.Internal.ByteArray as B import Crypto.Internal.Imports+import qualified Crypto.Internal.Poly1305 as PolyKey import qualified Crypto.MAC.Poly1305 as Poly1305 import qualified Data.ByteArray.Pack as P import Data.Memory.Endian@@ -174,44 +179,39 @@ -- -- The key length need to be 256 bits, and the nonce -- procured using either `nonce8` or `nonce12`-initialize-    :: ByteArrayAccess key-    => key -> Nonce -> CryptoFailable State-initialize key (Nonce8 nonce) = initialize' key nonce-initialize key (Nonce12 nonce) = initialize' key nonce+-- | A ChaCha20Poly1305 key: thirty-two bytes, checked once here rather than+-- at every use, so that 'initialize' and 'initializeX' cannot fail.+newtype Key = Key ScrubbedBytes+    deriving (ByteArrayAccess, Eq, NFData) -initialize'-    :: ByteArrayAccess key-    => key -> Bytes -> CryptoFailable State-initialize' key nonce-    | B.length key /= 32 = CryptoFailed CryptoError_KeySizeInvalid-    | otherwise = CryptoPassed $ initFromRootState rootState-  where-    rootState = ChaCha.initialize 20 key nonce+-- | Take thirty-two bytes for a key.  A different length is reported as+-- 'CryptoError_KeySizeInvalid'; nothing else about a key can be wrong.+key :: ByteArrayAccess ba => ba -> CryptoFailable Key+key k+    | B.length k /= 32 = CryptoFailed CryptoError_KeySizeInvalid+    | otherwise = CryptoPassed $ Key $ B.convert k +initialize :: Key -> Nonce -> State+initialize k (Nonce8 nonce) = initialize' k nonce+initialize k (Nonce12 nonce) = initialize' k nonce++initialize' :: Key -> Bytes -> State+initialize' k nonce = initFromRootState (ChaCha.initialize 20 k nonce)+ initFromRootState :: ChaCha.State -> State initFromRootState rootState = State encState polyState 0 0   where     (polyKey, encState) = ChaCha.generate rootState 64-    -- 64 bytes are generated so the ChaCha state advances a whole block; the-    -- first 32 of them are the key, so the length is right by construction-    polyState =-        Poly1305.initialize $-            throwCryptoError $-                Poly1305.key (B.take 32 polyKey :: ScrubbedBytes)+    -- 64 bytes are generated so the ChaCha state advances a whole block, and+    -- the first 32 of them are the key, so there is no length left to check+    polyState = Poly1305.initialize (PolyKey.Key (B.take 32 polyKey))  -- | Initialize a new XChaChaPoly1305 State -- -- The key length needs to be 256 bits, and the nonce -- procured using `nonce24`.-initializeX-    :: ByteArrayAccess key-    => key -> XNonce -> CryptoFailable State-initializeX key (Nonce24 nonce)-    | B.length key /= 32 = CryptoFailed CryptoError_KeySizeInvalid-    | otherwise = CryptoPassed $ initFromRootState rootState-  where-    rootState = ChaCha.initializeX 20 key nonce+initializeX :: Key -> XNonce -> State+initializeX k (Nonce24 nonce) = initFromRootState (ChaCha.initializeX 20 k nonce)  -- | Append Authenticated Data to the State and return -- the new modified State.@@ -267,8 +267,8 @@ aeadChacha20poly1305Init     :: (ByteArrayAccess k, ByteArrayAccess n)     => k -> n -> CryptoFailable (AEAD ChaCha20Poly1305)-aeadChacha20poly1305Init key nonce = do-    st0 <- nonce12 nonce >>= initialize key+aeadChacha20poly1305Init k nonce = do+    st0 <- initialize <$> key k <*> nonce12 nonce     return $ AEAD model st0   where     model =

@@ -48,8 +48,10 @@     Blake2bp (..),     Blake2s (..),     Blake2sp (..),+    Skein256 (..),     Skein256_224 (..),     Skein256_256 (..),+    Skein512 (..),     Skein512_224 (..),     Skein512_256 (..),     Skein512_384 (..),

@@ -1,7 +1,11 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  -- | -- Module      : Crypto.Hash.Skein256@@ -13,14 +17,17 @@ -- Module containing the binding functions to work with the -- Skein256 cryptographic hash. module Crypto.Hash.Skein256 (+    Skein256 (..),     Skein256_224 (..),     Skein256_256 (..), ) where  import Crypto.Hash.Types+import Crypto.Internal.Nat import Data.Data import Data.Word (Word32, Word8) import Foreign.Ptr (Ptr)+import GHC.TypeLits (KnownNat, Nat, type (+))  -- | Skein256 (224 bits) cryptographic hash algorithm data Skein256_224 = Skein256_224@@ -51,6 +58,38 @@     hashInternalInit p = c_skein256_init p 256     hashInternalUpdate = c_skein256_update     hashInternalFinalize p = c_skein256_finalize p 256++-- | Skein256 with the digest size given as a type parameter of kind 'Nat',+-- in bits.  @t'Skein256' 256@ is @t'Skein256_256'@; the sizes with a type of+-- their own+-- above are there for their names, and this one also takes the sizes that+-- have none.+--+-- A size that is not a whole number of bytes is rounded up to the next one,+-- as the implementation underneath does.+--+-- The output is produced in counter mode, a block of it per Threefish call,+-- so one large digest is a good deal cheaper than the same number of bytes+-- taken from repeated small ones: on an Apple M4, 512 KiB arrives at 947 MB/s+-- in one digest against 172 MB/s as 8192 separate @t'Skein256_256'@ ones.+--+-- Note the digest size goes into the configuration block, so it changes the+-- value the message is hashed from: a longer digest is /not/ an extension of+-- a shorter one.  That is the opposite of how t'Crypto.Hash.SHAKE.SHAKE128'+-- behaves.+data Skein256 (bitlen :: Nat) = Skein256+    deriving (Show, Data)++instance KnownNat bitlen => HashAlgorithm (Skein256 bitlen) where+    type HashBlockSize (Skein256 bitlen) = 32+    type HashDigestSize (Skein256 bitlen) = Div8 (bitlen + 7)+    type HashInternalContextSize (Skein256 bitlen) = 96+    hashBlockSize _ = 32+    hashDigestSize _ = byteLen (Proxy :: Proxy bitlen)+    hashInternalContextSize _ = 96+    hashInternalInit p = c_skein256_init p (integralNatVal (Proxy :: Proxy bitlen))+    hashInternalUpdate = c_skein256_update+    hashInternalFinalize p = c_skein256_finalize p (integralNatVal (Proxy :: Proxy bitlen))  foreign import ccall unsafe "crypton_skein256_init"     c_skein256_init :: Ptr (Context a) -> Word32 -> IO ()

@@ -1,7 +1,11 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  -- | -- Module      : Crypto.Hash.Skein512@@ -13,6 +17,7 @@ -- Module containing the binding functions to work with the -- Skein512 cryptographic hash. module Crypto.Hash.Skein512 (+    Skein512 (..),     Skein512_224 (..),     Skein512_256 (..),     Skein512_384 (..),@@ -20,9 +25,11 @@ ) where  import Crypto.Hash.Types+import Crypto.Internal.Nat import Data.Data import Data.Word (Word32, Word8) import Foreign.Ptr (Ptr)+import GHC.TypeLits (KnownNat, Nat, type (+))  -- | Skein512 (224 bits) cryptographic hash algorithm data Skein512_224 = Skein512_224@@ -83,6 +90,38 @@     hashInternalInit p = c_skein512_init p 512     hashInternalUpdate = c_skein512_update     hashInternalFinalize p = c_skein512_finalize p 512++-- | Skein512 with the digest size given as a type parameter of kind 'Nat',+-- in bits.  @t'Skein512' 512@ is @t'Skein512_512'@; the sizes with a type of+-- their own+-- above are there for their names, and this one also takes the sizes that+-- have none.+--+-- A size that is not a whole number of bytes is rounded up to the next one,+-- as the implementation underneath does.+--+-- The output is produced in counter mode, a block of it per Threefish call,+-- so one large digest is a good deal cheaper than the same number of bytes+-- taken from repeated small ones: on an Apple M4, 512 KiB arrives at 947 MB/s+-- in one digest against 172 MB/s as 8192 separate @t'Skein512_512'@ ones.+--+-- Note the digest size goes into the configuration block, so it changes the+-- value the message is hashed from: a longer digest is /not/ an extension of+-- a shorter one.  That is the opposite of how t'Crypto.Hash.SHAKE.SHAKE128'+-- behaves.+data Skein512 (bitlen :: Nat) = Skein512+    deriving (Show, Data)++instance KnownNat bitlen => HashAlgorithm (Skein512 bitlen) where+    type HashBlockSize (Skein512 bitlen) = 64+    type HashDigestSize (Skein512 bitlen) = Div8 (bitlen + 7)+    type HashInternalContextSize (Skein512 bitlen) = 160+    hashBlockSize _ = 64+    hashDigestSize _ = byteLen (Proxy :: Proxy bitlen)+    hashInternalContextSize _ = 160+    hashInternalInit p = c_skein512_init p (integralNatVal (Proxy :: Proxy bitlen))+    hashInternalUpdate = c_skein512_update+    hashInternalFinalize p = c_skein512_finalize p (integralNatVal (Proxy :: Proxy bitlen))  foreign import ccall unsafe "crypton_skein512_init"     c_skein512_init :: Ptr (Context a) -> Word32 -> IO ()

@@ -0,0 +1,37 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- |+-- Module      : Crypto.Internal.Poly1305+-- License     : BSD-style+-- Maintainer  : Kazu Yamamoto <kazu@iij.ad.jp>+-- Stability   : experimental+-- Portability : unknown+--+-- The Poly1305 key with its constructor, for the modules here that build one+-- from bytes whose length they already know.  "Crypto.MAC.Poly1305" exports+-- the type without the constructor, so that outside this library a key can+-- only be made by 'key', which checks.+module Crypto.Internal.Poly1305 (+    Key (..),+    key,+) where++import Crypto.Error+import Crypto.Internal.ByteArray (ByteArrayAccess, ScrubbedBytes)+import qualified Crypto.Internal.ByteArray as B+import Crypto.Internal.DeepSeq++-- | A Poly1305 key: thirty-two bytes, and the length is checked here rather+-- than at every use.  'Crypto.MAC.Poly1305.initialize' and+-- 'Crypto.MAC.Poly1305.auth' take one of these and cannot fail, so a caller+-- that holds a key does not carry an error case for a length it already knows+-- is right.+newtype Key = Key ScrubbedBytes+    deriving (ByteArrayAccess, Eq, NFData)++-- | Take thirty-two bytes for a key.  A different length is reported as+-- 'CryptoError_MacKeyInvalid'; nothing else about a key can be wrong.+key :: ByteArrayAccess ba => ba -> CryptoFailable Key+key k+    | B.length k /= 32 = CryptoFailed CryptoError_MacKeyInvalid+    | otherwise = CryptoPassed $ Key $ B.convert k

@@ -35,6 +35,7 @@  ) import qualified Crypto.Internal.ByteArray as B import Crypto.Internal.DeepSeq+import Crypto.Internal.Poly1305 (Key (..), key) import Data.Word import Foreign.C.Types import Foreign.Ptr@@ -47,20 +48,6 @@ -- cryptographic algorithms. newtype State = State ScrubbedBytes     deriving (ByteArrayAccess)---- | A Poly1305 key: thirty-two bytes, and the length is checked here rather--- than at every use.  'initialize' and 'auth' take one of these and cannot--- fail, so a caller that holds a key does not carry an error case for a--- length it already knows is right.-newtype Key = Key ScrubbedBytes-    deriving (ByteArrayAccess, Eq, NFData)---- | Take thirty-two bytes for a key.  A different length is reported as--- 'CryptoError_MacKeyInvalid'; nothing else about a key can be wrong.-key :: ByteArrayAccess ba => ba -> CryptoFailable Key-key k-    | B.length k /= 32 = CryptoFailed CryptoError_MacKeyInvalid-    | otherwise = CryptoPassed $ Key $ B.convert k  -- | Poly1305 State. use State instead of Ctx type Ctx = State

@@ -13,6 +13,36 @@ If you have no idea what you're doing, please do not use this directly. Instead, rely on higher level protocols or implementations. +Side channels+-------------++AES is where this matters most, and which implementation runs is decided at+runtime from what the processor has.++On x86-64 with AES-NI and carry-less multiply, and on AArch64 with the ARMv8+cryptographic extension, AES and GHASH are instructions rather than tables.+crypton's AES and AES-GCM then make no branch and no memory access that+depends on the key or on the data: the secrets stay in vector registers and+never reach one a branch can test, which the generated code is checked+against.  Every x86-64 part since about 2010 and every AArch64 part in+ordinary use has these.++Where neither is present crypton falls back to a table-driven AES, which+indexes a 256-byte substitution table with data derived from the key and the+input.  **That is not constant time**, and on a machine where an attacker can+observe the cache it is open to a timing attack.  The fallback exists so that+the library builds and runs everywhere; it is not meant for a setting where+that matters.++`Crypto.System.CPU.processorOptions` says which is in use.  `AESNI` in that+list means the instruction path, and `PCLMUL` that GHASH has its instruction+too; without `AESNI` it is the tables.  The list also reports `RDRAND`, which+is unrelated to this.++    ghci> import Crypto.System.CPU+    ghci> processorOptions+    [AESNI,PCLMUL]+ Performance ----------- @@ -21,6 +51,17 @@ the public key operations are one operation each; every figure is the best of several runs, and crypton and OpenSSL are run alternately so that neither gets the quieter machine.++The columns read 2.0.0 and are what 2.1.0 measures on every row but two.  The+only C 2.1.0 changed is AES-GCM's and P-256's, and of those only P-256 is on+a path these tables take: measured on the same EPYC 7763, ECDH P-256 goes+164.3 to 159.5 microseconds and ECDSA P-256 verification 231.1 to 226.2, so+those two rows are about 3% better than they read here.  ECDSA P-256 signing+does not move, being the base-point path.  What 2.1.0 did to AES-GCM was add+a one-call interface beside the one measured here -- key expanded once,+additional data, payload and tag together -- which is worth 3.6 times at 100+bytes and nothing at 16 KiB, so it does not show in a 16 KiB throughput+figure at all.  Bulk encryption and hashing are measured through crypton's C layer, as `openssl speed` measures OpenSSL's.  The public key operations are measured

@@ -195,7 +195,9 @@   where     cp k (ini, plain) =         let iniState =-                throwCryptoError $ CP.initialize k (throwCryptoError $ CP.nonce12 nonce12)+                CP.initialize+                    (throwCryptoError $ CP.key k)+                    (throwCryptoError $ CP.nonce12 nonce12)             afterAAD = CP.finalizeAAD (CP.appendAAD ini iniState)             (out, afterEncrypt) = CP.encrypt plain afterAAD             outtag = CP.finalize afterEncrypt

@@ -396,3 +396,58 @@ #include <aes/armv8_impl.c> #undef SIZED #undef NBR++/*+ * The fused entry point, over the three key sizes.  Each was generated with+ * its round count fixed, which is what lets the eight chains stay in+ * registers; the choice between them is made once per message here.+ */+TARGET_ARMV8_CRYPTO+void crypton_aes_armv8_gcm_fused(uint8_t *out, const block128 *ht,+                                 aes_key *key, const uint8_t *nonce,+                                 const uint8_t *aad, uint32_t aadlen,+                                 const uint8_t *in, uint32_t inlen,+                                 uint32_t taglen, aes_key *hpkey,+                                 uint32_t sampleoff, uint8_t *mask)+{+	switch (key->strength) {+	case 0:+		crypton_aes_armv8_gcm_fused128(out, ht, key, nonce, aad, aadlen,+		                               in, inlen, taglen, hpkey,+		                               sampleoff, mask);+		break;+	case 1:+		crypton_aes_armv8_gcm_fused192(out, ht, key, nonce, aad, aadlen,+		                               in, inlen, taglen, hpkey,+		                               sampleoff, mask);+		break;+	default:+		crypton_aes_armv8_gcm_fused256(out, ht, key, nonce, aad, aadlen,+		                               in, inlen, taglen, hpkey,+		                               sampleoff, mask);+		break;+	}+}++TARGET_ARMV8_CRYPTO+int crypton_aes_armv8_gcm_fused_dec(uint8_t *out, const block128 *ht,+                                    aes_key *key, const uint8_t *nonce,+                                    const uint8_t *aad, uint32_t aadlen,+                                    const uint8_t *in, uint32_t inlen,+                                    const uint8_t *tag, uint32_t taglen)+{+	switch (key->strength) {+	case 0:+		return crypton_aes_armv8_gcm_fused_dec128(out, ht, key, nonce,+		                                          aad, aadlen, in, inlen,+		                                          tag, taglen);+	case 1:+		return crypton_aes_armv8_gcm_fused_dec192(out, ht, key, nonce,+		                                          aad, aadlen, in, inlen,+		                                          tag, taglen);+	default:+		return crypton_aes_armv8_gcm_fused_dec256(out, ht, key, nonce,+		                                          aad, aadlen, in, inlen,+		                                          tag, taglen);+	}+}

@@ -523,6 +523,224 @@ 	} } +/*+ * One message, one call: the additional data, the counter-mode encryption,+ * the tag and the QUIC header protection mask, with the running tag and the+ * counter kept in registers from end to end.+ *+ * What this saves over composing crypton_aes_gcm_aad, _encrypt and _finish is+ * not the arithmetic but the boundaries.  Each of those reaches its+ * primitives through a branch table, so the 128-bit state goes back to memory+ * at every step and a header of one block pays a reduction of its own.  On an+ * Apple M4 that framing was 0.07 of the 0.112 microseconds a 100-byte packet+ * cost -- more than the encryption of the packet itself.+ *+ * The GHASH is taken in batches of WAY against the powers of H the key+ * already holds, so a batch costs one reduction rather than one per block,+ * and the additional data and the length block ride in the same batches as+ * the ciphertext instead of being multiplied on their own.+ */++/* start a batch, or continue one; blen is how many blocks this batch holds */+#define FG_ABSORB(blk)                                                        \+	do {                                                                  \+		uint8x16_t b_ = (blk), l_, h_;                                \+		if (bn == 0) {                                                \+			uint32_t left_ = gtotal - gidx;                       \+			blen = left_ < WAY ? left_ : WAY;                     \+			b_ = veorq_u8(b_, tag);                               \+			glo = vdupq_n_u8(0);                                  \+			ghi = vdupq_n_u8(0);                                  \+		}                                                             \+		clmul_pmull(b_, vld1q_u8((const uint8_t *) &ht[blen - bn - 1]), \+		            &l_, &h_);                                        \+		glo = veorq_u8(glo, l_);                                      \+		ghi = veorq_u8(ghi, h_);                                      \+		gidx++; bn++;                                                 \+		if (bn == blen) { tag = gfred_pmull(glo, ghi); bn = 0; }      \+	} while (0)++/* a block that is short, zero padded, as GHASH wants it */+#define FG_PARTIAL(p, n)                                                      \+	({ uint8_t buf_[16]; memset(buf_, 0, 16); memcpy(buf_, (p), (n));     \+	   vld1q_u8(buf_); })++TARGET_ARMV8_CRYPTO+void SIZED(crypton_aes_armv8_gcm_fused)(uint8_t *out, const block128 *ht,+                                        aes_key *key, const uint8_t *nonce,+                                        const uint8_t *aad, uint32_t aadlen,+                                        const uint8_t *in, uint32_t inlen,+                                        uint32_t taglen, aes_key *hpkey,+                                        uint32_t sampleoff, uint8_t *mask)+{+	const uint8_t *rk = FWD(key);+	uint8x16_t s[WAY];+	uint8x16_t tag = vdupq_n_u8(0), glo = tag, ghi = tag, ek0;+	uint32x4_t base;+	uint32_t c = 1, bn = 0, blen = 0, gidx = 0;+	uint32_t gtotal = (aadlen + 15) / 16 + (inlen + 15) / 16 + 1;+	uint32_t i, done;+	uint8_t y0[16], lenb[16];+	uint64_t la, lc;++	memcpy(y0, nonce, 12);+	y0[12] = 0; y0[13] = 0; y0[14] = 0; y0[15] = 1;+	base = vreinterpretq_u32_u8(vld1q_u8(y0));++	s[0] = vld1q_u8(y0);+	ENC_ROUNDS(EACH1);+	ek0 = s[0];++	for (i = 0; i + 16 <= aadlen; i += 16)+		FG_ABSORB(vld1q_u8(aad + i));+	if (i < aadlen)+		FG_ABSORB(FG_PARTIAL(aad + i, aadlen - i));++	for (done = 0; done + 16 * WAY <= inlen; done += 16 * WAY) {+		const uint8_t *p = in + done;+		uint8_t *q = out + done;++		EACH8(GCM_CTR);+		c += WAY;+		ENC_ROUNDS(EACH8);+		{+			const uint8_t *input = p;+			uint8_t *output = q;+			EACH8(GCM_ENC);+		}+		FG_ABSORB(s[0]); FG_ABSORB(s[1]); FG_ABSORB(s[2]); FG_ABSORB(s[3]);+		FG_ABSORB(s[4]); FG_ABSORB(s[5]); FG_ABSORB(s[6]); FG_ABSORB(s[7]);+	}++	for (; done < inlen; done += 16) {+		uint32_t n = inlen - done < 16 ? inlen - done : 16;+		uint8x16_t m_ = n == 16 ? vld1q_u8(in + done)+		                        : FG_PARTIAL(in + done, n);+		c++;+		s[0] = vreinterpretq_u8_u32(vsetq_lane_u32(cpu_to_be32(c), base, 3));+		ENC_ROUNDS(EACH1);+		s[0] = veorq_u8(s[0], m_);+		if (n == 16) {+			vst1q_u8(out + done, s[0]);+		} else {+			uint8_t buf_[16];+			vst1q_u8(buf_, s[0]);+			memcpy(out + done, buf_, n);+			memset(buf_ + n, 0, 16 - n);+			s[0] = vld1q_u8(buf_);+		}+		FG_ABSORB(s[0]);+	}++	la = (uint64_t) aadlen << 3;+	lc = (uint64_t) inlen << 3;+	for (i = 0; i < 8; i++) lenb[i] = (uint8_t) (la >> (56 - 8 * i));+	for (i = 0; i < 8; i++) lenb[8 + i] = (uint8_t) (lc >> (56 - 8 * i));+	FG_ABSORB(vld1q_u8(lenb));++	{+		uint8_t tbuf[16];+		vst1q_u8(tbuf, veorq_u8(tag, ek0));+		memcpy(out + inlen, tbuf, taglen);+	}++	if (hpkey != 0 && mask != 0) {+		block128 sample, m;+		memcpy(&sample, out + sampleoff, 16);+		crypton_aes_encrypt_ecb(&m, hpkey, &sample, 1);+		memcpy(mask, &m, 16);+	}+}+++/*+ * The same for decryption.  GCM_DEC leaves the ciphertext in s[] once it has+ * written the plaintext out, which is what GHASH wants, so the only other+ * difference is the end: the tag is compared here rather than written, every+ * byte of it whichever way the answer goes.+ */+TARGET_ARMV8_CRYPTO+int SIZED(crypton_aes_armv8_gcm_fused_dec)(uint8_t *out, const block128 *ht,+                                           aes_key *key, const uint8_t *nonce,+                                           const uint8_t *aad, uint32_t aadlen,+                                           const uint8_t *in, uint32_t inlen,+                                           const uint8_t *tagp, uint32_t taglen)+{+	const uint8_t *rk = FWD(key);+	uint8x16_t s[WAY];+	uint8x16_t tag = vdupq_n_u8(0), glo = tag, ghi = tag, ek0;+	uint32x4_t base;+	uint32_t c = 1, bn = 0, blen = 0, gidx = 0;+	uint32_t gtotal = (aadlen + 15) / 16 + (inlen + 15) / 16 + 1;+	uint32_t i, done;+	uint8_t y0[16], lenb[16], want[16];+	uint64_t la, lc;+	uint8_t diff = 0;++	memcpy(y0, nonce, 12);+	y0[12] = 0; y0[13] = 0; y0[14] = 0; y0[15] = 1;+	base = vreinterpretq_u32_u8(vld1q_u8(y0));++	s[0] = vld1q_u8(y0);+	ENC_ROUNDS(EACH1);+	ek0 = s[0];++	for (i = 0; i + 16 <= aadlen; i += 16)+		FG_ABSORB(vld1q_u8(aad + i));+	if (i < aadlen)+		FG_ABSORB(FG_PARTIAL(aad + i, aadlen - i));++	for (done = 0; done + 16 * WAY <= inlen; done += 16 * WAY) {+		const uint8_t *p = in + done;+		uint8_t *q = out + done;++		EACH8(GCM_CTR);+		c += WAY;+		ENC_ROUNDS(EACH8);+		{+			const uint8_t *input = p;+			uint8_t *output = q;+			EACH8(GCM_DEC);+		}+		FG_ABSORB(s[0]); FG_ABSORB(s[1]); FG_ABSORB(s[2]); FG_ABSORB(s[3]);+		FG_ABSORB(s[4]); FG_ABSORB(s[5]); FG_ABSORB(s[6]); FG_ABSORB(s[7]);+	}++	for (; done < inlen; done += 16) {+		uint32_t n = inlen - done < 16 ? inlen - done : 16;+		uint8x16_t m_ = n == 16 ? vld1q_u8(in + done)+		                        : FG_PARTIAL(in + done, n);+		c++;+		s[0] = vreinterpretq_u8_u32(vsetq_lane_u32(cpu_to_be32(c), base, 3));+		ENC_ROUNDS(EACH1);+		{+			uint8x16_t pl = veorq_u8(s[0], m_);+			if (n == 16) {+				vst1q_u8(out + done, pl);+			} else {+				uint8_t buf_[16];+				vst1q_u8(buf_, pl);+				memcpy(out + done, buf_, n);+			}+		}+		FG_ABSORB(m_);+	}++	la = (uint64_t) aadlen << 3;+	lc = (uint64_t) inlen << 3;+	for (i = 0; i < 8; i++) lenb[i] = (uint8_t) (la >> (56 - 8 * i));+	for (i = 0; i < 8; i++) lenb[8 + i] = (uint8_t) (lc >> (56 - 8 * i));+	FG_ABSORB(vld1q_u8(lenb));++	vst1q_u8(want, veorq_u8(tag, ek0));+	for (i = 0; i < taglen; i++)+		diff |= (uint8_t) (want[i] ^ tagp[i]);+	return diff == 0;+}++#undef FG_ABSORB+#undef FG_PARTIAL+ #undef WAY #undef EACH1 #undef EACH7

@@ -0,0 +1,988 @@+/*+ * A fused AES-GCM for x86-64, written to the design Kazuho Oku sets out in+ * "QUICむけにAES-GCM実装を最適化した話": keep AES-NI issuing every clock and+ * fit everything else -- the additional data, the tag, the QUIC header+ * protection mask -- into the gaps it leaves.  Written in C with intrinsics+ * rather than assembly, for the same reason he gives: the scheduling is what+ * is complicated here, and it has to stay readable to stay correct.+ *+ * The powers of H are built once per key, so the additional data, the+ * ciphertext and the length block are absorbed against them in batches that+ * share one reduction, rather than each block paying for a reduction of its+ * own.  How many powers, and so how large a batch, is+ * CRYPTON_GCM_FUSED_POWERS in crypton_aes.h.+ *+ * Only messages shorter than CRYPTON_GCM_FUSED_MAX_MESSAGE come here.  Above+ * that the stitched assembly in cbits/asm is faster, and crypton_aes.c sends+ * them there instead; below it, that assembly will not start at all.+ */++#include <crypton_cpu.h>++#ifdef WITH_GCM_FUSED++#include <stdint.h>+#include <string.h>+#include <wmmintrin.h>+#include <smmintrin.h>+#include <tmmintrin.h>++#include <crypton_aes.h>+#include <aes/gcm_fused_x86.h>++/*+ * aes_key is a struct of bytes, so its round keys sit wherever the members+ * before them leave them -- eight bytes in, as it happens.  A __m128i *+ * pointed at that gets an aligned load and a fault, so each round key is+ * fetched with an unaligned load instead.  Copying them somewhere aligned+ * would cost a copy per call, which at these message lengths is a tenth of+ * the whole; the load is free from L1 and the round key is fetched once for+ * all six lanes.+ */+#define RK(p, i) \+    _mm_loadu_si128((const __m128i *) ((const uint8_t *) (p) + 16 * (size_t) (i)))++/* a full sixteen-byte reversal: mask bytes 15,14,...,0 */+static const __m128i BSWAP = {0x08090a0b0c0d0e0fLL, 0x0001020304050607LL};+++#define TGT __attribute__((target("aes,pclmul,sse4.1")))++/* the two halves of a value added together: the term Karatsuba needs, and it+ * does not depend on what the value is multiplied by */+TGT static inline __m128i fold(__m128i a)+{+    return _mm_xor_si128(a, _mm_unpackhi_epi64(a, a));+}++/* GCM numbers the bits of a field element the other way round from the way+ * the carry-less multiply does.  Pre-shifting H is what saves the correction+ * after every multiply; the bit that falls off the top is the one the+ * polynomial reduces. */+TGT static __m128i twist(__m128i h)+{+    const __m128i poly = _mm_set_epi64x(0xc200000000000000ULL, 1);+    __m128i carried = _mm_slli_si128(_mm_srli_epi64(h, 63), 8);+    __m128i top = _mm_shuffle_epi32(h, 0xff);+    __m128i reduce = _mm_cmpgt_epi32(_mm_setzero_si128(), top);++    h = _mm_or_si128(_mm_slli_epi64(h, 1), carried);+    return _mm_xor_si128(h, _mm_and_si128(reduce, poly));+}++/* one reduction of a 256-bit product back into the field */+TGT static __m128i reduce256(__m128i lo, __m128i hi)+{+    const __m128i poly = _mm_set_epi64x(0xc200000000000000ULL, 1);+    __m128i t;++    t = _mm_clmulepi64_si128(lo, poly, 0x10);+    lo = _mm_xor_si128(_mm_shuffle_epi32(lo, 0x4e), t);+    t = _mm_clmulepi64_si128(lo, poly, 0x10);+    lo = _mm_xor_si128(_mm_shuffle_epi32(lo, 0x4e), t);+    return _mm_xor_si128(hi, lo);+}++/*+ * One multiply in exactly the form the hot loop uses it: the left operand+ * plain, the right one already twisted.  Building the table with the same+ * multiply that consumes it is the only way the two conventions cannot drift+ * apart.+ */+TGT static __m128i mul_twisted(__m128i a, __m128i ht)+{+    __m128i lo = _mm_clmulepi64_si128(a, ht, 0x00);+    __m128i hi = _mm_clmulepi64_si128(a, ht, 0x11);+    __m128i mid = _mm_clmulepi64_si128(fold(a), fold(ht), 0x00);++    mid = _mm_xor_si128(mid, _mm_xor_si128(lo, hi));+    lo = _mm_xor_si128(lo, _mm_slli_si128(mid, 8));+    hi = _mm_xor_si128(hi, _mm_srli_si128(mid, 8));+    return reduce256(lo, hi);+}++TGT void crypton_gcm_fused_key_init(aes_gcm_fused *fk, const aes_key *key)+{+    const uint8_t *rk = key->data;+    const int rounds = key->nbr;+    __m128i h, p;+    int i;++    /* H = E_K(0) */+    h = RK(rk, 0);+    for (i = 1; i < rounds; i++) h = _mm_aesenc_si128(h, RK(rk, i));+    h = _mm_aesenclast_si128(h, RK(rk, rounds));+    h = _mm_shuffle_epi8(h, BSWAP);++    {+        __m128i ht = twist(h);+        p = h;+        for (i = 0; i < CRYPTON_GCM_FUSED_POWERS; i++) {+            __m128i t = twist(p);+            _mm_storeu_si128((__m128i *) &fk->p[i].h, t);+            _mm_storeu_si128((__m128i *) &fk->p[i].r, fold(t));+            p = mul_twisted(p, ht);+        }+    }+}++/*+ * The running product.  Three plain locals and a macro, not a struct behind+ * a pointer: taking the address of the accumulators is enough to keep them+ * out of registers, and then every multiply reloads and restores them.  That+ * is the same mistake as reaching a table through an index the compiler+ * cannot fold, and it costs more here because it is on the inner path.+ */+#define GHASH_DECL __m128i glo = _mm_setzero_si128(),                        \+                            ghi = _mm_setzero_si128(),                       \+                            gmid = _mm_setzero_si128(),                      \+                            gtag = _mm_setzero_si128();                      \+                   int gidx = 0, gblen = 0, gbpos = 0++/*+ * Absorb one block.  Blocks are taken in batches of at most CRYPTON_GCM_FUSED_POWERS: the+ * first of a batch carries in the value the batch before it reduced to, the+ * rest go in against descending powers, and the batch ends with the one+ * reduction they share.  With the batch as long as the message this is+ * picotls's single reduction; with it fixed, the state stays a fixed size.+ */+#define GHASH_ONE(blk, unused_power)                                         \+    do {                                                                     \+        __m128i _b = (blk);                                                  \+        __m128i _h, _r;                                                      \+        if (gbpos == 0) {                                                    \+            int _left = gtotal - gidx;                                       \+            gblen = _left < CRYPTON_GCM_FUSED_POWERS ? _left : CRYPTON_GCM_FUSED_POWERS;             \+            _b = _mm_xor_si128(_b, gtag);                                    \+            glo = ghi = gmid = _mm_setzero_si128();                          \+        }                                                                    \+        _h = _mm_loadu_si128((const __m128i *) &fk->p[gblen-gbpos-1].h);     \+        _r = _mm_loadu_si128((const __m128i *) &fk->p[gblen-gbpos-1].r);     \+        glo = _mm_xor_si128(glo, _mm_clmulepi64_si128(_b, _h, 0x00));        \+        ghi = _mm_xor_si128(ghi, _mm_clmulepi64_si128(_b, _h, 0x11));        \+        gmid = _mm_xor_si128(gmid,                                           \+                   _mm_clmulepi64_si128(fold(_b), _r, 0x00));                \+        gidx++; gbpos++;                                                     \+        if (gbpos == gblen) {                                                \+            gtag = ghash_reduce(glo, ghi, gmid);                             \+            gbpos = 0;                                                       \+        }                                                                    \+    } while (0)++TGT static __m128i ghash_reduce(__m128i glo, __m128i ghi, __m128i gmid)+{+    __m128i mid = _mm_xor_si128(gmid, _mm_xor_si128(glo, ghi));+    __m128i lo = _mm_xor_si128(glo, _mm_slli_si128(mid, 8));+    __m128i hi = _mm_xor_si128(ghi, _mm_srli_si128(mid, 8));++    return reduce256(lo, hi);+}++/* zero every byte from n onwards, so a partial block can be fed to GHASH+ * without being written out and read back */+TGT static __m128i clampn(__m128i v, size_t n)+{+    const __m128i idx = {0x0706050403020100LL, 0x0f0e0d0c0b0a0908LL};+    return _mm_and_si128(v, _mm_cmpgt_epi8(_mm_set1_epi8((char) n), idx));+}++/*+ * A short block, zero padded, without going through the stack.+ *+ * The obvious way -- zero sixteen bytes, copy n in, load them back -- is+ * three trips to memory with a store the load has to wait for, and at these+ * lengths that is a tenth of the whole call.  Reading the sixteen bytes and+ * masking off what is above n is two instructions, but it reads past the end+ * of what the caller gave, so it has to be sure those bytes exist.+ *+ * They do unless the block ends a page.  A load of sixteen bytes that starts+ * at least sixteen from the end of a page stays inside it; and if the n bytes+ * asked for themselves cross the boundary then the next page is there to be+ * read as well.  What is left is a block near the end of a page whose own+ * bytes stop short of it, and that is read aligned -- which cannot leave the+ * page -- and shuffled down.  This is how picotls's fusion does it.+ */++/* thirty-two bytes of ones, then thirty-one of zeros: sixteen loaded from+ * 32 - n give n bytes of ones and the rest zeros */+static const uint8_t loadn_mask[63] = {+    0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,+    0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,+    0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,+    0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff};++/* the first sixteen map to byte offsets, the rest to zero */+static const uint8_t loadn_shuffle[31] = {+    0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07,+    0x08, 0x09, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f,+    0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80,+    0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80};++#if defined(__has_feature)+#if __has_feature(address_sanitizer)+#define NO_ASAN __attribute__((no_sanitize_address))+#endif+#elif defined(__SANITIZE_ADDRESS__)+#define NO_ASAN __attribute__((no_sanitize_address))+#endif+#ifndef NO_ASAN+#define NO_ASAN+#endif++TGT NO_ASAN static __m128i loadn_page_end(const uint8_t *p, size_t n)+{+    uintptr_t shift = (uintptr_t) p & 15;+    __m128i pattern = _mm_loadu_si128((const __m128i *) (loadn_shuffle + shift));++    (void) n;+    return _mm_shuffle_epi8(+        _mm_load_si128((const __m128i *) ((uintptr_t) p - shift)), pattern);+}++TGT NO_ASAN static __m128i loadn(const uint8_t *p, size_t n)+{+    __m128i mask = _mm_loadu_si128((const __m128i *) (loadn_mask + 32 - n));+    uintptr_t mod4k = (uintptr_t) p % 4096;+    __m128i v;++    if (mod4k <= 4096 - 16 || mod4k + n > 4096)+        v = _mm_loadu_si128((const __m128i *) p);+    else+        v = loadn_page_end(p, n);+    return _mm_and_si128(v, mask);+}++TGT static void storen(uint8_t *p, __m128i v, size_t n)+{+    uint8_t buf[16];+    _mm_storeu_si128((__m128i *) buf, v);+    memcpy(p, buf, n);+}++/* One block.  The ten rounds of the common case are written out for the+ * same reason the six-wide group is: a loop over a round count that lives in+ * the key leaves every round key fetched through an index the compiler+ * cannot fold, and adds a branch to a chain that is already latency-bound. */+TGT static __m128i aes_one_block(const uint8_t *rk, int rounds, __m128i v)+{+    const uint8_t *k = rk;+    int i;++    if (rounds == 10) {+        v = _mm_xor_si128(v, RK(k, 0));+        v = _mm_aesenc_si128(v, RK(k, 1));+        v = _mm_aesenc_si128(v, RK(k, 2));+        v = _mm_aesenc_si128(v, RK(k, 3));+        v = _mm_aesenc_si128(v, RK(k, 4));+        v = _mm_aesenc_si128(v, RK(k, 5));+        v = _mm_aesenc_si128(v, RK(k, 6));+        v = _mm_aesenc_si128(v, RK(k, 7));+        v = _mm_aesenc_si128(v, RK(k, 8));+        v = _mm_aesenc_si128(v, RK(k, 9));+        return _mm_aesenclast_si128(v, RK(k, 10));+    }+    v = _mm_xor_si128(v, RK(k, 0));+    for (i = 1; i < rounds; i++) v = _mm_aesenc_si128(v, RK(k, i));+    return _mm_aesenclast_si128(v, RK(k, rounds));+}++/*+ * Six blocks at once, with lane 5 free to run a different key schedule from+ * the rest.  Which schedule that lane uses is chosen once, into a pointer,+ * rather than tested inside the rounds, and the six live in named variables+ * rather than an array -- an array indexed by a running variable goes to+ * memory, and then every round is a load and a store instead of a register+ * to register operation, which is the whole of what this is trying to avoid.+ *+ * Lanes beyond what the caller needs still run.  Six are in flight whatever+ * the message length, so the spare ones cost nothing, and that is exactly+ * why the header protection mask and E(K,Y0) are worth putting in them+ * instead of giving each a dependent chain of its own.+ */+#define WIDE6(alt)                                                           \+    do {                                                                     \+        const uint8_t *ak = (alt);                                           \+        int r;                                                               \+        t0 = _mm_xor_si128(t0, RK(rk, 0));                                   \+        t1 = _mm_xor_si128(t1, RK(rk, 0));                                   \+        t2 = _mm_xor_si128(t2, RK(rk, 0));                                   \+        t3 = _mm_xor_si128(t3, RK(rk, 0));                                   \+        t4 = _mm_xor_si128(t4, RK(rk, 0));                                   \+        t5 = _mm_xor_si128(t5, RK(ak, 0));                                       \+        for (r = 1; r < rounds; r++) {                                   \+            __m128i k = RK(rk, r);                                           \+            t0 = _mm_aesenc_si128(t0, k);                                    \+            t1 = _mm_aesenc_si128(t1, k);                                    \+            t2 = _mm_aesenc_si128(t2, k);                                    \+            t3 = _mm_aesenc_si128(t3, k);                                    \+            t4 = _mm_aesenc_si128(t4, k);                                    \+            t5 = _mm_aesenc_si128(t5, RK(ak, r));                                \+            GSTEP();                                                         \+        }                                                                    \+        {                                                                    \+            __m128i k = RK(rk, rounds);                                  \+            t0 = _mm_aesenclast_si128(t0, k);                                \+            t1 = _mm_aesenclast_si128(t1, k);                                \+            t2 = _mm_aesenclast_si128(t2, k);                                \+            t3 = _mm_aesenclast_si128(t3, k);                                \+            t4 = _mm_aesenclast_si128(t4, k);                                \+            t5 = _mm_aesenclast_si128(t5, RK(ak, rounds));                   \+        }                                                                    \+    } while (0)++/* the same with nothing queued to absorb: the decryption side takes its+ * GHASH straight from the input and has no queue to drain */+#define WIDE6_NOQ(alt)                                                           \+    do {                                                                     \+        const uint8_t *ak = (alt);                                           \+        int r;                                                               \+        t0 = _mm_xor_si128(t0, RK(rk, 0));                                   \+        t1 = _mm_xor_si128(t1, RK(rk, 0));                                   \+        t2 = _mm_xor_si128(t2, RK(rk, 0));                                   \+        t3 = _mm_xor_si128(t3, RK(rk, 0));                                   \+        t4 = _mm_xor_si128(t4, RK(rk, 0));                                   \+        t5 = _mm_xor_si128(t5, RK(ak, 0));                                       \+        for (r = 1; r < rounds; r++) {                                   \+            __m128i k = RK(rk, r);                                           \+            t0 = _mm_aesenc_si128(t0, k);                                    \+            t1 = _mm_aesenc_si128(t1, k);                                    \+            t2 = _mm_aesenc_si128(t2, k);                                    \+            t3 = _mm_aesenc_si128(t3, k);                                    \+            t4 = _mm_aesenc_si128(t4, k);                                    \+            t5 = _mm_aesenc_si128(t5, RK(ak, r));                                \+        }                                                                    \+        {                                                                    \+            __m128i k = RK(rk, rounds);                                  \+            t0 = _mm_aesenclast_si128(t0, k);                                \+            t1 = _mm_aesenclast_si128(t1, k);                                \+            t2 = _mm_aesenclast_si128(t2, k);                                \+            t3 = _mm_aesenclast_si128(t3, k);                                \+            t4 = _mm_aesenclast_si128(t4, k);                                \+            t5 = _mm_aesenclast_si128(t5, RK(ak, rounds));                   \+        }                                                                    \+    } while (0)++/*+ * The same written out for the ten rounds of AES-128, with a slot for one+ * queued multiply between each of the first six.  The loop above cannot take+ * them: the round count is a value in the key, so there is no place the+ * compiler knows is a round apart from the next, and a test before each+ * multiply would end the basic block the scheduler works inside.  This pass+ * runs with a group's multiplies still waiting, and on a short message that+ * is most of what it has to do.+ */+#define WROUND6(r, ak)                                                       \+    do {                                                                     \+        __m128i k = RK(rk, r);                                               \+        t0 = _mm_aesenc_si128(t0, k);                                        \+        t1 = _mm_aesenc_si128(t1, k);                                        \+        t2 = _mm_aesenc_si128(t2, k);                                        \+        t3 = _mm_aesenc_si128(t3, k);                                        \+        t4 = _mm_aesenc_si128(t4, k);                                        \+        t5 = _mm_aesenc_si128(t5, RK(ak, r));                                \+    } while (0)++#define WIDE6_10(alt)                                                        \+    do {                                                                     \+        const uint8_t *ak = (alt);                                           \+        t0 = _mm_xor_si128(t0, RK(rk, 0));                                   \+        t1 = _mm_xor_si128(t1, RK(rk, 0));                                   \+        t2 = _mm_xor_si128(t2, RK(rk, 0));                                   \+        t3 = _mm_xor_si128(t3, RK(rk, 0));                                   \+        t4 = _mm_xor_si128(t4, RK(rk, 0));                                   \+        t5 = _mm_xor_si128(t5, RK(ak, 0));                                   \+        WROUND6(1, ak); GAT(0);                                              \+        WROUND6(2, ak); GAT(1);                                              \+        WROUND6(3, ak); GAT(2);                                              \+        WROUND6(4, ak); GAT(3);                                              \+        WROUND6(5, ak); GAT(4);                                              \+        WROUND6(6, ak); GAT(5);                                              \+        WROUND6(7, ak);                                                      \+        WROUND6(8, ak);                                                      \+        WROUND6(9, ak);                                                      \+        {                                                                    \+            __m128i k = RK(rk, 10);                                          \+            t0 = _mm_aesenclast_si128(t0, k);                                \+            t1 = _mm_aesenclast_si128(t1, k);                                \+            t2 = _mm_aesenclast_si128(t2, k);                                \+            t3 = _mm_aesenclast_si128(t3, k);                                \+            t4 = _mm_aesenclast_si128(t4, k);                                \+            t5 = _mm_aesenclast_si128(t5, RK(ak, 10));                       \+        }                                                                    \+    } while (0)++/*+ * v2: six blocks of AES in flight at once, so the ten rounds of one block no+ * longer wait on each other -- AES-NI is pipelined and will take one+ * instruction a clock as long as the instructions in flight are independent.+ * The GHASH multiplies of the group just finished are issued between the+ * rounds of the group now running, which is the stitching: they do not want+ * the same execution port, so held against each other they cost about what+ * the rounds alone cost.+ */++/*+ * The counter block, built without leaving the vector registers.+ *+ * GCM counts in the low 32 bits of the block, big endian, and wraps there.+ * ctr holds the block with its bytes reversed, so those four bytes are the+ * low lane and _mm_add_epi32 steps them without carrying into the nonce+ * above -- which is the wrap GCM asks for.  A shuffle puts the bytes back.+ *+ * The obvious way -- increment a uint32_t, byte swap it, pinsrd it in --+ * costs a move from a general register to a vector one for every lane, six+ * to a group, and those do not come free.+ */+#define CTR6(j)                                                              \+    do {                                                                     \+        ctr = _mm_add_epi32(ctr, one32);                                     \+        b##j = _mm_xor_si128(_mm_shuffle_epi8(ctr, BSWAP), RK(rk, 0));       \+    } while (0)++#define ROUND6(r)                                                            \+    do {                                                                     \+        __m128i k = RK(rk, r);                                               \+        b0 = _mm_aesenc_si128(b0, k);                                        \+        b1 = _mm_aesenc_si128(b1, k);                                        \+        b2 = _mm_aesenc_si128(b2, k);                                        \+        b3 = _mm_aesenc_si128(b3, k);                                        \+        b4 = _mm_aesenc_si128(b4, k);                                        \+        b5 = _mm_aesenc_si128(b5, k);                                        \+    } while (0)++#define LAST6(r)                                                             \+    do {                                                                     \+        __m128i k = RK(rk, r);                                               \+        b0 = _mm_aesenclast_si128(b0, k);                                    \+        b1 = _mm_aesenclast_si128(b1, k);                                    \+        b2 = _mm_aesenclast_si128(b2, k);                                    \+        b3 = _mm_aesenclast_si128(b3, k);                                    \+        b4 = _mm_aesenclast_si128(b4, k);                                    \+        b5 = _mm_aesenclast_si128(b5, k);                                    \+    } while (0)++/* one GHASH multiply, taken from a queue of blocks waiting to be absorbed,+ * to be issued in the gaps between AES rounds */+/* A ring, so that a block queued while others are still waiting costs an+ * index and not a move: the queue is walked from both ends and never+ * compacted. */+#define GQ_MASK 15++#define GPUSH(v)                                                             \+    do { gq[gw] = (v); gw++; gn++; } while (0)++#define GSTEP()                                                              \+    do {                                                                     \+        if (gn > 0) {                                                        \+            GHASH_ONE(gq[gi], gp);                                   \+            gi++; gp--; gn--;                                                \+        }                                                                    \+    } while (0)++/* the same at a slot the compiler can see, for the unrolled group below */+/*+ * One queued block, at a slot the compiler can see and with nothing to test+ * before it.  A test here would end the basic block, and the scheduler works+ * inside one: six tests turn the group into twelve blocks and the multiplies+ * can no longer be moved up among the rounds, which is the whole point of+ * writing them there.  The group below is entered only when the queue is+ * full, so there is nothing to test.+ */+/*+ * The block a slot names, read from the output where the group before it+ * left the ciphertext rather than from a copy kept beside it.  The copy+ * cost six stores a group for bytes already in memory; picotls's fusion+ * points its GHASH at the output it has just written for the same reason.+ */+#define GAT(j) GHASH_ONE(_mm_shuffle_epi8(                                   \+        _mm_loadu_si128((const __m128i *) (prev + 16 * (j))), BSWAP), gp - (j))++TGT void crypton_gcm_fused_encrypt(uint8_t *out, const aes_gcm_fused *fk,+                                   const aes_key *key, const uint8_t *nonce,+                                   const uint8_t *aad, size_t aadlen,+                                   const uint8_t *in, size_t inlen, size_t taglen,+                                   const aes_key *hpkey, size_t sampleoff,+                                   uint8_t *mask)+{+    const uint8_t *rk = key->data;+    const uint8_t *hprk = hpkey != 0 ? hpkey->data : rk;+    const int rounds = key->nbr;+    const int hprounds = hpkey != 0 ? hpkey->nbr : rounds;+    GHASH_DECL;+    __m128i ctrbase, ctr, one32, ek0, tag, b0, b1, b2, b3, b4, b5;+    const int ntail_pre = (int) ((inlen % 96 + 15) / 16);+    int lane_ek0;+    __m128i gq[6];+    unsigned gi = 0, gw = 0;+    int gn = 0;+    size_t nblk = (aadlen + 15) / 16 + (inlen + 15) / 16 + 1;+    const int gtotal = (int) nblk;+    int gp = (int) nblk;+    size_t i;+    size_t done;+    int lane_mask = 0;++    /*+     * Y0: the twelve bytes of nonce and a counter of one.  loadn reads the+     * nonce where it lies and masks what is above it, so this is one load+     * rather than three of four bytes each and a set built from them.+     */+    ctrbase = _mm_insert_epi32(loadn(nonce, 12), (int) __builtin_bswap32(1), 3);+    ctr = _mm_shuffle_epi8(ctrbase, BSWAP);+    one32 = _mm_set_epi32(0, 0, 0, 1);++    lane_ek0 = ntail_pre > 0 && ntail_pre <= 4;+    if (!lane_ek0)+        ek0 = aes_one_block(rk, rounds, ctrbase);++    /* The additional data goes in first and takes the highest powers, but it+     * is only queued here: absorbing it takes multiplies, and the multiplies+     * belong in the gaps between the AES rounds below rather than in front+     * of them where nothing else is running. */+    /*+     * The additional data goes in first and takes the highest powers.  It is+     * absorbed here rather than queued: what the queue is for is giving the+     * rounds below something to interleave with, and a queue that sometimes+     * holds the header and sometimes does not forces a test before every+     * multiply -- which is what stopped the interleaving from happening at+     * all.  See the peeled first group below.+     */+    {+        size_t nfull = aadlen / 16;+        size_t rest = aadlen % 16;++        for (i = 0; i < nfull; i++)+            GHASH_ONE(_mm_shuffle_epi8(+                _mm_loadu_si128((const __m128i *) (aad + i * 16)), BSWAP), 0);+        if (rest)+            GHASH_ONE(_mm_shuffle_epi8(loadn(aad + nfull * 16, rest), BSWAP), 0);+    }++    /* Whole groups of six.  The rounds are written out rather than looped:+     * the number of them is a value in the key, so a loop over it leaves the+     * compiler fetching each round key through an index it cannot fold, and+     * the six lanes go to memory with them.  Written out, the whole group+     * stays in registers, and the six multiplies of the group before can be+     * placed between the rounds by hand -- which is the stitching: AES-NI+     * and PCLMULQDQ do not contend for the same port, so the multiplies are+     * very nearly free.+     */+    done = 0;+    if (rounds == 10) {+        if (done + 96 <= inlen) {+            const uint8_t *p = in + done;+            uint8_t *q = out + done;++            CTR6(0); CTR6(1); CTR6(2); CTR6(3); CTR6(4); CTR6(5);+            ROUND6(1);+            ROUND6(2);+            ROUND6(3);+            ROUND6(4);+            ROUND6(5);+            ROUND6(6);+            ROUND6(7);+            ROUND6(8);+            ROUND6(9);+            LAST6(10);+            gn = 0; gi = 0; gw = 0;++            b0 = _mm_xor_si128(b0, _mm_loadu_si128((const __m128i *) p));+            b1 = _mm_xor_si128(b1, _mm_loadu_si128((const __m128i *) (p + 16)));+            b2 = _mm_xor_si128(b2, _mm_loadu_si128((const __m128i *) (p + 32)));+            b3 = _mm_xor_si128(b3, _mm_loadu_si128((const __m128i *) (p + 48)));+            b4 = _mm_xor_si128(b4, _mm_loadu_si128((const __m128i *) (p + 64)));+            b5 = _mm_xor_si128(b5, _mm_loadu_si128((const __m128i *) (p + 80)));+            _mm_storeu_si128((__m128i *) q, b0);+            _mm_storeu_si128((__m128i *) (q + 16), b1);+            _mm_storeu_si128((__m128i *) (q + 32), b2);+            _mm_storeu_si128((__m128i *) (q + 48), b3);+            _mm_storeu_si128((__m128i *) (q + 64), b4);+            _mm_storeu_si128((__m128i *) (q + 80), b5);++            done += 96;+        }+        for (; done + 96 <= inlen; done += 96) {+            const uint8_t *p = in + done;+            uint8_t *q = out + done;+            const uint8_t *prev = out + done - 96;++            CTR6(0); CTR6(1); CTR6(2); CTR6(3); CTR6(4); CTR6(5);+            ROUND6(1); GAT(0);+            ROUND6(2); GAT(1);+            ROUND6(3); GAT(2);+            ROUND6(4); GAT(3);+            ROUND6(5); GAT(4);+            ROUND6(6); GAT(5);+            ROUND6(7);+            ROUND6(8);+            ROUND6(9);+            LAST6(10);+            gp -= 6;++            b0 = _mm_xor_si128(b0, _mm_loadu_si128((const __m128i *) p));+            b1 = _mm_xor_si128(b1, _mm_loadu_si128((const __m128i *) (p + 16)));+            b2 = _mm_xor_si128(b2, _mm_loadu_si128((const __m128i *) (p + 32)));+            b3 = _mm_xor_si128(b3, _mm_loadu_si128((const __m128i *) (p + 48)));+            b4 = _mm_xor_si128(b4, _mm_loadu_si128((const __m128i *) (p + 64)));+            b5 = _mm_xor_si128(b5, _mm_loadu_si128((const __m128i *) (p + 80)));+            _mm_storeu_si128((__m128i *) q, b0);+            _mm_storeu_si128((__m128i *) (q + 16), b1);+            _mm_storeu_si128((__m128i *) (q + 32), b2);+            _mm_storeu_si128((__m128i *) (q + 48), b3);+            _mm_storeu_si128((__m128i *) (q + 64), b4);+            _mm_storeu_si128((__m128i *) (q + 80), b5);++            /* straight from the registers the last round left them in: the+             * queue existed only to hold them until the next group's rounds+             * could hide the multiplies, and that is 192 bytes of store and+             * load per 96 bytes of payload */+        }++    } else {+        for (done = 0; done + 96 <= inlen; done += 96) {+                const uint8_t *p = in + done;+                uint8_t *q = out + done;+                int r;++                CTR6(0); CTR6(1); CTR6(2); CTR6(3); CTR6(4); CTR6(5);+                for (r = 1; r < rounds; r++) {+                    ROUND6(r);+                    GSTEP();+                }+                LAST6(rounds);++                b0 = _mm_xor_si128(b0, _mm_loadu_si128((const __m128i *) p));+                b1 = _mm_xor_si128(b1, _mm_loadu_si128((const __m128i *) (p + 16)));+                b2 = _mm_xor_si128(b2, _mm_loadu_si128((const __m128i *) (p + 32)));+                b3 = _mm_xor_si128(b3, _mm_loadu_si128((const __m128i *) (p + 48)));+                b4 = _mm_xor_si128(b4, _mm_loadu_si128((const __m128i *) (p + 64)));+                b5 = _mm_xor_si128(b5, _mm_loadu_si128((const __m128i *) (p + 80)));+                _mm_storeu_si128((__m128i *) q, b0);+                _mm_storeu_si128((__m128i *) (q + 16), b1);+                _mm_storeu_si128((__m128i *) (q + 32), b2);+                _mm_storeu_si128((__m128i *) (q + 48), b3);+                _mm_storeu_si128((__m128i *) (q + 64), b4);+                _mm_storeu_si128((__m128i *) (q + 80), b5);++                while (gn > 0) GSTEP();+                gi = 0; gw = 0;+                gq[0] = _mm_shuffle_epi8(b0, BSWAP);+                gq[1] = _mm_shuffle_epi8(b1, BSWAP);+                gq[2] = _mm_shuffle_epi8(b2, BSWAP);+                gq[3] = _mm_shuffle_epi8(b3, BSWAP);+                gq[4] = _mm_shuffle_epi8(b4, BSWAP);+                gq[5] = _mm_shuffle_epi8(b5, BSWAP);+                gn = 6;+        }+    }++    /* The tail.  The wide pass below runs only when there are blocks for it:+     * sixty AES instructions to fill one lane is not worth it, so a message+     * that ends on a group boundary leaves E(K,Y0) the chain it was given+     * above and takes the mask on one of its own.+     *+     * The spare lane carries the mask only when two things hold.  The sample+     * has to lie entirely in output the groups above have already written:+     * this pass reads it while it runs, and the blocks it is itself+     * computing are stored after it, so a sample reaching into them would be+     * read before it exists.  And the two key schedules have to have the+     * same number of rounds, because the lanes share the loop that counts+     * them and a shorter schedule would be read past its end.  TLS and QUIC+     * satisfy both; anything else gets the mask on a chain of its own, which+     * is what it would have had anyway. */+    {+        __m128i t0, t1, t2, t3, t4, t5;+        __m128i tv[6];+        size_t toff[6];+        int ntail = 0, j;++        if (done >= inlen) goto no_tail;++        for (i = done; i < inlen; i += 16) {+            toff[ntail] = i;+            ctr = _mm_add_epi32(ctr, one32);+            tv[ntail] = _mm_shuffle_epi8(ctr, BSWAP);+            ntail++;+        }++        lane_mask = ntail > 0 && ntail <= 5 && hpkey != 0 && mask != 0+                 && hprounds == rounds+                 && sampleoff + 16 <= done;++        if (ntail > 0) {+            t0 = tv[0];+            t1 = ntail > 1 ? tv[1] : ctrbase;+            t2 = ntail > 2 ? tv[2] : ctrbase;+            t3 = ntail > 3 ? tv[3] : ctrbase;+            t4 = lane_ek0 ? ctrbase : (ntail > 4 ? tv[4] : ctrbase);+            t5 = lane_mask+               ? _mm_loadu_si128((const __m128i *) (out + sampleoff))+               : (ntail > 5 ? tv[5] : ctrbase);+            /* A group leaves exactly six queued, which is what lets the+             * slots below be named at compile time.  Where no group ran+             * there is nothing to place and the plain pass will do. */+            if (rounds == 10 && done >= 96) {+                const uint8_t *prev = out + done - 96;+                WIDE6_10(lane_mask ? hprk : rk);+            } else {+                WIDE6(lane_mask ? hprk : rk);+            }+            if (lane_ek0)+                ek0 = t4;+            else+                tv[4] = t4;+            if (lane_mask)+                _mm_storeu_si128((__m128i *) mask, t5);+            else if (ntail > 5)+                tv[5] = t5;+        }+no_tail:+        while (gn > 0) GSTEP();++        /* The last group's ciphertext is absorbed by the pass above where+         * there is one to absorb it.  A message that ends on a group+         * boundary has no such pass, so it is taken here. */+        if (rounds == 10 && done >= 96 && ntail == 0) {+            const uint8_t *prev = out + done - 96;+            GAT(0); GAT(1); GAT(2); GAT(3); GAT(4); GAT(5);+        }++        /*+         * The tail blocks, from the registers the pass left them in.  They+         * were going through an array indexed by the loop variable, which+         * the compiler cannot see through and so keeps in memory: every+         * block then reloaded its own keystream.  Named one per block and+         * reached by a test on a count instead, they stay where they are.+         */+#define TAILBLK(j, reg)                                                      \+        do {                                                                 \+            size_t off = done + 16 * (j);                                    \+            size_t n = inlen - off < 16 ? inlen - off : 16;                  \+            __m128i c = _mm_xor_si128(reg, n == 16                           \+                ? _mm_loadu_si128((const __m128i *) (in + off))              \+                : loadn(in + off, n));                                       \+            if (n == 16) {                                                   \+                _mm_storeu_si128((__m128i *) (out + off), c);                \+            } else {                                                         \+                /* the tag goes in directly above, so those bytes are        \+                 * written over anyway where there are sixteen to spare */   \+                if (n + taglen >= 16)                                        \+                    _mm_storeu_si128((__m128i *) (out + off), c);            \+                else                                                         \+                    storen(out + off, c, n);                                 \+                c = clampn(c, n);                                            \+            }                                                                \+            GHASH_ONE(_mm_shuffle_epi8(c, BSWAP), gp);                       \+            gp--;                                                            \+        } while (0)++        if (ntail > 0) TAILBLK(0, t0);+        if (ntail > 1) TAILBLK(1, t1);+        if (ntail > 2) TAILBLK(2, t2);+        if (ntail > 3) TAILBLK(3, t3);+        if (ntail > 4) TAILBLK(4, tv[4]);+        if (ntail > 5) TAILBLK(5, tv[5]);+#undef TAILBLK+    }++    {+        /*+         * The length block: the additional data's bit count and the+         * message's, each big endian in a half, and then reversed like+         * every other block on its way to GHASH.+         *+         * Reversed, that block is the two counts as ordinary little endian+         * words with the message's in the low half -- which is one set, and+         * no shuffle.  Sixteen byte stores to the stack and a load back is+         * what it cost before.+         */+        GHASH_ONE(_mm_set_epi64x((long long) ((uint64_t) aadlen << 3),+                                 (long long) ((uint64_t) inlen << 3)), gp);+    }++    tag = _mm_shuffle_epi8(gtag, BSWAP);+    tag = _mm_xor_si128(tag, ek0);+    if (taglen == 16)+        _mm_storeu_si128((__m128i *) (out + inlen), tag);+    else+        storen(out + inlen, tag, taglen);++    /* A sample the pass above could not reach -- because it covered blocks+     * that pass was still computing, or the tag, which is written just now+     * -- is taken here instead, where everything it can cover exists. */+    if (!lane_mask && hpkey != 0 && mask != 0)+        _mm_storeu_si128((__m128i *) mask,+                         aes_one_block(hprk, hprounds, _mm_loadu_si128(+                             (const __m128i *) (out + sampleoff))));+}+++/*+ * The same for decryption, which is the simpler of the two.+ *+ * What GHASH absorbs here is the ciphertext, and the ciphertext is the+ * input: it is there before any of the AES has run.  So there is no queue --+ * the multiplies of a group go between the rounds of that same group rather+ * than waiting for the one after, and nothing is stored and loaded back to+ * carry them across.+ *+ * The tag is compared here, every byte of it whichever way the answer goes,+ * and the answer is 1 for a message whose tag matched.+ */++/* one ciphertext block straight from the input, at a slot named here */+#define DAT(j) GHASH_ONE(_mm_shuffle_epi8(                                   \+        _mm_loadu_si128((const __m128i *) (p + 16 * (j))), BSWAP), 0)++/* the next counter block, into a named register */+#define CTRT(t)                                                              \+    do { ctr = _mm_add_epi32(ctr, one32);                                    \+         t = _mm_shuffle_epi8(ctr, BSWAP); } while (0)++TGT int crypton_gcm_fused_decrypt(uint8_t *out, const aes_gcm_fused *fk,+                                  const aes_key *key, const uint8_t *nonce,+                                  const uint8_t *aad, size_t aadlen,+                                  const uint8_t *in, size_t inlen,+                                  const uint8_t *tag, size_t taglen)+{+    const uint8_t *rk = key->data;+    const int rounds = key->nbr;+    GHASH_DECL;+    __m128i ctrbase, ctr, one32, ek0, want, b0, b1, b2, b3, b4, b5;+    const int ntail_pre = (int) ((inlen % 96 + 15) / 16);+    int lane_ek0, gp = 0;+    const int gtotal = (int) ((aadlen + 15) / 16 + (inlen + 15) / 16 + 1);+    size_t i;+    size_t done;+    uint8_t diff = 0;++    ctrbase = _mm_insert_epi32(loadn(nonce, 12), (int) __builtin_bswap32(1), 3);+    ctr = _mm_shuffle_epi8(ctrbase, BSWAP);+    one32 = _mm_set_epi32(0, 0, 0, 1);++    lane_ek0 = ntail_pre > 0 && ntail_pre <= 5;+    if (!lane_ek0)+        ek0 = aes_one_block(rk, rounds, ctrbase);++    {+        size_t nfull = aadlen / 16;+        size_t rest = aadlen % 16;++        for (i = 0; i < nfull; i++)+            GHASH_ONE(_mm_shuffle_epi8(+                _mm_loadu_si128((const __m128i *) (aad + i * 16)), BSWAP), 0);+        if (rest)+            GHASH_ONE(_mm_shuffle_epi8(loadn(aad + nfull * 16, rest), BSWAP), 0);+    }++    done = 0;+    if (rounds == 10) {+        for (; done + 96 <= inlen; done += 96) {+            const uint8_t *p = in + done;+            uint8_t *q = out + done;++            CTR6(0); CTR6(1); CTR6(2); CTR6(3); CTR6(4); CTR6(5);+            ROUND6(1); DAT(0);+            ROUND6(2); DAT(1);+            ROUND6(3); DAT(2);+            ROUND6(4); DAT(3);+            ROUND6(5); DAT(4);+            ROUND6(6); DAT(5);+            ROUND6(7);+            ROUND6(8);+            ROUND6(9);+            LAST6(10);++            _mm_storeu_si128((__m128i *) q,+                _mm_xor_si128(b0, _mm_loadu_si128((const __m128i *) p)));+            _mm_storeu_si128((__m128i *) (q + 16),+                _mm_xor_si128(b1, _mm_loadu_si128((const __m128i *) (p + 16))));+            _mm_storeu_si128((__m128i *) (q + 32),+                _mm_xor_si128(b2, _mm_loadu_si128((const __m128i *) (p + 32))));+            _mm_storeu_si128((__m128i *) (q + 48),+                _mm_xor_si128(b3, _mm_loadu_si128((const __m128i *) (p + 48))));+            _mm_storeu_si128((__m128i *) (q + 64),+                _mm_xor_si128(b4, _mm_loadu_si128((const __m128i *) (p + 64))));+            _mm_storeu_si128((__m128i *) (q + 80),+                _mm_xor_si128(b5, _mm_loadu_si128((const __m128i *) (p + 80))));+        }+    } else {+        for (; done + 96 <= inlen; done += 96) {+            const uint8_t *p = in + done;+            uint8_t *q = out + done;+            int r;++            CTR6(0); CTR6(1); CTR6(2); CTR6(3); CTR6(4); CTR6(5);+            for (r = 1; r < rounds; r++) {+                ROUND6(r);+                if (r <= 6) DAT(r - 1);+            }+            LAST6(rounds);++            _mm_storeu_si128((__m128i *) q,+                _mm_xor_si128(b0, _mm_loadu_si128((const __m128i *) p)));+            _mm_storeu_si128((__m128i *) (q + 16),+                _mm_xor_si128(b1, _mm_loadu_si128((const __m128i *) (p + 16))));+            _mm_storeu_si128((__m128i *) (q + 32),+                _mm_xor_si128(b2, _mm_loadu_si128((const __m128i *) (p + 32))));+            _mm_storeu_si128((__m128i *) (q + 48),+                _mm_xor_si128(b3, _mm_loadu_si128((const __m128i *) (p + 48))));+            _mm_storeu_si128((__m128i *) (q + 64),+                _mm_xor_si128(b4, _mm_loadu_si128((const __m128i *) (p + 64))));+            _mm_storeu_si128((__m128i *) (q + 80),+                _mm_xor_si128(b5, _mm_loadu_si128((const __m128i *) (p + 80))));+        }+    }++    /* the tail, with E(K,Y0) in a lane the length leaves idle */+    {+        __m128i t0, t1, t2, t3, t4, t5;+        int ntail = (int) ((inlen - done + 15) / 16), j;++        /* the counter is where the groups left it */+        t0 = t1 = t2 = t3 = t4 = t5 = ctrbase;+        if (ntail > 0) CTRT(t0);+        if (ntail > 1) CTRT(t1);+        if (ntail > 2) CTRT(t2);+        if (ntail > 3) CTRT(t3);+        if (ntail > 4) CTRT(t4);+        if (ntail > 5) CTRT(t5);++        if (ntail > 0) {+            WIDE6_NOQ(rk);+            if (lane_ek0) ek0 = t5;+        }++        for (j = 0; j < ntail; j++) {+            size_t off = done + 16 * (size_t) j;+            size_t n = inlen - off < 16 ? inlen - off : 16;+            __m128i c = n == 16 ? _mm_loadu_si128((const __m128i *) (in + off))+                                : loadn(in + off, n);+            __m128i ks = j == 0 ? t0 : j == 1 ? t1 : j == 2 ? t2+                       : j == 3 ? t3 : j == 4 ? t4 : t5;++            GHASH_ONE(_mm_shuffle_epi8(c, BSWAP), 0);+            {+                __m128i pl = _mm_xor_si128(ks, c);+                if (n == 16)+                    _mm_storeu_si128((__m128i *) (out + off), pl);+                else+                    storen(out + off, pl, n);+            }+        }+    }++    GHASH_ONE(_mm_set_epi64x((long long) ((uint64_t) aadlen << 3),+                             (long long) ((uint64_t) inlen << 3)), gp);++    want = _mm_xor_si128(_mm_shuffle_epi8(gtag, BSWAP), ek0);+    {+        uint8_t got[16];+        _mm_storeu_si128((__m128i *) got, want);+        for (i = 0; i < taglen; i++)+            diff |= (uint8_t) (got[i] ^ tag[i]);+    }+    return diff == 0;+}++#endif /* WITH_GCM_FUSED */

@@ -0,0 +1,54 @@+/*+ * Copyright (c) 2026 Kazu Yamamoto <kazu@iij.ad.jp>+ *+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted provided that the following conditions+ * are met:+ * 1. Redistributions of source code must retain the above copyright+ *    notice, this list of conditions and the following disclaimer.+ * 2. Redistributions in binary form must reproduce the above copyright+ *    notice, this list of conditions and the following disclaimer in the+ *    documentation and/or other materials provided with the distribution.+ * 3. Neither the name of the author nor the names of his contributors+ *    may be used to endorse or promote products derived from this software+ *    without specific prior written permission.+ *+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+ * SUCH DAMAGE.+ */++#ifndef CRYPTON_GCM_FUSED_X86_H+#define CRYPTON_GCM_FUSED_X86_H++#include <stdint.h>+#include <stddef.h>+#include <crypton_aes.h>++void crypton_gcm_fused_key_init(aes_gcm_fused *fk, const aes_key *key);++void crypton_gcm_fused_encrypt(uint8_t *out, const aes_gcm_fused *fk,+                               const aes_key *key,+                               const uint8_t *nonce,+                               const uint8_t *aad, size_t aadlen,+                               const uint8_t *in, size_t inlen, size_t taglen,+                               const aes_key *hpkey, size_t sampleoff,+                               uint8_t *mask);++int crypton_gcm_fused_decrypt(uint8_t *out, const aes_gcm_fused *fk,+                              const aes_key *key, const uint8_t *nonce,+                              const uint8_t *aad, size_t aadlen,+                              const uint8_t *in, size_t inlen,+                              const uint8_t *tag, size_t taglen);++#endif

@@ -38,6 +38,9 @@ #include <aes/generic.h> #include <aes/gf.h> #include <aes/x86ni.h>+#ifdef WITH_GCM_FUSED+#include <aes/gcm_fused_x86.h>+#endif  void crypton_aes_generic_encrypt_ecb(aes_block *output, aes_key *key, aes_block *input, uint32_t nb_blocks); void crypton_aes_generic_decrypt_ecb(aes_block *output, aes_key *key, aes_block *input, uint32_t nb_blocks);@@ -58,6 +61,17 @@  #ifdef WITH_ARMV8_CRYPTO void crypton_aes_armv8_init(aes_key *key, uint8_t *origkey, uint8_t size);+int crypton_aes_armv8_gcm_fused_dec(uint8_t *out, const block128 *ht,+                                    aes_key *key, const uint8_t *nonce,+                                    const uint8_t *aad, uint32_t aadlen,+                                    const uint8_t *in, uint32_t inlen,+                                    const uint8_t *tag, uint32_t taglen);+void crypton_aes_armv8_gcm_fused(uint8_t *out, const block128 *ht,+                                 aes_key *key, const uint8_t *nonce,+                                 const uint8_t *aad, uint32_t aadlen,+                                 const uint8_t *in, uint32_t inlen,+                                 uint32_t taglen, aes_key *hpkey,+                                 uint32_t sampleoff, uint8_t *mask); #define ARMV8_DECLS(sz) \ 	void crypton_aes_armv8_encrypt_block##sz(aes_block *output, aes_key *key, aes_block *input); \ 	void crypton_aes_armv8_decrypt_block##sz(aes_block *output, aes_key *key, aes_block *input); \@@ -532,20 +546,33 @@ 	crypton_gf_mul4(&gcm->tag, b, gcm->htable); } -void crypton_aes_gcm_init(aes_gcm *gcm, aes_key *key, uint8_t *iv, uint32_t len)+/* The part of the state that depends on the key alone: H = encrypt_K(0^128)+ * and the table of its multiples.  It is 256 of the 320 bytes, and a caller+ * that keeps a key can compute it once instead of once per message. */+void crypton_aes_gcm_key_init(aes_gcm_key *gk, aes_key *key) { 	block128 h;++	block128_zero(&h);+	crypton_aes_encrypt_block(&h, key, &h);+	crypton_hinit(gk->gcm.htable, &h);+#ifdef WITH_GCM_FUSED+	if (crypton_aes_cpu_options[CPU_AESNI]+	    && crypton_aes_cpu_options[CPU_PCLMUL])+		crypton_gcm_fused_key_init(&gk->fused, key);+#endif+}++/* Everything else: what the nonce and the message determine.  Leaves htable+ * alone, so it runs on a state whose key part is already there. */+static void gcm_message_init(aes_gcm *gcm, uint8_t *iv, uint32_t len)+{ 	gcm->length_aad = 0; 	gcm->length_input = 0; -	block128_zero(&h); 	block128_zero(&gcm->tag); 	block128_zero(&gcm->iv); -	/* prepare H : encrypt_K(0^128) */-	crypton_aes_encrypt_block(&h, key, &h);-	crypton_hinit(gcm->htable, &h);- 	if (len == 12) { 		block128_copy_bytes(&gcm->iv, iv, 12); 		gcm->iv.b[15] = 0x01;@@ -568,6 +595,16 @@ 	block128_copy_aligned(&gcm->civ, &gcm->iv); } +void crypton_aes_gcm_init(aes_gcm *gcm, aes_key *key, uint8_t *iv, uint32_t len)+{+	block128 h;++	block128_zero(&h);+	crypton_aes_encrypt_block(&h, key, &h);+	crypton_hinit(gcm->htable, &h);+	gcm_message_init(gcm, iv, len);+}+ void crypton_aes_gcm_aad(aes_gcm *gcm, uint8_t *input, uint32_t length) { 	gcm->length_aad += length;@@ -602,6 +639,161 @@ 	for (i = 0; i < 16; i++) { 		tag[i] = gcm->tag.b[i]; 	}+}++/* One message, one call.  The key part of the state comes in already built,+ * the rest is set up on the stack, and the additional data, the encryption+ * and the tag all happen before returning, so nothing crosses a language+ * boundary between them and no intermediate state is copied out.  The output+ * buffer takes the ciphertext and then the tag, so it wants length + taglen+ * bytes. */+void crypton_aes_gcm_full_encrypt(uint8_t *output, const aes_gcm_key *gcmkey, aes_key *key,+                                  uint8_t *iv, uint32_t ivlen,+                                  uint8_t *aad, uint32_t aadlen,+                                  uint8_t *input, uint32_t length, uint32_t taglen)+{+	aes_gcm gcm;+	uint8_t tag[16];++#ifdef WITH_GCM_FUSED+	/* Short messages go the other way: the assembly below will not start+	 * on anything under 288 bytes, and under about 1.5 KB the fused path+	 * is ahead of it even where it does. */+	if (ivlen == 12 && length <= CRYPTON_GCM_FUSED_MAX_MESSAGE+	    && crypton_aes_cpu_options[CPU_AESNI]+	    && crypton_aes_cpu_options[CPU_PCLMUL]) {+		crypton_gcm_fused_encrypt(output, &gcmkey->fused, key, iv,+		                          aad, aadlen, input, length, taglen,+		                          NULL, 0, NULL);+		return;+	}+#endif+#ifdef WITH_ARMV8_CRYPTO+	/* The same on AArch64, where the framing is what costs: composing the+	 * additional data, the encryption and the tag reaches each through the+	 * branch table, so the running state goes back to memory between them+	 * and a one-block header pays a reduction of its own.  Measured on an+	 * Apple M4, a 100-byte packet is 3.0x faster taken in one call.+	 *+	 * No length limit, unlike x86: there is no vendored assembly on this+	 * side for a long message to be handed to instead, and measured+	 * against the path this replaces it is never slower -- 1.25x at 1440+	 * bytes, level from about 6 KB up. */+	if (ivlen == 12+	    && crypton_aes_cpu_options[CPU_AESNI]+	    && crypton_aes_cpu_options[CPU_PCLMUL]) {+		crypton_aes_armv8_gcm_fused(output, gcmkey->gcm.htable, key, iv,+		                            aad, aadlen, input, length, taglen,+		                            NULL, 0, NULL);+		return;+	}+#endif+	memcpy(gcm.htable, gcmkey->gcm.htable, sizeof(gcm.htable));+	gcm_message_init(&gcm, iv, ivlen);+	if (aadlen)+		crypton_aes_gcm_aad(&gcm, aad, aadlen);+	if (length)+		crypton_aes_gcm_encrypt(output, &gcm, key, input, length);+	crypton_aes_gcm_finish(tag, &gcm, key);+	memcpy(output + length, tag, taglen);+}++/* The same, and then the header protection mask.  QUIC takes its sample from+ * the ciphertext, so the mask cannot be had before the encryption -- but it+ * can be had before returning, which saves a second crossing for one AES+ * block.  The block itself is about a nanosecond; what it saves is the call.+ * sampleoff is where the sixteen bytes of sample start in the output. */+void crypton_aes_gcm_full_encrypt_mask(uint8_t *output, const aes_gcm_key *gcmkey, aes_key *key,+                                       uint8_t *iv, uint32_t ivlen,+                                       uint8_t *aad, uint32_t aadlen,+                                       uint8_t *input, uint32_t length, uint32_t taglen,+                                       aes_key *hpkey, uint32_t sampleoff, uint8_t *mask)+{+	block128 sample, m;++#ifdef WITH_GCM_FUSED+	/* Here the mask rides in a lane of the AES pipeline that the message+	 * length leaves idle, so it costs very nearly nothing on top of the+	 * encryption rather than a block of its own. */+	if (ivlen == 12 && length <= CRYPTON_GCM_FUSED_MAX_MESSAGE+	    && crypton_aes_cpu_options[CPU_AESNI]+	    && crypton_aes_cpu_options[CPU_PCLMUL]) {+		crypton_gcm_fused_encrypt(output, &gcmkey->fused, key, iv,+		                          aad, aadlen, input, length, taglen,+		                          hpkey, sampleoff, mask);+		return;+	}+#endif+#ifdef WITH_ARMV8_CRYPTO+	/* The same on AArch64, where the framing is what costs: composing the+	 * additional data, the encryption and the tag reaches each through the+	 * branch table, so the running state goes back to memory between them+	 * and a one-block header pays a reduction of its own.  Measured on an+	 * Apple M4, a 100-byte packet is 3.3x faster taken in one call. */+	if (ivlen == 12+	    && crypton_aes_cpu_options[CPU_AESNI]+	    && crypton_aes_cpu_options[CPU_PCLMUL]) {+		crypton_aes_armv8_gcm_fused(output, gcmkey->gcm.htable, key, iv,+		                            aad, aadlen, input, length, taglen,+		                            hpkey, sampleoff, mask);+		return;+	}+#endif+	crypton_aes_gcm_full_encrypt(output, gcmkey, key, iv, ivlen, aad, aadlen,+	                             input, length, taglen);+	/* copied rather than cast: the sample lands wherever the header put it+	 * and a block128 is read as 64-bit words */+	memcpy(&sample, output + sampleoff, 16);+	crypton_aes_encrypt_block(&m, hpkey, &sample);+	memcpy(mask, &m, 16);+}++/* The same the other way, with the tag checked here rather than by the+ * caller: returns 1 when it matches and 0 when it does not, comparing every+ * byte either way.  The plaintext is written whatever the answer, so a caller+ * that gets 0 must not use it. */+int crypton_aes_gcm_full_decrypt(uint8_t *output, const aes_gcm_key *gcmkey, aes_key *key,+                                 uint8_t *iv, uint32_t ivlen,+                                 uint8_t *aad, uint32_t aadlen,+                                 uint8_t *input, uint32_t length,+                                 const uint8_t *tag, uint32_t taglen)+{+	aes_gcm gcm;+	uint8_t expected[16];+	uint32_t i;+	uint8_t diff = 0;++#ifdef WITH_GCM_FUSED+	/* The same as the encryption side, and simpler: what GHASH absorbs+	 * here is the ciphertext, which is the input, so the multiplies need+	 * not wait for anything.  Measured on an Intel Haswell, a 100-byte+	 * packet was three times the cost of encrypting one before this. */+	if (ivlen == 12 && length <= CRYPTON_GCM_FUSED_MAX_MESSAGE+	    && crypton_aes_cpu_options[CPU_AESNI]+	    && crypton_aes_cpu_options[CPU_PCLMUL])+		return crypton_gcm_fused_decrypt(output, &gcmkey->fused, key,+		                                 iv, aad, aadlen, input,+		                                 length, tag, taglen);+#endif+#ifdef WITH_ARMV8_CRYPTO+	if (ivlen == 12+	    && crypton_aes_cpu_options[CPU_AESNI]+	    && crypton_aes_cpu_options[CPU_PCLMUL])+		return crypton_aes_armv8_gcm_fused_dec(output, gcmkey->gcm.htable,+		                                       key, iv, aad, aadlen,+		                                       input, length, tag, taglen);+#endif+	memcpy(gcm.htable, gcmkey->gcm.htable, sizeof(gcm.htable));+	gcm_message_init(&gcm, iv, ivlen);+	if (aadlen)+		crypton_aes_gcm_aad(&gcm, aad, aadlen);+	if (length)+		crypton_aes_gcm_decrypt(output, &gcm, key, input, length);+	crypton_aes_gcm_finish(expected, &gcm, key);++	for (i = 0; i < taglen; i++)+		diff |= (uint8_t) (expected[i] ^ tag[i]);+	return diff == 0; }  static inline uint8_t ccm_b0_flags(uint32_t has_adata, uint32_t m, uint32_t l)

@@ -55,6 +55,55 @@ 	uint64_t length_input; } aes_gcm; +/*+ * How many powers of H a key keeps for the fused path in+ * cbits/aes/gcm_fused_x86.c.  A power for every block of the message would+ * fold its whole GHASH into one reduction, which is what picotls does, but+ * then the state grows with the longest message a caller might send and a+ * server holding many keys pays it for each.  A fixed count costs one+ * reduction per this many blocks and keeps the state one size.  Sixteen was+ * measured against 6, 8, 32, 64, 96 and 256: above eight the choice is worth+ * about two per cent, since only messages short enough to take this path at+ * all reach a second batch.  Six is worth avoiding -- at 1440 bytes it is+ * slower than not taking the path.+ */+#define CRYPTON_GCM_FUSED_POWERS 16++/*+ * Beyond this many bytes the stitched assembly in cbits/asm is faster than+ * the fused path, so longer messages go there instead.  Measured on an Intel+ * Haswell: even at 1440 bytes, the assembly ahead by 12 per cent at 3 KB and+ * 20 per cent at 16 KB, and the fused path ahead by 1.9x at 100 bytes and+ * 1.16x at 1200.  QUIC packets fall below this; TLS records do not.+ */+#define CRYPTON_GCM_FUSED_MAX_MESSAGE 1536++/*+ * The powers themselves, each shifted up by one bit, and beside each the+ * halves of it added together for the Karatsuba term.  The two are kept+ * adjacent rather than in two arrays: a multiply wants both, and two arrays+ * put them 256 bytes apart, which is two cache lines where this is one.+ *+ * Defined on every platform so that the key state below is one size+ * everywhere; filled only where the fused path is compiled in.+ */+typedef struct {+	struct {+		aes_block h;+		aes_block r;+	} p[CRYPTON_GCM_FUSED_POWERS];+} aes_gcm_fused;++/*+ * Everything a key determines, built once by crypton_aes_gcm_key_init and+ * read by every message sent under that key: the key half of a GCM state,+ * and the powers of H the fused path reads.  832 bytes.+ */+typedef struct {+	aes_gcm gcm;+	aes_gcm_fused fused;+} aes_gcm_key;+ /* size = 4*16+4*4= 80 */ typedef struct { 	aes_block xi;@@ -104,6 +153,21 @@                      uint32_t spoint, aes_block *input, uint32_t nb_blocks);  void crypton_aes_gcm_init(aes_gcm *gcm, aes_key *key, uint8_t *iv, uint32_t len);+void crypton_aes_gcm_key_init(aes_gcm_key *gk, aes_key *key);+void crypton_aes_gcm_full_encrypt(uint8_t *output, const aes_gcm_key *gcmkey, aes_key *key,+                                  uint8_t *iv, uint32_t ivlen,+                                  uint8_t *aad, uint32_t aadlen,+                                  uint8_t *input, uint32_t length, uint32_t taglen);+void crypton_aes_gcm_full_encrypt_mask(uint8_t *output, const aes_gcm_key *gcmkey, aes_key *key,+                                       uint8_t *iv, uint32_t ivlen,+                                       uint8_t *aad, uint32_t aadlen,+                                       uint8_t *input, uint32_t length, uint32_t taglen,+                                       aes_key *hpkey, uint32_t sampleoff, uint8_t *mask);+int crypton_aes_gcm_full_decrypt(uint8_t *output, const aes_gcm_key *gcmkey, aes_key *key,+                                 uint8_t *iv, uint32_t ivlen,+                                 uint8_t *aad, uint32_t aadlen,+                                 uint8_t *input, uint32_t length,+                                 const uint8_t *tag, uint32_t taglen); void crypton_aes_gcm_aad(aes_gcm *gcm, uint8_t *input, uint32_t length); void crypton_aes_gcm_encrypt(uint8_t *output, aes_gcm *gcm, aes_key *key, uint8_t *input, uint32_t length); void crypton_aes_gcm_decrypt(uint8_t *output, aes_gcm *gcm, aes_key *key, uint8_t *input, uint32_t length);

@@ -321,39 +321,6 @@   } } -/* select_jacobian_point sets {out_x,out_y,out_z} to the index'th entry of- * table. On entry: index < 16, table[0] must be zero. */-static void select_jacobian_point(felem out_x, felem out_y, felem out_z,-                                  const limb* table, limb index) {-  limb i, j;--  memset(out_x, 0, sizeof(felem));-  memset(out_y, 0, sizeof(felem));-  memset(out_z, 0, sizeof(felem));--  /* The implicit value at index 0 is all zero. We don't need to perform that-   * iteration of the loop because we already set out_* to zero. */-  table += 3 * NLIMBS;--  // Hit all entries to obscure cache profiling.-  for (i = 1; i < 16; i++) {-    limb mask = i ^ index;-    mask |= mask >> 2;-    mask |= mask >> 1;-    mask &= 1;-    mask--;-    for (j = 0; j < NLIMBS; j++, table++) {-      out_x[j] |= *table & mask;-    }-    for (j = 0; j < NLIMBS; j++, table++) {-      out_y[j] |= *table & mask;-    }-    for (j = 0; j < NLIMBS; j++, table++) {-      out_z[j] |= *table & mask;-    }-  }-}- /* scalar_base_mult sets {nx,ny,nz} = scalar*G where scalar is a little-endian  * number. Note that the value of scalar must be less than the order of the  * group. */@@ -424,61 +391,340 @@   felem_mul(y_out, ny, z_inv); } -/* scalar_base_mult sets {nx,ny,nz} = scalar*{x,y}. */+/* point_add_mixed_pm sets {xp,yp,zp} = {x1,y1,z1} + {x2,y2} and+ * {xm,ym,zm} = {x1,y1,z1} - {x2,y2}, where {x2,y2} is affine.+ *+ * Negating the second point changes the sign of s2 and so of r, and nothing+ * else: z1z1, tmp, u2, z1z1z1, h, i, j, v, the output z and the product y1*j+ * are common to the two.  What the second point costs over the first is one+ * squaring (r*r) and one multiplication (by r), rather than another eleven.+ *+ * The same restrictions as point_add_mixed: this does not handle P+P,+ * infinity+P nor P+infinity. */+static void point_add_mixed_pm(felem xp, felem yp, felem zp,+                               felem xm, felem ym, felem zm,+                               const felem x1, const felem y1, const felem z1,+                               const felem x2, const felem y2) {+  felem z1z1, z1z1z1, s2, u2, h, i, j, r, rr, v, y1j, tmp;++  felem_square(z1z1, z1);+  felem_sum(tmp, z1, z1);++  felem_mul(u2, x2, z1z1);+  felem_mul(z1z1z1, z1, z1z1);+  felem_mul(s2, y2, z1z1z1);+  felem_diff(h, u2, x1);+  felem_sum(i, h, h);+  felem_square(i, i);+  felem_mul(j, h, i);+  felem_mul(v, x1, i);+  felem_mul(y1j, y1, j);++  /* The two points share their z. */+  felem_mul(zp, tmp, h);+  felem_assign(zm, zp);++  /* X + P */+  felem_diff(r, s2, y1);+  felem_sum(r, r, r);+  felem_square(rr, r);+  felem_diff(xp, rr, j);+  felem_diff(xp, xp, v);+  felem_diff(xp, xp, v);+  felem_diff(tmp, v, xp);+  felem_mul(yp, tmp, r);+  felem_diff(yp, yp, y1j);+  felem_diff(yp, yp, y1j);++  /* X - P.  Negating the point negates s2, so r becomes -q where+   * q = 2*(s2 + y1).  The square is the same either way, and the sign is+   * carried into y by taking (xm - v) where the other took (v - xp):+   *   xm = q^2 - j - 2v+   *   ym = (v - xm)*(-q) - 2*y1*j = (xm - v)*q - 2*y1*j+   * so no field negation is needed. */+  felem_sum(r, s2, y1);+  felem_sum(r, r, r);+  felem_square(rr, r);+  felem_diff(xm, rr, j);+  felem_diff(xm, xm, v);+  felem_diff(xm, xm, v);+  felem_diff(tmp, xm, v);+  felem_mul(ym, tmp, r);+  felem_diff(ym, ym, y1j);+  felem_diff(ym, ym, y1j);+}++/* select_jacobian_odd sets {out_x,out_y,out_z} to the index'th of the 16+ * entries of table, for index < 16.  There is no implicit infinity at index+ * zero, as the unsigned window this replaces had: every entry is a real+ * point, which is what lets the signed representation below do without the+ * infinity masks. */+static void select_jacobian_odd(felem out_x, felem out_y, felem out_z,+                                const limb* table, limb index) {+  limb i, j;++  memset(out_x, 0, sizeof(felem));+  memset(out_y, 0, sizeof(felem));+  memset(out_z, 0, sizeof(felem));++  for (i = 0; i < 16; i++) {+    limb mask = i ^ index;+    mask |= mask >> 2;+    mask |= mask >> 1;+    mask &= 1;+    mask--;+    for (j = 0; j < NLIMBS; j++, table++) {+      out_x[j] |= *table & mask;+    }+    for (j = 0; j < NLIMBS; j++, table++) {+      out_y[j] |= *table & mask;+    }+    for (j = 0; j < NLIMBS; j++, table++) {+      out_z[j] |= *table & mask;+    }+  }+}++/* The scalar, recoded: 52 signed odd digits, each in {+-1,+-3,...,+-31}, so+ * that scalar = sum d_i * 32^i.  A digit is one byte: the low four bits are+ * the table index (|d|-1)/2, and bit four is set when d is negative.  One+ * byte rather than a byte and a word because this is the private key in+ * another form and has to be wiped afterwards. */+#define SABS_DIGITS 52+#define SABS_INDEX(b) ((limb)((b) & 15))+#define SABS_NEGMASK(b) ((limb)0 - (limb)((b) >> 4))+typedef struct {+  u8 digit[SABS_DIGITS];+} sabs_scalar;++/* words_are_zero returns 1 when |v| is zero and 0 otherwise, without a+ * branch. */+static u32 words_are_zero(u32 v) {+  v |= v >> 16;+  v |= v >> 8;+  v |= v >> 4;+  v |= v >> 2;+  v |= v >> 1;+  return (v & 1) ^ 1;+}++/* sabs_recode writes the signed representation of |scalar| into |out|.+ *+ * The recoding is the regular one of Joye and Tunstall: take the low six bits,+ * subtract 32, and carry the difference upwards.  It needs an odd input, which+ * is arranged by adding the group order to an even scalar -- that changes the+ * scalar but not the point it selects, the order being the order.  A zero+ * scalar is replaced by one and the caller is told, since zero times a point+ * is the infinity this code deliberately cannot represent.+ *+ * *dbl_mask is set to all ones when the last addition of the main loop would+ * be an addition of a point to itself, which the formulas there cannot do.+ * That happens exactly when the recoded scalar k' is congruent to twice its+ * lowest digit: the accumulator entering that step is (k' - d0)*P and what it+ * adds is d0*P, so they coincide when k' - d0 = d0.  With k' below 2^257 and+ * |2*d0| at most 62, k' - 2*d0 is then either zero or the order itself, which+ * is what is tested for below.  No earlier step can do this: entering step i+ * the accumulator is 32*m*P with |32*m| below the order, and the digit is at+ * most 31 in absolute value, so the two can only coincide as integers, which+ * they cannot -- m is odd and so is never zero.+ *+ * Constant time in the scalar: every branch below is on a loop counter. */+static limb sabs_recode(sabs_scalar* out, limb* dbl_mask,+                        const crypton_p256_int* scalar) {+  u32 k[9], n[9], ksaved[9];+  u32 nonzero;+  limb is_zero_mask;+  int i, b;++  for (i = 0; i < 9; i++) {+    k[i] = 0;+    n[i] = 0;+  }+  /* A word at a time.  Bit at a time would be 512 calls into another+   * translation unit, which the compiler cannot inline away. */+  for (b = 0; b < 256; b += 32) {+    k[b >> 5] = (u32)(P256_DIGIT(scalar, b / P256_BITSPERDIGIT)+                      >> (b % P256_BITSPERDIGIT));+    n[b >> 5] = (u32)(P256_DIGIT(&crypton_SECP256r1_n, b / P256_BITSPERDIGIT)+                      >> (b % P256_BITSPERDIGIT));+  }++  /* Replace a zero scalar by one, and report it. */+  nonzero = 0;+  for (i = 0; i < 9; i++) {+    nonzero |= k[i];+  }+  {+    u32 z = words_are_zero(nonzero);+    k[0] |= z;+    is_zero_mask = (limb)0 - (limb)z;+  }++  /* An even scalar becomes odd by adding the order.  The sum is below 2^257,+   * which is why nine words and fifty-two digits are enough. */+  {+    u32 addmask = (u32)0 - (u32)((k[0] & 1) ^ 1);+    u64 carry = 0;+    for (i = 0; i < 9; i++) {+      u64 t = (u64)k[i] + (u64)(n[i] & addmask) + carry;+      k[i] = (u32)t;+      carry = t >> 32;+    }+  }++  for (i = 0; i < 9; i++) {+    ksaved[i] = k[i];+  }++  for (i = 0; i < SABS_DIGITS - 1; i++) {+    u32 r6 = k[0] & 63;            /* odd, so never 32 */+    u32 hi = (r6 >> 5) & 1;        /* 1 when the digit is positive */+    u32 wabs = ((r6 - 32) & (0u - hi)) | ((32 - r6) & (hi - 1));+    u32 mlo = 32u - r6;            /* two's complement of the digit's negation */+    u32 ext = 0u - hi;             /* its sign extension */+    u64 carry = 0;+    int w;++    out->digit[i] = (u8)(((wabs - 1) >> 1) | ((hi ^ 1) << 4));++    if (i == 0) {+      /* k' - 2*d0, against zero and against the order. */+      u32 two_w = (u32)(2u * r6) - 64u;   /* 2*d0, two's complement */+      u32 two_w_ext = 0u - (hi ^ 1);      /* its sign extension */+      u32 zero_acc = 0, order_acc = 0;+      u64 borrow = 0;+      int w2;+      for (w2 = 0; w2 < 9; w2++) {+        u32 sub = (w2 == 0) ? two_w : two_w_ext;+        u64 d = (u64)ksaved[w2] - ((u64)sub + borrow);+        u32 dw = (u32)d;+        borrow = (d >> 32) & 1;+        zero_acc |= dw;+        order_acc |= dw ^ n[w2];+      }+      zero_acc |= (u32)borrow;      /* a negative difference is neither */+      order_acc |= (u32)borrow;+      *dbl_mask = (limb)0 - (limb)(words_are_zero(zero_acc)+                                   | words_are_zero(order_acc));+    }++    /* k -= digit, i.e. k += -digit, sign extended over the nine words. */+    for (w = 0; w < 9; w++) {+      u64 t = (u64)k[w] + (u64)(w == 0 ? mlo : ext) + carry;+      k[w] = (u32)t;+      carry = t >> 32;+    }+    /* k >>= 5 */+    for (w = 0; w < 8; w++) {+      k[w] = (k[w] >> 5) | (k[w + 1] << 27);+    }+    k[8] >>= 5;+  }++  /* What is left is odd, positive and at most five: the scalar is below+   * 2^257 and fifty-one digits have taken 255 bits off it, each leaving a+   * remainder below one. */+  out->digit[SABS_DIGITS - 1] = (u8)((k[0] - 1) >> 1);++  return is_zero_mask;+}++/* scalar_mult sets {nx,ny,nz} = scalar*{x,y}.+ *+ * A five-bit signed window.  The scalar is recoded into 52 digits, every one+ * of them odd and none of them zero, so the table holds only the odd+ * multiples P, 3P, ..., 31P and a negative digit is served by negating y,+ * which is free.  Against the four-bit unsigned window this replaces, the+ * main loop trades 252 doublings and 64 additions for 255 and 51, and --+ * because no digit is zero and no partial sum is the infinity -- it drops the+ * masks that stood in for infinity on every iteration.+ *+ * The table is built so that each pair of neighbouring odd multiples comes+ * out of one doubling and one shared addition:+ *+ *   2P = 2*P                3P  = 2P + P+ *   6P = 2*(3P)             5P  = 6P - P,  7P  = 6P + P+ *   10P = 2*(5P)            9P  = 10P - P, 11P = 10P + P+ *   ...+ *   30P = 2*(15P)           29P = 30P - P, 31P = 30P + P+ *+ * which is eight doublings, one mixed addition and seven shared pairs. */ static void scalar_mult(felem nx, felem ny, felem nz, const felem x,                         const felem y, const crypton_p256_int* scalar) {-  int i;-  felem px, py, pz, tx, ty, tz;-  felem precomp[16][3];-  limb n_is_infinity_mask, index, p_is_noninfinite_mask, mask;+  /* odd[k] is (2k+1)*P, for k in 0..15. */+  felem odd[16][3];+  felem dx, dy, dz, px, py, pz, negy, ddx, ddy, ddz;+  sabs_scalar rec;+  limb is_zero_mask, dbl_mask;+  int i, k; -  /* We precompute 0,1,2,... times {x,y}. */-  memset(precomp, 0, sizeof(felem) * 3);-  memcpy(&precomp[1][0], x, sizeof(felem));-  memcpy(&precomp[1][1], y, sizeof(felem));-  memcpy(&precomp[1][2], kOne, sizeof(felem));+  is_zero_mask = sabs_recode(&rec, &dbl_mask, scalar); -  for (i = 2; i < 16; i += 2) {-    point_double(precomp[i][0], precomp[i][1], precomp[i][2],-                 precomp[i / 2][0], precomp[i / 2][1], precomp[i / 2][2]);+  felem_assign(odd[0][0], x);+  felem_assign(odd[0][1], y);+  memcpy(odd[0][2], kOne, sizeof(felem)); -    point_add_mixed(precomp[i + 1][0], precomp[i + 1][1], precomp[i + 1][2],-                    precomp[i][0], precomp[i][1], precomp[i][2], x, y);+  /* 3P = 2P + P */+  point_double(dx, dy, dz, x, y, kOne);+  point_add_mixed(odd[1][0], odd[1][1], odd[1][2], dx, dy, dz, x, y);++  /* (4k+2)P from (2k+1)P, then (4k+1)P and (4k+3)P from it. */+  for (k = 1; k < 8; k++) {+    point_double(dx, dy, dz, odd[k][0], odd[k][1], odd[k][2]);+    point_add_mixed_pm(odd[2 * k + 1][0], odd[2 * k + 1][1], odd[2 * k + 1][2],+                       odd[2 * k][0], odd[2 * k][1], odd[2 * k][2],+                       dx, dy, dz, x, y);   } -  memset(nx, 0, sizeof(felem));-  memset(ny, 0, sizeof(felem));-  memset(nz, 0, sizeof(felem));-  n_is_infinity_mask = -1;+  /* The top digit initialises the accumulator; it is always positive. */+  select_jacobian_odd(nx, ny, nz, odd[0][0],+                      SABS_INDEX(rec.digit[SABS_DIGITS - 1])); -  /* We add in a window of four bits each iteration and do this 64 times. */-  for (i = 0; i < 256; i += 4) {-    if (i) {-      point_double(nx, ny, nz, nx, ny, nz);-      point_double(nx, ny, nz, nx, ny, nz);-      point_double(nx, ny, nz, nx, ny, nz);-      point_double(nx, ny, nz, nx, ny, nz);-    }+  for (i = SABS_DIGITS - 2; i >= 0; i--) {+    point_double(nx, ny, nz, nx, ny, nz);+    point_double(nx, ny, nz, nx, ny, nz);+    point_double(nx, ny, nz, nx, ny, nz);+    point_double(nx, ny, nz, nx, ny, nz);+    point_double(nx, ny, nz, nx, ny, nz); -    index = (crypton_p256_get_bit(scalar, 255 - i - 0) << 3) |-            (crypton_p256_get_bit(scalar, 255 - i - 1) << 2) |-            (crypton_p256_get_bit(scalar, 255 - i - 2) << 1) |-            crypton_p256_get_bit(scalar, 255 - i - 3);+    select_jacobian_odd(px, py, pz, odd[0][0], SABS_INDEX(rec.digit[i]));+    felem_diff(negy, kZero, py);+    copy_conditional(py, negy, SABS_NEGMASK(rec.digit[i])); -    /* See the comments in scalar_base_mult about handling infinities. */-    select_jacobian_point(px, py, pz, precomp[0][0], index);-    point_add(tx, ty, tz, nx, ny, nz, px, py, pz);-    copy_conditional(nx, px, n_is_infinity_mask);-    copy_conditional(ny, py, n_is_infinity_mask);-    copy_conditional(nz, pz, n_is_infinity_mask);+    /* point_add finishes with z before it touches x, and with each of x+     * and y before the next, so the accumulator can be its own output. */+    point_add(nx, ny, nz, nx, ny, nz, px, py, pz); -    p_is_noninfinite_mask = NON_ZERO_TO_ALL_ONES(index);-    mask = p_is_noninfinite_mask & ~n_is_infinity_mask;+    /* On the last step alone the accumulator can be the very point being+     * added, and these formulas answer the infinity where the truth is twice+     * that point.  Doubling it is the answer there; the recoder said whether+     * this is that case.  One doubling on one of fifty-one iterations. */+    if (i == 0) {+      point_double(ddx, ddy, ddz, px, py, pz);+      copy_conditional(nx, ddx, dbl_mask);+      copy_conditional(ny, ddy, dbl_mask);+      copy_conditional(nz, ddz, dbl_mask);+    }+  } -    copy_conditional(nx, tx, mask);-    copy_conditional(ny, ty, mask);-    copy_conditional(nz, tz, mask);-    n_is_infinity_mask &= ~p_is_noninfinite_mask;+  /* Zero was replaced by one on the way in; put the infinity back.  All+   * three coordinates, not just z: crypton_p256_points_mul_vartime reads the+   * comment above it as saying the whole point is zero. */+  for (i = 0; i < NLIMBS; i++) {+    nx[i] &= ~is_zero_mask;+    ny[i] &= ~is_zero_mask;+    nz[i] &= ~is_zero_mask;+  }++  /* The recoded scalar is the private key in another representation, so it+   * does not stay on the stack.  Written through a volatile pointer, since a+   * plain memset here is dead and may be dropped. */+  {+    volatile unsigned char* p = (volatile unsigned char*)&rec;+    unsigned b;+    for (b = 0; b < sizeof(rec); b++) {+      p[b] = 0;+    }   } } 

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               crypton-version:            2.0.1+version:            2.1.0 license:            BSD-3-Clause license-file:       LICENSE copyright:          Vincent Hanquez <vincent@snarc.org>@@ -143,6 +143,7 @@ library     exposed-modules:         Crypto.Cipher.AES+        Crypto.Cipher.AES.GCM         Crypto.Cipher.AESGCMSIV         Crypto.Cipher.Blowfish         Crypto.Cipher.Camellia@@ -319,6 +320,7 @@         Crypto.Internal.ECC         Crypto.Internal.Endian         Crypto.Internal.Imports+        Crypto.Internal.Poly1305         Crypto.Internal.Nat         Crypto.Internal.WordArray         Crypto.Internal.Words@@ -543,8 +545,10 @@             -- checked in per object format since it comes from a             -- generator.             if arch(x86_64)-                cc-options: -DWITH_X86_GCM_ASM-                c-sources:  cbits/aes/gcm_x86_asm.c+                cc-options: -DWITH_X86_GCM_ASM -DWITH_GCM_FUSED+                c-sources:+                    cbits/aes/gcm_x86_asm.c+                    cbits/aes/gcm_fused_x86.c                  if os(osx)                     asm-sources: cbits/asm/aesni-gcm-x86_64-macosx.S@@ -555,7 +559,12 @@                 else                     asm-sources: cbits/asm/aesni-gcm-x86_64-elf.S -    else+    -- Neither of the two branches above.  This was an `else`, which pairs with+    -- the x86 `if` alone and so fired on AArch64 as well, where the ARMv8+    -- branch had already named every file it names.  Cabal drops the repeats,+    -- so nothing was built twice, but the line read as the fallback for a+    -- platform with no AES instructions and was not one.+    if !((flag(support_aesni) && arch(aarch64)) || ((flag(support_aesni) && (((os(linux) || os(freebsd)) || os(osx)) || os(windows))) && (arch(i386) || arch(x86_64))))         c-sources:             cbits/aes/generic.c             cbits/aes/gf.c

@@ -20,6 +20,10 @@ import qualified BlockCipher.AES.GCMLong as KATGCMLong import qualified BlockCipher.AES.OCB3 as KATOCB3 import qualified BlockCipher.AES.XTS as KATXTS+import qualified Crypto.Cipher.AES.GCM as GCM+import Data.Bits (xor)+import Foreign.Marshal.Alloc (allocaBytes)+import Foreign.Ptr (castPtr)  {- instance Show AES.AES where@@ -200,8 +204,8 @@                 ++ "-byte AAD, "                 ++ show ptlen                 ++ "-byte message"-            ) $-            case klen of+            )+            $ case klen of                 16 -> run (undefined :: AES.AES128) v                 24 -> run (undefined :: AES.AES192) v                 _ -> run (undefined :: AES.AES256) v@@ -215,13 +219,78 @@         digest ciphertext `shouldBe` ctHash         aeadSimpleDecrypt aead aad ciphertext authTag `shouldBe` Just plaintext       where-        cipher = throwCryptoError (cipherInit (KATGCMLong.gcmKey klen)) `asTypeOf` cipherWitness+        cipher =+            throwCryptoError (cipherInit (KATGCMLong.gcmKey klen)) `asTypeOf` cipherWitness         aead = throwCryptoError (aeadInit AEAD_GCM cipher KATGCMLong.gcmIV)         aad = KATGCMLong.gcmAAD aadlen         plaintext = KATGCMLong.gcmPlaintext ptlen         (authTag, ciphertext) = aeadSimpleEncrypt aead aad plaintext 16     digest bs = BA.convert (hash bs :: Digest SHA256) :: ByteString +-- | Crypto.Cipher.AES.GCM builds the key part of the state once and does a+-- whole message in one call.  It has to answer exactly what the general+-- interface answers, so it is run over the same vectors, and a tampered+-- message has to come back as Nothing rather than as plaintext.+oneShotTests :: Spec+oneShotTests = describe "Crypto.Cipher.AES.GCM" $ do+    describe "agrees with the general interface" $ do+        run "AES-128" KATGCM.vectors_aes128_enc+        run "AES-192" KATGCM.vectors_aes192_enc+        run "AES-256" KATGCM.vectors_aes256_enc+    describe "refuses a message that was interfered with" $ do+        it "a flipped bit in the tag" $ tamper (\(c, t) -> (c, flipFirst t))+        it "a flipped bit in the ciphertext" $ tamper (\(c, t) -> (flipFirst c, t))+    it "refuses input shorter than the tag" $+        (GCM.decrypt ctx16 iv16 B.empty (B.replicate 8 0) 16 :: Maybe B.ByteString)+            `shouldBe` Nothing+    describe "header protection" $ do+        it "writes the ciphertext encrypt gives" $+            withMask 4 `shouldReturn` Just (plainSealed, expectedMask 4)+        it "and at another offset" $+            withMask 0 `shouldReturn` Just (plainSealed, expectedMask 0)+        it "refuses a sample that does not fit, writing nothing" $ do+            withMask (B.length plainSealed - 15) `shouldReturn` Nothing+            withMask (-1) `shouldReturn` Nothing+  where+    run name vs =+        it name $+            [ (key, iv)+            | (key, iv, aad, input, out, taglen, tag) <- vs+            , let ctx = throwCryptoError (GCM.newContext key)+            , let sealed = GCM.encrypt ctx iv aad input taglen :: B.ByteString+            , sealed /= out `B.append` tag+                || GCM.decrypt ctx iv aad sealed taglen /= Just input+            ]+                `shouldBe` []+    ctx16 = throwCryptoError (GCM.newContext (B.replicate 16 0x2b))+    iv16 = B.replicate 12 0x77+    -- header protection keeps a key of its own, as QUIC does+    hpKeyBytes = B.replicate 16 0x9c+    hpKey = throwCryptoError (GCM.newHeaderKey hpKeyBytes)+    hpAes = throwCryptoError (cipherInit hpKeyBytes) :: AES.AES128+    message = "a packet payload" :: B.ByteString+    header = "\x40\x01\x02\x03" :: B.ByteString+    plainSealed = GCM.encrypt ctx16 iv16 header message 16 :: B.ByteString+    -- the buffers the caller owns, as a packet writer would have them+    withMask off =+        allocaBytes (B.length message + 16) $ \outp ->+            allocaBytes 16 $ \maskp -> do+                ok <- GCM.encryptWithMask ctx16 hpKey iv16 header message 16 off outp maskp+                if ok+                    then do+                        sealed <- B.packCStringLen (castPtr outp, B.length message + 16)+                        mask <- B.packCStringLen (castPtr maskp, 16)+                        return (Just (sealed, mask))+                    else return Nothing+    expectedMask off = ecbEncrypt hpAes (B.take 16 (B.drop off plainSealed))+    flipFirst b = B.cons (B.head b `xor` 1) (B.tail b)+    tamper f =+        let sealed = GCM.encrypt ctx16 iv16 B.empty ("hello there" :: B.ByteString) 16+            (c, t) = B.splitAt (B.length sealed - 16) sealed+            (c', t') = f (c, t)+         in (GCM.decrypt ctx16 iv16 B.empty (c' `B.append` t') 16 :: Maybe B.ByteString)+                `shouldBe` Nothing+ spec :: Spec spec = do     testBlockCipher128 kats128 (undefined :: AES.AES128)@@ -230,3 +299,4 @@     aeadIVLengthTests     aeadTagLengthTests     gcmLongTests+    oneShotTests

@@ -135,13 +135,16 @@             , "a8f04b0f7201a0d728101c9d26525b31764a3493fcd8458f"             ]         )-    , {--          , ("Skein256-160", HashAlg Skein256_160, [-              "ff800bed6d2044ee9d604a674e3fda50d9b24a72",-              "3265703c166aa3e0d7da070b9cf1b1a5953f0a77",-              "17b29aa1424b3ec022505bd215ff73fd2e6d1e5a" ])-      -}-+    ,+        ( "Skein256-160"+        , HashAlg (Skein256 :: Skein256 160)+        ,+            [ "ff800bed6d2044ee9d604a674e3fda50d9b24a72"+            , "3265703c166aa3e0d7da070b9cf1b1a5953f0a77"+            , "17b29aa1424b3ec022505bd215ff73fd2e6d1e5a"+            ]+        )+    ,         ( "Skein256-256"         , HashAlg Skein256_256         ,@@ -150,13 +153,16 @@             , "fb2f2f2deed0e1dd7ee2b91cee34e2d1c22072e1f5eaee288c35a0723eb653cd"             ]         )-    , {--          , ("Skein512-160", HashAlg Skein512_160, [-              "49daf1ccebb3544bc93cb5019ba91b0eea8876ee",-              "826325ee55a6dd18c3b2dbbc9c10420f5475975e",-              "7544ec7a35712ec953f02b0d0c86641cae4eb6e5" ])-      -}-+    ,+        ( "Skein512-160"+        , HashAlg (Skein512 :: Skein512 160)+        ,+            [ "49daf1ccebb3544bc93cb5019ba91b0eea8876ee"+            , "826325ee55a6dd18c3b2dbbc9c10420f5475975e"+            , "7544ec7a35712ec953f02b0d0c86641cae4eb6e5"+            ]+        )+    ,         ( "Skein512-384"         , HashAlg Skein512_384         ,@@ -563,9 +569,41 @@         Nothing -> error ("invalid Nat: " ++ show n)         Just (SomeNat p) -> convert (hashEmpty p) +-- | The Skein types with the size in their name and the ones that take it as+-- a type parameter are the same function, and the parameter also takes the+-- sizes that have no name of their own.+skeinNatTests :: Spec+skeinNatTests = describe "Skein with the digest size as a type parameter" $ do+    describe "agrees with the type of that name" $ do+        it "Skein256 224" $ same (Skein256 :: Skein256 224) Skein256_224+        it "Skein256 256" $ same (Skein256 :: Skein256 256) Skein256_256+        it "Skein512 224" $ same (Skein512 :: Skein512 224) Skein512_224+        it "Skein512 256" $ same (Skein512 :: Skein512 256) Skein512_256+        it "Skein512 384" $ same (Skein512 :: Skein512 384) Skein512_384+        it "Skein512 512" $ same (Skein512 :: Skein512 512) Skein512_512+    describe "takes a size no named type offers" $ do+        it "8 bits" $ len (Skein512 :: Skein512 8) `shouldBe` 1+        it "1024 bits" $ len (Skein512 :: Skein512 1024) `shouldBe` 128+        it "8192 bits" $ len (Skein512 :: Skein512 8192) `shouldBe` 1024+        it "rounds a size that is not a whole number of bytes up" $ do+            len (Skein512 :: Skein512 100) `shouldBe` 13+            len (Skein256 :: Skein256 1) `shouldBe` 1+    -- the length goes into the configuration block, so it changes the chaining+    -- value the message is hashed from: a longer digest is not an extension of+    -- a shorter one, which is the opposite of how SHAKE behaves+    it "answers a different size with an unrelated digest, not a longer one" $ do+        let short = convert (hashWith (Skein512 :: Skein512 256) v1) :: ByteString+            long = convert (hashWith (Skein512 :: Skein512 512) v1) :: ByteString+        B.take (B.length short) long `shouldNotBe` short+  where+    same a b = map (h a) vectors `shouldBe` map (h b) vectors+    h alg m = convert (hashWith alg m) :: ByteString+    len alg = B.length (convert (hashWith alg v1) :: ByteString)+ spec :: Spec spec = do     describe "KATs" $ mapM_ makeTestAlg expected+    skeinNatTests     describe "KATs over several blocks" $         mapM_ (makeTestAlgWith longVectors) expectedLong     describe "Chunking" $ mapM_ makeTestChunk expected

@@ -191,6 +191,19 @@         prop "point-add-inverse" propertyPointAddInverse         prop "point-negate" propertyPointNegate         prop "point-mul" propertyPointMul+        -- A signed window can reach the last addition with the accumulator+        -- equal to the very point it is adding, which the formulas cannot+        -- do: they answer the infinity where the truth is twice that point.+        -- Which scalars do it depends on the window and on the order mod 64;+        -- for the five-bit window here it is 30 alone, and the sweep that+        -- found it covered every scalar below a million and every one within+        -- a million of the order.  The neighbours are here because they are+        -- the family it came from.+        describe "point-mul-small-scalars" $+            sequence_+                [ it (show k) (casePointMulSmall k)+                | k <- [1 .. 70] ++ [2 ^ (32 :: Int), 2 ^ (64 :: Int)]+                ]         prop "infinity" $             let gN = P256.toPoint P256.scalarN                 g1 = P256.pointBase@@ -239,6 +252,13 @@                 [ eqTest "p256" pR (P256.pointMul (unP256Scalar s) p)                 , eqTest "ecc" peR (pointP256ToECC pR)                 ]++    -- k * (7 * G), against the reference implementation.+    casePointMulSmall k =+        let base = P256.toPoint (unP256Scalar (P256Scalar 7))+            baseE = ECC.pointMul curve 7 curveGen+            got = P256.pointMul (unP256Scalar (P256Scalar k)) base+         in ECC.pointMul curve k baseE `propertyEq` pointP256ToECC got      pointInfinity :: P256.Point     pointInfinity = P256.pointFromIntegers (0, 0)

@@ -89,8 +89,39 @@         CryptoPassed st -> aeadSimpleDecrypt st a5aad a5cipher (AuthTag $ B.convert a5tag)         _ -> Nothing +-- | The key is checked once, where it is made, and initializing cannot fail+-- after that.+keyTests :: Spec+keyTests = describe "key" $ do+    it "takes thirty-two bytes" $+        passed (CP.key (B.replicate 32 0x41)) `shouldBe` True+    it "refuses any other length" $+        [n | n <- [0, 1, 16, 31, 33, 64], passed (CP.key (B.replicate n 0x41))]+            `shouldBe` []+    it "says which error" $+        -- Key has no Show, on purpose: it is key material+        errorOf (CP.key (B.replicate 31 0x41))+            `shouldBe` Just CryptoError_KeySizeInvalid+    it "and the AEAD entry point reports the same thing" $+        errorOf+            (CP.aeadChacha20poly1305Init (B.replicate 31 0x41) (B.replicate 12 0x42))+            `shouldBe` Just CryptoError_KeySizeInvalid+    it "a key that was taken initializes without an error case" $ do+        let k = throwCryptoError (CP.key (B.replicate 32 0x41))+            n = throwCryptoError (CP.nonce12 (B.replicate 12 0x42))+            st = CP.initialize k n+            (out, st') = CP.encrypt ("hello" :: B.ByteString) (CP.finalizeAAD st)+        B.length out `shouldBe` 5+        B.length (B.convert (CP.finalize st') :: B.ByteString) `shouldBe` 16+  where+    passed (CryptoPassed _) = True+    passed (CryptoFailed _) = False+    errorOf (CryptoFailed e) = Just e+    errorOf (CryptoPassed _) = Nothing+ spec :: Spec spec = do+    keyTests     it "V1" runEncrypt     it "V1-decrypt" runDecrypt     it "V1-extended" runEncryptX@@ -101,8 +132,9 @@   where     runEncrypt =         let ini =-                throwCryptoError $-                    CP.initialize key (throwCryptoError $ CP.nonce8 constant iv)+                CP.initialize+                    (throwCryptoError $ CP.key key)+                    (throwCryptoError $ CP.nonce8 constant iv)             afterAAD = CP.finalizeAAD (CP.appendAAD aad ini)             (out, afterEncrypt) = CP.encrypt plaintext afterAAD             outtag = CP.finalize afterEncrypt@@ -112,7 +144,9 @@                 ]     runEncryptX =         let ini =-                throwCryptoError $ CP.initializeX key (throwCryptoError $ CP.nonce24 ivX)+                CP.initializeX+                    (throwCryptoError $ CP.key key)+                    (throwCryptoError $ CP.nonce24 ivX)             afterAAD = CP.finalizeAAD (CP.appendAAD aad ini)             (out, afterEncrypt) = CP.encrypt plaintext afterAAD             outtag = CP.finalize afterEncrypt@@ -123,8 +157,9 @@      runDecrypt =         let ini =-                throwCryptoError $-                    CP.initialize key (throwCryptoError $ CP.nonce8 constant iv)+                CP.initialize+                    (throwCryptoError $ CP.key key)+                    (throwCryptoError $ CP.nonce8 constant iv)             afterAAD = CP.finalizeAAD (CP.appendAAD aad ini)             (out, afterDecrypt) = CP.decrypt ciphertext afterAAD             outtag = CP.finalize afterDecrypt@@ -135,7 +170,9 @@      runDecryptX =         let ini =-                throwCryptoError $ CP.initializeX key (throwCryptoError $ CP.nonce24 ivX)+                CP.initializeX+                    (throwCryptoError $ CP.key key)+                    (throwCryptoError $ CP.nonce24 ivX)             afterAAD = CP.finalizeAAD (CP.appendAAD aad ini)             (out, afterDecrypt) = CP.decrypt ciphertextX afterAAD             outtag = CP.finalize afterDecrypt