From 3e5be5fdf3526f329d1948db350cf866439f999f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 9 Feb 2018 22:24:55 +0100 Subject: [PATCH 001/176] Add Read instance for Digest type --- Crypto/Hash/Types.hs | 25 ++++++++++++++++++++++++- 1 file changed, 24 insertions(+), 1 deletion(-) diff --git a/Crypto/Hash/Types.hs b/Crypto/Hash/Types.hs index 7cc2979..c537ada 100644 --- a/Crypto/Hash/Types.hs +++ b/Crypto/Hash/Types.hs @@ -9,6 +9,7 @@ -- {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} module Crypto.Hash.Types ( HashAlgorithm(..) @@ -19,9 +20,13 @@ module Crypto.Hash.Types import Crypto.Internal.Imports import Crypto.Internal.ByteArray (ByteArrayAccess, Bytes) import qualified Crypto.Internal.ByteArray as B +import Control.Monad.ST +import Data.Char (digitToInt, isHexDigit) import Foreign.Ptr (Ptr) -import Basement.Block (Block) +import Basement.Block (Block, unsafeFreeze) +import Basement.Block.Mutable (MutableBlock, new, unsafeWrite) import Basement.NormalForm (deepseq) +import Basement.Types.OffsetSize (CountOf(..), Offset(..)) import GHC.TypeLits (Nat) -- | Class representing hashing algorithms. @@ -79,3 +84,21 @@ instance NFData (Digest a) where instance Show (Digest a) where show (Digest bs) = map (toEnum . fromIntegral) $ B.unpack (B.convertToBase B.Base16 bs :: Bytes) + +instance HashAlgorithm a => Read (Digest a) where + readsPrec _ str = runST $ do mut <- new (CountOf len) + loop mut len str + where + len = hashDigestSize (undefined :: a) + + loop :: MutableBlock Word8 s -> Int -> String -> ST s [(Digest a, String)] + loop mut 0 cs = (\b -> [(Digest b, cs)]) <$> unsafeFreeze mut + loop _ _ [] = return [] + loop _ _ [_] = return [] + loop mut n (c:(d:ds)) + | not (isHexDigit c) = return [] + | not (isHexDigit d) = return [] + | otherwise = do + let w8 = fromIntegral $ digitToInt c * 16 + digitToInt d + unsafeWrite mut (Offset $ len - n) w8 + loop mut (n - 1) ds From 467ed66c1673e43f728cb4bbf07dd74b7978d323 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Mon, 12 Mar 2018 08:35:49 +0000 Subject: [PATCH 002/176] Drop GHC 7.8 and GHC 7.10 support, refer to pkg-guidelines --- .haskell-ci | 4 ---- .travis.yml | 22 +++++----------------- README.md | 23 +---------------------- cryptonite.cabal | 19 +++++++++++-------- 4 files changed, 17 insertions(+), 51 deletions(-) diff --git a/.haskell-ci b/.haskell-ci index 3efdf32..e8c5b9a 100644 --- a/.haskell-ci +++ b/.haskell-ci @@ -1,6 +1,4 @@ # compiler supported and their equivalent LTS -compiler: ghc-7.8 lts-2.22 -compiler: ghc-7.10 lts-6.35 compiler: ghc-8.0 lts-9.21 compiler: ghc-8.2 lts-10.4 compiler: ghc-8.4 ghc-8.4-alpha2 @@ -13,9 +11,7 @@ option: gaugedeps extradep=gauge-0.2.1 option: basementmin extradep=basement-0.0.6 extradep=foundation-0.0.19 extradep=memory-0.14.14 # builds -build: ghc-7.8 basementmin gaugedeps nohaddock build: ghc-8.2 basementmin gaugedeps -build: ghc-7.10 basementmin gaugedeps build: ghc-8.0 basementmin gaugedeps build: ghc-8.0 basementmin gaugedeps os=osx build: ghc-8.4 basementmin testdeps gaugedeps extradep=vector-0.12.0.1 diff --git a/.travis.yml b/.travis.yml index e96b525..e244fe9 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,4 +1,4 @@ -# ~*~ auto-generated by haskell-ci with config : 5bc659023c72919bd64a856cc98a6b681c8180a770cee29b5b1e33698264f127 ~*~ +# ~*~ auto-generated by haskell-ci with config : 26f0e346401960c8aed161c0e7d667cbc8aaeff9264b6ea514e302ae9b0f6a79 ~*~ # Use new container infrastructure to enable caching sudo: false @@ -12,9 +12,7 @@ cache: matrix: include: - - { env: BUILD=stack RESOLVER=ghc-7.8, compiler: ghc-7.8, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } - { env: BUILD=stack RESOLVER=ghc-8.2, compiler: ghc-8.2, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } - - { env: BUILD=stack RESOLVER=ghc-7.10, compiler: ghc-7.10, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } - { env: BUILD=stack RESOLVER=ghc-8.0, compiler: ghc-8.0, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } - { env: BUILD=stack RESOLVER=ghc-8.0, compiler: ghc-8.0, language: generic, addons: { apt: { packages: [ libgmp-dev ] } }, os: osx } - { env: BUILD=stack RESOLVER=ghc-8.4, compiler: ghc-8.4, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } @@ -49,33 +47,23 @@ script: stack) # create the build stack.yaml case "$RESOLVER" in - ghc-7.8) - echo "{ resolver: lts-2.22, packages: [ '.' ], extra-deps: [ basement-0.0.6, foundation-0.0.19, memory-0.14.14, gauge-0.2.1 ], flags: {} }" > stack.yaml - export HADDOCK_OPTs="--no-haddock" - ;; ghc-8.2) echo "{ resolver: lts-10.4, packages: [ '.' ], extra-deps: [ basement-0.0.6, foundation-0.0.19, memory-0.14.14, gauge-0.2.1 ], flags: {} }" > stack.yaml - export HADDOCK_OPTs="--haddock --no-haddock-deps" - ;; - ghc-7.10) - echo "{ resolver: lts-6.35, packages: [ '.' ], extra-deps: [ basement-0.0.6, foundation-0.0.19, memory-0.14.14, gauge-0.2.1 ], flags: {} }" > stack.yaml - export HADDOCK_OPTs="--haddock --no-haddock-deps" + stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; ghc-8.0) echo "{ resolver: lts-9.21, packages: [ '.' ], extra-deps: [ basement-0.0.6, foundation-0.0.19, memory-0.14.14, gauge-0.2.1 ], flags: {} }" > stack.yaml - export HADDOCK_OPTs="--haddock --no-haddock-deps" + stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; ghc-8.0) echo "{ resolver: lts-9.21, packages: [ '.' ], extra-deps: [ basement-0.0.6, foundation-0.0.19, memory-0.14.14, gauge-0.2.1 ], flags: {} }" > stack.yaml - export HADDOCK_OPTs="--haddock --no-haddock-deps" + stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; ghc-8.4) echo "{ setup-info: { ghc: { \"linux32-nopie\": { \"8.4.0.20180118\": { url: \"https://downloads.haskell.org/~ghc/8.4.1-alpha2/ghc-8.4.0.20180118-i386-deb8-linux.tar.xz\", sha256: \"be1a3b5de9f671199533d22f2810d9b62c6392b32b39833cd384a094566703c6\" } }, \"windows32\": { \"8.4.0.20180118\": { url: \"https://downloads.haskell.org/~ghc/8.4.1-alpha2/ghc-8.4.0.20180118-i386-unknown-mingw32.tar.xz\", sha256: \"3f4b9291ad35d89ca7b3561312a4329545aedceb5c4c8c5c4cf01550037376a1\" } }, \"linux64\": { \"8.4.0.20180118\": { url: \"https://downloads.haskell.org/~ghc/8.4.1-alpha2/ghc-8.4.0.20180118-x86_64-deb8-linux.tar.xz\", sha256: \"55b54bce14661c19288c3413b8fab95d2b7fae407986323c7f0b6a732bec6a38\" } }, \"linux64-tinfo\": { \"8.4.0.20180118\": { url: \"https://downloads.haskell.org/~ghc/8.4.1-alpha2/ghc-8.4.0.20180118-x86_64-deb8-linux.tar.xz\", sha256: \"55b54bce14661c19288c3413b8fab95d2b7fae407986323c7f0b6a732bec6a38\" } }, \"linux64-tinfo6\": { \"8.4.0.20180118\": { url: \"https://downloads.haskell.org/~ghc/8.4.1-alpha2/ghc-8.4.0.20180118-x86_64-fedora27-linux.tar.xz\", sha256: \"47c7e4350c9560f984bde75b243aa10c91e37494152d87d20f84fcee857338ef\" } }, \"linux64-tinfo-nopie\": { \"8.4.0.20180118\": { url: \"https://downloads.haskell.org/~ghc/8.4.1-alpha2/ghc-8.4.0.20180118-x86_64-fedora27-linux.tar.xz\", sha256: \"47c7e4350c9560f984bde75b243aa10c91e37494152d87d20f84fcee857338ef\" } }, \"linux64-nopie\": { \"8.4.0.20180118\": { url: \"https://downloads.haskell.org/~ghc/8.4.1-alpha2/ghc-8.4.0.20180118-x86_64-deb8-linux.tar.xz\", sha256: \"55b54bce14661c19288c3413b8fab95d2b7fae407986323c7f0b6a732bec6a38\" } }, \"windows64\": { \"8.4.0.20180118\": { url: \"https://downloads.haskell.org/~ghc/8.4.1-alpha2/ghc-8.4.0.20180118-x86_64-unknown-mingw32.tar.xz\", sha256: \"93dd7f80e3c645b79a91f3023046144ec88927961a3443019034e2893de43752\" } }, \"macosx\": { \"8.4.0.20180118\": { url: \"https://downloads.haskell.org/~ghc/8.4.1-alpha2/ghc-8.4.0.20180118-x86_64-apple-darwin.tar.xz\", sha256: \"b3119b255ab3d1a09fcf9919bddbbe2cd77f9175de14e4b23f20b40abe5edea1\" } } } }, resolver: ghc-8.4.0.20180118, compiler: ghc-8.4.0.20180118, compiler-check: match-exact, packages: [ '.' ], extra-deps: [ vector-0.12.0.1, basement-0.0.6, foundation-0.0.19, memory-0.14.14, QuickCheck-2.11.3, ansi-terminal-0.8.0.1, async-2.1.1.1, call-stack-0.1.0, clock-0.7.2, optparse-applicative-0.14.0.0, random-1.1, tagged-0.8.5, unbounded-delays-0.1.1.0, tasty-1.0.0.1, tasty-hunit-0.10.0.1, tasty-kat-0.0.3, tasty-quickcheck-0.9.2, ansi-wl-pprint-0.6.8.2, colour-2.3.4, tf-random-0.5, transformers-compat-0.5.1.4, primitive-0.6.3.0, gauge-0.2.1 ], flags: {}, allow-newer: true }" > stack.yaml - export HADDOCK_OPTs="--haddock --no-haddock-deps" + stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; esac - # build & run test - stack --no-terminal test --install-ghc --coverage --bench --no-run-benchmarks ${HADDOCK_OPTS} ;; hlint) curl -sL https://raw.github.com/ndmitchell/hlint/master/misc/travis.sh | sh -s . --cpp-define=__GLASGOW_HASKELL__=800 --cpp-define=x86_64_HOST_ARCH=1 --cpp-define=mingw32_HOST_OS=1 diff --git a/README.md b/README.md index 56b1b98..a81e889 100644 --- a/README.md +++ b/README.md @@ -43,28 +43,7 @@ The coding style of this project mostly follows: Support ------- -cryptonite supports the following platforms: - -* Windows >= 8 -* OSX >= 10.8 -* Linux -* BSDs - -On the following architectures: - -* x86-64 -* i386 - -On the following haskell versions: - -* GHC 7.8.x -* GHC 7.10.x -* GHC 8.0.x -* GHC 8.2.x - -Further platforms and architectures probably work too, but since the -maintainer(s) don't have regular access to them, we can't commit to -further support. +See [Haskell packages guidelines](https://github.com/vincenthz/haskell-pkg-guidelines/blob/master/README.md#support) Known Building Issues --------------------- diff --git a/cryptonite.cabal b/cryptonite.cabal index ead6ee1..f282306 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -184,6 +184,7 @@ Library Crypto.Error.Types Crypto.Number.Compat Crypto.Hash.Types + Crypto.Hash.Blake2 Crypto.Hash.Blake2s Crypto.Hash.Blake2sp Crypto.Hash.Blake2b @@ -195,6 +196,7 @@ Library Crypto.Hash.SHA512 Crypto.Hash.SHA512t Crypto.Hash.SHA3 + Crypto.Hash.SHAKE Crypto.Hash.Keccak Crypto.Hash.MD2 Crypto.Hash.MD4 @@ -219,14 +221,15 @@ Library Crypto.Internal.CompatPrim Crypto.Internal.DeepSeq Crypto.Internal.Imports + Crypto.Internal.Nat Crypto.Internal.Words Crypto.Internal.WordArray - if impl(ghc >= 7.8) - Other-modules: Crypto.Hash.SHAKE - Crypto.Hash.Blake2 - Crypto.Internal.Nat - Build-depends: base >= 4.6 && < 5 - , bytestring + if impl(ghc < 8.0) + Buildable: False + else + Build-depends: base + + Build-depends: bytestring , memory >= 0.14.14 , basement >= 0.0.6 , ghc-prim @@ -416,7 +419,7 @@ Test-Suite test-cryptonite Salsa Utils XSalsa - Build-Depends: base >= 3 && < 5 + Build-Depends: base , bytestring , memory , tasty @@ -432,7 +435,7 @@ Benchmark bench-cryptonite hs-source-dirs: benchs Main-is: Bench.hs Other-modules: Number.F2m - Build-Depends: base >= 3 && < 5 + Build-Depends: base , bytestring , deepseq , memory From d2da00445de3d4a5d358d3bbc5c9d73cb49f7aa1 Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Thu, 5 Apr 2018 21:40:50 -0400 Subject: [PATCH 003/176] fix spelling of "exponent" --- Crypto/Number/ModArithmetic.hs | 8 ++++---- Crypto/PubKey/RSA.hs | 4 ++-- Crypto/PubKey/RSA/Types.hs | 4 ++-- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/Crypto/Number/ModArithmetic.hs b/Crypto/Number/ModArithmetic.hs index 398c17c..4ca6317 100644 --- a/Crypto/Number/ModArithmetic.hs +++ b/Crypto/Number/ModArithmetic.hs @@ -28,7 +28,7 @@ data CoprimesAssertionError = CoprimesAssertionError instance Exception CoprimesAssertionError --- | Compute the modular exponentiation of base^exponant using +-- | Compute the modular exponentiation of base^exponent using -- algorithms design to avoid side channels and timing measurement -- -- Modulo need to be odd otherwise the normal fast modular exponentiation @@ -42,7 +42,7 @@ instance Exception CoprimesAssertionError -- (which is now integer-gmp2), so is has the same security as old -- ghc version. expSafe :: Integer -- ^ base - -> Integer -- ^ exponant + -> Integer -- ^ exponent -> Integer -- ^ modulo -> Integer -- ^ result expSafe b e m @@ -52,14 +52,14 @@ expSafe b e m | otherwise = gmpPowModInteger b e m `onGmpUnsupported` exponentiation b e m --- | Compute the modular exponentiation of base^exponant using +-- | Compute the modular exponentiation of base^exponent using -- the fastest algorithm without any consideration for -- hiding parameters. -- -- Use this function when all the parameters are public, -- otherwise 'expSafe' should be prefered. expFast :: Integer -- ^ base - -> Integer -- ^ exponant + -> Integer -- ^ exponent -> Integer -- ^ modulo -> Integer -- ^ result expFast b e m = gmpPowModInteger b e m `onGmpUnsupported` exponentiation b e m diff --git a/Crypto/PubKey/RSA.hs b/Crypto/PubKey/RSA.hs index eea7070..131da3d 100644 --- a/Crypto/PubKey/RSA.hs +++ b/Crypto/PubKey/RSA.hs @@ -55,7 +55,7 @@ toPositive int -- generateWith :: (Integer, Integer) -- ^ chosen distinct primes p and q -> Int -- ^ size in bytes - -> Integer -- ^ RSA public exponant 'e' + -> Integer -- ^ RSA public exponent 'e' -> Maybe (PublicKey, PrivateKey) generateWith (p,q) size e = case inverse e phi of @@ -81,7 +81,7 @@ generateWith (p,q) size e = -- | generate a pair of (private, public) key of size in bytes. generate :: MonadRandom m => Int -- ^ size in bytes - -> Integer -- ^ RSA public exponant 'e' + -> Integer -- ^ RSA public exponent 'e' -> m (PublicKey, PrivateKey) generate size e = loop where diff --git a/Crypto/PubKey/RSA/Types.hs b/Crypto/PubKey/RSA/Types.hs index 9adeea7..d3ac487 100644 --- a/Crypto/PubKey/RSA/Types.hs +++ b/Crypto/PubKey/RSA/Types.hs @@ -41,7 +41,7 @@ data Error = data PublicKey = PublicKey { public_size :: Int -- ^ size of key in bytes , public_n :: Integer -- ^ public p*q - , public_e :: Integer -- ^ public exponant e + , public_e :: Integer -- ^ public exponent e } deriving (Show,Read,Eq,Data,Typeable) instance NFData PublicKey where @@ -59,7 +59,7 @@ instance NFData PublicKey where -- data PrivateKey = PrivateKey { private_pub :: PublicKey -- ^ public part of a private key (size, n and e) - , private_d :: Integer -- ^ private exponant d + , private_d :: Integer -- ^ private exponent d , private_p :: Integer -- ^ p prime number , private_q :: Integer -- ^ q prime number , private_dP :: Integer -- ^ d mod (p-1) From d27d4646278372549e0540797a48ac4b0ecaecd0 Mon Sep 17 00:00:00 2001 From: Luke Taylor Date: Tue, 17 Apr 2018 13:46:51 +0100 Subject: [PATCH 004/176] Fix cost parsing for bcrypt The tens value was wrong for values of 20+, as reported in #230. It should be 10*costTens not 10^costTens. This wasn't detected because the values are the same when costTens is 1, and using high cost values is rare with bcrypt because of the performance hit. Also added a simple hash and validate test since the KAT tests only do validation. This doesn't cover this bug since the cost value is too high to include in the test. It allows similar issues to be tested locally though. --- Crypto/KDF/BCrypt.hs | 2 +- tests/BCrypt.hs | 4 ++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/Crypto/KDF/BCrypt.hs b/Crypto/KDF/BCrypt.hs index 745de0f..b374b4f 100644 --- a/Crypto/KDF/BCrypt.hs +++ b/Crypto/KDF/BCrypt.hs @@ -159,7 +159,7 @@ parseBCryptHash bc = do costTens = fromIntegral (B.index bc 4) - zero costUnits = fromIntegral (B.index bc 5) - zero version = chr (fromIntegral (B.index bc 2)) - cost = costUnits + (if costTens == 0 then 0 else 10^costTens) :: Int + cost = costUnits + 10*costTens :: Int decodeSaltHash saltHash = do let (s, h) = B.splitAt 22 saltHash diff --git a/tests/BCrypt.hs b/tests/BCrypt.hs index 0a932f2..8a9562b 100644 --- a/tests/BCrypt.hs +++ b/tests/BCrypt.hs @@ -75,4 +75,8 @@ makeKATs = concatMap maketest (zip3 is passwords hashes) tests = testGroup "bcrypt" [ testGroup "KATs" makeKATs , testCase "Invalid hash length" (assertEqual "" (Left "Invalid hash format") (validatePasswordEither B.empty ("$2a$06$DCq7YPn5Rq63x1Lad4cll.TV4S6ytwfsfvkgY8jIucDrjc8deX1s" :: B.ByteString))) + , testCase "Hash and validate" (assertBool "Hashed password should validate" (validatePassword somePassword (bcrypt 5 aSalt somePassword :: B.ByteString))) ] + where + somePassword = "some password" :: B.ByteString + aSalt = "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f" :: B.ByteString From 15f63fd84955756436e6a6e2dca04147e6b95501 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Mon, 16 Apr 2018 06:45:46 +0200 Subject: [PATCH 005/176] Enable powModSecInteger with integer-gmp >= 1.0.2.0 --- Crypto/Number/Compat.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/Crypto/Number/Compat.hs b/Crypto/Number/Compat.hs index ffc1f30..6a77c22 100644 --- a/Crypto/Number/Compat.hs +++ b/Crypto/Number/Compat.hs @@ -70,7 +70,9 @@ gmpLog2 _ = GmpUnsupported -- | Compute the power modulus using extra security to remain constant -- time wise through GMP gmpPowModSecInteger :: Integer -> Integer -> Integer -> GmpSupported Integer -#if MIN_VERSION_integer_gmp(1,0,0) +#if MIN_VERSION_integer_gmp(1,0,2) +gmpPowModSecInteger b e m = GmpSupported (powModSecInteger b e m) +#elif MIN_VERSION_integer_gmp(1,0,0) gmpPowModSecInteger _ _ _ = GmpUnsupported #elif MIN_VERSION_integer_gmp(0,5,1) gmpPowModSecInteger b e m = GmpSupported (powModSecInteger b e m) From a2a2372412e11ae2b6458ff42b3ad7335e1eb68e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 20 Apr 2018 20:43:44 +0200 Subject: [PATCH 006/176] Use newer GHC and lts for CI --- .haskell-ci | 4 ++-- .travis.yml | 7 ++++--- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/.haskell-ci b/.haskell-ci index e8c5b9a..82d4a84 100644 --- a/.haskell-ci +++ b/.haskell-ci @@ -1,7 +1,7 @@ # compiler supported and their equivalent LTS compiler: ghc-8.0 lts-9.21 -compiler: ghc-8.2 lts-10.4 -compiler: ghc-8.4 ghc-8.4-alpha2 +compiler: ghc-8.2 lts-11.6 +compiler: ghc-8.4 ghc-8.4.2 # options # option: alias x=y z=v diff --git a/.travis.yml b/.travis.yml index e244fe9..eec4255 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,4 +1,4 @@ -# ~*~ auto-generated by haskell-ci with config : 26f0e346401960c8aed161c0e7d667cbc8aaeff9264b6ea514e302ae9b0f6a79 ~*~ +# ~*~ auto-generated by haskell-ci with config : 7d7fe90696706f37292f4d718fa1a63b938490d653e3abf049623087b2e6e901 ~*~ # Use new container infrastructure to enable caching sudo: false @@ -48,7 +48,7 @@ script: # create the build stack.yaml case "$RESOLVER" in ghc-8.2) - echo "{ resolver: lts-10.4, packages: [ '.' ], extra-deps: [ basement-0.0.6, foundation-0.0.19, memory-0.14.14, gauge-0.2.1 ], flags: {} }" > stack.yaml + echo "{ resolver: lts-11.6, packages: [ '.' ], extra-deps: [ basement-0.0.6, foundation-0.0.19, memory-0.14.14, gauge-0.2.1 ], flags: {} }" > stack.yaml stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; ghc-8.0) @@ -60,7 +60,7 @@ script: stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; ghc-8.4) - echo "{ setup-info: { ghc: { \"linux32-nopie\": { \"8.4.0.20180118\": { url: \"https://downloads.haskell.org/~ghc/8.4.1-alpha2/ghc-8.4.0.20180118-i386-deb8-linux.tar.xz\", sha256: \"be1a3b5de9f671199533d22f2810d9b62c6392b32b39833cd384a094566703c6\" } }, \"windows32\": { \"8.4.0.20180118\": { url: \"https://downloads.haskell.org/~ghc/8.4.1-alpha2/ghc-8.4.0.20180118-i386-unknown-mingw32.tar.xz\", sha256: \"3f4b9291ad35d89ca7b3561312a4329545aedceb5c4c8c5c4cf01550037376a1\" } }, \"linux64\": { \"8.4.0.20180118\": { url: \"https://downloads.haskell.org/~ghc/8.4.1-alpha2/ghc-8.4.0.20180118-x86_64-deb8-linux.tar.xz\", sha256: \"55b54bce14661c19288c3413b8fab95d2b7fae407986323c7f0b6a732bec6a38\" } }, \"linux64-tinfo\": { \"8.4.0.20180118\": { url: \"https://downloads.haskell.org/~ghc/8.4.1-alpha2/ghc-8.4.0.20180118-x86_64-deb8-linux.tar.xz\", sha256: \"55b54bce14661c19288c3413b8fab95d2b7fae407986323c7f0b6a732bec6a38\" } }, \"linux64-tinfo6\": { \"8.4.0.20180118\": { url: \"https://downloads.haskell.org/~ghc/8.4.1-alpha2/ghc-8.4.0.20180118-x86_64-fedora27-linux.tar.xz\", sha256: \"47c7e4350c9560f984bde75b243aa10c91e37494152d87d20f84fcee857338ef\" } }, \"linux64-tinfo-nopie\": { \"8.4.0.20180118\": { url: \"https://downloads.haskell.org/~ghc/8.4.1-alpha2/ghc-8.4.0.20180118-x86_64-fedora27-linux.tar.xz\", sha256: \"47c7e4350c9560f984bde75b243aa10c91e37494152d87d20f84fcee857338ef\" } }, \"linux64-nopie\": { \"8.4.0.20180118\": { url: \"https://downloads.haskell.org/~ghc/8.4.1-alpha2/ghc-8.4.0.20180118-x86_64-deb8-linux.tar.xz\", sha256: \"55b54bce14661c19288c3413b8fab95d2b7fae407986323c7f0b6a732bec6a38\" } }, \"windows64\": { \"8.4.0.20180118\": { url: \"https://downloads.haskell.org/~ghc/8.4.1-alpha2/ghc-8.4.0.20180118-x86_64-unknown-mingw32.tar.xz\", sha256: \"93dd7f80e3c645b79a91f3023046144ec88927961a3443019034e2893de43752\" } }, \"macosx\": { \"8.4.0.20180118\": { url: \"https://downloads.haskell.org/~ghc/8.4.1-alpha2/ghc-8.4.0.20180118-x86_64-apple-darwin.tar.xz\", sha256: \"b3119b255ab3d1a09fcf9919bddbbe2cd77f9175de14e4b23f20b40abe5edea1\" } } } }, resolver: ghc-8.4.0.20180118, compiler: ghc-8.4.0.20180118, compiler-check: match-exact, packages: [ '.' ], extra-deps: [ vector-0.12.0.1, basement-0.0.6, foundation-0.0.19, memory-0.14.14, QuickCheck-2.11.3, ansi-terminal-0.8.0.1, async-2.1.1.1, call-stack-0.1.0, clock-0.7.2, optparse-applicative-0.14.0.0, random-1.1, tagged-0.8.5, unbounded-delays-0.1.1.0, tasty-1.0.0.1, tasty-hunit-0.10.0.1, tasty-kat-0.0.3, tasty-quickcheck-0.9.2, ansi-wl-pprint-0.6.8.2, colour-2.3.4, tf-random-0.5, transformers-compat-0.5.1.4, primitive-0.6.3.0, gauge-0.2.1 ], flags: {}, allow-newer: true }" > stack.yaml + echo "{ resolver: ghc-8.4.2, packages: [ '.' ], extra-deps: [ vector-0.12.0.1, basement-0.0.6, foundation-0.0.19, memory-0.14.14, QuickCheck-2.11.3, ansi-terminal-0.8.0.1, async-2.1.1.1, call-stack-0.1.0, clock-0.7.2, optparse-applicative-0.14.0.0, random-1.1, tagged-0.8.5, unbounded-delays-0.1.1.0, tasty-1.0.0.1, tasty-hunit-0.10.0.1, tasty-kat-0.0.3, tasty-quickcheck-0.9.2, ansi-wl-pprint-0.6.8.2, colour-2.3.4, tf-random-0.5, transformers-compat-0.5.1.4, primitive-0.6.3.0, gauge-0.2.1 ], flags: {}, allow-newer: true }" > stack.yaml stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; esac @@ -75,3 +75,4 @@ script: esac set +ex + From 9d961e92e93f2f10b527fbbb2157cfc78e9e0cbe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 21 Apr 2018 07:55:25 +0200 Subject: [PATCH 007/176] Comment about not having Show instance for HMAC Closes #232. --- Crypto/MAC/HMAC.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Crypto/MAC/HMAC.hs b/Crypto/MAC/HMAC.hs index 77582e3..f44008a 100644 --- a/Crypto/MAC/HMAC.hs +++ b/Crypto/MAC/HMAC.hs @@ -32,7 +32,8 @@ import Crypto.Internal.Imports -- | Represent an HMAC that is a phantom type with the hash used to produce the mac. -- --- The Eq instance is constant time. +-- The Eq instance is constant time. No Show instance is provided, to avoid +-- printing by mistake. newtype HMAC a = HMAC { hmacGetDigest :: Digest a } deriving (ByteArrayAccess) From 1fa6c35c352c5b6809da561a755a9e416a4e2714 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 27 Apr 2018 21:29:28 +0200 Subject: [PATCH 008/176] Update tested-with --- cryptonite.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cryptonite.cabal b/cryptonite.cabal index f282306..855aa39 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -36,7 +36,7 @@ Build-Type: Simple Homepage: https://github.com/haskell-crypto/cryptonite Bug-reports: https://github.com/haskell-crypto/cryptonite/issues Cabal-Version: >=1.18 -tested-with: GHC==8.0.2, GHC==7.10.3, GHC==7.8.4 +tested-with: GHC==8.4.2, GHC==8.2.2, GHC==8.0.2 extra-doc-files: README.md CHANGELOG.md extra-source-files: cbits/*.h cbits/aes/*.h From b3a1506d82570cb9836b56f71832f3e468f10c03 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 28 Apr 2018 08:09:25 +0200 Subject: [PATCH 009/176] Remove conditionals related to SHAKE and Blake2 Not needed anymore now that GHC > 8.0. --- Crypto/Hash/Algorithms.hs | 5 ----- QA.hs | 1 - tests/Hash.hs | 5 ----- 3 files changed, 11 deletions(-) diff --git a/Crypto/Hash/Algorithms.hs b/Crypto/Hash/Algorithms.hs index ade287f..1565c0b 100644 --- a/Crypto/Hash/Algorithms.hs +++ b/Crypto/Hash/Algorithms.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} -- | -- Module : Crypto.Hash.Algorithms -- License : BSD-style @@ -42,12 +41,10 @@ module Crypto.Hash.Algorithms , SHA3_256(..) , SHA3_384(..) , SHA3_512(..) -#if MIN_VERSION_base(4,7,0) , SHAKE128(..) , SHAKE256(..) , Blake2b(..), Blake2bp(..) , Blake2s(..), Blake2sp(..) -#endif , Skein256_224(..) , Skein256_256(..) , Skein512_224(..) @@ -78,7 +75,5 @@ import Crypto.Hash.Tiger import Crypto.Hash.Skein256 import Crypto.Hash.Skein512 import Crypto.Hash.Whirlpool -#if MIN_VERSION_base(4,7,0) import Crypto.Hash.SHAKE import Crypto.Hash.Blake2 -#endif diff --git a/QA.hs b/QA.hs index 949e24a..19827dd 100644 --- a/QA.hs +++ b/QA.hs @@ -26,7 +26,6 @@ allowedExtensions = , TypeFamilies, KindSignatures ] perModuleAllowedExtensions = [ ("Crypto/Hash/Utils.hs", [MagicHash]) - , ("Crypto/Hash/Algorithms.hs", [CPP]) , ("Crypto/Hash/SHAKE.hs", [UndecidableInstances,TypeOperators,ConstraintKinds,DataKinds,KindSignatures]) , ("Crypto/Internal/ByteArray.hs", [MagicHash, UnboxedTuples]) , ("Crypto/Internal/Memory.hs", [MagicHash, UnboxedTuples]) diff --git a/tests/Hash.hs b/tests/Hash.hs index abbdb6c..f139bc1 100644 --- a/tests/Hash.hs +++ b/tests/Hash.hs @@ -1,10 +1,7 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ExistentialQuantification #-} -#if MIN_VERSION_base(4,7,0) {-# LANGUAGE DataKinds #-} -#endif module Hash ( tests ) where @@ -174,7 +171,6 @@ expected = [ "69217a3079908094e11121d042354a7c1f55b6482ca1a51e1b250dfd1ed0eef9", "606beeec743ccbeff6cbcdf5d5302aa855c256c29b88c8ed331ea1a6bf3c8812", "94662583a600a12dff357c0a6f1b514a710ef0f587a38e8d2e4d7f67e9c81667" ]) -#if MIN_VERSION_base(4,7,0) , ("SHAKE128_4096", HashAlg (SHAKE128 :: SHAKE128 4096), [ "7f9c2ba4e88f827d616045507605853ed73b8093f6efbc88eb1a6eacfa66ef263cb1eea988004b93103cfb0aeefd2a686e01fa4a58e8a3639ca8a1e3f9ae57e235b8cc873c23dc62b8d260169afa2f75ab916a58d974918835d25e6a435085b2badfd6dfaac359a5efbb7bcc4b59d538df9a04302e10c8bc1cbf1a0b3a5120ea17cda7cfad765f5623474d368ccca8af0007cd9f5e4c849f167a580b14aabdefaee7eef47cb0fca9767be1fda69419dfb927e9df07348b196691abaeb580b32def58538b8d23f87732ea63b02b4fa0f4873360e2841928cd60dd4cee8cc0d4c922a96188d032675c8ac850933c7aff1533b94c834adbb69c6115bad4692d8619f90b0cdf8a7b9c264029ac185b70b83f2801f2f4b3f70c593ea3aeeb613a7f1b1de33fd75081f592305f2e4526edc09631b10958f464d889f31ba010250fda7f1368ec2967fc84ef2ae9aff268e0b1700affc6820b523a3d917135f2dff2ee06bfe72b3124721d4a26c04e53a75e30e73a7a9c4a95d91c55d495e9f51dd0b5e9d83c6d5e8ce803aa62b8d654db53d09b8dcff273cdfeb573fad8bcd45578bec2e770d01efde86e721a3f7c6cce275dabe6e2143f1af18da7efddc4c7b70b5e345db93cc936bea323491ccb38a388f546a9ff00dd4e1300b9b2153d2041d205b443e41b45a653f2a5c4492c1add544512dda2529833462b71a41a45be97290b6f", "f4202e3c5852f9182a0430fd8144f0a74b95e7417ecae17db0f8cfeed0e3e66eb5585ec6f86021cacf272c798bcf97d368b886b18fec3a571f096086a523717a3732d50db2b0b7998b4117ae66a761ccf1847a1616f4c07d5178d0d965f9feba351420f8bfb6f5ab9a0cb102568eabf3dfa4e22279f8082dce8143eb78235a1a54914ab71abb07f2f3648468370b9fbb071e074f1c030a4030225f40c39480339f3dc71d0f04f71326de1381674cc89e259e219927fae8ea2799a03da862a55afafe670957a2af3318d919d0a3358f3b891236d6a8e8d19999d1076b529968faefbd880d77bb300829dca87e9c8e4c28e0800ff37490a5bd8c36c0b0bdb2701a5d58d03378b9dbd384389e3ef0fd4003b08998fd3f32fe1a0810fc0eccaad94bca8dd83b34559c333f0b16dfc2896ed87b30ba14c81f87cd8b4bb6317db89b0e7e94c0616f9a665fba5b0e6fb3549c9d7b68e66d08a86eb2faec05cc462a771806b93cc38b0a4feb9935c6c8945da6a589891ba5ee99753cfdd38e1abc7147fd74b7c7d1ce0609b6680a2e18888d84949b6e6cf6a2aa4113535aaee079459e3f257b569a9450523c41f5b5ba4b79b3ba5949140a74bb048de0657d04954bdd71dae76f61e2a1f88aecb91cfa5b36c1bf3350a798dc4dcf48628effe3a0c5340c756bd922f78d0e36ef7df12ce78c179cc721ad087e15ea496bf5f60b21b5822d", @@ -215,7 +211,6 @@ expected = [ "69217a3079908094e11121d042354a7c1f55b6482ca1a51e1b250dfd1ed0eef9", "606beeec743ccbeff6cbcdf5d5302aa855c256c29b88c8ed331ea1a6bf3c8812", "94662583a600a12dff357c0a6f1b514a710ef0f587a38e8d2e4d7f67e9c81667" ]) -#endif ] runhash :: HashAlg -> ByteString -> ByteString From d0ac50c1afa6bc78db347f629d70f6fac237b51d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 29 Apr 2018 10:43:55 +0200 Subject: [PATCH 010/176] Additional QA clean-up --- Crypto/PubKey/Curve448.hs | 1 - QA.hs | 6 ++++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/Crypto/PubKey/Curve448.hs b/Crypto/PubKey/Curve448.hs index bc83fb9..0900773 100644 --- a/Crypto/PubKey/Curve448.hs +++ b/Crypto/PubKey/Curve448.hs @@ -12,7 +12,6 @@ -- data types are compatible with the encoding specified in RFC 7748. -- {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MagicHash #-} module Crypto.PubKey.Curve448 ( SecretKey , PublicKey diff --git a/QA.hs b/QA.hs index 19827dd..09bb60e 100644 --- a/QA.hs +++ b/QA.hs @@ -23,10 +23,10 @@ newtype ModuleName = ModuleName String allowedExtensions = [ ScopedTypeVariables, BangPatterns, ForeignFunctionInterface, DeriveDataTypeable, ViewPatterns, GeneralizedNewtypeDeriving, ExistentialQuantification, EmptyDataDecls - , TypeFamilies, KindSignatures ] + , TypeFamilies, KindSignatures, DataKinds ] perModuleAllowedExtensions = [ ("Crypto/Hash/Utils.hs", [MagicHash]) - , ("Crypto/Hash/SHAKE.hs", [UndecidableInstances,TypeOperators,ConstraintKinds,DataKinds,KindSignatures]) + , ("Crypto/Hash/SHAKE.hs", [UndecidableInstances,TypeOperators,ConstraintKinds]) , ("Crypto/Internal/ByteArray.hs", [MagicHash, UnboxedTuples]) , ("Crypto/Internal/Memory.hs", [MagicHash, UnboxedTuples]) , ("Crypto/Internal/Compat.hs", [CPP]) @@ -42,8 +42,10 @@ perModuleAllowedExtensions = , ("Crypto/Cipher/AES.hs", [CPP]) , ("Crypto/Cipher/Types/Block.hs", [Rank2Types, MultiParamTypeClasses]) , ("Crypto/Cipher/Types/AEAD.hs", [Rank2Types]) + , ("Crypto/Cipher/CAST5/Primitive.hs", [MagicHash]) , ("Crypto/Cipher/Camellia/Primitive.hs", [MagicHash]) , ("Crypto/Cipher/DES/Primitive.hs", [FlexibleInstances]) + , ("Crypto/Cipher/Twofish/Primitive.hs", [MagicHash]) , ("Crypto/PubKey/Curve25519.hs", [MagicHash]) , ("Crypto/Number/Compat.hs", [UnboxedTuples,MagicHash,CPP]) ] From 4622e5fc8ece82f4cf31358e31cd02cf020e558e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Tue, 1 May 2018 08:23:08 +0200 Subject: [PATCH 011/176] Fix ECC failures on arm64 Resolves #234. --- cryptonite.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cryptonite.cabal b/cryptonite.cabal index 855aa39..bbfebac 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -272,7 +272,7 @@ Library , cbits/decaf/include , cbits/decaf/p448 - if arch(x86_64) + if arch(x86_64) || arch(aarch64) C-sources: cbits/decaf/p448/arch_ref64/f_impl.c , cbits/decaf/p448/f_generic.c , cbits/decaf/p448/f_arithmetic.c @@ -295,7 +295,7 @@ Library include-dirs: cbits/decaf/include/arch_32 , cbits/decaf/p448/arch_32 - if arch(x86_64) + if arch(x86_64) || arch(aarch64) C-sources: cbits/curve25519/curve25519-donna-c64.c else C-sources: cbits/curve25519/curve25519-donna.c From ff8a1c524dbcc5da5e32adfe9e9a01f371898788 Mon Sep 17 00:00:00 2001 From: Lars Petersen Date: Tue, 8 May 2018 22:08:20 +0200 Subject: [PATCH 012/176] Extend the internal interface of the Blowfish module. In preparation of an implementation of the bcrypt_pbkdf (a variant of PBKDF2 used by OpenSSH) algorithm, certain low-level operations of the Blowfish algorithm need to be generalized and exposed. The Blowfish.Primitive module has already been extended to account for the requirements imposed by the BCrypt algorithm, but the salt length was limited to 16 bytes and the BCrypt specific key schedule setup has been hard-coded into the Blowfish module. This commit makes a clear distintion between the expandKey and expandKeyWithSalt operation. Both take arbitrary sized salts and keys now. The specialized operation for 16 byte salts as used by BCrypt has been preserved and is selected automatically. Also, the BCrypt specific parts have been move to the BCrypt module with regard to separation of concern. A benchmark for generating BCrypt hashes with cost 10 shows a performance improvement from 158 to 141ms on average (Intel i5-6500) after this refactoring. Further experiments suggest that the specialized expandKeyWithSalt128 does not have any advantage over the generalized version and might be removed in favour of less branches and exceptional behaviour. --- Crypto/Cipher/Blowfish/Box.hs | 12 +- Crypto/Cipher/Blowfish/Primitive.hs | 351 ++++++++++++++++------------ Crypto/KDF/BCrypt.hs | 33 ++- 3 files changed, 239 insertions(+), 157 deletions(-) diff --git a/Crypto/Cipher/Blowfish/Box.hs b/Crypto/Cipher/Blowfish/Box.hs index 2a2f42c..34414a7 100644 --- a/Crypto/Cipher/Blowfish/Box.hs +++ b/Crypto/Cipher/Blowfish/Box.hs @@ -5,15 +5,19 @@ -- Portability : Good {-# LANGUAGE MagicHash #-} module Crypto.Cipher.Blowfish.Box - ( createKeySchedule + ( KeySchedule(..) + , createKeySchedule ) where -import Crypto.Internal.WordArray (mutableArray32FromAddrBE, MutableArray32) +import Crypto.Internal.WordArray (MutableArray32, + mutableArray32FromAddrBE) + +newtype KeySchedule = KeySchedule MutableArray32 -- | Create a key schedule mutable array of the pbox followed by -- all the sboxes. -createKeySchedule :: IO MutableArray32 -createKeySchedule = mutableArray32FromAddrBE 1042 "\ +createKeySchedule :: IO KeySchedule +createKeySchedule = KeySchedule `fmap` mutableArray32FromAddrBE 1042 "\ \\x24\x3f\x6a\x88\x85\xa3\x08\xd3\x13\x19\x8a\x2e\x03\x70\x73\x44\ \\xa4\x09\x38\x22\x29\x9f\x31\xd0\x08\x2e\xfa\x98\xec\x4e\x6c\x89\ \\x45\x28\x21\xe6\x38\xd0\x13\x77\xbe\x54\x66\xcf\x34\xe9\x0c\x6c\ diff --git a/Crypto/Cipher/Blowfish/Primitive.hs b/Crypto/Cipher/Blowfish/Primitive.hs index 6fcd388..572a5ec 100644 --- a/Crypto/Cipher/Blowfish/Primitive.hs +++ b/Crypto/Cipher/Blowfish/Primitive.hs @@ -5,6 +5,7 @@ -- Portability : Good -- Rewritten by Vincent Hanquez (c) 2015 +-- Lars Petersen (c) 2018 -- -- Original code: -- Crypto.Cipher.Blowfish.Primitive, copyright (c) 2012 Stijn van Drongelen @@ -16,186 +17,242 @@ module Crypto.Cipher.Blowfish.Primitive , initBlowfish , encrypt , decrypt - , eksBlowfish + , KeySchedule + , createKeySchedule + , freezeKeySchedule + , expandKey + , expandKeyWithSalt ) where -import Control.Monad (when) +import Control.Monad (when) import Data.Bits import Data.Memory.Endian import Data.Word +import Crypto.Cipher.Blowfish.Box import Crypto.Error +import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, Bytes) +import qualified Crypto.Internal.ByteArray as B import Crypto.Internal.Compat import Crypto.Internal.Imports -import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, Bytes) -import qualified Crypto.Internal.ByteArray as B -import Crypto.Internal.Words import Crypto.Internal.WordArray -import Crypto.Cipher.Blowfish.Box +import Crypto.Internal.Words --- | variable keyed blowfish state -data Context = BF (Int -> Word32) -- p - (Int -> Word32) -- sbox0 - (Int -> Word32) -- sbox1 - (Int -> Word32) -- sbox2 - (Int -> Word32) -- sbox2 +newtype Context = Context Array32 instance NFData Context where - rnf (BF p a b c d) = p `seq` a `seq` b `seq` c `seq` d `seq` () - --- | Encrypt blocks --- --- Input need to be a multiple of 8 bytes -encrypt :: ByteArray ba => Context -> ba -> ba -encrypt = cipher - --- | Decrypt blocks --- --- Input need to be a multiple of 8 bytes -decrypt :: ByteArray ba => Context -> ba -> ba -decrypt = cipher . decryptContext - -decryptContext :: Context -> Context -decryptContext (BF p s0 s1 s2 s3) = BF (\i -> p (17-i)) s0 s1 s2 s3 - -cipher :: ByteArray ba => Context -> ba -> ba -cipher ctx b - | B.length b == 0 = B.empty - | B.length b `mod` 8 /= 0 = error "invalid data length" - | otherwise = B.mapAsWord64 (coreCrypto ctx) b + rnf a = a `seq` () -- | Initialize a new Blowfish context from a key. -- -- key needs to be between 0 and 448 bits. initBlowfish :: ByteArrayAccess key => key -> CryptoFailable Context initBlowfish key - | len > (448 `div` 8) = CryptoFailed CryptoError_KeySizeInvalid - | otherwise = CryptoPassed $ makeKeySchedule key (Nothing :: Maybe (Bytes, Int)) - where len = B.length key + | B.length key > (448 `div` 8) = CryptoFailed CryptoError_KeySizeInvalid + | otherwise = CryptoPassed $ unsafeDoIO $ do + ks <- createKeySchedule + expandKey ks key + freezeKeySchedule ks --- | The BCrypt "expensive key schedule" version of blowfish. +-- | Get an immutable Blowfish context by freezing a mutable key schedule. +freezeKeySchedule :: KeySchedule -> IO Context +freezeKeySchedule (KeySchedule ma) = Context `fmap` mutableArray32Freeze ma + +expandKey :: (ByteArrayAccess key) => KeySchedule -> key -> IO () +expandKey ks@(KeySchedule ma) key = do + when (B.length key > 0) $ iterKeyStream key 0 0 $ \i l r a0 a1 cont-> do + mutableArrayWriteXor32 ma i l + mutableArrayWriteXor32 ma (i + 1) r + when (i + 2 < 18) (cont a0 a1) + loop 0 0 0 + where + loop i l r = do + n <- cipherBlockMutable ks (fromIntegral l `shiftL` 32 .|. fromIntegral r) + let nl = fromIntegral (n `shiftR` 32) + nr = fromIntegral (n .&. 0xffffffff) + mutableArrayWrite32 ma i nl + mutableArrayWrite32 ma (i + 1) nr + when (i < 18 + 1024) (loop (i + 2) nl nr) + +expandKeyWithSalt :: (ByteArrayAccess key, ByteArrayAccess salt) + => KeySchedule + -> key + -> salt + -> IO () +expandKeyWithSalt ks key salt + | B.length salt == 16 = expandKeyWithSalt128 ks key (fromBE $ B.toW64BE salt 0) (fromBE $ B.toW64BE salt 8) + | otherwise = expandKeyWithSaltAny ks key salt + +expandKeyWithSaltAny :: (ByteArrayAccess key, ByteArrayAccess salt) + => KeySchedule -- ^ The key schedule + -> key -- ^ The key + -> salt -- ^ The salt + -> IO () +expandKeyWithSaltAny ks@(KeySchedule ma) key salt = do + when (B.length key > 0) $ iterKeyStream key 0 0 $ \i l r a0 a1 cont-> do + mutableArrayWriteXor32 ma i l + mutableArrayWriteXor32 ma (i + 1) r + when (i + 2 < 18) (cont a0 a1) + -- Go through the entire key schedule overwriting the P-Array and S-Boxes + when (B.length salt > 0) $ iterKeyStream salt 0 0 $ \i l r a0 a1 cont-> do + let l' = xor l a0 + let r' = xor r a1 + n <- cipherBlockMutable ks (fromIntegral l' `shiftL` 32 .|. fromIntegral r') + let nl = fromIntegral (n `shiftR` 32) + nr = fromIntegral (n .&. 0xffffffff) + mutableArrayWrite32 ma i nl + mutableArrayWrite32 ma (i + 1) nr + when (i + 2 < 18 + 1024) (cont nl nr) + +expandKeyWithSalt128 :: ByteArrayAccess ba + => KeySchedule -- ^ The key schedule + -> ba -- ^ The key + -> Word64 -- ^ First word of the salt + -> Word64 -- ^ Second word of the salt + -> IO () +expandKeyWithSalt128 ks@(KeySchedule ma) key salt1 salt2 = do + when (B.length key > 0) $ iterKeyStream key 0 0 $ \i l r a0 a1 cont-> do + mutableArrayWriteXor32 ma i l + mutableArrayWriteXor32 ma (i + 1) r + when (i + 2 < 18) (cont a0 a1) + -- Go through the entire key schedule overwriting the P-Array and S-Boxes + loop 0 salt1 salt1 salt2 + where + loop i input slt1 slt2 + | i == 1042 = return () + | otherwise = do + n <- cipherBlockMutable ks input + let nl = fromIntegral (n `shiftR` 32) + nr = fromIntegral (n .&. 0xffffffff) + mutableArrayWrite32 ma i nl + mutableArrayWrite32 ma (i+1) nr + loop (i+2) (n `xor` slt2) slt2 slt1 + +-- | Encrypt blocks -- --- Salt must be 128 bits --- Cost must be between 4 and 31 inclusive --- See -eksBlowfish :: (ByteArrayAccess salt, ByteArrayAccess password) => Int -> salt -> password -> Context -eksBlowfish cost salt key - | B.length salt /= 16 = error "bcrypt salt must be 16 bytes" - | otherwise = makeKeySchedule key (Just (salt, cost)) +-- Input need to be a multiple of 8 bytes +encrypt :: ByteArray ba => Context -> ba -> ba +encrypt ctx ba + | B.length ba == 0 = B.empty + | B.length ba `mod` 8 /= 0 = error "invalid data length" + | otherwise = B.mapAsWord64 (cipherBlock ctx False) ba -coreCrypto :: Context -> Word64 -> Word64 -coreCrypto (BF p s0 s1 s2 s3) input = doRound input 0 - where - -- transform the input over 16 rounds +-- | Decrypt blocks +-- +-- Input need to be a multiple of 8 bytes +decrypt :: ByteArray ba => Context -> ba -> ba +decrypt ctx ba + | B.length ba == 0 = B.empty + | B.length ba `mod` 8 /= 0 = error "invalid data length" + | otherwise = B.mapAsWord64 (cipherBlock ctx True) ba + +-- | Encrypt or decrypt a single block of 64 bits. +-- +-- The inverse argument decides whether to encrypt or decrypt. +cipherBlock :: Context -> Bool -> Word64 -> Word64 +cipherBlock (Context ar) inverse input = doRound input 0 + where + -- | Transform the input over 16 rounds doRound :: Word64 -> Int -> Word64 doRound i roundIndex | roundIndex == 16 = let final = (fromIntegral (p 16) `shiftL` 32) .|. fromIntegral (p 17) in rotateL (i `xor` final) 32 | otherwise = - let newr = fromIntegral (i `shiftR` 32) `xor` (p roundIndex) - newi = ((i `shiftL` 32) `xor` (f newr)) .|. (fromIntegral newr) + let newr = fromIntegral (i `shiftR` 32) `xor` p roundIndex + newi = ((i `shiftL` 32) `xor` f newr) .|. fromIntegral newr in doRound newi (roundIndex+1) + + -- | The Blowfish Feistel function F f :: Word32 -> Word64 - f t = let a = s0 (fromIntegral $ (t `shiftR` 24) .&. 0xff) - b = s1 (fromIntegral $ (t `shiftR` 16) .&. 0xff) - c = s2 (fromIntegral $ (t `shiftR` 8) .&. 0xff) - d = s3 (fromIntegral $ t .&. 0xff) + f t = let a = s0 (0xff .&. (t `shiftR` 24)) + b = s1 (0xff .&. (t `shiftR` 16)) + c = s2 (0xff .&. (t `shiftR` 8)) + d = s3 (0xff .&. t) in fromIntegral (((a + b) `xor` c) + d) `shiftL` 32 + -- | S-Box arrays, each containing 256 32-bit words + -- The first 18 words contain the P-Array of subkeys + s0, s1, s2, s3 :: Word32 -> Word32 + s0 i = arrayRead32 ar (fromIntegral i + 18) + s1 i = arrayRead32 ar (fromIntegral i + 274) + s2 i = arrayRead32 ar (fromIntegral i + 530) + s3 i = arrayRead32 ar (fromIntegral i + 786) + p :: Int -> Word32 + p i | inverse = arrayRead32 ar (17 - fromIntegral i) + | otherwise = arrayRead32 ar (fromIntegral i) --- | Create a key schedule for either plain Blowfish or the BCrypt "EKS" version --- For the expensive version, the salt and cost factor are supplied. Salt must be --- a 128-bit byte array. --- --- The standard case is just a single key expansion with the salt set to zero. -makeKeySchedule :: (ByteArrayAccess key, ByteArrayAccess salt) => key-> Maybe (salt, Int) -> Context -makeKeySchedule keyBytes saltCost = - let v = unsafeDoIO $ do - mv <- createKeySchedule - case saltCost of - -- Standard blowfish - Nothing -> expandKey mv 0 0 keyBytes - -- The expensive case - Just (s, cost) -> do - let (salt1, salt2) = splitSalt s - expandKey mv salt1 salt2 keyBytes - forM_ [1..2^cost :: Int] $ \_ -> do - expandKey mv 0 0 keyBytes - expandKey mv 0 0 s - mutableArray32Freeze mv - in BF (\i -> arrayRead32 v i) - (\i -> arrayRead32 v (s0+i)) - (\i -> arrayRead32 v (s1+i)) - (\i -> arrayRead32 v (s2+i)) - (\i -> arrayRead32 v (s3+i)) - where - splitSalt s = (fromBE (B.toW64BE s 0), fromBE (B.toW64BE s 8)) +-- | Blowfish encrypt a Word using the current state of the key schedule +cipherBlockMutable :: KeySchedule -> Word64 -> IO Word64 +cipherBlockMutable (KeySchedule ma) input = doRound input 0 + where + -- | Transform the input over 16 rounds + doRound i roundIndex + | roundIndex == 16 = do + pVal1 <- mutableArrayRead32 ma 16 + pVal2 <- mutableArrayRead32 ma 17 + let final = (fromIntegral pVal1 `shiftL` 32) .|. fromIntegral pVal2 + return $ rotateL (i `xor` final) 32 + | otherwise = do + pVal <- mutableArrayRead32 ma roundIndex + let newr = fromIntegral (i `shiftR` 32) `xor` pVal + newr' <- f newr + let newi = ((i `shiftL` 32) `xor` newr') .|. fromIntegral newr + doRound newi (roundIndex+1) - -- Indices of the S-Box arrays, each containing 256 32-bit words - -- The first 18 words contain the P-Array of subkeys - s0 = 18 - s1 = 274 - s2 = 530 - s3 = 786 + -- | The Blowfish Feistel function F + f :: Word32 -> IO Word64 + f t = do + a <- s0 (0xff .&. (t `shiftR` 24)) + b <- s1 (0xff .&. (t `shiftR` 16)) + c <- s2 (0xff .&. (t `shiftR` 8)) + d <- s3 (0xff .&. t) + return (fromIntegral (((a + b) `xor` c) + d) `shiftL` 32) -expandKey :: ByteArrayAccess ba - => MutableArray32 -- ^ The key schedule - -> Word64 -- ^ First word of the salt - -> Word64 -- ^ Second word of the salt - -> ba -- ^ The key - -> IO () -expandKey mv salt1 salt2 key = do - when (len > 0) $ forM_ [0..17] $ \i -> do - let a = B.index key ((i * 4 + 0) `mod` len) - b = B.index key ((i * 4 + 1) `mod` len) - c = B.index key ((i * 4 + 2) `mod` len) - d = B.index key ((i * 4 + 3) `mod` len) - k = (fromIntegral a `shiftL` 24) .|. - (fromIntegral b `shiftL` 16) .|. - (fromIntegral c `shiftL` 8) .|. - (fromIntegral d) - mutableArrayWriteXor32 mv i k - prepare mv - return () - where - len = B.length key + -- | S-Box arrays, each containing 256 32-bit words + -- The first 18 words contain the P-Array of subkeys + s0, s1, s2, s3 :: Word32 -> IO Word32 + s0 i = mutableArrayRead32 ma (fromIntegral i + 18) + s1 i = mutableArrayRead32 ma (fromIntegral i + 274) + s2 i = mutableArrayRead32 ma (fromIntegral i + 530) + s3 i = mutableArrayRead32 ma (fromIntegral i + 786) - -- | Go through the entire key schedule overwriting the P-Array and S-Boxes - prepare mctx = loop 0 salt1 salt1 salt2 - where loop i input slt1 slt2 - | i == 1042 = return () - | otherwise = do - ninput <- coreCryptoMutable input - let (nl, nr) = w64to32 ninput - mutableArrayWrite32 mctx i nl - mutableArrayWrite32 mctx (i+1) nr - loop (i+2) (ninput `xor` slt2) slt2 slt1 - - -- | Blowfish encrypt a Word using the current state of the key schedule - coreCryptoMutable :: Word64 -> IO Word64 - coreCryptoMutable input = doRound input 0 - where doRound i roundIndex - | roundIndex == 16 = do - pVal1 <- mutableArrayRead32 mctx 16 - pVal2 <- mutableArrayRead32 mctx 17 - let final = (fromIntegral pVal1 `shiftL` 32) .|. fromIntegral pVal2 - return $ rotateL (i `xor` final) 32 - | otherwise = do - pVal <- mutableArrayRead32 mctx roundIndex - let newr = fromIntegral (i `shiftR` 32) `xor` pVal - newr' <- f newr - let newi = ((i `shiftL` 32) `xor` newr') .|. (fromIntegral newr) - doRound newi (roundIndex+1) - - -- The Blowfish Feistel function F - f :: Word32 -> IO Word64 - f t = do a <- mutableArrayRead32 mctx (s0 + fromIntegral ((t `shiftR` 24) .&. 0xff)) - b <- mutableArrayRead32 mctx (s1 + fromIntegral ((t `shiftR` 16) .&. 0xff)) - c <- mutableArrayRead32 mctx (s2 + fromIntegral ((t `shiftR` 8) .&. 0xff)) - d <- mutableArrayRead32 mctx (s3 + fromIntegral (t .&. 0xff)) - return (fromIntegral (((a + b) `xor` c) + d) `shiftL` 32) - where s0 = 18 - s1 = 274 - s2 = 530 - s3 = 786 +iterKeyStream :: (ByteArrayAccess x) + => x + -> Word32 + -> Word32 + -> (Int -> Word32 -> Word32 -> Word32 -> Word32 -> (Word32 -> Word32 -> IO ()) -> IO ()) + -> IO () +iterKeyStream x a0 a1 g = f 0 0 a0 a1 + where + len = B.length x + -- Avoiding the modulo operation when interating over the ring + -- buffer is assumed to be more efficient here. All other + -- implementations do this, too. The branch prediction shall prefer + -- the branch with the increment. + n j = if j + 1 >= len then 0 else j + 1 + f i j0 b0 b1 = g i l r b0 b1 (f (i + 2) j8) + where + j1 = n j0 + j2 = n j1 + j3 = n j2 + j4 = n j3 + j5 = n j4 + j6 = n j5 + j7 = n j6 + j8 = n j7 + x0 = fromIntegral (B.index x j0) + x1 = fromIntegral (B.index x j1) + x2 = fromIntegral (B.index x j2) + x3 = fromIntegral (B.index x j3) + x4 = fromIntegral (B.index x j4) + x5 = fromIntegral (B.index x j5) + x6 = fromIntegral (B.index x j6) + x7 = fromIntegral (B.index x j7) + l = shiftL x0 24 .|. shiftL x1 16 .|. shiftL x2 8 .|. x3 + r = shiftL x4 24 .|. shiftL x5 16 .|. shiftL x6 8 .|. x7 +{-# INLINE iterKeyStream #-} +-- Benchmarking shows that GHC considers this function too big to inline +-- although forcing inlining causes an actual improvement. +-- It is assumed that all function calls (especially the continuation) +-- collapse into a tight loop after inlining. diff --git a/Crypto/KDF/BCrypt.hs b/Crypto/KDF/BCrypt.hs index b374b4f..0a706bc 100644 --- a/Crypto/KDF/BCrypt.hs +++ b/Crypto/KDF/BCrypt.hs @@ -52,11 +52,16 @@ module Crypto.KDF.BCrypt ) where -import Control.Monad (unless, when) -import Crypto.Cipher.Blowfish.Primitive (eksBlowfish, encrypt) -import Crypto.Random (MonadRandom, getRandomBytes) -import Data.ByteArray (ByteArrayAccess, ByteArray, Bytes) -import qualified Data.ByteArray as B +import Control.Monad (forM_, unless, when) +import Crypto.Cipher.Blowfish.Primitive (Context, createKeySchedule, + encrypt, expandKey, + expandKeyWithSalt, + freezeKeySchedule) +import Crypto.Internal.Compat +import Crypto.Random (MonadRandom, getRandomBytes) +import Data.ByteArray (ByteArray, ByteArrayAccess, + Bytes) +import qualified Data.ByteArray as B import Data.ByteArray.Encoding import Data.Char @@ -136,7 +141,7 @@ rawHash _ cost salt password = B.take 23 hash -- Another compatibility bug. Igno -- Truncate the password if necessary and append a null byte for C compatibility key = B.snoc (B.take 72 password) 0 - ctx = eksBlowfish cost salt key + ctx = expensiveBlowfishContext key salt cost -- The BCrypt plaintext: "OrpheanBeholderScryDoubt" orpheanBeholder = B.pack [79,114,112,104,101,97,110,66,101,104,111,108,100,101,114,83,99,114,121,68,111,117,98,116] @@ -166,3 +171,19 @@ parseBCryptHash bc = do salt <- convertFromBase Base64OpenBSD s hash <- convertFromBase Base64OpenBSD h return (salt, hash) + +-- | Create a key schedule for the BCrypt "EKS" version. +-- +-- Salt must be a 128-bit byte array. +-- Cost must be between 4 and 31 inclusive +-- See +expensiveBlowfishContext :: (ByteArrayAccess key, ByteArrayAccess salt) => key-> salt -> Int -> Context +expensiveBlowfishContext keyBytes saltBytes cost + | B.length saltBytes /= 16 = error "bcrypt salt must be 16 bytes" + | otherwise = unsafeDoIO $ do + ks <- createKeySchedule + expandKeyWithSalt ks keyBytes saltBytes + forM_ [1..2^cost :: Int] $ \_ -> do + expandKey ks keyBytes + expandKey ks saltBytes + freezeKeySchedule ks From 8a61d8e5e27f7100c7579f251d0efb5a3711d58d Mon Sep 17 00:00:00 2001 From: Leif Warner Date: Mon, 18 Jun 2018 00:20:48 -0700 Subject: [PATCH 013/176] Derive a Data instance for Digest. --- Crypto/Hash/Types.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/Crypto/Hash/Types.hs b/Crypto/Hash/Types.hs index c537ada..65a3b61 100644 --- a/Crypto/Hash/Types.hs +++ b/Crypto/Hash/Types.hs @@ -8,6 +8,7 @@ -- Crypto hash types definitions -- {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} @@ -28,6 +29,7 @@ import Basement.Block.Mutable (MutableBlock, new, unsafeWrite) import Basement.NormalForm (deepseq) import Basement.Types.OffsetSize (CountOf(..), Offset(..)) import GHC.TypeLits (Nat) +import Data.Data (Data) -- | Class representing hashing algorithms. -- @@ -76,7 +78,7 @@ newtype Context a = Context Bytes -- Creating a digest from a bytearray is also possible with function -- 'Crypto.Hash.digestFromByteString'. newtype Digest a = Digest (Block Word8) - deriving (Eq,Ord,ByteArrayAccess) + deriving (Eq,Ord,ByteArrayAccess, Data) instance NFData (Digest a) where rnf (Digest u) = u `deepseq` () From 1288127d8ebc0346ae3c8cb82dcf999a3f85b0df Mon Sep 17 00:00:00 2001 From: tom-bop Date: Thu, 30 Aug 2018 15:54:03 +0000 Subject: [PATCH 014/176] Fix typo in bcrypt example --- Crypto/KDF/BCrypt.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Crypto/KDF/BCrypt.hs b/Crypto/KDF/BCrypt.hs index b374b4f..d6f7d5d 100644 --- a/Crypto/KDF/BCrypt.hs +++ b/Crypto/KDF/BCrypt.hs @@ -11,7 +11,7 @@ -- >>> validatePassword password bcryptHash -- >>> True -- >>> let otherPassword = B.pack "otherpassword" --- >>> otherHash <- hashPassword 12 otherPasssword :: IO B.ByteString +-- >>> otherHash <- hashPassword 12 otherPassword :: IO B.ByteString -- >>> validatePassword otherPassword otherHash -- >>> True -- From e7b3abebf89379f79c2daff080e07cba730efe4e Mon Sep 17 00:00:00 2001 From: Carlos Rodriguez Date: Thu, 6 Sep 2018 20:27:32 +0200 Subject: [PATCH 015/176] Implemented Rabin cryptosystem and some of its variations (including Rabin-Williams). --- Crypto/Number/Basic.hs | 16 +++ Crypto/Number/ModArithmetic.hs | 27 +++++ Crypto/PubKey/Rabin/Basic.hs | 174 ++++++++++++++++++++++++++++++++ Crypto/PubKey/Rabin/Modified.hs | 104 +++++++++++++++++++ Crypto/PubKey/Rabin/RW.hs | 140 +++++++++++++++++++++++++ Crypto/PubKey/Rabin/Types.hs | 42 ++++++++ cryptonite.cabal | 6 ++ tests/KAT_PubKey.hs | 2 + tests/KAT_PubKey/Rabin.hs | 89 ++++++++++++++++ tests/Number.hs | 3 + 10 files changed, 603 insertions(+) create mode 100644 Crypto/PubKey/Rabin/Basic.hs create mode 100644 Crypto/PubKey/Rabin/Modified.hs create mode 100644 Crypto/PubKey/Rabin/RW.hs create mode 100644 Crypto/PubKey/Rabin/Types.hs create mode 100644 tests/KAT_PubKey/Rabin.hs diff --git a/Crypto/Number/Basic.hs b/Crypto/Number/Basic.hs index 52b6e4e..d0c8dca 100644 --- a/Crypto/Number/Basic.hs +++ b/Crypto/Number/Basic.hs @@ -13,8 +13,11 @@ module Crypto.Number.Basic , log2 , numBits , numBytes + , asPowerOf2AndOdd ) where +import Data.Bits + import Crypto.Number.Compat -- | @sqrti@ returns two integers @(l,b)@ so that @l <= sqrt i <= b@. @@ -98,3 +101,16 @@ numBits n = gmpSizeInBits n `onGmpUnsupported` (if n == 0 then 1 else computeBit -- | Compute the number of bytes for an integer numBytes :: Integer -> Int numBytes n = gmpSizeInBytes n `onGmpUnsupported` ((numBits n + 7) `div` 8) + +-- | Express an integer as a odd number and a power of 2 +asPowerOf2AndOdd :: Integer -> (Int, Integer) +asPowerOf2AndOdd a + | a == 0 = (0, 0) + | odd a = (0, a) + | a < 0 = let (e, a1) = asPowerOf2AndOdd $ abs a in (e, -a1) + | isPowerOf2 a = (log2 a, 1) + | otherwise = loop a 0 + where + isPowerOf2 n = (n /= 0) && ((n .&. (n - 1)) == 0) + loop n pw = if n `mod` 2 == 0 then loop (n `div` 2) (pw + 1) + else (pw, n) \ No newline at end of file diff --git a/Crypto/Number/ModArithmetic.hs b/Crypto/Number/ModArithmetic.hs index 4ca6317..02729c6 100644 --- a/Crypto/Number/ModArithmetic.hs +++ b/Crypto/Number/ModArithmetic.hs @@ -15,6 +15,7 @@ module Crypto.Number.ModArithmetic -- * Inverse computing , inverse , inverseCoprimes + , jacobi ) where import Control.Exception (throw, Exception) @@ -95,3 +96,29 @@ inverseCoprimes g m = case inverse g m of Nothing -> throw CoprimesAssertionError Just i -> i + +-- | Computes the Jacobi symbol (a/n). +-- 0 = a < n; n = 3 and odd. +-- +-- The Legendre and Jacobi symbols are indistinguishable exactly when the +-- lower argument is an odd prime, in which case they have the same value. +-- +-- See algorithm 2.149 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al. +jacobi :: Integer -> Integer -> Maybe Integer +jacobi a n + | n < 3 || even n = Nothing + | a == 0 || a == 1 = Just a + | n <= a = jacobi (a `mod` n) n + | a < 0 = + let b = if n `mod` 4 == 1 then 1 else -1 + in fmap (*b) (jacobi (-a) n) + | otherwise = + let (e, a1) = asPowerOf2AndOdd a + nMod8 = n `mod` 8 + nMod4 = n `mod` 4 + a1Mod4 = a1 `mod` 4 + s' = if even e || nMod8 == 1 || nMod8 == 7 then 1 else -1 + s = if nMod4 == 3 && a1Mod4 == 3 then -s' else s' + n1 = n `mod` a1 + in if a1 == 1 then Just s + else fmap (*s) (jacobi n1 a1) \ No newline at end of file diff --git a/Crypto/PubKey/Rabin/Basic.hs b/Crypto/PubKey/Rabin/Basic.hs new file mode 100644 index 0000000..f82d5a3 --- /dev/null +++ b/Crypto/PubKey/Rabin/Basic.hs @@ -0,0 +1,174 @@ +-- | +-- Module : Crypto.PubKey.Rabin.Basic +-- License : BSD-style +-- Maintainer : Carlos Rodrigue-Vega +-- Stability : experimental +-- Portability : unknown +-- +-- Rabin cryptosystem for public-key cryptography and digital signature. +-- +{-# LANGUAGE DeriveDataTypeable #-} +module Crypto.PubKey.Rabin.Basic + ( PublicKey(..) + , PrivateKey(..) + , generate + , encrypt + , decrypt + , sign + , verify + ) where + +import System.Random (getStdGen, randomRs) + +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Data + +import Crypto.Hash +import Crypto.Number.Basic (gcde, asPowerOf2AndOdd) +import Crypto.Number.ModArithmetic (expSafe, jacobi) +import Crypto.Number.Prime (isProbablyPrime) +import Crypto.Number.Serialize (i2osp, os2ip) +import Crypto.PubKey.Rabin.Types +import Crypto.Random (MonadRandom, getRandomBytes) + +-- | Represent a Rabin public key. +data PublicKey = PublicKey + { public_size :: Int -- ^ size of key in bytes + , public_n :: Integer -- ^ public p*q + } deriving (Show, Read, Eq, Data, Typeable) + +-- | Represent a Rabin private key. +data PrivateKey = PrivateKey + { private_pub :: PublicKey + , private_p :: Integer -- ^ p prime number + , private_q :: Integer -- ^ q prime number + , private_a :: Integer + , private_b :: Integer + } deriving (Show, Read, Eq, Data, Typeable) + +-- | Rabin Signature. +data Signature = Signature (Integer, Integer) + +-- | Generate a pair of (private, public) key of size in bytes. +-- Primes p and q are both congruent 3 mod 4. +-- +-- See algorithm 8.11 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al. +generate :: MonadRandom m + => Int + -> m (PublicKey, PrivateKey) +generate size = do + (p, q) <- generatePrimes size (\p -> p `mod` 4 == 3) (\q -> q `mod` 4 == 3) + return (generateKeys p q) + where + generateKeys p q = + let n = p*q + (a, b, _) = gcde p q + publicKey = PublicKey { public_size = size + , public_n = n } + privateKey = PrivateKey { private_pub = publicKey + , private_p = p + , private_q = q + , private_a = a + , private_b = b } + in (publicKey, privateKey) + +-- | Encrypt plaintext using public key. +-- +-- See algorithm 8.11 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al. +encrypt :: PublicKey -- ^ public key + -> ByteString -- ^ plaintext + -> Either Error ByteString +encrypt pk m = + let m' = os2ip m + n = public_n pk + in if m' < 0 then Left InvalidParameters + else if m' >= n then Left MessageTooLong + else Right $ i2osp $ expSafe m' 2 n + +-- | Decrypt ciphertext using private key. +-- +-- See algorithm 8.12 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al. +decrypt :: PrivateKey -- ^ private key + -> ByteString -- ^ ciphertext + -> (ByteString, ByteString, ByteString, ByteString) +decrypt pk c = + let p = private_p pk + q = private_q pk + a = private_a pk + b = private_b pk + n = public_n $ private_pub pk + c' = os2ip c + in mapTuple i2osp $ sqroot' c' p q a b n + where mapTuple f (w, x, y, z) = (f w, f x, f y, f z) + +-- | Sign message using hash algorithm and private key. +-- +-- See https://en.wikipedia.org/wiki/Rabin_signature_algorithm. +sign :: (MonadRandom m, HashAlgorithm hash) + => PrivateKey -- ^ private key + -> hash -- ^ hash function + -> ByteString -- ^ message to sign + -> m (Either Error Signature) +sign pk hashAlg m = + let p = private_p pk + q = private_q pk + a = private_a pk + b = private_b pk + n = public_n $ private_pub pk + in do + (padding, h) <- loop p q + return (if h >= n then Left MessageTooLong + else let (r, _, _, _) = sqroot' h p q a b n + in Right $ Signature (os2ip padding, r)) + where + loop p q = do + padding <- getRandomBytes 8 + let h = os2ip $ hashWith hashAlg $ B.append m padding + case (jacobi (h `mod` p) p, jacobi (h `mod` q) q) of + (Just 1, Just 1) -> return (padding, h) + _ -> loop p q + +-- | Verify signature using hash algorithm and public key. +-- +-- See https://en.wikipedia.org/wiki/Rabin_signature_algorithm. +verify :: (HashAlgorithm hash) + => PublicKey -- ^ private key + -> hash -- ^ hash function + -> ByteString -- ^ message + -> Signature -- ^ signature + -> Bool +verify pk hashAlg m (Signature (padding, x)) = + let n = public_n pk + h = os2ip $ hashWith hashAlg $ B.append m $ i2osp padding + h' = expSafe x 2 n + in h' == h + +-- | Square roots modulo prime p where p is congruent 3 mod 4 +-- Value a must be a quadratic residue modulo p (i.e. jacobi symbol (a/n) = 1). +-- +-- See algorithm 3.36 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al. +sqroot :: Integer + -> Integer -- ^ prime p + -> (Integer, Integer) +sqroot a p = + let r = expSafe a ((p + 1) `div` 4) p + in (r, -r) + +-- | Square roots modulo n given its prime factors p and q (both congruent 3 mod 4) +-- Value a must be a quadratic residue of both modulo p and modulo q (i.e. jacobi symbols (a/p) = (a/q) = 1). +-- +-- See algorithm 3.44 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al. +sqroot' :: Integer + -> Integer -- ^ prime p + -> Integer -- ^ prime q + -> Integer -- ^ c such that c*p + d*q = 1 + -> Integer -- ^ d such that c*p + d*q = 1 + -> Integer -- ^ n = p*q + -> (Integer, Integer, Integer, Integer) +sqroot' a p q c d n = + let (r, _) = sqroot a p + (s, _) = sqroot a q + x = (r*d*q + s*c*p) `mod` n + y = (r*d*q - s*c*p) `mod` n + in (x, (-x) `mod` n, y, (-y) `mod` n) diff --git a/Crypto/PubKey/Rabin/Modified.hs b/Crypto/PubKey/Rabin/Modified.hs new file mode 100644 index 0000000..67c652f --- /dev/null +++ b/Crypto/PubKey/Rabin/Modified.hs @@ -0,0 +1,104 @@ +-- | +-- Module : Crypto.PubKey.Rabin.Modified +-- License : BSD-style +-- Maintainer : Carlos Rodrigue-Vega +-- Stability : experimental +-- Portability : unknown +-- +-- Modified-Rabin public-key digital signature algorithm. +-- See algorithm 11.30 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al. +-- +{-# LANGUAGE DeriveDataTypeable #-} +module Crypto.PubKey.Rabin.Modified + ( PublicKey(..) + , PrivateKey(..) + , generate + , sign + , verify + ) where + +import Data.ByteString +import qualified Data.ByteString as B +import Data.Data + +import Crypto.Hash +import Crypto.Number.Basic (gcde) +import Crypto.Number.ModArithmetic (expSafe, jacobi) +import Crypto.Number.Serialize (i2osp, os2ip) +import Crypto.PubKey.Rabin.Types +import Crypto.Random.Types + +-- | Represent a Modified-Rabin public key. +data PublicKey = PublicKey + { public_size :: Int -- ^ size of key in bytes + , public_n :: Integer -- ^ public p*q + } deriving (Show, Read, Eq, Data, Typeable) + +-- | Represent a Modified-Rabin private key. +data PrivateKey = PrivateKey + { private_pub :: PublicKey + , private_p :: Integer -- ^ p prime number + , private_q :: Integer -- ^ q prime number + , private_d :: Integer + } deriving (Show, Read, Eq, Data, Typeable) + +-- | Generate a pair of (private, public) key of size in bytes. +-- Prime p is congruent 3 mod 8 and prime q is congruent 7 mod 8. +generate :: MonadRandom m + => Int + -> m (PublicKey, PrivateKey) +generate size = do + (p, q) <- generatePrimes size (\p -> p `mod` 8 == 3) (\q -> q `mod` 8 == 7) + return (generateKeys p q) + where + generateKeys p q = + let n = p*q + d = (n - p - q + 5) `div` 8 + publicKey = PublicKey { public_size = size + , public_n = n } + privateKey = PrivateKey { private_pub = publicKey + , private_p = p + , private_q = q + , private_d = d } + in (publicKey, privateKey) + +-- | Sign message using hash algorithm and private key. +sign :: (HashAlgorithm hash) + => PrivateKey -- ^ private key + -> hash -- ^ hash function + -> ByteString -- ^ message to sign + -> Either Error ByteString +sign pk hashAlg m = + let d = private_d pk + n = public_n $ private_pub pk + h = os2ip $ hashWith hashAlg m + limit = (n - 6) `div` 16 + in if h > limit then Left MessageTooLong + else let h' = 16*h + 6 + in case jacobi h' n of + Just 1 -> Right $ i2osp $ expSafe h' d n + Just (-1) -> Right $ i2osp $ expSafe (h' `div` 2) d n + _ -> Left InvalidParameters + +-- | Verify signature using hash algorithm and public key. +verify :: (HashAlgorithm hash) + => PublicKey -- ^ public key + -> hash -- ^ hash function + -> ByteString -- ^ message + -> ByteString -- ^ signature + -> Bool +verify pk hashAlg m s = + let n = public_n pk + h = os2ip $ hashWith hashAlg m + s' = os2ip s + s'' = expSafe s' 2 n + s''' = case s'' `mod` 8 of + 6 -> s'' + 3 -> 2*s'' + 7 -> n - s'' + 2 -> 2*(n - s'') + _ -> 0 + in case s''' `mod` 16 of + 6 -> let h' = (s''' - 6) `div` 16 + in h' == h + _ -> False diff --git a/Crypto/PubKey/Rabin/RW.hs b/Crypto/PubKey/Rabin/RW.hs new file mode 100644 index 0000000..2ad85a3 --- /dev/null +++ b/Crypto/PubKey/Rabin/RW.hs @@ -0,0 +1,140 @@ +-- | +-- Module : Crypto.PubKey.Rabin.RW +-- License : BSD-style +-- Maintainer : Carlos Rodrigue-Vega +-- Stability : experimental +-- Portability : unknown +-- +-- Rabin-Williams cryptosystem for public-key encryption and digital signature. +-- See pages 323 - 324 in "Computational Number Theory and Modern Cryptography" by Song Y. Yan. +-- Also inspired by https://github.com/vanilala/vncrypt/blob/master/vncrypt/vnrw_gmp.c. +-- +{-# LANGUAGE DeriveDataTypeable #-} +module Crypto.PubKey.Rabin.RW + ( PublicKey(..) + , PrivateKey(..) + , generate + , encrypt + , decrypt + , sign + , verify + ) where + +import Data.ByteString +import qualified Data.ByteString as B +import Data.Data + +import Crypto.Hash +import Crypto.Number.Basic (gcde) +import Crypto.Number.ModArithmetic (expSafe, jacobi) +import Crypto.Number.Serialize (i2osp, os2ip) +import Crypto.PubKey.Rabin.Types +import Crypto.Random.Types + +-- | Represent a Rabin-Williams public key. +data PublicKey = PublicKey + { public_size :: Int -- ^ size of key in bytes + , public_n :: Integer -- ^ public p*q + } deriving (Show, Read, Eq, Data, Typeable) + +-- | Represent a Rabin-Williams private key. +data PrivateKey = PrivateKey + { private_pub :: PublicKey + , private_p :: Integer -- ^ p prime number + , private_q :: Integer -- ^ q prime number + , private_d :: Integer + } deriving (Show, Read, Eq, Data, Typeable) + +-- | Generate a pair of (private, public) key of size in bytes. +-- Prime p is congruent 3 mod 8 and prime q is congruent 7 mod 8. +generate :: MonadRandom m + => Int + -> m (PublicKey, PrivateKey) +generate size = do + (p, q) <- generatePrimes size (\p -> p `mod` 8 == 3) (\q -> q `mod` 8 == 7) + return (generateKeys p q) + where + generateKeys p q = + let n = p*q + d = ((p - 1)*(q - 1) `div` 4 + 1) `div` 2 + publicKey = PublicKey { public_size = size + , public_n = n } + privateKey = PrivateKey { private_pub = publicKey + , private_p = p + , private_q = q + , private_d = d } + in (publicKey, privateKey) + +-- | Encrypt plaintext using public key. +encrypt :: PublicKey -- ^ public key + -> ByteString -- ^ plaintext + -> Either Error ByteString +encrypt pk m = + let n = public_n pk + in case ep1 n $ os2ip m of + Right m' -> Right $ i2osp $ ep2 n m' + Left err -> Left err + +-- | Decrypt ciphertext using private key. +decrypt :: PrivateKey -- ^ private key + -> ByteString -- ^ ciphertext + -> ByteString +decrypt pk c = + let d = private_d pk + n = public_n $ private_pub pk + in i2osp $ dp2 n $ dp1 d n $ os2ip c + +-- | Sign message using hash algorithm and private key. +sign :: (HashAlgorithm hash) + => PrivateKey -- ^ private key + -> hash -- ^ hash function + -> ByteString -- ^ message to sign + -> Either Error ByteString +sign pk hashAlg m = + let d = private_d pk + n = public_n $ private_pub pk + in case ep1 n $ os2ip $ hashWith hashAlg m of + Right m' -> Right (i2osp $ dp1 d n m') + Left err -> Left err + +-- | Verify signature using hash algorithm and public key. +verify :: (HashAlgorithm hash) + => PublicKey -- ^ public key + -> hash -- ^ hash function + -> ByteString -- ^ message + -> ByteString -- ^ signature + -> Bool +verify pk hashAlg m s = + let n = public_n pk + h = os2ip $ hashWith hashAlg m + h' = dp2 n $ ep2 n $ os2ip s + in h' == h + +-- | Encryption primitive 1 +ep1 :: Integer -> Integer -> Either Error Integer +ep1 n m = + let m' = 2*m + 1 + m'' = 2*m' + m''' = 2*m'' + in case jacobi m' n of + Just (-1) | m'' < n -> Right m'' + Just 1 | m''' < n -> Right m''' + _ -> Left InvalidParameters + +-- | Encryption primitive 2 +ep2 :: Integer -> Integer -> Integer +ep2 n m = expSafe m 2 n + +-- | Decryption primitive 1 +dp1 :: Integer -> Integer -> Integer -> Integer +dp1 d n c = expSafe c d n + +-- | Decryption primitive 2 +dp2 :: Integer -> Integer -> Integer +dp2 n c = let c' = c `div` 2 + c'' = (n - c) `div` 2 + in case c `mod` 4 of + 0 -> ((c' `div` 2 - 1) `div` 2) + 1 -> ((c'' `div` 2 - 1) `div` 2) + 2 -> ((c' - 1) `div` 2) + _ -> ((c'' - 1) `div` 2) diff --git a/Crypto/PubKey/Rabin/Types.hs b/Crypto/PubKey/Rabin/Types.hs new file mode 100644 index 0000000..a2bfe14 --- /dev/null +++ b/Crypto/PubKey/Rabin/Types.hs @@ -0,0 +1,42 @@ +-- | +-- Module : Crypto.PubKey.Rabin.Types +-- License : BSD-style +-- Maintainer : Carlos Rodrigue-Vega +-- Stability : experimental +-- Portability : unknown +-- +module Crypto.PubKey.Rabin.Types + ( Error(..) + , generatePrimes + ) where + +import Crypto.Number.Basic (numBits) +import Crypto.Number.Prime (generatePrime, findPrimeFromWith) +import Crypto.Random.Types + +type PrimeCondition = Integer -> Bool + +-- | Error possible during encryption, decryption or signing. +data Error = MessageTooLong -- ^ the message to encrypt is too long + | InvalidParameters -- ^ some parameters lead to breaking assumptions + deriving (Show, Eq) + +-- | Generate primes p & q +generatePrimes :: MonadRandom m + => Int -- ^ size in bytes + -> PrimeCondition -- ^ condition prime p must satisfy + -> PrimeCondition -- ^ condition prime q must satisfy + -> m (Integer, Integer) -- ^ chosen distinct primes p and q +generatePrimes size pCond qCond = + let pBits = (8*(size `div` 2)) + qBits = (8*(size - (size `div` 2))) + in do + p <- generatePrime' pBits pCond + q <- generatePrime' qBits qCond + return (p, q) + where + generatePrime' bits cond = do + pr' <- generatePrime bits + let pr = findPrimeFromWith cond pr' + if numBits pr == bits then return pr + else generatePrime' bits cond diff --git a/cryptonite.cabal b/cryptonite.cabal index bbfebac..2673891 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -162,6 +162,10 @@ Library Crypto.PubKey.RSA.PSS Crypto.PubKey.RSA.OAEP Crypto.PubKey.RSA.Types + Crypto.PubKey.Rabin.Basic + Crypto.PubKey.Rabin.Modified + Crypto.PubKey.Rabin.RW + Crypto.PubKey.Rabin.Types Crypto.Random Crypto.Random.Types Crypto.Random.Entropy @@ -231,6 +235,7 @@ Library Build-depends: bytestring , memory >= 0.14.14 + , random , basement >= 0.0.6 , ghc-prim ghc-options: -Wall -fwarn-tabs -optc-O3 -fno-warn-unused-imports @@ -406,6 +411,7 @@ Test-Suite test-cryptonite KAT_PubKey.OAEP KAT_PubKey.PSS KAT_PubKey.P256 + KAT_PubKey.Rabin KAT_PubKey KAT_RC4 KAT_Scrypt diff --git a/tests/KAT_PubKey.hs b/tests/KAT_PubKey.hs index 13dd71e..b87404e 100644 --- a/tests/KAT_PubKey.hs +++ b/tests/KAT_PubKey.hs @@ -16,6 +16,7 @@ import KAT_PubKey.PSS import KAT_PubKey.DSA import KAT_PubKey.ECC import KAT_PubKey.ECDSA +import KAT_PubKey.Rabin import Utils import qualified KAT_PubKey.P256 as P256 @@ -41,6 +42,7 @@ tests = testGroup "PubKey" , eccTests , ecdsaTests , P256.tests + , rabinTests ] --newKats = [ eccKatTests ] diff --git a/tests/KAT_PubKey/Rabin.hs b/tests/KAT_PubKey/Rabin.hs new file mode 100644 index 0000000..e1d6ab3 --- /dev/null +++ b/tests/KAT_PubKey/Rabin.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE OverloadedStrings #-} +module KAT_PubKey.Rabin (rabinTests) where + +import Imports +import Crypto.Hash +import qualified Crypto.PubKey.Rabin.Basic as Basic +import qualified Crypto.PubKey.Rabin.Modified as ModRabin +import qualified Crypto.PubKey.Rabin.RW as RW + +data VectorRabin = VectorRabin + { msg :: ByteString + , size :: Int + } + +vectors = + [ VectorRabin + { msg = "\xd4\x36\xe9\x95\x69\xfd\x32\xa7\xc8\xa0\x5b\xbc\x90\xd3\x2c\x49" + , size = 32 + } + , VectorRabin + { msg = "\x52\xe6\x50\xd9\x8e\x7f\x2a\x04\x8b\x4f\x86\x85\x21\x53\xb9\x7e\x01\xdd\x31\x6f\x34\x6a\x19\xf6\x7a\x85" + , size = 64 + } + , VectorRabin + { msg = "\x66\x28\x19\x4e\x12\x07\x3d\xb0\x3b\xa9\x4c\xda\x9e\xf9\x53\x23\x97\xd5\x0d\xba\x79\xb9\x87\x00\x4a\xfe\xfe\x34" + , size = 128 + } + ] + +doBasicEncryptionTest (i, vector) = testCase (show i) (do + let message = msg vector + (pubKey, privKey) <- Basic.generate (size vector) + let cipherText = Basic.encrypt pubKey message + actual = case cipherText of + Left _ -> False + Right c -> let (p, p', p'', p''') = Basic.decrypt privKey c + in elem message [p, p', p'', p'''] + (True @=? actual)) + +doBasicSignatureTest (i, vector) = testCase (show i) (do + let message = msg vector + (pubKey, privKey) <- Basic.generate (size vector) + signature <- Basic.sign privKey SHA1 message + let actual = case signature of + Left _ -> False + Right s -> Basic.verify pubKey SHA1 message s + (True @=? actual)) + +doModifiedSignatureTest (i, vector) = testCase (show i) (do + let message = msg vector + (pubKey, privKey) <- ModRabin.generate (size vector) + let signature = ModRabin.sign privKey SHA1 message + actual = case signature of + Left _ -> False + Right s -> ModRabin.verify pubKey SHA1 message s + (True @=? actual)) + +doRwEncryptionTest (i, vector) = testCase (show i) (do + let message = msg vector + (pubKey, privKey) <- RW.generate (size vector) + let cipherText = RW.encrypt pubKey message + actual = case cipherText of + Left _ -> False + Right c -> let p = RW.decrypt privKey c + in message == p + (True @=? actual)) + +doRwSignatureTest (i, vector) = testCase (show i) (do + let message = msg vector + (pubKey, privKey) <- RW.generate (size vector) + let signature = RW.sign privKey SHA1 message + actual = case signature of + Left _ -> False + Right s -> RW.verify pubKey SHA1 message s + (True @=? actual)) + +rabinTests = testGroup "Rabin" + [ testGroup "Basic" + [ testGroup "encryption" $ map doBasicEncryptionTest (zip [katZero..] vectors) + , testGroup "signature" $ map doBasicSignatureTest (zip [katZero..] vectors) + ] + , testGroup "Modified" + [ testGroup "signature" $ map doModifiedSignatureTest (zip [katZero..] vectors) + ] + , testGroup "RW" + [ testGroup "encryption" $ map doRwEncryptionTest (zip [katZero..] vectors) + , testGroup "signature" $ map doRwSignatureTest (zip [katZero..] vectors) + ] + ] diff --git a/tests/Number.hs b/tests/Number.hs index 8016e70..fd77fa7 100644 --- a/tests/Number.hs +++ b/tests/Number.hs @@ -52,6 +52,9 @@ tests = testGroup "number" in bits == numBits prime , testProperty "marshalling" $ \qaInt -> getQAInteger qaInt == os2ip (i2osp (getQAInteger qaInt) :: Bytes) + , testProperty "as-power-of-2-and-odd" $ \n -> + let (e, a1) = asPowerOf2AndOdd n + in n == (2^e)*a1 , testGroup "marshalling-kat-to-bytearray" $ map toSerializationKat $ zip [katZero..] serializationVectors , testGroup "marshalling-kat-to-integer" $ map toSerializationKatInteger $ zip [katZero..] serializationVectors ] From aa745ba250d2e2f719e99aa0330e93e1f5df8fa4 Mon Sep 17 00:00:00 2001 From: Carlos Rodriguez Date: Thu, 6 Sep 2018 20:48:15 +0200 Subject: [PATCH 016/176] Replaced tab with spaces. --- cryptonite.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cryptonite.cabal b/cryptonite.cabal index 2673891..e28ffd7 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -235,7 +235,7 @@ Library Build-depends: bytestring , memory >= 0.14.14 - , random + , random , basement >= 0.0.6 , ghc-prim ghc-options: -Wall -fwarn-tabs -optc-O3 -fno-warn-unused-imports From c285d7f52794d2d048c252bc36353803f7bd3a3a Mon Sep 17 00:00:00 2001 From: Carlos Rodriguez Date: Sat, 6 Oct 2018 16:53:22 +0200 Subject: [PATCH 017/176] Added OAEP scheme and created test vectors for Rabin cryptosystem. --- Crypto/Number/Basic.hs | 2 +- Crypto/PubKey/Rabin/Basic.hs | 175 ++++++++++++++++++++---------- Crypto/PubKey/Rabin/Modified.hs | 57 +++++----- Crypto/PubKey/Rabin/OAEP.hs | 100 +++++++++++++++++ Crypto/PubKey/Rabin/RW.hs | 101 +++++++++++------- Crypto/PubKey/Rabin/Types.hs | 1 + cryptonite.cabal | 1 + tests/KAT_PubKey/Rabin.hs | 184 +++++++++++++++++++++----------- 8 files changed, 432 insertions(+), 189 deletions(-) create mode 100644 Crypto/PubKey/Rabin/OAEP.hs diff --git a/Crypto/Number/Basic.hs b/Crypto/Number/Basic.hs index d0c8dca..e624b42 100644 --- a/Crypto/Number/Basic.hs +++ b/Crypto/Number/Basic.hs @@ -102,7 +102,7 @@ numBits n = gmpSizeInBits n `onGmpUnsupported` (if n == 0 then 1 else computeBit numBytes :: Integer -> Int numBytes n = gmpSizeInBytes n `onGmpUnsupported` ((numBits n + 7) `div` 8) --- | Express an integer as a odd number and a power of 2 +-- | Express an integer as an odd number and a power of 2 asPowerOf2AndOdd :: Integer -> (Int, Integer) asPowerOf2AndOdd a | a == 0 = (0, 0) diff --git a/Crypto/PubKey/Rabin/Basic.hs b/Crypto/PubKey/Rabin/Basic.hs index f82d5a3..0d9792e 100644 --- a/Crypto/PubKey/Rabin/Basic.hs +++ b/Crypto/PubKey/Rabin/Basic.hs @@ -11,10 +11,13 @@ module Crypto.PubKey.Rabin.Basic ( PublicKey(..) , PrivateKey(..) + , Signature(..) , generate , encrypt + , encryptWithSeed , decrypt , sign + , signWith , verify ) where @@ -23,12 +26,14 @@ import System.Random (getStdGen, randomRs) import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.Data +import Data.Either (rights) import Crypto.Hash -import Crypto.Number.Basic (gcde, asPowerOf2AndOdd) +import Crypto.Number.Basic (gcde, numBytes, asPowerOf2AndOdd) import Crypto.Number.ModArithmetic (expSafe, jacobi) import Crypto.Number.Prime (isProbablyPrime) -import Crypto.Number.Serialize (i2osp, os2ip) +import Crypto.Number.Serialize (i2osp, i2ospOf_, os2ip) +import Crypto.PubKey.Rabin.OAEP import Crypto.PubKey.Rabin.Types import Crypto.Random (MonadRandom, getRandomBytes) @@ -48,100 +53,154 @@ data PrivateKey = PrivateKey } deriving (Show, Read, Eq, Data, Typeable) -- | Rabin Signature. -data Signature = Signature (Integer, Integer) +data Signature = Signature (Integer, Integer) deriving (Show, Read, Eq, Data, Typeable) -- | Generate a pair of (private, public) key of size in bytes. -- Primes p and q are both congruent 3 mod 4. -- -- See algorithm 8.11 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al. generate :: MonadRandom m - => Int + => Int -> m (PublicKey, PrivateKey) generate size = do (p, q) <- generatePrimes size (\p -> p `mod` 4 == 3) (\q -> q `mod` 4 == 3) - return (generateKeys p q) - where - generateKeys p q = - let n = p*q - (a, b, _) = gcde p q - publicKey = PublicKey { public_size = size - , public_n = n } - privateKey = PrivateKey { private_pub = publicKey - , private_p = p - , private_q = q - , private_a = a - , private_b = b } - in (publicKey, privateKey) + return $ generateKeys p q + where + generateKeys p q = + let n = p*q + (a, b, _) = gcde p q + publicKey = PublicKey { public_size = size + , public_n = n } + privateKey = PrivateKey { private_pub = publicKey + , private_p = p + , private_q = q + , private_a = a + , private_b = b } + in (publicKey, privateKey) --- | Encrypt plaintext using public key. +-- | Encrypt plaintext using public key an a predefined OAEP seed. -- -- See algorithm 8.11 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al. -encrypt :: PublicKey -- ^ public key - -> ByteString -- ^ plaintext - -> Either Error ByteString -encrypt pk m = - let m' = os2ip m - n = public_n pk - in if m' < 0 then Left InvalidParameters - else if m' >= n then Left MessageTooLong - else Right $ i2osp $ expSafe m' 2 n +encryptWithSeed :: HashAlgorithm hash + => ByteString -- ^ Seed + -> OAEPParams hash ByteString ByteString -- ^ OAEP padding + -> PublicKey -- ^ public key + -> ByteString -- ^ plaintext + -> Either Error ByteString +encryptWithSeed seed oaep pk m = + let n = public_n pk + k = numBytes n + in do + m' <- pad seed oaep k m + let m'' = os2ip m' + return $ i2osp $ expSafe m'' 2 n + +-- | Encrypt plaintext using public key. +encrypt :: (HashAlgorithm hash, MonadRandom m) + => OAEPParams hash ByteString ByteString -- ^ OAEP padding parameters + -> PublicKey -- ^ public key + -> ByteString -- ^ plaintext + -> m (Either Error ByteString) +encrypt oaep pk m = do + seed <- getRandomBytes hashLen + return $ encryptWithSeed seed oaep pk m + where + hashLen = hashDigestSize (oaepHash oaep) -- | Decrypt ciphertext using private key. -- -- See algorithm 8.12 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al. -decrypt :: PrivateKey -- ^ private key - -> ByteString -- ^ ciphertext - -> (ByteString, ByteString, ByteString, ByteString) -decrypt pk c = +decrypt :: HashAlgorithm hash + => OAEPParams hash ByteString ByteString -- ^ OAEP padding parameters + -> PrivateKey -- ^ private key + -> ByteString -- ^ ciphertext + -> Maybe ByteString +decrypt oaep pk c = let p = private_p pk q = private_q pk a = private_a pk b = private_b pk - n = public_n $ private_pub pk + n = public_n $ private_pub pk + k = numBytes n c' = os2ip c - in mapTuple i2osp $ sqroot' c' p q a b n - where mapTuple f (w, x, y, z) = (f w, f x, f y, f z) + solutions = rights $ toList $ mapTuple (unpad oaep k . i2ospOf_ k) $ sqroot' c' p q a b n + in if length solutions /= 1 then Nothing + else Just $ head solutions + where toList (w, x, y, z) = w:x:y:z:[] + mapTuple f (w, x, y, z) = (f w, f x, f y, f z) + +-- | Sign message using padding, hash algorithm and private key. +-- +-- See . +signWith :: HashAlgorithm hash + => ByteString -- ^ padding + -> PrivateKey -- ^ private key + -> hash -- ^ hash function + -> ByteString -- ^ message to sign + -> Either Error Signature +signWith padding pk hashAlg m = do + h <- calculateHash padding pk hashAlg m + signature <- calculateSignature h + return signature + where + calculateSignature h = + let p = private_p pk + q = private_q pk + a = private_a pk + b = private_b pk + n = public_n $ private_pub pk + in if h >= n then Left MessageTooLong + else let (r, _, _, _) = sqroot' h p q a b n + in Right $ Signature (os2ip padding, r) -- | Sign message using hash algorithm and private key. -- --- See https://en.wikipedia.org/wiki/Rabin_signature_algorithm. +-- See . sign :: (MonadRandom m, HashAlgorithm hash) => PrivateKey -- ^ private key -> hash -- ^ hash function -> ByteString -- ^ message to sign -> m (Either Error Signature) -sign pk hashAlg m = - let p = private_p pk - q = private_q pk - a = private_a pk - b = private_b pk - n = public_n $ private_pub pk - in do - (padding, h) <- loop p q - return (if h >= n then Left MessageTooLong - else let (r, _, _, _) = sqroot' h p q a b n - in Right $ Signature (os2ip padding, r)) - where - loop p q = do - padding <- getRandomBytes 8 - let h = os2ip $ hashWith hashAlg $ B.append m padding - case (jacobi (h `mod` p) p, jacobi (h `mod` q) q) of - (Just 1, Just 1) -> return (padding, h) - _ -> loop p q +sign pk hashAlg m = do + padding <- findPadding + return $ signWith padding pk hashAlg m + where + findPadding = do + padding <- getRandomBytes 8 + case calculateHash padding pk hashAlg m of + Right _ -> return padding + _ -> findPadding + +-- | Calculate hash of message and padding. +-- If the padding is valid, then the result of the hash operation is returned, otherwise an error. +calculateHash :: HashAlgorithm hash + => ByteString -- ^ padding + -> PrivateKey -- ^ private key + -> hash -- ^ hash function + -> ByteString -- ^ message to sign + -> Either Error Integer +calculateHash padding pk hashAlg m = + let p = private_p pk + q = private_q pk + h = os2ip $ hashWith hashAlg $ B.append padding m + in case (jacobi (h `mod` p) p, jacobi (h `mod` q) q) of + (Just 1, Just 1) -> Right h + _ -> Left InvalidParameters -- | Verify signature using hash algorithm and public key. -- --- See https://en.wikipedia.org/wiki/Rabin_signature_algorithm. -verify :: (HashAlgorithm hash) +-- See . +verify :: HashAlgorithm hash => PublicKey -- ^ private key -> hash -- ^ hash function -> ByteString -- ^ message -> Signature -- ^ signature -> Bool -verify pk hashAlg m (Signature (padding, x)) = +verify pk hashAlg m (Signature (padding, s)) = let n = public_n pk - h = os2ip $ hashWith hashAlg $ B.append m $ i2osp padding - h' = expSafe x 2 n + p = i2osp padding + h = os2ip $ hashWith hashAlg $ B.append p m + h' = expSafe s 2 n in h' == h -- | Square roots modulo prime p where p is congruent 3 mod 4 diff --git a/Crypto/PubKey/Rabin/Modified.hs b/Crypto/PubKey/Rabin/Modified.hs index 67c652f..c9c7797 100644 --- a/Crypto/PubKey/Rabin/Modified.hs +++ b/Crypto/PubKey/Rabin/Modified.hs @@ -49,25 +49,25 @@ generate :: MonadRandom m -> m (PublicKey, PrivateKey) generate size = do (p, q) <- generatePrimes size (\p -> p `mod` 8 == 3) (\q -> q `mod` 8 == 7) - return (generateKeys p q) - where - generateKeys p q = - let n = p*q - d = (n - p - q + 5) `div` 8 - publicKey = PublicKey { public_size = size - , public_n = n } - privateKey = PrivateKey { private_pub = publicKey - , private_p = p - , private_q = q - , private_d = d } - in (publicKey, privateKey) + return $ generateKeys p q + where + generateKeys p q = + let n = p*q + d = (n - p - q + 5) `div` 8 + publicKey = PublicKey { public_size = size + , public_n = n } + privateKey = PrivateKey { private_pub = publicKey + , private_p = p + , private_q = q + , private_d = d } + in (publicKey, privateKey) -- | Sign message using hash algorithm and private key. -sign :: (HashAlgorithm hash) +sign :: HashAlgorithm hash => PrivateKey -- ^ private key -> hash -- ^ hash function -> ByteString -- ^ message to sign - -> Either Error ByteString + -> Either Error Integer sign pk hashAlg m = let d = private_d pk n = public_n $ private_pub pk @@ -76,29 +76,28 @@ sign pk hashAlg m = in if h > limit then Left MessageTooLong else let h' = 16*h + 6 in case jacobi h' n of - Just 1 -> Right $ i2osp $ expSafe h' d n - Just (-1) -> Right $ i2osp $ expSafe (h' `div` 2) d n + Just 1 -> Right $ expSafe h' d n + Just (-1) -> Right $ expSafe (h' `div` 2) d n _ -> Left InvalidParameters -- | Verify signature using hash algorithm and public key. -verify :: (HashAlgorithm hash) +verify :: HashAlgorithm hash => PublicKey -- ^ public key -> hash -- ^ hash function -> ByteString -- ^ message - -> ByteString -- ^ signature + -> Integer -- ^ signature -> Bool verify pk hashAlg m s = - let n = public_n pk - h = os2ip $ hashWith hashAlg m - s' = os2ip s - s'' = expSafe s' 2 n - s''' = case s'' `mod` 8 of - 6 -> s'' - 3 -> 2*s'' - 7 -> n - s'' - 2 -> 2*(n - s'') + let n = public_n pk + h = os2ip $ hashWith hashAlg m + s' = expSafe s 2 n + s'' = case s' `mod` 8 of + 6 -> s' + 3 -> 2*s' + 7 -> n - s' + 2 -> 2*(n - s') _ -> 0 - in case s''' `mod` 16 of - 6 -> let h' = (s''' - 6) `div` 16 + in case s'' `mod` 16 of + 6 -> let h' = (s'' - 6) `div` 16 in h' == h _ -> False diff --git a/Crypto/PubKey/Rabin/OAEP.hs b/Crypto/PubKey/Rabin/OAEP.hs new file mode 100644 index 0000000..9976e83 --- /dev/null +++ b/Crypto/PubKey/Rabin/OAEP.hs @@ -0,0 +1,100 @@ +-- | +-- Module : Crypto.PubKey.Rabin.OAEP +-- License : BSD-style +-- Maintainer : Carlos Rodrigue-Vega +-- Stability : experimental +-- Portability : unknown +-- +-- OAEP padding scheme. +-- See . +-- +module Crypto.PubKey.Rabin.OAEP + ( OAEPParams(..) + , defaultOAEPParams + , pad + , unpad + ) where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Bits (xor) + +import Crypto.Hash +import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray) +import qualified Crypto.Internal.ByteArray as B (convert) +import Crypto.PubKey.MaskGenFunction +import Crypto.PubKey.Internal (and') +import Crypto.PubKey.Rabin.Types + +-- | Parameters for OAEP padding. +data OAEPParams hash seed output = OAEPParams + { oaepHash :: hash -- ^ hash function to use + , oaepMaskGenAlg :: MaskGenAlgorithm seed output -- ^ mask Gen algorithm to use + , oaepLabel :: Maybe ByteString -- ^ optional label prepended to message + } + +-- | Default Params with a specified hash function. +defaultOAEPParams :: (ByteArrayAccess seed, ByteArray output, HashAlgorithm hash) + => hash + -> OAEPParams hash seed output +defaultOAEPParams hashAlg = + OAEPParams { oaepHash = hashAlg + , oaepMaskGenAlg = mgf1 hashAlg + , oaepLabel = Nothing + } + +-- | Pad a message using OAEP. +pad :: HashAlgorithm hash + => ByteString -- ^ Seed + -> OAEPParams hash ByteString ByteString -- ^ OAEP params to use + -> Int -- ^ size of public key in bytes + -> ByteString -- ^ Message pad + -> Either Error ByteString +pad seed oaep k msg + | k < 2*hashLen+2 = Left InvalidParameters + | B.length seed /= hashLen = Left InvalidParameters + | mLen > k - 2*hashLen-2 = Left MessageTooLong + | otherwise = Right em + where -- parameters + mLen = B.length msg + mgf = oaepMaskGenAlg oaep + labelHash = hashWith (oaepHash oaep) (maybe B.empty id $ oaepLabel oaep) + hashLen = hashDigestSize (oaepHash oaep) + -- put fields + ps = B.replicate (k - mLen - 2*hashLen - 2) 0 + db = B.concat [B.convert labelHash, ps, B.singleton 0x1, msg] + dbmask = mgf seed (k - hashLen - 1) + maskedDB = B.pack $ B.zipWith xor db dbmask + seedMask = mgf maskedDB hashLen + maskedSeed = B.pack $ B.zipWith xor seed seedMask + em = B.concat [B.singleton 0x0, maskedSeed, maskedDB] + +-- | Un-pad a OAEP encoded message. +unpad :: HashAlgorithm hash + => OAEPParams hash ByteString ByteString -- ^ OAEP params to use + -> Int -- ^ size of public key in bytes + -> ByteString -- ^ encoded message (not encrypted) + -> Either Error ByteString +unpad oaep k em + | paddingSuccess = Right msg + | otherwise = Left MessageNotRecognized + where -- parameters + mgf = oaepMaskGenAlg oaep + labelHash = B.convert $ hashWith (oaepHash oaep) (maybe B.empty id $ oaepLabel oaep) + hashLen = hashDigestSize (oaepHash oaep) + -- getting em's fields + (pb, em0) = B.splitAt 1 em + (maskedSeed, maskedDB) = B.splitAt hashLen em0 + seedMask = mgf maskedDB hashLen + seed = B.pack $ B.zipWith xor maskedSeed seedMask + dbmask = mgf seed (k - hashLen - 1) + db = B.pack $ B.zipWith xor maskedDB dbmask + -- getting db's fields + (labelHash', db1) = B.splitAt hashLen db + (_, db2) = B.break (/= 0) db1 + (ps1, msg) = B.splitAt 1 db2 + + paddingSuccess = and' [ labelHash' == labelHash -- no need for constant eq + , ps1 == B.replicate 1 0x1 + , pb == B.replicate 1 0x0 + ] diff --git a/Crypto/PubKey/Rabin/RW.hs b/Crypto/PubKey/Rabin/RW.hs index 2ad85a3..6ca9616 100644 --- a/Crypto/PubKey/Rabin/RW.hs +++ b/Crypto/PubKey/Rabin/RW.hs @@ -15,6 +15,7 @@ module Crypto.PubKey.Rabin.RW , PrivateKey(..) , generate , encrypt + , encryptWithSeed , decrypt , sign , verify @@ -25,9 +26,10 @@ import qualified Data.ByteString as B import Data.Data import Crypto.Hash -import Crypto.Number.Basic (gcde) +import Crypto.Number.Basic (numBytes, gcde) import Crypto.Number.ModArithmetic (expSafe, jacobi) -import Crypto.Number.Serialize (i2osp, os2ip) +import Crypto.Number.Serialize (i2osp, i2ospOf_, os2ip) +import Crypto.PubKey.Rabin.OAEP import Crypto.PubKey.Rabin.Types import Crypto.Random.Types @@ -53,61 +55,86 @@ generate :: MonadRandom m generate size = do (p, q) <- generatePrimes size (\p -> p `mod` 8 == 3) (\q -> q `mod` 8 == 7) return (generateKeys p q) - where - generateKeys p q = - let n = p*q - d = ((p - 1)*(q - 1) `div` 4 + 1) `div` 2 - publicKey = PublicKey { public_size = size - , public_n = n } - privateKey = PrivateKey { private_pub = publicKey - , private_p = p - , private_q = q - , private_d = d } - in (publicKey, privateKey) + where + generateKeys p q = + let n = p*q + d = ((p - 1)*(q - 1) `div` 4 + 1) `div` 2 + publicKey = PublicKey { public_size = size + , public_n = n } + privateKey = PrivateKey { private_pub = publicKey + , private_p = p + , private_q = q + , private_d = d } + in (publicKey, privateKey) + +-- | Encrypt plaintext using public key an a predefined OAEP seed. +-- +-- See algorithm 8.11 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al. +encryptWithSeed :: HashAlgorithm hash + => ByteString -- ^ Seed + -> OAEPParams hash ByteString ByteString -- ^ OAEP padding + -> PublicKey -- ^ public key + -> ByteString -- ^ plaintext + -> Either Error ByteString +encryptWithSeed seed oaep pk m = + let n = public_n pk + k = numBytes n + in do + m' <- pad seed oaep k m + m'' <- ep1 n $ os2ip m' + return $ i2osp $ ep2 n m'' -- | Encrypt plaintext using public key. -encrypt :: PublicKey -- ^ public key - -> ByteString -- ^ plaintext - -> Either Error ByteString -encrypt pk m = - let n = public_n pk - in case ep1 n $ os2ip m of - Right m' -> Right $ i2osp $ ep2 n m' - Left err -> Left err +encrypt :: (HashAlgorithm hash, MonadRandom m) + => OAEPParams hash ByteString ByteString -- ^ OAEP padding parameters + -> PublicKey -- ^ public key + -> ByteString -- ^ plaintext + -> m (Either Error ByteString) +encrypt oaep pk m = do + seed <- getRandomBytes hashLen + return $ encryptWithSeed seed oaep pk m + where + hashLen = hashDigestSize (oaepHash oaep) -- | Decrypt ciphertext using private key. -decrypt :: PrivateKey -- ^ private key - -> ByteString -- ^ ciphertext - -> ByteString -decrypt pk c = +decrypt :: HashAlgorithm hash + => OAEPParams hash ByteString ByteString -- ^ OAEP padding parameters + -> PrivateKey -- ^ private key + -> ByteString -- ^ ciphertext + -> Maybe ByteString +decrypt oaep pk c = let d = private_d pk - n = public_n $ private_pub pk - in i2osp $ dp2 n $ dp1 d n $ os2ip c + n = public_n $ private_pub pk + k = numBytes n + c' = i2ospOf_ k $ dp2 n $ dp1 d n $ os2ip c + in case unpad oaep k c' of + Left _ -> Nothing + Right p -> Just p -- | Sign message using hash algorithm and private key. -sign :: (HashAlgorithm hash) +sign :: HashAlgorithm hash => PrivateKey -- ^ private key -> hash -- ^ hash function -> ByteString -- ^ message to sign - -> Either Error ByteString + -> Either Error Integer sign pk hashAlg m = - let d = private_d pk - n = public_n $ private_pub pk - in case ep1 n $ os2ip $ hashWith hashAlg m of - Right m' -> Right (i2osp $ dp1 d n m') - Left err -> Left err + let d = private_d pk + n = public_n $ private_pub pk + in do + m' <- ep1 n $ os2ip $ hashWith hashAlg m + return $ dp1 d n m' -- | Verify signature using hash algorithm and public key. -verify :: (HashAlgorithm hash) +verify :: HashAlgorithm hash => PublicKey -- ^ public key -> hash -- ^ hash function -> ByteString -- ^ message - -> ByteString -- ^ signature + -> Integer -- ^ signature -> Bool verify pk hashAlg m s = let n = public_n pk h = os2ip $ hashWith hashAlg m - h' = dp2 n $ ep2 n $ os2ip s + h' = dp2 n $ ep2 n s in h' == h -- | Encryption primitive 1 diff --git a/Crypto/PubKey/Rabin/Types.hs b/Crypto/PubKey/Rabin/Types.hs index a2bfe14..403e8d7 100644 --- a/Crypto/PubKey/Rabin/Types.hs +++ b/Crypto/PubKey/Rabin/Types.hs @@ -18,6 +18,7 @@ type PrimeCondition = Integer -> Bool -- | Error possible during encryption, decryption or signing. data Error = MessageTooLong -- ^ the message to encrypt is too long + | MessageNotRecognized -- ^ the message decrypted doesn't have a OAEP structure | InvalidParameters -- ^ some parameters lead to breaking assumptions deriving (Show, Eq) diff --git a/cryptonite.cabal b/cryptonite.cabal index e28ffd7..975f794 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -162,6 +162,7 @@ Library Crypto.PubKey.RSA.PSS Crypto.PubKey.RSA.OAEP Crypto.PubKey.RSA.Types + Crypto.PubKey.Rabin.OAEP Crypto.PubKey.Rabin.Basic Crypto.PubKey.Rabin.Modified Crypto.PubKey.Rabin.RW diff --git a/tests/KAT_PubKey/Rabin.hs b/tests/KAT_PubKey/Rabin.hs index e1d6ab3..2f44260 100644 --- a/tests/KAT_PubKey/Rabin.hs +++ b/tests/KAT_PubKey/Rabin.hs @@ -1,89 +1,145 @@ {-# LANGUAGE OverloadedStrings #-} module KAT_PubKey.Rabin (rabinTests) where -import Imports +import qualified Data.ByteString as B + import Crypto.Hash -import qualified Crypto.PubKey.Rabin.Basic as Basic -import qualified Crypto.PubKey.Rabin.Modified as ModRabin +import Crypto.Number.Serialize (os2ip) +import qualified Crypto.PubKey.Rabin.Basic as BRabin +import qualified Crypto.PubKey.Rabin.Modified as MRabin +import qualified Crypto.PubKey.Rabin.OAEP as OAEP import qualified Crypto.PubKey.Rabin.RW as RW -data VectorRabin = VectorRabin - { msg :: ByteString - , size :: Int +import Imports + +basicRabinKey = BRabin.PrivateKey + { BRabin.private_pub = BRabin.PublicKey + { BRabin.public_n = 0xc9c4b0df9db989d93df4137fc2de2a9cee2610523f7a450ecbbf252babe98fba2f8e389c3e420c081e18f584c5746ca43f77f6af1fc79161f8bf8fbcb9564779986ecbe656dd16740cb8e399c33ff1dcc679e73c9c98a58c65a8673b7de57290a2d3191cb27e29d627f7ec6e874b1406051ffe9181e4d90d1b487b100ad30685 + , BRabin.public_size = 128 + } + , BRabin.private_p = 0xe071f231ab5912285a1f8db199795f5efdea4c32f646a3436eaec091ba853a3092216f26b539bbac1fe2ab2e4fbb20aad272a434a1e909bf6d3028aecae2a7b7 + , BRabin.private_q = 0xe6229470dc7da58bfcd962f1b3ddcf52304efbfb91d31c8ed84dbae2380c1ad2e338a523b4250863a689b3f262f949bd7a9f1a603c36634bb932dd71bf5daba3 + , BRabin.private_a = 0x65956653f711a63b776ce45862d4cd78f1ad7b1f8ed118bb8b5ea5fffd59762da5dc7c5298e236a8e45d5c93477cbc51f214b1cd1a4980eda859c1cb05e55666 + , BRabin.private_b = -0x63126dd9c5d6b5215f62012885570e1306b6a47ec1c46553f3b13ceae869149d14544438dbb976800cd62fbb52266f9a6405bc91f192a462c974bc8a6f832e03 } -vectors = - [ VectorRabin - { msg = "\xd4\x36\xe9\x95\x69\xfd\x32\xa7\xc8\xa0\x5b\xbc\x90\xd3\x2c\x49" - , size = 32 +modifiedRabinKey = MRabin.PrivateKey + { MRabin.private_pub = MRabin.PublicKey + { MRabin.public_n = 0x9461a6e7c55cb610f20fd9af5d642404a63332a8d7c4fe7aa559cbcaec691e7216eed5d9322cb6a8619c220a0241b44e0d0a7cefda01fb84e59722b4e842ab5e190d214424bbdfed6d523426fc57a28045dfbb6e8159123077c542c0278ee2daf2d8993e286bf709a10a948da6b13008441581a22233f0ad3d5ebc5858ff7be5 + , MRabin.public_size = 128 } - , VectorRabin - { msg = "\x52\xe6\x50\xd9\x8e\x7f\x2a\x04\x8b\x4f\x86\x85\x21\x53\xb9\x7e\x01\xdd\x31\x6f\x34\x6a\x19\xf6\x7a\x85" - , size = 64 + , MRabin.private_p = 0xc401e0ddbe565a8797292389bebb561c35eb019116ba25cc6c865a8d3d7bc599626ddf0bc4f575c22f89144fe99fc3300dd497ec2b7acc0221e729a61756b3f3 + , MRabin.private_q = 0xc1cc0e35f23f5086691a18c755881e3fe6937581948b109f47605b45d055e7b352e19ff729dfb33fbecb1d28b115e590449e5e4e228ab1876d889d3d41d87ec7 + , MRabin.private_d = 0x128c34dcf8ab96c21e41fb35ebac848094c666551af89fcf54ab39795d8d23ce42dddabb264596d50c33844140483689c1a14f9dfb403f709cb2e4569d08556b9267e6460e84c69beda1defabd0285c4852c288b7ac27b78987bd19da337a6b1c7b123476732d9c0f656cc62a17f70e8fe34516cfa85ce6475bddeae9ffa0926 + } + +rwKey = RW.PrivateKey + { RW.private_pub = RW.PublicKey + { RW.public_n = 0x992db4c84564c68d4ee2fe0903d938b41e83bcac48dfe8f2219ccee2ccbdefda4cbeea9f1c98a515c5f39a458f5ea11bca97102aaa3d9ac69e000093024e7b968359287cdf57bdacff5df1893df3539c7e358f037d49b5c6ae7110ab8117220c73b6265987039c2c97078fccacdd3f5a560aff5076fdc3958c532db28ab9a855 + , RW.public_size = 128 } - , VectorRabin - { msg = "\x66\x28\x19\x4e\x12\x07\x3d\xb0\x3b\xa9\x4c\xda\x9e\xf9\x53\x23\x97\xd5\x0d\xba\x79\xb9\x87\x00\x4a\xfe\xfe\x34" - , size = 128 - } + , RW.private_p = 0xc144dd739c45397d61868ca944a9729a7ad34cf90466c8f5c98a88f5ab5e3288bcfd31d4af1d441d23a756a60abd4cf05c3e0b0053eb150166a327ae31e9347b + , RW.private_q = 0xcae5a381f25a27ae2c359068753118fc384471cd6027e88b8b910306fb940781261089259a3c569546677aebd268704c767a071dbd4f50cb9f15fe448788856f + , RW.private_d = 0x1325b69908ac98d1a9dc5fc1207b271683d07795891bfd1e443399dc5997bdfb4997dd53e39314a2b8be7348b1ebd4237952e2055547b358d3c000126049cf729ee5d4f0ea170b902e343a8ef0831900b963ba07a3176088ab2ab095db449d0052150d6be7b5402f459f17c759f6f043b06a5da64cb86bb910d340f7fa28fdce + } + +data EncryptionVector = EncryptionVector + { seed :: ByteString + , plainText :: ByteString + , cipherText :: ByteString + } + +data SignatureVector = SignatureVector + { message :: ByteString + , padding :: ByteString + , signature :: Integer + } + +basicRabinEncryptionVectors = + [ EncryptionVector + { plainText = "\x75\x0c\x40\x47\xf5\x47\xe8\xe4\x14\x11\x85\x65\x23\x29\x8a\xc9\xba\xe2\x45\xef\xaf\x13\x97\xfb\xe5\x6f\x9d\xd5" + , seed = "\x0c\xc7\x42\xce\x4a\x9b\x7f\x32\xf9\x51\xbc\xb2\x51\xef\xd9\x25\xfe\x4f\xe3\x5f" + , cipherText = "\xaf\xc7\x03\xe3\x9d\x2f\x81\xc6\x3a\x80\x2a\xd1\x44\x26\x3f\x17\x0c\x0a\xe6\x48\x68\x98\x23\x14\x8f\x95\xd2\xce\xbb\xe7\x3f\x49\x34\x76\x1d\x99\x30\x7b\xeb\x84\xe5\x2a\x10\xd2\x1e\x11\x7e\x65\xe8\x88\x24\xc1\x12\xeb\x19\x0d\x97\xcd\x12\x25\x6b\x1f\x9b\x0c\x40\x40\xa3\x47\x00\xb7\x11\xf8\x50\x08\x51\x79\xe8\x1b\xd1\x77\xe0\x99\xa7\xe1\x5c\x63\xda\x29\xc7\xde\x28\x5d\x60\xed\x8e\xb2\x12\xd4\xfe\xb8\x1a\x5d\x17\x65\x80\x62\x6e\x65\x5c\x37\x07\x1c\xfa\xff\xe6\x21\xa5\x9f\xcd\x6a\x6a\xce\xa6\x96\xb2\xc5\x08\xe6" + } ] -doBasicEncryptionTest (i, vector) = testCase (show i) (do - let message = msg vector - (pubKey, privKey) <- Basic.generate (size vector) - let cipherText = Basic.encrypt pubKey message - actual = case cipherText of - Left _ -> False - Right c -> let (p, p', p'', p''') = Basic.decrypt privKey c - in elem message [p, p', p'', p'''] - (True @=? actual)) +basicRabinSignatureVectors = + [ SignatureVector + { message = "\x75\x0c\x40\x47\xf5\x47\xe8\xe4\x14\x11\x85\x65\x23\x29\x8a\xc9\xba\xe2\x45\xef\xaf\x13\x97\xfb\xe5\x6f\x9d\xd5" + , padding = "\xe9\x87\x17\x15\xa2\xe4\x30\x15" + , signature = 0xac95807bdd03ca975690151d39d23d75e5db2731c4ba30b83c3f3ea74709e4d4e340d7dab952356a76c9b8705b214e28d59f5bdc7c7fdff4e104569e30359b5c65c2dcd5b94db58505cd8b188267121700beebd7edbee492e374514646471b5c3fa252a2580dc7343f455683815d6d7c590dd3bcaa7df41d8b08197ccb183408 + } + ] -doBasicSignatureTest (i, vector) = testCase (show i) (do - let message = msg vector - (pubKey, privKey) <- Basic.generate (size vector) - signature <- Basic.sign privKey SHA1 message - let actual = case signature of - Left _ -> False - Right s -> Basic.verify pubKey SHA1 message s - (True @=? actual)) +modifiedRabinSignatureVectors = + [ SignatureVector + { message = "\x75\x0c\x40\x47\xf5\x47\xe8\xe4\x14\x11\x85\x65\x23\x29\x8a\xc9\xba\xe2\x45\xef\xaf\x13\x97\xfb\xe5\x6f\x9d\xd5" + , padding = B.empty -- not used + , signature = 0x278c7c269119218ab7f501ea53a97ab15a3a5a263c6daed8980abec78291e9729e0e3457731cdea8ec31a7566e93d10fc9b2615fe3e54f4533a5506ac24a3bd286e270324e538066f0ddf503f9b5e0c18e18379659834906ebd99c0d31588c66e70fc653bc8865b9239999cbd35704917d8647d1199286c533233e3e03582dd + } + ] + +rwEncryptionVectors = + [ EncryptionVector + { plainText = "\x75\x0c\x40\x47\xf5\x47\xe8\xe4\x14\x11\x85\x65\x23\x29\x8a\xc9\xba\xe2\x45\xef\xaf\x13\x97\xfb\xe5\x6f\x9d\xd5" + , seed = "\x0c\xc7\x42\xce\x4a\x9b\x7f\x32\xf9\x51\xbc\xb2\x51\xef\xd9\x25\xfe\x4f\xe3\x5f" + , cipherText = "\x40\xc2\xe3\x36\xac\x46\x72\x8a\xaf\x33\x75\xe1\x27\xd0\x38\x40\xe2\x24\x4e\x20\xa7\x5d\x85\xd3\x74\x81\x21\xfd\xc9\x40\x90\x80\x8c\xed\x2d\xd3\x5b\xc4\xb7\xc9\x7c\x80\xa5\x2f\x63\x86\x34\x4e\x8c\x92\x07\x86\x9e\xda\xfd\xf8\x11\x83\x8a\x5a\x23\xc1\xe6\x77\x37\x5d\xf9\x5c\x60\xd1\x6d\xfd\x0c\x54\xd1\x00\xe9\xab\x97\x6d\x8e\x83\x8b\x6e\x1a\x38\x73\x43\xe2\x24\xc2\xe2\x4e\x74\x3f\xe4\x4d\xdd\x27\xed\xc7\x72\x88\xd3\x0f\x93\xb3\xdb\xa2\xb7\xaf\x6d\xe9\xab\x76\x53\x63\xf9\x62\xd7\x52\x44\x61\x60\x5d\x2e\x9b\xf7" + } + ] -doModifiedSignatureTest (i, vector) = testCase (show i) (do - let message = msg vector - (pubKey, privKey) <- ModRabin.generate (size vector) - let signature = ModRabin.sign privKey SHA1 message - actual = case signature of - Left _ -> False - Right s -> ModRabin.verify pubKey SHA1 message s - (True @=? actual)) +rwSignatureVectors = + [ SignatureVector + { message = "\x75\x0c\x40\x47\xf5\x47\xe8\xe4\x14\x11\x85\x65\x23\x29\x8a\xc9\xba\xe2\x45\xef\xaf\x13\x97\xfb\xe5\x6f\x9d\xd5" + , padding = B.empty -- not used + , signature = 0x1e57b554a8e83aacd9d4067f9535991e7db47803250cded5cc8af5458a6bb11fea852139e0afe143f9339dd94a518e354e702134d1ae222460127829d92e8bf6441336f5ae7044ec7b6c3ad8b9aeeb1ea02a49798e020cb5b558120bbb51f060eb1608ba68f90cac7edb1051c177d3bdbb99d1ad92e8d75d6f72f1d06f1d25be + } + ] -doRwEncryptionTest (i, vector) = testCase (show i) (do - let message = msg vector - (pubKey, privKey) <- RW.generate (size vector) - let cipherText = RW.encrypt pubKey message - actual = case cipherText of - Left _ -> False - Right c -> let p = RW.decrypt privKey c - in message == p - (True @=? actual)) +doBasicRabinEncryptTest key (i, vector) = testCase (show i) (Right (cipherText vector) @=? actual) + where actual = BRabin.encryptWithSeed (seed vector) (OAEP.defaultOAEPParams SHA1) key (plainText vector) -doRwSignatureTest (i, vector) = testCase (show i) (do - let message = msg vector - (pubKey, privKey) <- RW.generate (size vector) - let signature = RW.sign privKey SHA1 message - actual = case signature of - Left _ -> False - Right s -> RW.verify pubKey SHA1 message s - (True @=? actual)) +doBasicRabinDecryptTest key (i, vector) = testCase (show i) (Just (plainText vector) @=? actual) + where actual = BRabin.decrypt (OAEP.defaultOAEPParams SHA1) key (cipherText vector) + +doBasicRabinSignTest key (i, vector) = testCase (show i) (Right (BRabin.Signature ((os2ip $ padding vector), (signature vector))) @=? actual) + where actual = BRabin.signWith (padding vector) key SHA1 (message vector) + +doBasicRabinVerifyTest key (i, vector) = testCase (show i) (True @=? actual) + where actual = BRabin.verify key SHA1 (message vector) (BRabin.Signature ((os2ip $ padding vector), (signature vector))) + +doModifiedRabinSignTest key (i, vector) = testCase (show i) (Right (signature vector) @=? actual) + where actual = MRabin.sign key SHA1 (message vector) + +doModifiedRabinVerifyTest key (i, vector) = testCase (show i) (True @=? actual) + where actual = MRabin.verify key SHA1 (message vector) (signature vector) + +doRwEncryptTest key (i, vector) = testCase (show i) (Right (cipherText vector) @=? actual) + where actual = RW.encryptWithSeed (seed vector) (OAEP.defaultOAEPParams SHA1) key (plainText vector) + +doRwDecryptTest key (i, vector) = testCase (show i) (Just (plainText vector) @=? actual) + where actual = RW.decrypt (OAEP.defaultOAEPParams SHA1) key (cipherText vector) + +doRwSignTest key (i, vector) = testCase (show i) (Right (signature vector) @=? actual) + where actual = RW.sign key SHA1 (message vector) + +doRwVerifyTest key (i, vector) = testCase (show i) (True @=? actual) + where actual = RW.verify key SHA1 (message vector) (signature vector) rabinTests = testGroup "Rabin" [ testGroup "Basic" - [ testGroup "encryption" $ map doBasicEncryptionTest (zip [katZero..] vectors) - , testGroup "signature" $ map doBasicSignatureTest (zip [katZero..] vectors) + [ testGroup "encrypt" $ map (doBasicRabinEncryptTest $ BRabin.private_pub basicRabinKey) (zip [katZero..] basicRabinEncryptionVectors) + , testGroup "decrypt" $ map (doBasicRabinDecryptTest $ basicRabinKey) (zip [katZero..] basicRabinEncryptionVectors) + , testGroup "sign" $ map (doBasicRabinSignTest $ basicRabinKey) (zip [katZero..] basicRabinSignatureVectors) + , testGroup "verify" $ map (doBasicRabinVerifyTest $ BRabin.private_pub basicRabinKey) (zip [katZero..] basicRabinSignatureVectors) ] , testGroup "Modified" - [ testGroup "signature" $ map doModifiedSignatureTest (zip [katZero..] vectors) + [ testGroup "sign" $ map (doModifiedRabinSignTest $ modifiedRabinKey) (zip [katZero..] modifiedRabinSignatureVectors) + , testGroup "verify" $ map (doModifiedRabinVerifyTest $ MRabin.private_pub modifiedRabinKey) (zip [katZero..] modifiedRabinSignatureVectors) ] , testGroup "RW" - [ testGroup "encryption" $ map doRwEncryptionTest (zip [katZero..] vectors) - , testGroup "signature" $ map doRwSignatureTest (zip [katZero..] vectors) + [ testGroup "encrypt" $ map (doRwEncryptTest $ RW.private_pub rwKey) (zip [katZero..] rwEncryptionVectors) + , testGroup "decrypt" $ map (doRwDecryptTest $ rwKey) (zip [katZero..] rwEncryptionVectors) + , testGroup "sign" $ map (doRwSignTest $ rwKey) (zip [katZero..] rwSignatureVectors) + , testGroup "verify" $ map (doRwVerifyTest $ RW.private_pub rwKey) (zip [katZero..] rwSignatureVectors) ] ] From e10ef06885df90754e24c06bbb312e851d60587e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 14 Oct 2018 16:58:29 +0200 Subject: [PATCH 018/176] Remove unnecessary language extension --- Crypto/Hash/SHAKE.hs | 1 - tests/Hash.hs | 1 - 2 files changed, 2 deletions(-) diff --git a/Crypto/Hash/SHAKE.hs b/Crypto/Hash/SHAKE.hs index aa9d692..5d36228 100644 --- a/Crypto/Hash/SHAKE.hs +++ b/Crypto/Hash/SHAKE.hs @@ -12,7 +12,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE DataKinds #-} -{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeFamilies #-} diff --git a/tests/Hash.hs b/tests/Hash.hs index f139bc1..5c699ef 100644 --- a/tests/Hash.hs +++ b/tests/Hash.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE DataKinds #-} module Hash From 0ab1c41ac87b3a64d2270748d395706e6c5549e0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 14 Oct 2018 16:58:29 +0200 Subject: [PATCH 019/176] Add missing Data instances --- Crypto/Hash/SHAKE.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/Crypto/Hash/SHAKE.hs b/Crypto/Hash/SHAKE.hs index 5d36228..4eed297 100644 --- a/Crypto/Hash/SHAKE.hs +++ b/Crypto/Hash/SHAKE.hs @@ -22,6 +22,7 @@ module Crypto.Hash.SHAKE import Crypto.Hash.Types import Foreign.Ptr (Ptr) +import Data.Data import Data.Typeable import Data.Word (Word8, Word32) @@ -37,7 +38,7 @@ import Crypto.Internal.Nat -- correlated (one being a prefix of the other). Results are unrelated to -- 'SHAKE256' results. data SHAKE128 (bitlen :: Nat) = SHAKE128 - deriving (Show, Typeable) + deriving (Show, Data, Typeable) instance (IsDivisibleBy8 bitlen, KnownNat bitlen) => HashAlgorithm (SHAKE128 bitlen) where type HashBlockSize (SHAKE128 bitlen) = 168 @@ -58,7 +59,7 @@ instance (IsDivisibleBy8 bitlen, KnownNat bitlen) => HashAlgorithm (SHAKE128 bit -- correlated (one being a prefix of the other). Results are unrelated to -- 'SHAKE128' results. data SHAKE256 (bitlen :: Nat) = SHAKE256 - deriving (Show, Typeable) + deriving (Show, Data, Typeable) instance (IsDivisibleBy8 bitlen, KnownNat bitlen) => HashAlgorithm (SHAKE256 bitlen) where type HashBlockSize (SHAKE256 bitlen) = 136 From 455504b8e2f02bad2294a079057b0da41b5ab087 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 14 Oct 2018 16:58:29 +0200 Subject: [PATCH 020/176] Implement SHAKE output not divisible by 8 bits --- Crypto/Hash/SHAKE.hs | 33 ++++++++++++++++++++++----------- Crypto/Internal/Nat.hs | 4 ++-- tests/Hash.hs | 20 ++++++++++++++++++++ 3 files changed, 44 insertions(+), 13 deletions(-) diff --git a/Crypto/Hash/SHAKE.hs b/Crypto/Hash/SHAKE.hs index 4eed297..63d19d8 100644 --- a/Crypto/Hash/SHAKE.hs +++ b/Crypto/Hash/SHAKE.hs @@ -20,19 +20,21 @@ module Crypto.Hash.SHAKE ( SHAKE128 (..), SHAKE256 (..) ) where +import Control.Monad (when) import Crypto.Hash.Types -import Foreign.Ptr (Ptr) +import Foreign.Ptr (Ptr, castPtr) +import Foreign.Storable (Storable(..)) +import Data.Bits import Data.Data import Data.Typeable import Data.Word (Word8, Word32) import Data.Proxy (Proxy(..)) -import GHC.TypeLits (Nat, KnownNat, natVal) +import GHC.TypeLits (Nat, KnownNat, type (+)) import Crypto.Internal.Nat -- | SHAKE128 (128 bits) extendable output function. Supports an arbitrary --- digest size (multiple of 8 bits), to be specified as a type parameter --- of kind 'Nat'. +-- digest size, to be specified as a type parameter of kind 'Nat'. -- -- Note: outputs from @'SHAKE128' n@ and @'SHAKE128' m@ for the same input are -- correlated (one being a prefix of the other). Results are unrelated to @@ -40,9 +42,9 @@ import Crypto.Internal.Nat data SHAKE128 (bitlen :: Nat) = SHAKE128 deriving (Show, Data, Typeable) -instance (IsDivisibleBy8 bitlen, KnownNat bitlen) => HashAlgorithm (SHAKE128 bitlen) where +instance KnownNat bitlen => HashAlgorithm (SHAKE128 bitlen) where type HashBlockSize (SHAKE128 bitlen) = 168 - type HashDigestSize (SHAKE128 bitlen) = Div8 bitlen + type HashDigestSize (SHAKE128 bitlen) = Div8 (bitlen + 7) type HashInternalContextSize (SHAKE128 bitlen) = 376 hashBlockSize _ = 168 hashDigestSize _ = byteLen (Proxy :: Proxy bitlen) @@ -52,8 +54,7 @@ instance (IsDivisibleBy8 bitlen, KnownNat bitlen) => HashAlgorithm (SHAKE128 bit hashInternalFinalize = shakeFinalizeOutput (Proxy :: Proxy bitlen) -- | SHAKE256 (256 bits) extendable output function. Supports an arbitrary --- digest size (multiple of 8 bits), to be specified as a type parameter --- of kind 'Nat'. +-- digest size, to be specified as a type parameter of kind 'Nat'. -- -- Note: outputs from @'SHAKE256' n@ and @'SHAKE256' m@ for the same input are -- correlated (one being a prefix of the other). Results are unrelated to @@ -61,9 +62,9 @@ instance (IsDivisibleBy8 bitlen, KnownNat bitlen) => HashAlgorithm (SHAKE128 bit data SHAKE256 (bitlen :: Nat) = SHAKE256 deriving (Show, Data, Typeable) -instance (IsDivisibleBy8 bitlen, KnownNat bitlen) => HashAlgorithm (SHAKE256 bitlen) where +instance KnownNat bitlen => HashAlgorithm (SHAKE256 bitlen) where type HashBlockSize (SHAKE256 bitlen) = 136 - type HashDigestSize (SHAKE256 bitlen) = Div8 bitlen + type HashDigestSize (SHAKE256 bitlen) = Div8 (bitlen + 7) type HashInternalContextSize (SHAKE256 bitlen) = 344 hashBlockSize _ = 136 hashDigestSize _ = byteLen (Proxy :: Proxy bitlen) @@ -72,7 +73,7 @@ instance (IsDivisibleBy8 bitlen, KnownNat bitlen) => HashAlgorithm (SHAKE256 bit hashInternalUpdate = c_sha3_update hashInternalFinalize = shakeFinalizeOutput (Proxy :: Proxy bitlen) -shakeFinalizeOutput :: (IsDivisibleBy8 bitlen, KnownNat bitlen) +shakeFinalizeOutput :: KnownNat bitlen => proxy bitlen -> Ptr (Context a) -> Ptr (Digest a) @@ -80,6 +81,16 @@ shakeFinalizeOutput :: (IsDivisibleBy8 bitlen, KnownNat bitlen) shakeFinalizeOutput d ctx dig = do c_sha3_finalize_shake ctx c_sha3_output ctx dig (byteLen d) + shakeTruncate d (castPtr dig) + +shakeTruncate :: KnownNat bitlen => proxy bitlen -> Ptr Word8 -> IO () +shakeTruncate d ptr = + when (bits > 0) $ do + byte <- peekElemOff ptr index + pokeElemOff ptr index (byte .&. mask) + where + mask = (1 `shiftL` bits) - 1 + (index, bits) = integralNatVal d `divMod` 8 foreign import ccall unsafe "cryptonite_sha3_init" c_sha3_init :: Ptr (Context a) -> Word32 -> IO () diff --git a/Crypto/Internal/Nat.hs b/Crypto/Internal/Nat.hs index 39eae6f..3698a6b 100644 --- a/Crypto/Internal/Nat.hs +++ b/Crypto/Internal/Nat.hs @@ -15,8 +15,8 @@ module Crypto.Internal.Nat import GHC.TypeLits -byteLen :: (KnownNat bitlen, IsDivisibleBy8 bitlen, Num a) => proxy bitlen -> a -byteLen d = fromInteger (natVal d `div` 8) +byteLen :: (KnownNat bitlen, Num a) => proxy bitlen -> a +byteLen d = fromInteger ((natVal d + 7) `div` 8) integralNatVal :: (KnownNat bitlen, Num a) => proxy bitlen -> a integralNatVal = fromInteger . natVal diff --git a/tests/Hash.hs b/tests/Hash.hs index 5c699ef..d0f82c0 100644 --- a/tests/Hash.hs +++ b/tests/Hash.hs @@ -8,7 +8,9 @@ module Hash import Crypto.Hash import qualified Data.ByteString as B +import Data.ByteArray (convert) import qualified Data.ByteArray.Encoding as B (convertToBase, Base(..)) +import GHC.TypeLits import Imports v0,v1,v2 :: ByteString @@ -234,7 +236,25 @@ makeTestChunk (hashName, hashAlg, _) = runhash hashAlg inp `propertyEq` runhashinc hashAlg (chunkS ckLen inp) ] +-- SHAKE128 truncation example with expected byte at final position +-- +shake128TruncationBytes = [0x01, 0x03, 0x07, 0x0f, 0x0f, 0x2f, 0x6f, 0x6f] + +makeTestSHAKE128Truncation i byte = + testCase (show i) $ xof 4088 `B.snoc` byte @=? xof (4088 + i) + where + hashEmpty :: KnownNat n => proxy n -> Digest (SHAKE128 n) + hashEmpty _ = hash B.empty + + xof n = case someNatVal n of + Nothing -> error ("invalid Nat: " ++ show n) + Just (SomeNat p) -> convert (hashEmpty p) + tests = testGroup "hash" [ testGroup "KATs" (map makeTestAlg expected) , testGroup "Chunking" (concatMap makeTestChunk expected) + , testGroup "Truncating" + [ testGroup "SHAKE128" + (zipWith makeTestSHAKE128Truncation [1..] shake128TruncationBytes) + ] ] From 6a7594d2be3c388b9ad220f8f44230efa5d6c0f2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Tue, 23 Oct 2018 19:32:23 +0200 Subject: [PATCH 021/176] Add GHC 8.6 to CI and bump LTS versions --- .haskell-ci | 12 ++++++------ .travis.yml | 12 ++++++++---- 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/.haskell-ci b/.haskell-ci index 82d4a84..e0ccd0d 100644 --- a/.haskell-ci +++ b/.haskell-ci @@ -1,20 +1,20 @@ # compiler supported and their equivalent LTS compiler: ghc-8.0 lts-9.21 -compiler: ghc-8.2 lts-11.6 -compiler: ghc-8.4 ghc-8.4.2 +compiler: ghc-8.2 lts-11.22 +compiler: ghc-8.4 lts-12.14 +compiler: ghc-8.6 nightly-2018-10-21 # options # option: alias x=y z=v -option: testdeps extradep=QuickCheck-2.11.3 extradep=ansi-terminal-0.8.0.1 extradep=async-2.1.1.1 extradep=call-stack-0.1.0 extradep=clock-0.7.2 extradep=optparse-applicative-0.14.0.0 extradep=random-1.1 extradep=tagged-0.8.5 extradep=unbounded-delays-0.1.1.0 extradep=tasty-1.0.0.1 extradep=tasty-hunit-0.10.0.1 extradep=tasty-kat-0.0.3 extradep=tasty-quickcheck-0.9.2 extradep=ansi-wl-pprint-0.6.8.2 extradep=colour-2.3.4 extradep=tf-random-0.5 extradep=transformers-compat-0.5.1.4 extradep=primitive-0.6.3.0 allow-newer option: gaugedeps extradep=gauge-0.2.1 - option: basementmin extradep=basement-0.0.6 extradep=foundation-0.0.19 extradep=memory-0.14.14 # builds -build: ghc-8.2 basementmin gaugedeps +build: ghc-8.2 build: ghc-8.0 basementmin gaugedeps build: ghc-8.0 basementmin gaugedeps os=osx -build: ghc-8.4 basementmin testdeps gaugedeps extradep=vector-0.12.0.1 +build: ghc-8.4 +build: ghc-8.6 # packages package: '.' diff --git a/.travis.yml b/.travis.yml index eec4255..6b45760 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,4 +1,4 @@ -# ~*~ auto-generated by haskell-ci with config : 7d7fe90696706f37292f4d718fa1a63b938490d653e3abf049623087b2e6e901 ~*~ +# ~*~ auto-generated by haskell-ci with config : 7cb8db1c90854ae440aca1b3cde96895bf9153ceeddfe5fd39d82f8e300414c6 ~*~ # Use new container infrastructure to enable caching sudo: false @@ -16,6 +16,7 @@ matrix: - { env: BUILD=stack RESOLVER=ghc-8.0, compiler: ghc-8.0, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } - { env: BUILD=stack RESOLVER=ghc-8.0, compiler: ghc-8.0, language: generic, addons: { apt: { packages: [ libgmp-dev ] } }, os: osx } - { env: BUILD=stack RESOLVER=ghc-8.4, compiler: ghc-8.4, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } + - { env: BUILD=stack RESOLVER=ghc-8.6, compiler: ghc-8.6, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } - { env: BUILD=hlint, compiler: hlint, language: generic } - { env: BUILD=weeder, compiler: weeder, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } allow_failures: @@ -48,7 +49,7 @@ script: # create the build stack.yaml case "$RESOLVER" in ghc-8.2) - echo "{ resolver: lts-11.6, packages: [ '.' ], extra-deps: [ basement-0.0.6, foundation-0.0.19, memory-0.14.14, gauge-0.2.1 ], flags: {} }" > stack.yaml + echo "{ resolver: lts-11.22, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; ghc-8.0) @@ -60,7 +61,11 @@ script: stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; ghc-8.4) - echo "{ resolver: ghc-8.4.2, packages: [ '.' ], extra-deps: [ vector-0.12.0.1, basement-0.0.6, foundation-0.0.19, memory-0.14.14, QuickCheck-2.11.3, ansi-terminal-0.8.0.1, async-2.1.1.1, call-stack-0.1.0, clock-0.7.2, optparse-applicative-0.14.0.0, random-1.1, tagged-0.8.5, unbounded-delays-0.1.1.0, tasty-1.0.0.1, tasty-hunit-0.10.0.1, tasty-kat-0.0.3, tasty-quickcheck-0.9.2, ansi-wl-pprint-0.6.8.2, colour-2.3.4, tf-random-0.5, transformers-compat-0.5.1.4, primitive-0.6.3.0, gauge-0.2.1 ], flags: {}, allow-newer: true }" > stack.yaml + echo "{ resolver: lts-12.14, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml + stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps + ;; + ghc-8.6) + echo "{ resolver: nightly-2018-10-21, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; esac @@ -75,4 +80,3 @@ script: esac set +ex - From 77bc512a8796a9043aaae227b807b8e76534d951 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Wed, 24 Oct 2018 21:25:14 +0200 Subject: [PATCH 022/176] Add a default stack.yaml Will be useful for the weeder build in CI. --- stack.yaml | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 stack.yaml diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..57f8c6b --- /dev/null +++ b/stack.yaml @@ -0,0 +1,3 @@ +# ~*~ auto-generated by haskell-ci with config : 7cb8db1c90854ae440aca1b3cde96895bf9153ceeddfe5fd39d82f8e300414c6 ~*~ +{ resolver: lts-12.14, packages: [ '.' ], extra-deps: [], flags: {} } + From ee9c485a4d589205479d1f767f54d624e05a1fb8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 26 Oct 2018 18:31:29 +0200 Subject: [PATCH 023/176] Update tested-with --- cryptonite.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cryptonite.cabal b/cryptonite.cabal index bbfebac..5d19c59 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -36,7 +36,7 @@ Build-Type: Simple Homepage: https://github.com/haskell-crypto/cryptonite Bug-reports: https://github.com/haskell-crypto/cryptonite/issues Cabal-Version: >=1.18 -tested-with: GHC==8.4.2, GHC==8.2.2, GHC==8.0.2 +tested-with: GHC==8.6.1, GHC==8.4.3, GHC==8.2.2, GHC==8.0.2 extra-doc-files: README.md CHANGELOG.md extra-source-files: cbits/*.h cbits/aes/*.h From d4bd9287f2d964368caf87bc24bc1d91499eee9c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 28 Oct 2018 17:52:36 +0100 Subject: [PATCH 024/176] Test with GHC 8.4.4 --- .haskell-ci | 2 +- .travis.yml | 4 ++-- cryptonite.cabal | 2 +- stack.yaml | 4 ++-- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/.haskell-ci b/.haskell-ci index e0ccd0d..bb9bd3f 100644 --- a/.haskell-ci +++ b/.haskell-ci @@ -1,7 +1,7 @@ # compiler supported and their equivalent LTS compiler: ghc-8.0 lts-9.21 compiler: ghc-8.2 lts-11.22 -compiler: ghc-8.4 lts-12.14 +compiler: ghc-8.4 lts-12.15 compiler: ghc-8.6 nightly-2018-10-21 # options diff --git a/.travis.yml b/.travis.yml index 6b45760..e542406 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,4 +1,4 @@ -# ~*~ auto-generated by haskell-ci with config : 7cb8db1c90854ae440aca1b3cde96895bf9153ceeddfe5fd39d82f8e300414c6 ~*~ +# ~*~ auto-generated by haskell-ci with config : c5de1915986b17c62e2a4cbe1fb7b3d47a6b1dc45a8f4d4fa78654695dfd1f43 ~*~ # Use new container infrastructure to enable caching sudo: false @@ -61,7 +61,7 @@ script: stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; ghc-8.4) - echo "{ resolver: lts-12.14, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml + echo "{ resolver: lts-12.15, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; ghc-8.6) diff --git a/cryptonite.cabal b/cryptonite.cabal index 5d19c59..f2fa323 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -36,7 +36,7 @@ Build-Type: Simple Homepage: https://github.com/haskell-crypto/cryptonite Bug-reports: https://github.com/haskell-crypto/cryptonite/issues Cabal-Version: >=1.18 -tested-with: GHC==8.6.1, GHC==8.4.3, GHC==8.2.2, GHC==8.0.2 +tested-with: GHC==8.6.1, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 extra-doc-files: README.md CHANGELOG.md extra-source-files: cbits/*.h cbits/aes/*.h diff --git a/stack.yaml b/stack.yaml index 57f8c6b..bd5b3a6 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1,3 @@ -# ~*~ auto-generated by haskell-ci with config : 7cb8db1c90854ae440aca1b3cde96895bf9153ceeddfe5fd39d82f8e300414c6 ~*~ -{ resolver: lts-12.14, packages: [ '.' ], extra-deps: [], flags: {} } +# ~*~ auto-generated by haskell-ci with config : c5de1915986b17c62e2a4cbe1fb7b3d47a6b1dc45a8f4d4fa78654695dfd1f43 ~*~ +{ resolver: lts-12.15, packages: [ '.' ], extra-deps: [], flags: {} } From f4e094aacbde15c863d6ebc06aec47926bf9b34a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 25 Sep 2016 09:06:35 +0200 Subject: [PATCH 025/176] Fix PKCS#1 v1.5 padding The padding string is at least 8 bytes long + 3 other bytes, so it should be 11. --- Crypto/PubKey/RSA/PKCS15.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Crypto/PubKey/RSA/PKCS15.hs b/Crypto/PubKey/RSA/PKCS15.hs index d3b9311..9edbf64 100644 --- a/Crypto/PubKey/RSA/PKCS15.hs +++ b/Crypto/PubKey/RSA/PKCS15.hs @@ -111,8 +111,8 @@ pad len m -- | Produce a standard PKCS1.5 padding for signature padSignature :: ByteArray signature => Int -> signature -> Either Error signature padSignature klen signature - | klen < siglen+1 = Left SignatureTooLong - | otherwise = Right (B.pack padding `B.append` signature) + | klen < siglen + 11 = Left SignatureTooLong + | otherwise = Right (B.pack padding `B.append` signature) where siglen = B.length signature padding = 0 : 1 : (replicate (klen - siglen - 3) 0xff ++ [0]) From 01faa66fd43f7d4962c7ffe508813034d6e04638 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 27 Nov 2016 19:20:01 +0100 Subject: [PATCH 026/176] Add tests for RSA signature and verification This includes tests for SignatureTooLong edge cases. --- cryptonite.cabal | 1 + tests/KAT_PubKey.hs | 2 + tests/KAT_PubKey/RSA.hs | 102 ++++++++++++++++++++++++++++++++++++++++ 3 files changed, 105 insertions(+) create mode 100644 tests/KAT_PubKey/RSA.hs diff --git a/cryptonite.cabal b/cryptonite.cabal index f2fa323..9878725 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -406,6 +406,7 @@ Test-Suite test-cryptonite KAT_PubKey.OAEP KAT_PubKey.PSS KAT_PubKey.P256 + KAT_PubKey.RSA KAT_PubKey KAT_RC4 KAT_Scrypt diff --git a/tests/KAT_PubKey.hs b/tests/KAT_PubKey.hs index 13dd71e..a45a4a2 100644 --- a/tests/KAT_PubKey.hs +++ b/tests/KAT_PubKey.hs @@ -16,6 +16,7 @@ import KAT_PubKey.PSS import KAT_PubKey.DSA import KAT_PubKey.ECC import KAT_PubKey.ECDSA +import KAT_PubKey.RSA import Utils import qualified KAT_PubKey.P256 as P256 @@ -35,6 +36,7 @@ vectorsMGF = tests = testGroup "PubKey" [ testGroup "MGF1" $ map doMGFTest (zip [katZero..] vectorsMGF) + , rsaTests , pssTests , oaepTests , dsaTests diff --git a/tests/KAT_PubKey/RSA.hs b/tests/KAT_PubKey/RSA.hs new file mode 100644 index 0000000..068043c --- /dev/null +++ b/tests/KAT_PubKey/RSA.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE OverloadedStrings #-} +module KAT_PubKey.RSA (rsaTests) where + +import qualified Crypto.PubKey.RSA as RSA +import qualified Crypto.PubKey.RSA.PKCS15 as RSA +import Crypto.Hash + +import Imports + +import Data.Either (isRight) + +data VectorRSA = VectorRSA + { size :: Int + , msg :: ByteString + , n :: Integer + , e :: Integer + , d :: Integer + , p :: Integer + , q :: Integer + , dP :: Integer + , dQ :: Integer + , qinv :: Integer + , sig :: Either RSA.Error ByteString + } + +vectorsSHA1 = + [ VectorRSA + { size = 2048 `div` 8 + , msg = "The quick brown fox jumps over the lazy dog" + , n = 0x00c896c245fcca81775346c5f4f958229cab1aee08196dab4ee5959018b856aab93e4486f37a32da1a6804403c88473ecf9f1b9266fc682400d45329b6ec195710c98d9ba728bc09d767e7e9d9b8b102c3b7e7529b87f649a2a5ebe165da21863ec7842de600a834a8be2227bc989145b52f84ba685d45484a3d530745598a5d8a9e7551b3278bf139a770929f776aed5d43559205fe937df93eeb8ff3fb3f2ce22d4b8a5c17aeafd19758ac5e6251df09ef6a2858e8558a7f476dde4efe859ff2fcb97767614563033fd1d2d300196b1abf256f7badb16c17def3804946d1bf9cd51760176b41bbd506b44ff2bfe5bcd5052180da3cfbbc6cd6f662c06a8baed9 + , e = 0x10001 + , d = 0x58aa533bae8f310536d95cdd796e5cf655a7f4b9bdcbbd62859743f7b95c0de10e462a44ebaa18c07d640ba4f6344fee648d427ca56bbf2662b45407187be70173a655bc6104257182eb7f720ef2a79f2de6619c804ffca299a7179df6fac4a57179daf4052c550295f0f111ab7ae38e406ff219f9c88b38cdbcaac51bdc4e961361b87e100d168fc08b298626a806b3bfeaa9579f400bbe6e3e6e4ae9b27446e1c5ce8c10c848b9ad7b6ed3a6b3871ad6a1a88af24e581da054845c197e8bae1582858410087c1180c4f0cc61689abfd0f61b8031910f3b3779e11a7fbe823d9a704c63c313f78c994975de834ee9ead5faf6c18b3e4248c51ba307776bf845 + , p = 0x00f85bfcfe55af59445f21f67ab1d8617d1f84360556eeb660d5c466f29e4d2228f9cc3fde4c594ea97069a19c666b68b6d905b65738ae63de6c11f9181ee9262313e5165591651bb3abec192abbc8c3694550bcffa451a2e2d1976bf3ecbc4480354f8d8646133298156aaa626b8807c5295850f93686400835466b6a5ccec61b + , q = 0x00cec28b22b1d37c6c60d25e9747cb1bebd1270f0306db56ed8533f392d6a0cfe6b3dde13789758cf89febac214ba96667e46599f89ca210dced550ca6092a854ff95dff80ea48ff1a83455f4bb93f2ececa782da03b85a789239e8be5264130628724ceab57c8f76e4c7e822bf4fbf334c7d32610bec65047433e0e3b636afe1b + , dP = 0x52fe0a50c339514f33ab19be6e67ac4c2f97f2a55e236ef674f8a89e329ffbe64d731f749d76ca7e7c7e0fef3f9a6ce78d260784a600408736fdda8b60e8f0419088612a3ee7d695f7c171b78200d8abf8e9bdfe7f5e785beb45fa610c9eed151abb76c383ef2e5cfbeb24fcb68a426e741e7b108c53d859e5d39e5970a1f839 + , dQ = 0x39ef91853b47038a6ae707d2642fa9b73e782f60adbf307085eeb4c5e496532b56234a4481a40ac870275da846c74506bf9d28b3dd501c618baf5548013185018fe2a301c0a48bb726297e367dc6129ba7685d8094ad32f0dea64295074f24fbb6dabd7e8daea686a5b09d512be89d91a09cae01eb332eb389480e3cddf2d119 + , qinv = 0x09ce1fa29008ef4b9798e5b8ec213dbdfec4fab4403ebf4b8786ad401ef33bc880c40a990b0826f72415192a206a504b27d2ba45ca555706200ea8e7a9b42d4077e9e6e0d80d4144966c53a36d23d30d987322dcc0013efe8df3b6b5914a2ceefc22cc5de6d569731794e9894f18f11d36a79558dc4c3ae5db1ce9bd05e7bf2e + , sig = Right "\x56\x66\x99\x0f\xd4\xea\x2b\xe0\x6d\x46\x3b\x10\x99\x5b\x06\x32\x5e\xec\x29\xfe\xa4\x63\x4d\x54\xf6\x31\x74\x5d\x01\x5a\x67\x09\x2e\xa7\x02\x8a\x48\x00\x3c\x0d\xef\x04\xe7\x52\x46\xe0\xfa\xb1\x42\x26\x89\xe7\xec\x25\x44\x76\xa0\x86\x33\xb0\xbe\x22\x17\x88\x9b\x18\x4d\x3e\xc2\x9b\xd4\x61\x2b\x9e\xde\x08\x56\xf8\xd5\xee\xb8\x38\xf4\x3d\xda\x9a\xbb\x34\x58\x87\x71\x1d\x1a\x7e\xc7\x3d\x46\x39\x01\x79\x29\x8b\xa4\xcd\xce\xd7\xab\xcb\x2e\x94\x5c\xfd\x54\xcc\xef\x80\x31\xfc\x5e\x8f\xc2\x4d\x76\x1e\x4c\xbc\x50\x7a\x9b\x08\xae\x85\xeb\x6a\xe0\x80\xdc\xff\x60\x13\xb0\x31\x94\x14\x9d\x8f\x9f\x48\x38\xcf\x4c\x82\x9d\x3b\x68\xc6\xe4\xe9\x5d\x94\x74\xa2\xac\x1f\xb9\x84\x41\x86\x11\xeb\x2c\x50\x64\xd7\x00\xe0\x85\x21\x5a\xd7\xae\x9b\x4c\x8e\x6a\x92\x97\xac\xcc\xb8\x38\x4f\x41\xb9\x3d\xa9\xfe\x69\x8b\x04\x81\xad\xfb\x0f\x49\x74\xfe\x26\x9c\x86\x0c\xf3\xd1\x8e\xa1\xb5\xaf\xef\x85\x3d\xfe\xd0\x7c\xcf\x18\xe4\x0f\x14\x99\xea\x93\x61\x79\x16\xbf\x38\xac\xa2\xa2\xac\xac\x2d\xae\x21\x85\x71\x94\xda\x5d\xa1\x82\xa8\x76\x82\xe5\x2f" + } + , VectorRSA + { size = 360 `div` 8 + , msg = "The quick brown fox jumps over the lazy dog" + , n = 0x00bc2d7481c83c8be55da4caeaf1a30dbf9a1226ba7443c0a66213180d3eb8e29c3162401b7be067dff8f571a8eb + , e = 0x10001 + , d = 0x726fb62d82c707507a2d5055a6934136270d28ce350c3a36d89066e26fb54f5b33da0bc9a05c2084f2b39be4e1 + , p = 0x0e3ff89e1f95a461c9f5ee480fd7b13529a225f3ee07fb + , q = 0x0d349ebc89329b493c03451ad20155de9775df55c55fd1 + , dP = 0x00943adef9fb93a561967bab33f198c2c7414e777df997 + , dQ = 0x078de99ceb5392f7f327dfb97717a27ae2e4606dddaa71 + , qinv = 0x0c54d59eaa029844fb3fe33a180161590b1cb103cc668e + , sig = Left RSA.SignatureTooLong + } + , VectorRSA + { size = 368 `div` 8 + , msg = "The quick brown fox jumps over the lazy dog" + , n = 0x009cff2fd20246e390d6860b48a3926e83086d1386f7147e9f195623cf8f18546ceb20d428b77e0748864c8f611cb7 + , e = 0x10001 + , d = 0x0097706cbf6624dd448c3a36ce35c27d49762a4948ca33804178d2ff826f8d336aaed622801c8d76d442be371da841 + , p = 0x00d12519f81441069ab1a86c38e0065e9578a46e655d5a17 + , q = 0x00c02b485ac3ee241d57b6b282f830d7d5bf6f4de75c1661 + , dP = 0x00a1af4611444f34f4d88d7504cf23fd711e70382c42ec07 + , dQ = 0x04226a4219a90bf9dda33e9ff6bb0649c0fea20c723cc1 + , qinv = 0x5dd87bf3c1e295dcc8602859a7cd74f05a2fe91a9d5877 + , sig = Right "\x51\xe4\xdd\x98\xee\xd5\x06\xef\x7a\xa5\x3c\xaf\x29\x33\xa4\x91\xfa\x8b\xb8\x09\xcf\x3e\xa1\x64\x92\x71\xad\x7b\x3a\x83\xb2\xa0\x77\x94\x4e\x59\xdf\x69\x58\x2e\xc8\x8d\xa0\x70\xfe\x7d" + } + ] + +vectorToPrivate :: VectorRSA -> RSA.PrivateKey +vectorToPrivate vector = RSA.PrivateKey + { RSA.private_pub = vectorToPublic vector + , RSA.private_d = d vector + , RSA.private_p = p vector + , RSA.private_q = q vector + , RSA.private_dP = dP vector + , RSA.private_dQ = dQ vector + , RSA.private_qinv = qinv vector + } + +vectorToPublic :: VectorRSA -> RSA.PublicKey +vectorToPublic vector = RSA.PublicKey + { RSA.public_size = size vector + , RSA.public_n = n vector + , RSA.public_e = e vector + } + +vectorHasSignature :: VectorRSA -> Bool +vectorHasSignature = isRight . sig + +doSignatureTest (i, vector) = testCase (show i) (expected @=? actual) + where expected = sig vector + actual = RSA.sign Nothing (Just SHA1) (vectorToPrivate vector) (msg vector) + +doVerifyTest (i, vector) = testCase (show i) (True @=? actual) + where actual = RSA.verify (Just SHA1) (vectorToPublic vector) (msg vector) bs + Right bs = sig vector + +rsaTests = testGroup "RSA" + [ testGroup "SHA1" + [ testGroup "signature" $ map doSignatureTest (zip [katZero..] vectorsSHA1) + , testGroup "verify" $ map doVerifyTest $ filter (vectorHasSignature . snd) (zip [katZero..] vectorsSHA1) + ] + ] From 9847554392dc0e6188d0e120924ed09c74c6e456 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Thu, 1 Nov 2018 09:08:39 +0100 Subject: [PATCH 027/176] Fixed comment about expSafe --- Crypto/Number/ModArithmetic.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/Crypto/Number/ModArithmetic.hs b/Crypto/Number/ModArithmetic.hs index 4ca6317..11a618e 100644 --- a/Crypto/Number/ModArithmetic.hs +++ b/Crypto/Number/ModArithmetic.hs @@ -38,9 +38,8 @@ instance Exception CoprimesAssertionError -- from expFast, and thus provide the same unstudied and dubious -- timing and side channels claims. -- --- with GHC 7.10, the powModSecInteger is missing from integer-gmp --- (which is now integer-gmp2), so is has the same security as old --- ghc version. +-- Before GHC 8.4.2, powModSecInteger is missing from integer-gmp, +-- so expSafe has the same security as expFast. expSafe :: Integer -- ^ base -> Integer -- ^ exponent -> Integer -- ^ modulo From 3165027840d29af2ba7d5ffc79c5f564fd6494e4 Mon Sep 17 00:00:00 2001 From: Carlos Rodriguez Date: Sat, 3 Nov 2018 21:12:53 +0100 Subject: [PATCH 028/176] Fixed typo in name. --- Crypto/PubKey/Rabin/RW.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Crypto/PubKey/Rabin/RW.hs b/Crypto/PubKey/Rabin/RW.hs index 6ca9616..7b0bcaa 100644 --- a/Crypto/PubKey/Rabin/RW.hs +++ b/Crypto/PubKey/Rabin/RW.hs @@ -1,7 +1,7 @@ -- | -- Module : Crypto.PubKey.Rabin.RW -- License : BSD-style --- Maintainer : Carlos Rodrigue-Vega +-- Maintainer : Carlos Rodriguez-Vega -- Stability : experimental -- Portability : unknown -- From 95f0f3d0c93ec2a164f37572bb98aa2d204e4b52 Mon Sep 17 00:00:00 2001 From: Carlos Rodriguez Date: Sat, 3 Nov 2018 21:17:46 +0100 Subject: [PATCH 029/176] Fixed typos in name. --- Crypto/PubKey/Rabin/Basic.hs | 2 +- Crypto/PubKey/Rabin/Modified.hs | 2 +- Crypto/PubKey/Rabin/OAEP.hs | 2 +- Crypto/PubKey/Rabin/Types.hs | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/Crypto/PubKey/Rabin/Basic.hs b/Crypto/PubKey/Rabin/Basic.hs index 0d9792e..3933b25 100644 --- a/Crypto/PubKey/Rabin/Basic.hs +++ b/Crypto/PubKey/Rabin/Basic.hs @@ -1,7 +1,7 @@ -- | -- Module : Crypto.PubKey.Rabin.Basic -- License : BSD-style --- Maintainer : Carlos Rodrigue-Vega +-- Maintainer : Carlos Rodriguez-Vega -- Stability : experimental -- Portability : unknown -- diff --git a/Crypto/PubKey/Rabin/Modified.hs b/Crypto/PubKey/Rabin/Modified.hs index c9c7797..f3836ab 100644 --- a/Crypto/PubKey/Rabin/Modified.hs +++ b/Crypto/PubKey/Rabin/Modified.hs @@ -1,7 +1,7 @@ -- | -- Module : Crypto.PubKey.Rabin.Modified -- License : BSD-style --- Maintainer : Carlos Rodrigue-Vega +-- Maintainer : Carlos Rodriguez-Vega -- Stability : experimental -- Portability : unknown -- diff --git a/Crypto/PubKey/Rabin/OAEP.hs b/Crypto/PubKey/Rabin/OAEP.hs index 9976e83..2274767 100644 --- a/Crypto/PubKey/Rabin/OAEP.hs +++ b/Crypto/PubKey/Rabin/OAEP.hs @@ -1,7 +1,7 @@ -- | -- Module : Crypto.PubKey.Rabin.OAEP -- License : BSD-style --- Maintainer : Carlos Rodrigue-Vega +-- Maintainer : Carlos Rodriguez-Vega -- Stability : experimental -- Portability : unknown -- diff --git a/Crypto/PubKey/Rabin/Types.hs b/Crypto/PubKey/Rabin/Types.hs index 403e8d7..2d00823 100644 --- a/Crypto/PubKey/Rabin/Types.hs +++ b/Crypto/PubKey/Rabin/Types.hs @@ -1,7 +1,7 @@ -- | -- Module : Crypto.PubKey.Rabin.Types -- License : BSD-style --- Maintainer : Carlos Rodrigue-Vega +-- Maintainer : Carlos Rodriguez-Vega -- Stability : experimental -- Portability : unknown -- From cc18bf41eef4b116d07b054289c7572e5e3ff9b4 Mon Sep 17 00:00:00 2001 From: Carlos Rodriguez Date: Sun, 11 Nov 2018 17:14:23 +0100 Subject: [PATCH 030/176] Corrected value boundaries in description of function. --- Crypto/Number/ModArithmetic.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Crypto/Number/ModArithmetic.hs b/Crypto/Number/ModArithmetic.hs index 7250555..ef59d7e 100644 --- a/Crypto/Number/ModArithmetic.hs +++ b/Crypto/Number/ModArithmetic.hs @@ -97,7 +97,7 @@ inverseCoprimes g m = Just i -> i -- | Computes the Jacobi symbol (a/n). --- 0 = a < n; n = 3 and odd. +-- 0 ≤ a < n; n ≥ 3 and odd. -- -- The Legendre and Jacobi symbols are indistinguishable exactly when the -- lower argument is an odd prime, in which case they have the same value. @@ -120,4 +120,4 @@ jacobi a n s = if nMod4 == 3 && a1Mod4 == 3 then -s' else s' n1 = n `mod` a1 in if a1 == 1 then Just s - else fmap (*s) (jacobi n1 a1) \ No newline at end of file + else fmap (*s) (jacobi n1 a1) From ddfdbbd4bec88527126556c2a8c552b61aa0a89c Mon Sep 17 00:00:00 2001 From: Carlos Rodriguez Date: Tue, 18 Dec 2018 20:19:14 +0100 Subject: [PATCH 031/176] Removed unnecessary reference to random. --- Crypto/PubKey/Rabin/Basic.hs | 2 -- cryptonite.cabal | 1 - 2 files changed, 3 deletions(-) diff --git a/Crypto/PubKey/Rabin/Basic.hs b/Crypto/PubKey/Rabin/Basic.hs index 3933b25..bcce97a 100644 --- a/Crypto/PubKey/Rabin/Basic.hs +++ b/Crypto/PubKey/Rabin/Basic.hs @@ -21,8 +21,6 @@ module Crypto.PubKey.Rabin.Basic , verify ) where -import System.Random (getStdGen, randomRs) - import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.Data diff --git a/cryptonite.cabal b/cryptonite.cabal index 3405eae..2c09c5c 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -236,7 +236,6 @@ Library Build-depends: bytestring , memory >= 0.14.14 - , random , basement >= 0.0.6 , ghc-prim ghc-options: -Wall -fwarn-tabs -optc-O3 -fno-warn-unused-imports From 3de65a43a1d1923a86914f6a24207d49d7e706e4 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Sun, 6 Jan 2019 16:08:48 +0000 Subject: [PATCH 032/176] fix QA building command --- Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Makefile b/Makefile index e976722..4bfa1d6 100644 --- a/Makefile +++ b/Makefile @@ -1,8 +1,8 @@ all: - cabal build + stack build check: QA ./QA QA: QA.hs - ghc --make QA + stack ghc --package haskell-src-exts --package ansi-terminal -- --make QA From d964064d80843d9cd14011da7d3705dac2178353 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Thu, 10 Jan 2019 21:17:43 +0100 Subject: [PATCH 033/176] Use heterogeneous equality --- Crypto/PubKey/RSA/PSS.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Crypto/PubKey/RSA/PSS.hs b/Crypto/PubKey/RSA/PSS.hs index 8abd228..40353a7 100644 --- a/Crypto/PubKey/RSA/PSS.hs +++ b/Crypto/PubKey/RSA/PSS.hs @@ -30,7 +30,7 @@ import Data.Bits (xor, shiftR, (.&.)) import Data.Word import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray) -import qualified Crypto.Internal.ByteArray as B (convert) +import qualified Crypto.Internal.ByteArray as B (convert, eq) import Data.ByteString (ByteString) import qualified Data.ByteString as B @@ -165,7 +165,7 @@ verifyDigest params pk digest s | B.last em /= pssTrailerField params = False | not (B.all (== 0) ps0) = False | b1 /= B.singleton 1 = False - | otherwise = h == B.convert h' + | otherwise = B.eq h h' where -- parameters hashLen = hashDigestSize (pssHash params) mHash = B.convert digest From 274911c608aefa3f46603ce5a158bd4b98277def Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Thu, 10 Jan 2019 21:20:02 +0100 Subject: [PATCH 034/176] Accept hlint suggestions --- Crypto/PubKey/RSA/PSS.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Crypto/PubKey/RSA/PSS.hs b/Crypto/PubKey/RSA/PSS.hs index 40353a7..b221262 100644 --- a/Crypto/PubKey/RSA/PSS.hs +++ b/Crypto/PubKey/RSA/PSS.hs @@ -80,7 +80,7 @@ signDigestWithSalt salt blinder params pk digest m' = B.concat [B.replicate 8 0,mHash,salt] h = B.convert $ hashWith (pssHash params) m' db = B.concat [B.replicate (dbLen - saltLen - 1) 0,B.singleton 1,salt] - dbmask = (pssMaskGenAlg params) h dbLen + dbmask = pssMaskGenAlg params h dbLen maskedDB = B.pack $ normalizeToKeySize pubBits $ B.zipWith xor db dbmask em = B.concat [maskedDB, h, B.singleton (pssTrailerField params)] @@ -148,7 +148,7 @@ verify :: HashAlgorithm hash -> ByteString -- ^ Message to verify -> ByteString -- ^ Signature -> Bool -verify params pk m s = verifyDigest params pk mHash s +verify params pk m = verifyDigest params pk mHash where mHash = hashWith (pssHash params) m -- | Verify a signature using the PSS Parameters @@ -175,7 +175,7 @@ verifyDigest params pk digest s em = ep pk s maskedDB = B.take (B.length em - hashLen - 1) em h = B.take hashLen $ B.drop (B.length maskedDB) em - dbmask = (pssMaskGenAlg params) h dbLen + dbmask = pssMaskGenAlg params h dbLen db = B.pack $ normalizeToKeySize pubBits $ B.zipWith xor maskedDB dbmask (ps0,z) = B.break (== 1) db (b1,salt) = B.splitAt 1 z @@ -186,5 +186,5 @@ normalizeToKeySize :: Int -> [Word8] -> [Word8] normalizeToKeySize _ [] = [] -- very unlikely normalizeToKeySize bits (x:xs) = x .&. mask : xs where mask = if sh > 0 then 0xff `shiftR` (8-sh) else 0xff - sh = ((bits-1) .&. 0x7) + sh = (bits-1) .&. 0x7 From f9ae52327c336109310892614d9da0aaf5e439c4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 12 Jan 2019 09:22:15 +0100 Subject: [PATCH 035/176] RSASSA-PSS with key of arbitrary length Instead of public_size / private_size which are in bytes only, this uses function numBits to recover the effective length of the modulus in bits. The patch also handles removal of unneeded initial byte when the length is 1 modulo 8. --- Crypto/PubKey/RSA/PSS.hs | 27 ++++++++++++++++++--------- 1 file changed, 18 insertions(+), 9 deletions(-) diff --git a/Crypto/PubKey/RSA/PSS.hs b/Crypto/PubKey/RSA/PSS.hs index b221262..2f6ddf3 100644 --- a/Crypto/PubKey/RSA/PSS.hs +++ b/Crypto/PubKey/RSA/PSS.hs @@ -26,6 +26,7 @@ import Crypto.PubKey.RSA.Prim import Crypto.PubKey.RSA (generateBlinder) import Crypto.PubKey.MaskGenFunction import Crypto.Hash +import Crypto.Number.Basic (numBits) import Data.Bits (xor, shiftR, (.&.)) import Data.Word @@ -69,14 +70,15 @@ signDigestWithSalt :: HashAlgorithm hash -> Digest hash -- ^ Message digest -> Either Error ByteString signDigestWithSalt salt blinder params pk digest - | k < hashLen + saltLen + 2 = Left InvalidParameters - | otherwise = Right $ dp blinder pk em + | emLen < hashLen + saltLen + 2 = Left InvalidParameters + | otherwise = Right $ dp blinder pk em where k = private_size pk + emLen = if emTruncate pubBits then k - 1 else k mHash = B.convert digest - dbLen = k - hashLen - 1 + dbLen = emLen - hashLen - 1 saltLen = B.length salt hashLen = hashDigestSize (pssHash params) - pubBits = private_size pk * 8 -- to change if public_size is converted in bytes + pubBits = numBits (private_n pk) m' = B.concat [B.replicate 8 0,mHash,salt] h = B.convert $ hashWith (pssHash params) m' db = B.concat [B.replicate (dbLen - saltLen - 1) 0,B.singleton 1,salt] @@ -161,7 +163,8 @@ verifyDigest :: HashAlgorithm hash -> ByteString -- ^ Signature -> Bool verifyDigest params pk digest s - | public_size pk /= B.length s = False + | B.length s /= k = False + | B.any (/= 0) pre = False | B.last em /= pssTrailerField params = False | not (B.all (== 0) ps0) = False | b1 /= B.singleton 1 = False @@ -169,11 +172,13 @@ verifyDigest params pk digest s where -- parameters hashLen = hashDigestSize (pssHash params) mHash = B.convert digest - dbLen = public_size pk - hashLen - 1 - pubBits = public_size pk * 8 -- to change if public_size is converted in bytes + k = public_size pk + emLen = if emTruncate pubBits then k - 1 else k + dbLen = emLen - hashLen - 1 + pubBits = numBits (public_n pk) -- unmarshall fields - em = ep pk s - maskedDB = B.take (B.length em - hashLen - 1) em + (pre, em) = B.splitAt (k - emLen) (ep pk s) -- drop 0..1 byte + maskedDB = B.take dbLen em h = B.take hashLen $ B.drop (B.length maskedDB) em dbmask = pssMaskGenAlg params h dbLen db = B.pack $ normalizeToKeySize pubBits $ B.zipWith xor maskedDB dbmask @@ -182,6 +187,10 @@ verifyDigest params pk digest s m' = B.concat [B.replicate 8 0,mHash,salt] h' = hashWith (pssHash params) m' +-- When the modulus has bit length 1 modulo 8 we drop the first byte. +emTruncate :: Int -> Bool +emTruncate bits = ((bits-1) .&. 0x7) == 0 + normalizeToKeySize :: Int -> [Word8] -> [Word8] normalizeToKeySize _ [] = [] -- very unlikely normalizeToKeySize bits (x:xs) = x .&. mask : xs From 8eb8d01577f020f70642cbaa6a630c9c6607bf4b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 12 Jan 2019 14:12:20 +0100 Subject: [PATCH 036/176] RSASSA-PSS vectors with key size 1025, 1026, 1031 --- tests/KAT_PubKey/PSS.hs | 183 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 183 insertions(+) diff --git a/tests/KAT_PubKey/PSS.hs b/tests/KAT_PubKey/PSS.hs index 9e3f0ea..bf7ed82 100644 --- a/tests/KAT_PubKey/PSS.hs +++ b/tests/KAT_PubKey/PSS.hs @@ -6,6 +6,9 @@ import qualified Crypto.PubKey.RSA.PSS as PSS import Imports +-- Module contains one vector generated by the implementation itself and other +-- vectors from + data VectorPSS = VectorPSS { message :: ByteString , salt :: ByteString , signature :: ByteString @@ -457,6 +460,180 @@ e2 98 c7 bb ce 2e ee 78 2a 19 5a a6 6f e2 d0 73 -} +-- ================================== +-- Example 2: A 1025-bit RSA Key Pair +-- ================================== + +rsaKey2 = PrivateKey + { private_pub = PublicKey + { public_n = 0x01d40c1bcf97a68ae7cdbd8a7bf3e34fa19dcca4ef75a47454375f94514d88fed006fb829f8419ff87d6315da68a1ff3a0938e9abb3464011c303ad99199cf0c7c7a8b477dce829e8844f625b115e5e9c4a59cf8f8113b6834336a2fd2689b472cbb5e5cabe674350c59b6c17e176874fb42f8fc3d176a017edc61fd326c4b33c9 + , public_e = 0x010001 + , public_size = 129 + } + , private_d = 0x027d147e4673057377fd1ea201565772176a7dc38358d376045685a2e787c23c15576bc16b9f444402d6bfc5d98a3e88ea13ef67c353eca0c0ddba9255bd7b8bb50a644afdfd1dd51695b252d22e7318d1b6687a1c10ff75545f3db0fe602d5f2b7f294e3601eab7b9d1cecd767f64692e3e536ca2846cb0c2dd486a39fa75b1 + , private_p = 0x016601e926a0f8c9e26ecab769ea65a5e7c52cc9e080ef519457c644da6891c5a104d3ea7955929a22e7c68a7af9fcad777c3ccc2b9e3d3650bce404399b7e59d1 + , private_q = 0x014eafa1d4d0184da7e31f877d1281ddda625664869e8379e67ad3b75eae74a580e9827abd6eb7a002cb5411f5266797768fb8e95ae40e3e8a01f35ff89e56c079 + , private_dP = 0xe247cce504939b8f0a36090de200938755e2444b29539a7da7a902f6056835c0db7b52559497cfe2c61a8086d0213c472c78851800b171f6401de2e9c2756f31 + , private_dQ = 0xb12fba757855e586e46f64c38a70c68b3f548d93d787b399999d4c8f0bbd2581c21e19ed0018a6d5d3df86424b3abcad40199d31495b61309f27c1bf55d487c1 + , private_qinv = 0x564b1e1fa003bda91e89090425aac05b91da9ee25061e7628d5f51304a84992fdc33762bd378a59f030a334d532bd0dae8f298ea9ed844636ad5fb8cbdc03cad + } + +vectorsKey2 = + [ + -- Example 2.1 + VectorPSS + { message = "\xda\xba\x03\x20\x66\x26\x3f\xae\xdb\x65\x98\x48\x11\x52\x78\xa5\x2c\x44\xfa\xa3\xa7\x6f\x37\x51\x5e\xd3\x36\x32\x10\x72\xc4\x0a\x9d\x9b\x53\xbc\x05\x01\x40\x78\xad\xf5\x20\x87\x51\x46\xaa\xe7\x0f\xf0\x60\x22\x6d\xcb\x7b\x1f\x1f\xc2\x7e\x93\x60" + , salt = "\x57\xbf\x16\x0b\xcb\x02\xbb\x1d\xc7\x28\x0c\xf0\x45\x85\x30\xb7\xd2\x83\x2f\xf7" + , signature = "\x01\x4c\x5b\xa5\x33\x83\x28\xcc\xc6\xe7\xa9\x0b\xf1\xc0\xab\x3f\xd6\x06\xff\x47\x96\xd3\xc1\x2e\x4b\x63\x9e\xd9\x13\x6a\x5f\xec\x6c\x16\xd8\x88\x4b\xdd\x99\xcf\xdc\x52\x14\x56\xb0\x74\x2b\x73\x68\x68\xcf\x90\xde\x09\x9a\xdb\x8d\x5f\xfd\x1d\xef\xf3\x9b\xa4\x00\x7a\xb7\x46\xce\xfd\xb2\x2d\x7d\xf0\xe2\x25\xf5\x46\x27\xdc\x65\x46\x61\x31\x72\x1b\x90\xaf\x44\x53\x63\xa8\x35\x8b\x9f\x60\x76\x42\xf7\x8f\xab\x0a\xb0\xf4\x3b\x71\x68\xd6\x4b\xae\x70\xd8\x82\x78\x48\xd8\xef\x1e\x42\x1c\x57\x54\xdd\xf4\x2c\x25\x89\xb5\xb3" + } + -- Example 2.2 + , VectorPSS + { message = "\xe4\xf8\x60\x1a\x8a\x6d\xa1\xbe\x34\x44\x7c\x09\x59\xc0\x58\x57\x0c\x36\x68\xcf\xd5\x1d\xd5\xf9\xcc\xd6\xad\x44\x11\xfe\x82\x13\x48\x6d\x78\xa6\xc4\x9f\x93\xef\xc2\xca\x22\x88\xce\xbc\x2b\x9b\x60\xbd\x04\xb1\xe2\x20\xd8\x6e\x3d\x48\x48\xd7\x09\xd0\x32\xd1\xe8\xc6\xa0\x70\xc6\xaf\x9a\x49\x9f\xcf\x95\x35\x4b\x14\xba\x61\x27\xc7\x39\xde\x1b\xb0\xfd\x16\x43\x1e\x46\x93\x8a\xec\x0c\xf8\xad\x9e\xb7\x2e\x83\x2a\x70\x35\xde\x9b\x78\x07\xbd\xc0\xed\x8b\x68\xeb\x0f\x5a\xc2\x21\x6b\xe4\x0c\xe9\x20\xc0\xdb\x0e\xdd\xd3\x86\x0e\xd7\x88\xef\xac\xca\xca\x50\x2d\x8f\x2b\xd6\xd1\xa7\xc1\xf4\x1f\xf4\x6f\x16\x81\xc8\xf1\xf8\x18\xe9\xc4\xf6\xd9\x1a\x0c\x78\x03\xcc\xc6\x3d\x76\xa6\x54\x4d\x84\x3e\x08\x4e\x36\x3b\x8a\xcc\x55\xaa\x53\x17\x33\xed\xb5\xde\xe5\xb5\x19\x6e\x9f\x03\xe8\xb7\x31\xb3\x77\x64\x28\xd9\xe4\x57\xfe\x3f\xbc\xb3\xdb\x72\x74\x44\x2d\x78\x58\x90\xe9\xcb\x08\x54\xb6\x44\x4d\xac\xe7\x91\xd7\x27\x3d\xe1\x88\x97\x19\x33\x8a\x77\xfe" + , salt = "\x7f\x6d\xd3\x59\xe6\x04\xe6\x08\x70\xe8\x98\xe4\x7b\x19\xbf\x2e\x5a\x7b\x2a\x90" + , signature = "\x01\x09\x91\x65\x6c\xca\x18\x2b\x7f\x29\xd2\xdb\xc0\x07\xe7\xae\x0f\xec\x15\x8e\xb6\x75\x9c\xb9\xc4\x5c\x5f\xf8\x7c\x76\x35\xdd\x46\xd1\x50\x88\x2f\x4d\xe1\xe9\xae\x65\xe7\xf7\xd9\x01\x8f\x68\x36\x95\x4a\x47\xc0\xa8\x1a\x8a\x6b\x6f\x83\xf2\x94\x4d\x60\x81\xb1\xaa\x7c\x75\x9b\x25\x4b\x2c\x34\xb6\x91\xda\x67\xcc\x02\x26\xe2\x0b\x2f\x18\xb4\x22\x12\x76\x1d\xcd\x4b\x90\x8a\x62\xb3\x71\xb5\x91\x8c\x57\x42\xaf\x4b\x53\x7e\x29\x69\x17\x67\x4f\xb9\x14\x19\x47\x61\x62\x1c\xc1\x9a\x41\xf6\xfb\x95\x3f\xbc\xbb\x64\x9d\xea" + } + -- Example 2.3 + , VectorPSS + { message = "\x52\xa1\xd9\x6c\x8a\xc3\x9e\x41\xe4\x55\x80\x98\x01\xb9\x27\xa5\xb4\x45\xc1\x0d\x90\x2a\x0d\xcd\x38\x50\xd2\x2a\x66\xd2\xbb\x07\x03\xe6\x7d\x58\x67\x11\x45\x95\xaa\xbf\x5a\x7a\xeb\x5a\x8f\x87\x03\x4b\xbb\x30\xe1\x3c\xfd\x48\x17\xa9\xbe\x76\x23\x00\x23\x60\x6d\x02\x86\xa3\xfa\xf8\xa4\xd2\x2b\x72\x8e\xc5\x18\x07\x9f\x9e\x64\x52\x6e\x3a\x0c\xc7\x94\x1a\xa3\x38\xc4\x37\x99\x7c\x68\x0c\xca\xc6\x7c\x66\xbf\xa1" + , salt = "\xfc\xa8\x62\x06\x8b\xce\x22\x46\x72\x4b\x70\x8a\x05\x19\xda\x17\xe6\x48\x68\x8c" + , signature = "\x00\x7f\x00\x30\x01\x8f\x53\xcd\xc7\x1f\x23\xd0\x36\x59\xfd\xe5\x4d\x42\x41\xf7\x58\xa7\x50\xb4\x2f\x18\x5f\x87\x57\x85\x20\xc3\x07\x42\xaf\xd8\x43\x59\xb6\xe6\xe8\xd3\xed\x95\x9d\xc6\xfe\x48\x6b\xed\xc8\xe2\xcf\x00\x1f\x63\xa7\xab\xe1\x62\x56\xa1\xb8\x4d\xf0\xd2\x49\xfc\x05\xd3\x19\x4c\xe5\xf0\x91\x27\x42\xdb\xbf\x80\xdd\x17\x4f\x6c\x51\xf6\xba\xd7\xf1\x6c\xf3\x36\x4e\xba\x09\x5a\x06\x26\x7d\xc3\x79\x38\x03\xac\x75\x26\xae\xbe\x0a\x47\x5d\x38\xb8\xc2\x24\x7a\xb5\x1c\x48\x98\xdf\x70\x47\xdc\x6a\xdf\x52\xc6\xc4" + } + -- Example 2.4 + , VectorPSS + { message = "\xa7\x18\x2c\x83\xac\x18\xbe\x65\x70\xa1\x06\xaa\x9d\x5c\x4e\x3d\xbb\xd4\xaf\xae\xb0\xc6\x0c\x4a\x23\xe1\x96\x9d\x79\xff" + , salt = "\x80\x70\xef\x2d\xe9\x45\xc0\x23\x87\x68\x4b\xa0\xd3\x30\x96\x73\x22\x35\xd4\x40" + , signature = "\x00\x9c\xd2\xf4\xed\xbe\x23\xe1\x23\x46\xae\x8c\x76\xdd\x9a\xd3\x23\x0a\x62\x07\x61\x41\xf1\x6c\x15\x2b\xa1\x85\x13\xa4\x8e\xf6\xf0\x10\xe0\xe3\x7f\xd3\xdf\x10\xa1\xec\x62\x9a\x0c\xb5\xa3\xb5\xd2\x89\x30\x07\x29\x8c\x30\x93\x6a\x95\x90\x3b\x6b\xa8\x55\x55\xd9\xec\x36\x73\xa0\x61\x08\xfd\x62\xa2\xfd\xa5\x6d\x1c\xe2\xe8\x5c\x4d\xb6\xb2\x4a\x81\xca\x3b\x49\x6c\x36\xd4\xfd\x06\xeb\x7c\x91\x66\xd8\xe9\x48\x77\xc4\x2b\xea\x62\x2b\x3b\xfe\x92\x51\xfd\xc2\x1d\x8d\x53\x71\xba\xda\xd7\x8a\x48\x82\x14\x79\x63\x35\xb4\x0b" + } + -- Example 2.5 + , VectorPSS + { message = "\x86\xa8\x3d\x4a\x72\xee\x93\x2a\x4f\x56\x30\xaf\x65\x79\xa3\x86\xb7\x8f\xe8\x89\x99\xe0\xab\xd2\xd4\x90\x34\xa4\xbf\xc8\x54\xdd\x94\xf1\x09\x4e\x2e\x8c\xd7\xa1\x79\xd1\x95\x88\xe4\xae\xfc\x1b\x1b\xd2\x5e\x95\xe3\xdd\x46\x1f" + , salt = "\x17\x63\x9a\x4e\x88\xd7\x22\xc4\xfc\xa2\x4d\x07\x9a\x8b\x29\xc3\x24\x33\xb0\xc9" + , signature = "\x00\xec\x43\x08\x24\x93\x1e\xbd\x3b\xaa\x43\x03\x4d\xae\x98\xba\x64\x6b\x8c\x36\x01\x3d\x16\x71\xc3\xcf\x1c\xf8\x26\x0c\x37\x4b\x19\xf8\xe1\xcc\x8d\x96\x50\x12\x40\x5e\x7e\x9b\xf7\x37\x86\x12\xdf\xcc\x85\xfc\xe1\x2c\xda\x11\xf9\x50\xbd\x0b\xa8\x87\x67\x40\x43\x6c\x1d\x25\x95\xa6\x4a\x1b\x32\xef\xcf\xb7\x4a\x21\xc8\x73\xb3\xcc\x33\xaa\xf4\xe3\xdc\x39\x53\xde\x67\xf0\x67\x4c\x04\x53\xb4\xfd\x9f\x60\x44\x06\xd4\x41\xb8\x16\x09\x8c\xb1\x06\xfe\x34\x72\xbc\x25\x1f\x81\x5f\x59\xdb\x2e\x43\x78\xa3\xad\xdc\x18\x1e\xcf" + } + -- Example 2.6 + , VectorPSS + { message = "\x04\x9f\x91\x54\xd8\x71\xac\x4a\x7c\x7a\xb4\x53\x25\xba\x75\x45\xa1\xed\x08\xf7\x05\x25\xb2\x66\x7c\xf1" + , salt = "\x37\x81\x0d\xef\x10\x55\xed\x92\x2b\x06\x3d\xf7\x98\xde\x5d\x0a\xab\xf8\x86\xee" + , signature = "\x00\x47\x5b\x16\x48\xf8\x14\xa8\xdc\x0a\xbd\xc3\x7b\x55\x27\xf5\x43\xb6\x66\xbb\x6e\x39\xd3\x0e\x5b\x49\xd3\xb8\x76\xdc\xcc\x58\xea\xc1\x4e\x32\xa2\xd5\x5c\x26\x16\x01\x44\x56\xad\x2f\x24\x6f\xc8\xe3\xd5\x60\xda\x3d\xdf\x37\x9a\x1c\x0b\xd2\x00\xf1\x02\x21\xdf\x07\x8c\x21\x9a\x15\x1b\xc8\xd4\xec\x9d\x2f\xc2\x56\x44\x67\x81\x10\x14\xef\x15\xd8\xea\x01\xc2\xeb\xbf\xf8\xc2\xc8\xef\xab\x38\x09\x6e\x55\xfc\xbe\x32\x85\xc7\xaa\x55\x88\x51\x25\x4f\xaf\xfa\x92\xc1\xc7\x2b\x78\x75\x86\x63\xef\x45\x82\x84\x31\x39\xd7\xa6" + } + ] + +-- ================================== +-- Example 3: A 1026-bit RSA Key Pair +-- ================================== + +rsaKey3 = PrivateKey + { private_pub = PublicKey + { public_n = 0x02f246ef451ed3eebb9a310200cc25859c048e4be798302991112eb68ce6db674e280da21feded1ae74880ca522b18db249385012827c515f0e466a1ffa691d98170574e9d0eadb087586ca48933da3cc953d95bd0ed50de10ddcb6736107d6c831c7f663e833ca4c097e700ce0fb945f88fb85fe8e5a773172565b914a471a443 + , public_e = 0x010001 + , public_size = 129 + } + , private_d = 0x651451733b56de5ac0a689a4aeb6e6894a69014e076c88dd7a667eab3232bbccd2fc44ba2fa9c31db46f21edd1fdb23c5c128a5da5bab91e7f952b67759c7cff705415ac9fa0907c7ca6178f668fb948d869da4cc3b7356f4008dfd5449d32ee02d9a477eb69fc29266e5d9070512375a50fbbcc27e238ad98425f6ebbf88991 + , private_p = 0x01bd36e18ece4b0fdb2e9c9d548bd1a7d6e2c21c6fdc35074a1d05b1c6c8b3d558ea2639c9a9a421680169317252558bd148ad215aac550e2dcf12a82d0ebfe853 + , private_q = 0x01b1b656ad86d8e19d5dc86292b3a192fdf6e0dd37877bad14822fa00190cab265f90d3f02057b6f54d6ecb14491e5adeacebc48bf0ebd2a2ad26d402e54f61651 + , private_dP = 0x1f2779fd2e3e5e6bae05539518fba0cd0ead1aa4513a7cba18f1cf10e3f68195693d278a0f0ee72f89f9bc760d80e2f9d0261d516501c6ae39f14a476ce2ccf5 + , private_dQ = 0x011a0d36794b04a854aab4b2462d439a5046c91d940b2bc6f75b62956fef35a2a6e63c5309817f307bbff9d59e7e331bd363f6d66849b18346adea169f0ae9aec1 + , private_qinv = 0x0b30f0ecf558752fb3a6ce4ba2b8c675f659eba6c376585a1b39712d038ae3d2b46fcb418ae15d0905da6440e1513a30b9b7d6668fbc5e88e5ab7a175e73ba35 + } + +vectorsKey3 = + [ + -- Example 3.1 + VectorPSS + { message = "\x59\x4b\x37\x33\x3b\xbb\x2c\x84\x52\x4a\x87\xc1\xa0\x1f\x75\xfc\xec\x0e\x32\x56\xf1\x08\xe3\x8d\xca\x36\xd7\x0d\x00\x57" + , salt = "\xf3\x1a\xd6\xc8\xcf\x89\xdf\x78\xed\x77\xfe\xac\xbc\xc2\xf8\xb0\xa8\xe4\xcf\xaa" + , signature = "\x00\x88\xb1\x35\xfb\x17\x94\xb6\xb9\x6c\x4a\x3e\x67\x81\x97\xf8\xca\xc5\x2b\x64\xb2\xfe\x90\x7d\x6f\x27\xde\x76\x11\x24\x96\x4a\x99\xa0\x1a\x88\x27\x40\xec\xfa\xed\x6c\x01\xa4\x74\x64\xbb\x05\x18\x23\x13\xc0\x13\x38\xa8\xcd\x09\x72\x14\xcd\x68\xca\x10\x3b\xd5\x7d\x3b\xc9\xe8\x16\x21\x3e\x61\xd7\x84\xf1\x82\x46\x7a\xbf\x8a\x01\xcf\x25\x3e\x99\xa1\x56\xea\xa8\xe3\xe1\xf9\x0e\x3c\x6e\x4e\x3a\xa2\xd8\x3e\xd0\x34\x5b\x89\xfa\xfc\x9c\x26\x07\x7c\x14\xb6\xac\x51\x45\x4f\xa2\x6e\x44\x6e\x3a\x2f\x15\x3b\x2b\x16\x79\x7f" + } + -- Example 3.2 + , VectorPSS + { message = "\x8b\x76\x95\x28\x88\x4a\x0d\x1f\xfd\x09\x0c\xf1\x02\x99\x3e\x79\x6d\xad\xcf\xbd\xdd\x38\xe4\x4f\xf6\x32\x4c\xa4\x51" + , salt = "\xfc\xf9\xf0\xe1\xf1\x99\xa3\xd1\xd0\xda\x68\x1c\x5b\x86\x06\xfc\x64\x29\x39\xf7" + , signature = "\x02\xa5\xf0\xa8\x58\xa0\x86\x4a\x4f\x65\x01\x7a\x7d\x69\x45\x4f\x3f\x97\x3a\x29\x99\x83\x9b\x7b\xbc\x48\xbf\x78\x64\x11\x69\x17\x95\x56\xf5\x95\xfa\x41\xf6\xff\x18\xe2\x86\xc2\x78\x30\x79\xbc\x09\x10\xee\x9c\xc3\x4f\x49\xba\x68\x11\x24\xf9\x23\xdf\xa8\x8f\x42\x61\x41\xa3\x68\xa5\xf5\xa9\x30\xc6\x28\xc2\xc3\xc2\x00\xe1\x8a\x76\x44\x72\x1a\x0c\xbe\xc6\xdd\x3f\x62\x79\xbd\xe3\xe8\xf2\xbe\x5e\x2d\x4e\xe5\x6f\x97\xe7\xce\xaf\x33\x05\x4b\xe7\x04\x2b\xd9\x1a\x63\xbb\x09\xf8\x97\xbd\x41\xe8\x11\x97\xde\xe9\x9b\x11\xaf" + } + -- Example 3.3 + , VectorPSS + { message = "\x1a\xbd\xba\x48\x9c\x5a\xda\x2f\x99\x5e\xd1\x6f\x19\xd5\xa9\x4d\x9e\x6e\xc3\x4a\x8d\x84\xf8\x45\x57\xd2\x6e\x5e\xf9\xb0\x2b\x22\x88\x7e\x3f\x9a\x4b\x69\x0a\xd1\x14\x92\x09\xc2\x0c\x61\x43\x1f\x0c\x01\x7c\x36\xc2\x65\x7b\x35\xd7\xb0\x7d\x3f\x5a\xd8\x70\x85\x07\xa9\xc1\xb8\x31\xdf\x83\x5a\x56\xf8\x31\x07\x18\x14\xea\x5d\x3d\x8d\x8f\x6a\xde\x40\xcb\xa3\x8b\x42\xdb\x7a\x2d\x3d\x7a\x29\xc8\xf0\xa7\x9a\x78\x38\xcf\x58\xa9\x75\x7f\xa2\xfe\x4c\x40\xdf\x9b\xaa\x19\x3b\xfc\x6f\x92\xb1\x23\xad\x57\xb0\x7a\xce\x3e\x6a\xc0\x68\xc9\xf1\x06\xaf\xd9\xee\xb0\x3b\x4f\x37\xc2\x5d\xbf\xbc\xfb\x30\x71\xf6\xf9\x77\x17\x66\xd0\x72\xf3\xbb\x07\x0a\xf6\x60\x55\x32\x97\x3a\xe2\x50\x51" + , salt = "\x98\x6e\x7c\x43\xdb\xb6\x71\xbd\x41\xb9\xa7\xf4\xb6\xaf\xc8\x0e\x80\x5f\x24\x23" + , signature = "\x02\x44\xbc\xd1\xc8\xc1\x69\x55\x73\x6c\x80\x3b\xe4\x01\x27\x2e\x18\xcb\x99\x08\x11\xb1\x4f\x72\xdb\x96\x41\x24\xd5\xfa\x76\x06\x49\xcb\xb5\x7a\xfb\x87\x55\xdb\xb6\x2b\xf5\x1f\x46\x6c\xf2\x3a\x0a\x16\x07\x57\x6e\x98\x3d\x77\x8f\xce\xff\xa9\x2d\xf7\x54\x8a\xea\x8e\xa4\xec\xad\x2c\x29\xdd\x9f\x95\xbc\x07\xfe\x91\xec\xf8\xbe\xe2\x55\xbf\xe8\x76\x2f\xd7\x69\x0a\xa9\xbf\xa4\xfa\x08\x49\xef\x72\x8c\x2c\x42\xc4\x53\x23\x64\x52\x2d\xf2\xab\x7f\x9f\x8a\x03\xb6\x3f\x7a\x49\x91\x75\x82\x86\x68\xf5\xef\x5a\x29\xe3\x80\x2c" + } + -- Example 3.4 + , VectorPSS + { message = "\x8f\xb4\x31\xf5\xee\x79\x2b\x6c\x2a\xc7\xdb\x53\xcc\x42\x86\x55\xae\xb3\x2d\x03\xf4\xe8\x89\xc5\xc2\x5d\xe6\x83\xc4\x61\xb5\x3a\xcf\x89\xf9\xf8\xd3\xaa\xbd\xf6\xb9\xf0\xc2\xa1\xde\x12\xe1\x5b\x49\xed\xb3\x91\x9a\x65\x2f\xe9\x49\x1c\x25\xa7\xfc\xe1\xf7\x22\xc2\x54\x36\x08\xb6\x9d\xc3\x75\xec" + , salt = "\xf8\x31\x2d\x9c\x8e\xea\x13\xec\x0a\x4c\x7b\x98\x12\x0c\x87\x50\x90\x87\xc4\x78" + , signature = "\x01\x96\xf1\x2a\x00\x5b\x98\x12\x9c\x8d\xf1\x3c\x4c\xb1\x6f\x8a\xa8\x87\xd3\xc4\x0d\x96\xdf\x3a\x88\xe7\x53\x2e\xf3\x9c\xd9\x92\xf2\x73\xab\xc3\x70\xbc\x1b\xe6\xf0\x97\xcf\xeb\xbf\x01\x18\xfd\x9e\xf4\xb9\x27\x15\x5f\x3d\xf2\x2b\x90\x4d\x90\x70\x2d\x1f\x7b\xa7\xa5\x2b\xed\x8b\x89\x42\xf4\x12\xcd\x7b\xd6\x76\xc9\xd1\x8e\x17\x03\x91\xdc\xd3\x45\xc0\x6a\x73\x09\x64\xb3\xf3\x0b\xcc\xe0\xbb\x20\xba\x10\x6f\x9a\xb0\xee\xb3\x9c\xf8\xa6\x60\x7f\x75\xc0\x34\x7f\x0a\xf7\x9f\x16\xaf\xa0\x81\xd2\xc9\x2d\x1e\xe6\xf8\x36\xb8" + } + -- Example 3.5 + , VectorPSS + { message = "\xfe\xf4\x16\x1d\xfa\xaf\x9c\x52\x95\x05\x1d\xfc\x1f\xf3\x81\x0c\x8c\x9e\xc2\xe8\x66\xf7\x07\x54\x22\xc8\xec\x42\x16\xa9\xc4\xff\x49\x42\x7d\x48\x3c\xae\x10\xc8\x53\x4a\x41\xb2\xfd\x15\xfe\xe0\x69\x60\xec\x6f\xb3\xf7\xa7\xe9\x4a\x2f\x8a\x2e\x3e\x43\xdc\x4a\x40\x57\x6c\x30\x97\xac\x95\x3b\x1d\xe8\x6f\x0b\x4e\xd3\x6d\x64\x4f\x23\xae\x14\x42\x55\x29\x62\x24\x64\xca\x0c\xbf\x0b\x17\x41\x34\x72\x38\x15\x7f\xab\x59\xe4\xde\x55\x24\x09\x6d\x62\xba\xec\x63\xac\x64" + , salt = "\x50\x32\x7e\xfe\xc6\x29\x2f\x98\x01\x9f\xc6\x7a\x2a\x66\x38\x56\x3e\x9b\x6e\x2d" + , signature = "\x02\x1e\xca\x3a\xb4\x89\x22\x64\xec\x22\x41\x1a\x75\x2d\x92\x22\x10\x76\xd4\xe0\x1c\x0e\x6f\x0d\xde\x9a\xfd\x26\xba\x5a\xcf\x6d\x73\x9e\xf9\x87\x54\x5d\x16\x68\x3e\x56\x74\xc9\xe7\x0f\x1d\xe6\x49\xd7\xe6\x1d\x48\xd0\xca\xeb\x4f\xb4\xd8\xb2\x4f\xba\x84\xa6\xe3\x10\x8f\xee\x7d\x07\x05\x97\x32\x66\xac\x52\x4b\x4a\xd2\x80\xf7\xae\x17\xdc\x59\xd9\x6d\x33\x51\x58\x6b\x5a\x3b\xdb\x89\x5d\x1e\x1f\x78\x20\xac\x61\x35\xd8\x75\x34\x80\x99\x83\x82\xba\x32\xb7\x34\x95\x59\x60\x8c\x38\x74\x52\x90\xa8\x5e\xf4\xe9\xf9\xbd\x83" + } + -- Example 3.6 + , VectorPSS + { message = "\xef\xd2\x37\xbb\x09\x8a\x44\x3a\xee\xb2\xbf\x6c\x3f\x8c\x81\xb8\xc0\x1b\x7f\xcb\x3f\xeb" + , salt = "\xb0\xde\x3f\xc2\x5b\x65\xf5\xaf\x96\xb1\xd5\xcc\x3b\x27\xd0\xc6\x05\x30\x87\xb3" + , signature = "\x01\x2f\xaf\xec\x86\x2f\x56\xe9\xe9\x2f\x60\xab\x0c\x77\x82\x4f\x42\x99\xa0\xca\x73\x4e\xd2\x6e\x06\x44\xd5\xd2\x22\xc7\xf0\xbd\xe0\x39\x64\xf8\xe7\x0a\x5c\xb6\x5e\xd4\x4e\x44\xd5\x6a\xe0\xed\xf1\xff\x86\xca\x03\x2c\xc5\xdd\x44\x04\xdb\xb7\x6a\xb8\x54\x58\x6c\x44\xee\xd8\x33\x6d\x08\xd4\x57\xce\x6c\x03\x69\x3b\x45\xc0\xf1\xef\xef\x93\x62\x4b\x95\xb8\xec\x16\x9c\x61\x6d\x20\xe5\x53\x8e\xbc\x0b\x67\x37\xa6\xf8\x2b\x4b\xc0\x57\x09\x24\xfc\x6b\x35\x75\x9a\x33\x48\x42\x62\x79\xf8\xb3\xd7\x74\x4e\x2d\x22\x24\x26\xce" + } + ] + +-- ================================== +-- Example 8: A 1031-bit RSA Key Pair +-- ================================== + +rsaKey8 = PrivateKey + { private_pub = PublicKey + { public_n = 0x495370a1fb18543c16d3631e3163255df62be6eee890d5f25509e4f778a8ea6fbbbcdf85dff64e0d972003ab3681fbba6dd41fd541829b2e582de9f2a4a4e0a2d0900bef4753db3cee0ee06c7dfae8b1d53b5953218f9cceea695b08668edeaadced9463b1d790d5ebf27e9115b46cad4d9a2b8efab0561b0810344739ada0733f + , public_e = 0x010001 + , public_size = 129 + } + , private_d = 0x6c66ffe98980c38fcdeab5159898836165f4b4b817c4f6a8d486ee4ea9130fe9b9092bd136d184f95f504a607eac565846d2fdd6597a8967c7396ef95a6eeebb4578a643966dca4d8ee3de842de63279c618159c1ab54a89437b6a6120e4930afb52a4ba6ced8a4947ac64b30a3497cbe701c2d6266d517219ad0ec6d347dbe9 + , private_p = 0x08dad7f11363faa623d5d6d5e8a319328d82190d7127d2846c439b0ab72619b0a43a95320e4ec34fc3a9cea876422305bd76c5ba7be9e2f410c8060645a1d29edb + , private_q = 0x0847e732376fc7900f898ea82eb2b0fc418565fdae62f7d9ec4ce2217b97990dd272db157f99f63c0dcbb9fbacdbd4c4dadb6df67756358ca4174825b48f49706d + , private_dP = 0x05c2a83c124b3621a2aa57ea2c3efe035eff4560f33ddebb7adab81fce69a0c8c2edc16520dda83d59a23be867963ac65f2cc710bbcfb96ee103deb771d105fd85 + , private_dQ = 0x04cae8aa0d9faa165c87b682ec140b8ed3b50b24594b7a3b2c220b3669bb819f984f55310a1ae7823651d4a02e99447972595139363434e5e30a7e7d241551e1b9 + , private_qinv = 0x07d3e47bf686600b11ac283ce88dbb3f6051e8efd04680e44c171ef531b80b2b7c39fc766320e2cf15d8d99820e96ff30dc69691839c4b40d7b06e45307dc91f3f + } + +vectorsKey8 = + [ + -- Example 8.1 + VectorPSS + { message = "\x81\x33\x2f\x4b\xe6\x29\x48\x41\x5e\xa1\xd8\x99\x79\x2e\xea\xcf\x6c\x6e\x1d\xb1\xda\x8b\xe1\x3b\x5c\xea\x41\xdb\x2f\xed\x46\x70\x92\xe1\xff\x39\x89\x14\xc7\x14\x25\x97\x75\xf5\x95\xf8\x54\x7f\x73\x56\x92\xa5\x75\xe6\x92\x3a\xf7\x8f\x22\xc6\x99\x7d\xdb\x90\xfb\x6f\x72\xd7\xbb\x0d\xd5\x74\x4a\x31\xde\xcd\x3d\xc3\x68\x58\x49\x83\x6e\xd3\x4a\xec\x59\x63\x04\xad\x11\x84\x3c\x4f\x88\x48\x9f\x20\x97\x35\xf5\xfb\x7f\xda\xf7\xce\xc8\xad\xdc\x58\x18\x16\x8f\x88\x0a\xcb\xf4\x90\xd5\x10\x05\xb7\xa8\xe8\x4e\x43\xe5\x42\x87\x97\x75\x71\xdd\x99\xee\xa4\xb1\x61\xeb\x2d\xf1\xf5\x10\x8f\x12\xa4\x14\x2a\x83\x32\x2e\xdb\x05\xa7\x54\x87\xa3\x43\x5c\x9a\x78\xce\x53\xed\x93\xbc\x55\x08\x57\xd7\xa9\xfb" + , salt = "\x1d\x65\x49\x1d\x79\xc8\x64\xb3\x73\x00\x9b\xe6\xf6\xf2\x46\x7b\xac\x4c\x78\xfa" + , signature = "\x02\x62\xac\x25\x4b\xfa\x77\xf3\xc1\xac\xa2\x2c\x51\x79\xf8\xf0\x40\x42\x2b\x3c\x5b\xaf\xd4\x0a\x8f\x21\xcf\x0f\xa5\xa6\x67\xcc\xd5\x99\x3d\x42\xdb\xaf\xb4\x09\xc5\x20\xe2\x5f\xce\x2b\x1e\xe1\xe7\x16\x57\x7f\x1e\xfa\x17\xf3\xda\x28\x05\x2f\x40\xf0\x41\x9b\x23\x10\x6d\x78\x45\xaa\xf0\x11\x25\xb6\x98\xe7\xa4\xdf\xe9\x2d\x39\x67\xbb\x00\xc4\xd0\xd3\x5b\xa3\x55\x2a\xb9\xa8\xb3\xee\xf0\x7c\x7f\xec\xdb\xc5\x42\x4a\xc4\xdb\x1e\x20\xcb\x37\xd0\xb2\x74\x47\x69\x94\x0e\xa9\x07\xe1\x7f\xbb\xca\x67\x3b\x20\x52\x23\x80\xc5" + } + -- Example 8.2 + , VectorPSS + { message = "\xe2\xf9\x6e\xaf\x0e\x05\xe7\xba\x32\x6e\xcc\xa0\xba\x7f\xd2\xf7\xc0\x23\x56\xf3\xce\xde\x9d\x0f\xaa\xbf\x4f\xcc\x8e\x60\xa9\x73\xe5\x59\x5f\xd9\xea\x08" + , salt = "\x43\x5c\x09\x8a\xa9\x90\x9e\xb2\x37\x7f\x12\x48\xb0\x91\xb6\x89\x87\xff\x18\x38" + , signature = "\x27\x07\xb9\xad\x51\x15\xc5\x8c\x94\xe9\x32\xe8\xec\x0a\x28\x0f\x56\x33\x9e\x44\xa1\xb5\x8d\x4d\xdc\xff\x2f\x31\x2e\x5f\x34\xdc\xfe\x39\xe8\x9c\x6a\x94\xdc\xee\x86\xdb\xbd\xae\x5b\x79\xba\x4e\x08\x19\xa9\xe7\xbf\xd9\xd9\x82\xe7\xee\x6c\x86\xee\x68\x39\x6e\x8b\x3a\x14\xc9\xc8\xf3\x4b\x17\x8e\xb7\x41\xf9\xd3\xf1\x21\x10\x9b\xf5\xc8\x17\x2f\xad\xa2\xe7\x68\xf9\xea\x14\x33\x03\x2c\x00\x4a\x8a\xa0\x7e\xb9\x90\x00\x0a\x48\xdc\x94\xc8\xba\xc8\xaa\xbe\x2b\x09\xb1\xaa\x46\xc0\xa2\xaa\x0e\x12\xf6\x3f\xbb\xa7\x75\xba\x7e" + } + -- Example 8.3 + , VectorPSS + { message = "\xe3\x5c\x6e\xd9\x8f\x64\xa6\xd5\xa6\x48\xfc\xab\x8a\xdb\x16\x33\x1d\xb3\x2e\x5d\x15\xc7\x4a\x40\xed\xf9\x4c\x3d\xc4\xa4\xde\x79\x2d\x19\x08\x89\xf2\x0f\x1e\x24\xed\x12\x05\x4a\x6b\x28\x79\x8f\xcb\x42\xd1\xc5\x48\x76\x9b\x73\x4c\x96\x37\x31\x42\x09\x2a\xed\x27\x76\x03\xf4\x73\x8d\xf4\xdc\x14\x46\x58\x6d\x0e\xc6\x4d\xa4\xfb\x60\x53\x6d\xb2\xae\x17\xfc\x7e\x3c\x04\xbb\xfb\xbb\xd9\x07\xbf\x11\x7c\x08\x63\x6f\xa1\x6f\x95\xf5\x1a\x62\x16\x93\x4d\x3e\x34\xf8\x50\x30\xf1\x7b\xbb\xc5\xba\x69\x14\x40\x58\xaf\xf0\x81\xe0\xb1\x9c\xf0\x3c\x17\x19\x5c\x5e\x88\x8b\xa5\x8f\x6f\xe0\xa0\x2e\x5c\x3b\xda\x97\x19\xa7" + , salt = "\xc6\xeb\xbe\x76\xdf\x0c\x4a\xea\x32\xc4\x74\x17\x5b\x2f\x13\x68\x62\xd0\x45\x29" + , signature = "\x2a\xd2\x05\x09\xd7\x8c\xf2\x6d\x1b\x6c\x40\x61\x46\x08\x6e\x4b\x0c\x91\xa9\x1c\x2b\xd1\x64\xc8\x7b\x96\x6b\x8f\xaa\x42\xaa\x0c\xa4\x46\x02\x23\x23\xba\x4b\x1a\x1b\x89\x70\x6d\x7f\x4c\x3b\xe5\x7d\x7b\x69\x70\x2d\x16\x8a\xb5\x95\x5e\xe2\x90\x35\x6b\x8c\x4a\x29\xed\x46\x7d\x54\x7e\xc2\x3c\xba\xdf\x28\x6c\xcb\x58\x63\xc6\x67\x9d\xa4\x67\xfc\x93\x24\xa1\x51\xc7\xec\x55\xaa\xc6\xdb\x40\x84\xf8\x27\x26\x82\x5c\xfe\x1a\xa4\x21\xbc\x64\x04\x9f\xb4\x2f\x23\x14\x8f\x9c\x25\xb2\xdc\x30\x04\x37\xc3\x8d\x42\x8a\xa7\x5f\x96" + } + -- Example 8.4 + , VectorPSS + { message = "\xdb\xc5\xf7\x50\xa7\xa1\x4b\xe2\xb9\x3e\x83\x8d\x18\xd1\x4a\x86\x95\xe5\x2e\x8a\xdd\x9c\x0a\xc7\x33\xb8\xf5\x6d\x27\x47\xe5\x29\xa0\xcc\xa5\x32\xdd\x49\xb9\x02\xae\xfe\xd5\x14\x44\x7f\x9e\x81\xd1\x61\x95\xc2\x85\x38\x68\xcb\x9b\x30\xf7\xd0\xd4\x95\xc6\x9d\x01\xb5\xc5\xd5\x0b\x27\x04\x5d\xb3\x86\x6c\x23\x24\xa4\x4a\x11\x0b\x17\x17\x74\x6d\xe4\x57\xd1\xc8\xc4\x5c\x3c\xd2\xa9\x29\x70\xc3\xd5\x96\x32\x05\x5d\x4c\x98\xa4\x1d\x6e\x99\xe2\xa3\xdd\xd5\xf7\xf9\x97\x9a\xb3\xcd\x18\xf3\x75\x05\xd2\x51\x41\xde\x2a\x1b\xff\x17\xb3\xa7\xdc\xe9\x41\x9e\xcc\x38\x5c\xf1\x1d\x72\x84\x0f\x19\x95\x3f\xd0\x50\x92\x51\xf6\xca\xfd\xe2\x89\x3d\x0e\x75\xc7\x81\xba\x7a\x50\x12\xca\x40\x1a\x4f\xa9\x9e\x04\xb3\xc3\x24\x9f\x92\x6d\x5a\xfe\x82\xcc\x87\xda\xb2\x2c\x3c\x1b\x10\x5d\xe4\x8e\x34\xac\xe9\xc9\x12\x4e\x59\x59\x7a\xc7\xeb\xf8" + , salt = "\x02\x1f\xdc\xc6\xeb\xb5\xe1\x9b\x1c\xb1\x6e\x9c\x67\xf2\x76\x81\x65\x7f\xe2\x0a" + , signature = "\x1e\x24\xe6\xe5\x86\x28\xe5\x17\x50\x44\xa9\xeb\x6d\x83\x7d\x48\xaf\x12\x60\xb0\x52\x0e\x87\x32\x7d\xe7\x89\x7e\xe4\xd5\xb9\xf0\xdf\x0b\xe3\xe0\x9e\xd4\xde\xa8\xc1\x45\x4f\xf3\x42\x3b\xb0\x8e\x17\x93\x24\x5a\x9d\xf8\xbf\x6a\xb3\x96\x8c\x8e\xdd\xc3\xb5\x32\x85\x71\xc7\x7f\x09\x1c\xc5\x78\x57\x69\x12\xdf\xeb\xd1\x64\xb9\xde\x54\x54\xfe\x0b\xe1\xc1\xf6\x38\x5b\x32\x83\x60\xce\x67\xec\x7a\x05\xf6\xe3\x0e\xb4\x5c\x17\xc4\x8a\xc7\x00\x41\xd2\xca\xb6\x7f\x0a\x2a\xe7\xaa\xfd\xcc\x8d\x24\x5e\xa3\x44\x2a\x63\x00\xcc\xc7" + } + -- Example 8.5 + , VectorPSS + { message = "\x04\xdc\x25\x1b\xe7\x2e\x88\xe5\x72\x34\x85\xb6\x38\x3a\x63\x7e\x2f\xef\xe0\x76\x60\xc5\x19\xa5\x60\xb8\xbc\x18\xbd\xed\xb8\x6e\xae\x23\x64\xea\x53\xba\x9d\xca\x6e\xb3\xd2\xe7\xd6\xb8\x06\xaf\x42\xb3\xe8\x7f\x29\x1b\x4a\x88\x81\xd5\xbf\x57\x2c\xc9\xa8\x5e\x19\xc8\x6a\xcb\x28\xf0\x98\xf9\xda\x03\x83\xc5\x66\xd3\xc0\xf5\x8c\xfd\x8f\x39\x5d\xcf\x60\x2e\x5c\xd4\x0e\x8c\x71\x83\xf7\x14\x99\x6e\x22\x97\xef" + , salt = "\xc5\x58\xd7\x16\x7c\xbb\x45\x08\xad\xa0\x42\x97\x1e\x71\xb1\x37\x7e\xea\x42\x69" + , signature = "\x33\x34\x1b\xa3\x57\x6a\x13\x0a\x50\xe2\xa5\xcf\x86\x79\x22\x43\x88\xd5\x69\x3f\x5a\xcc\xc2\x35\xac\x95\xad\xd6\x8e\x5e\xb1\xee\xc3\x16\x66\xd0\xca\x7a\x1c\xda\x6f\x70\xa1\xaa\x76\x2c\x05\x75\x2a\x51\x95\x0c\xdb\x8a\xf3\xc5\x37\x9f\x18\xcf\xe6\xb5\xbc\x55\xa4\x64\x82\x26\xa1\x5e\x91\x2e\xf1\x9a\xd7\x7a\xde\xea\x91\x1d\x67\xcf\xef\xd6\x9b\xa4\x3f\xa4\x11\x91\x35\xff\x64\x21\x17\xba\x98\x5a\x7e\x01\x00\x32\x5e\x95\x19\xf1\xca\x6a\x92\x16\xbd\xa0\x55\xb5\x78\x50\x15\x29\x11\x25\xe9\x0d\xcd\x07\xa2\xca\x96\x73\xee" + } + -- Example 8.6 + , VectorPSS + { message = "\x0e\xa3\x7d\xf9\xa6\xfe\xa4\xa8\xb6\x10\x37\x3c\x24\xcf\x39\x0c\x20\xfa\x6e\x21\x35\xc4\x00\xc8\xa3\x4f\x5c\x18\x3a\x7e\x8e\xa4\xc9\xae\x09\x0e\xd3\x17\x59\xf4\x2d\xc7\x77\x19\xcc\xa4\x00\xec\xdc\xc5\x17\xac\xfc\x7a\xc6\x90\x26\x75\xb2\xef\x30\xc5\x09\x66\x5f\x33\x21\x48\x2f\xc6\x9a\x9f\xb5\x70\xd1\x5e\x01\xc8\x45\xd0\xd8\xe5\x0d\x2a\x24\xcb\xf1\xcf\x0e\x71\x49\x75\xa5\xdb\x7b\x18\xd9\xe9\xe9\xcb\x91\xb5\xcb\x16\x86\x90\x60\xed\x18\xb7\xb5\x62\x45\x50\x3f\x0c\xaf\x90\x35\x2b\x8d\xe8\x1c\xb5\xa1\xd9\xc6\x33\x60\x92\xf0\xcd" + , salt = "\x76\xfd\x4e\x64\xfd\xc9\x8e\xb9\x27\xa0\x40\x3e\x35\xa0\x84\xe7\x6b\xa9\xf9\x2a" + , signature = "\x1e\xd1\xd8\x48\xfb\x1e\xdb\x44\x12\x9b\xd9\xb3\x54\x79\x5a\xf9\x7a\x06\x9a\x7a\x00\xd0\x15\x10\x48\x59\x3e\x0c\x72\xc3\x51\x7f\xf9\xff\x2a\x41\xd0\xcb\x5a\x0a\xc8\x60\xd7\x36\xa1\x99\x70\x4f\x7c\xb6\xa5\x39\x86\xa8\x8b\xbd\x8a\xbc\xc0\x07\x6a\x2c\xe8\x47\x88\x00\x31\x52\x5d\x44\x9d\xa2\xac\x78\x35\x63\x74\xc5\x36\xe3\x43\xfa\xa7\xcb\xa4\x2a\x5a\xaa\x65\x06\x08\x77\x91\xc0\x6a\x8e\x98\x93\x35\xae\xd1\x9b\xfa\xb2\xd5\xe6\x7e\x27\xfb\x0c\x28\x75\xaf\x89\x6c\x21\xb6\xe8\xe7\x30\x9d\x04\xe4\xf6\x72\x7e\x69\x46\x3e" + } + ] + doSignTest key (i, vector) = testCase (show i) (Right (signature vector) @=? actual) where actual = PSS.signWithSalt (salt vector) Nothing PSS.defaultPSSParamsSHA1 key (message vector) @@ -470,4 +647,10 @@ pssTests = testGroup "RSA-PSS" [ doVerifyTest rsaKeyInt (katZero, vectorInt) ] , testGroup "signature key 1024" $ map (doSignTest rsaKey1) (zip [katZero..] vectorsKey1) , testGroup "verify key 1024" $ map (doVerifyTest rsaKey1) (zip [katZero..] vectorsKey1) + , testGroup "signature key 1025" $ map (doSignTest rsaKey2) (zip [katZero..] vectorsKey2) + , testGroup "verify key 1025" $ map (doVerifyTest rsaKey2) (zip [katZero..] vectorsKey2) + , testGroup "signature key 1026" $ map (doSignTest rsaKey3) (zip [katZero..] vectorsKey3) + , testGroup "verify key 1026" $ map (doVerifyTest rsaKey3) (zip [katZero..] vectorsKey3) + , testGroup "signature key 1031" $ map (doSignTest rsaKey8) (zip [katZero..] vectorsKey8) + , testGroup "verify key 1031" $ map (doVerifyTest rsaKey8) (zip [katZero..] vectorsKey8) ] From ae0e9c0f3e30a666165c54e31b8e83ca623b81f8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 12 Jan 2019 14:13:27 +0100 Subject: [PATCH 037/176] Remove commented example 10 --- tests/KAT_PubKey/PSS.hs | 308 ---------------------------------------- 1 file changed, 308 deletions(-) diff --git a/tests/KAT_PubKey/PSS.hs b/tests/KAT_PubKey/PSS.hs index bf7ed82..551ac61 100644 --- a/tests/KAT_PubKey/PSS.hs +++ b/tests/KAT_PubKey/PSS.hs @@ -152,314 +152,6 @@ vectorsKey1 = } ] -{- -# =================================== -# Example 10: A 2048-bit RSA Key Pair -# =================================== - -# ------------------------------ -# Components of the RSA Key Pair -# ------------------------------ - -# RSA modulus n: -a5 dd 86 7a c4 cb 02 f9 0b 94 57 d4 8c 14 a7 70 -ef 99 1c 56 c3 9c 0e c6 5f d1 1a fa 89 37 ce a5 -7b 9b e7 ac 73 b4 5c 00 17 61 5b 82 d6 22 e3 18 -75 3b 60 27 c0 fd 15 7b e1 2f 80 90 fe e2 a7 ad -cd 0e ef 75 9f 88 ba 49 97 c7 a4 2d 58 c9 aa 12 -cb 99 ae 00 1f e5 21 c1 3b b5 43 14 45 a8 d5 ae -4f 5e 4c 7e 94 8a c2 27 d3 60 40 71 f2 0e 57 7e -90 5f be b1 5d fa f0 6d 1d e5 ae 62 53 d6 3a 6a -21 20 b3 1a 5d a5 da bc 95 50 60 0e 20 f2 7d 37 -39 e2 62 79 25 fe a3 cc 50 9f 21 df f0 4e 6e ea -45 49 c5 40 d6 80 9f f9 30 7e ed e9 1f ff 58 73 -3d 83 85 a2 37 d6 d3 70 5a 33 e3 91 90 09 92 07 -0d f7 ad f1 35 7c f7 e3 70 0c e3 66 7d e8 3f 17 -b8 df 17 78 db 38 1d ce 09 cb 4a d0 58 a5 11 00 -1a 73 81 98 ee 27 cf 55 a1 3b 75 45 39 90 65 82 -ec 8b 17 4b d5 8d 5d 1f 3d 76 7c 61 37 21 ae 05 - -# RSA public exponent e: -01 00 01 - -# RSA private exponent d: -2d 2f f5 67 b3 fe 74 e0 61 91 b7 fd ed 6d e1 12 -29 0c 67 06 92 43 0d 59 69 18 40 47 da 23 4c 96 -93 de ed 16 73 ed 42 95 39 c9 69 d3 72 c0 4d 6b -47 e0 f5 b8 ce e0 84 3e 5c 22 83 5d bd 3b 05 a0 -99 79 84 ae 60 58 b1 1b c4 90 7c bf 67 ed 84 fa -9a e2 52 df b0 d0 cd 49 e6 18 e3 5d fd fe 59 bc -a3 dd d6 6c 33 ce bb c7 7a d4 41 aa 69 5e 13 e3 -24 b5 18 f0 1c 60 f5 a8 5c 99 4a d1 79 f2 a6 b5 -fb e9 34 02 b1 17 67 be 01 bf 07 34 44 d6 ba 1d -d2 bc a5 bd 07 4d 4a 5f ae 35 31 ad 13 03 d8 4b -30 d8 97 31 8c bb ba 04 e0 3c 2e 66 de 6d 91 f8 -2f 96 ea 1d 4b b5 4a 5a ae 10 2d 59 46 57 f5 c9 -78 95 53 51 2b 29 6d ea 29 d8 02 31 96 35 7e 3e -3a 6e 95 8f 39 e3 c2 34 40 38 ea 60 4b 31 ed c6 -f0 f7 ff 6e 71 81 a5 7c 92 82 6a 26 8f 86 76 8e -96 f8 78 56 2f c7 1d 85 d6 9e 44 86 12 f7 04 8f - -# Prime p: -cf d5 02 83 fe ee b9 7f 6f 08 d7 3c bc 7b 38 36 -f8 2b bc d4 99 47 9f 5e 6f 76 fd fc b8 b3 8c 4f -71 dc 9e 88 bd 6a 6f 76 37 1a fd 65 d2 af 18 62 -b3 2a fb 34 a9 5f 71 b8 b1 32 04 3f fe be 3a 95 -2b af 75 92 44 81 48 c0 3f 9c 69 b1 d6 8e 4c e5 -cf 32 c8 6b af 46 fe d3 01 ca 1a b4 03 06 9b 32 -f4 56 b9 1f 71 89 8a b0 81 cd 8c 42 52 ef 52 71 -91 5c 97 94 b8 f2 95 85 1d a7 51 0f 99 cb 73 eb - -# Prime q: -cc 4e 90 d2 a1 b3 a0 65 d3 b2 d1 f5 a8 fc e3 1b -54 44 75 66 4e ab 56 1d 29 71 b9 9f b7 be f8 44 -e8 ec 1f 36 0b 8c 2a c8 35 96 92 97 1e a6 a3 8f -72 3f cc 21 1f 5d bc b1 77 a0 fd ac 51 64 a1 d4 -ff 7f bb 4e 82 99 86 35 3c b9 83 65 9a 14 8c dd -42 0c 7d 31 ba 38 22 ea 90 a3 2b e4 6c 03 0e 8c -17 e1 fa 0a d3 78 59 e0 6b 0a a6 fa 3b 21 6d 9c -be 6c 0e 22 33 97 69 c0 a6 15 91 3e 5d a7 19 cf - -# p's CRT exponent dP: -1c 2d 1f c3 2f 6b c4 00 4f d8 5d fd e0 fb bf 9a -4c 38 f9 c7 c4 e4 1d ea 1a a8 82 34 a2 01 cd 92 -f3 b7 da 52 65 83 a9 8a d8 5b b3 60 fb 98 3b 71 -1e 23 44 9d 56 1d 17 78 d7 a5 15 48 6b cb f4 7b -46 c9 e9 e1 a3 a1 f7 70 00 ef be b0 9a 8a fe 47 -e5 b8 57 cd a9 9c b1 6d 7f ff 9b 71 2e 3b d6 0c -a9 6d 9c 79 73 d6 16 d4 69 34 a9 c0 50 28 1c 00 -43 99 ce ff 1d b7 dd a7 87 66 a8 a9 b9 cb 08 73 - -# q's CRT exponent dQ: -cb 3b 3c 04 ca a5 8c 60 be 7d 9b 2d eb b3 e3 96 -43 f4 f5 73 97 be 08 23 6a 1e 9e af aa 70 65 36 -e7 1c 3a cf e0 1c c6 51 f2 3c 9e 05 85 8f ee 13 -bb 6a 8a fc 47 df 4e dc 9a 4b a3 0b ce cb 73 d0 -15 78 52 32 7e e7 89 01 5c 2e 8d ee 7b 9f 05 a0 -f3 1a c9 4e b6 17 31 64 74 0c 5c 95 14 7c d5 f3 -b5 ae 2c b4 a8 37 87 f0 1d 8a b3 1f 27 c2 d0 ee -a2 dd 8a 11 ab 90 6a ba 20 7c 43 c6 ee 12 53 31 - -# CRT coefficient qInv: -12 f6 b2 cf 13 74 a7 36 fa d0 56 16 05 0f 96 ab -4b 61 d1 17 7c 7f 9d 52 5a 29 f3 d1 80 e7 76 67 -e9 9d 99 ab f0 52 5d 07 58 66 0f 37 52 65 5b 0f -25 b8 df 84 31 d9 a8 ff 77 c1 6c 12 a0 a5 12 2a -9f 0b f7 cf d5 a2 66 a3 5c 15 9f 99 12 08 b9 03 -16 ff 44 4f 3e 0b 6b d0 e9 3b 8a 7a 24 48 e9 57 -e3 dd a6 cf cf 22 66 b1 06 01 3a c4 68 08 d3 b3 -88 7b 3b 00 34 4b aa c9 53 0b 4c e7 08 fc 32 b6 - -# --------------------------------- -# RSASSA-PSS Signature Example 10.1 -# --------------------------------- - -# Message to be signed: -88 31 77 e5 12 6b 9b e2 d9 a9 68 03 27 d5 37 0c -6f 26 86 1f 58 20 c4 3d a6 7a 3a d6 09 - -# Salt: -04 e2 15 ee 6f f9 34 b9 da 70 d7 73 0c 87 34 ab -fc ec de 89 - -# Signature: -82 c2 b1 60 09 3b 8a a3 c0 f7 52 2b 19 f8 73 54 -06 6c 77 84 7a bf 2a 9f ce 54 2d 0e 84 e9 20 c5 -af b4 9f fd fd ac e1 65 60 ee 94 a1 36 96 01 14 -8e ba d7 a0 e1 51 cf 16 33 17 91 a5 72 7d 05 f2 -1e 74 e7 eb 81 14 40 20 69 35 d7 44 76 5a 15 e7 -9f 01 5c b6 6c 53 2c 87 a6 a0 59 61 c8 bf ad 74 -1a 9a 66 57 02 28 94 39 3e 72 23 73 97 96 c0 2a -77 45 5d 0f 55 5b 0e c0 1d df 25 9b 62 07 fd 0f -d5 76 14 ce f1 a5 57 3b aa ff 4e c0 00 69 95 16 -59 b8 5f 24 30 0a 25 16 0c a8 52 2d c6 e6 72 7e -57 d0 19 d7 e6 36 29 b8 fe 5e 89 e2 5c c1 5b eb -3a 64 75 77 55 92 99 28 0b 9b 28 f7 9b 04 09 00 -0b e2 5b bd 96 40 8b a3 b4 3c c4 86 18 4d d1 c8 -e6 25 53 fa 1a f4 04 0f 60 66 3d e7 f5 e4 9c 04 -38 8e 25 7f 1c e8 9c 95 da b4 8a 31 5d 9b 66 b1 -b7 62 82 33 87 6f f2 38 52 30 d0 70 d0 7e 16 66 - -# --------------------------------- -# RSASSA-PSS Signature Example 10.2 -# --------------------------------- - -# Message to be signed: -dd 67 0a 01 46 58 68 ad c9 3f 26 13 19 57 a5 0c -52 fb 77 7c db aa 30 89 2c 9e 12 36 11 64 ec 13 -97 9d 43 04 81 18 e4 44 5d b8 7b ee 58 dd 98 7b -34 25 d0 20 71 d8 db ae 80 70 8b 03 9d bb 64 db -d1 de 56 57 d9 fe d0 c1 18 a5 41 43 74 2e 0f f3 -c8 7f 74 e4 58 57 64 7a f3 f7 9e b0 a1 4c 9d 75 -ea 9a 1a 04 b7 cf 47 8a 89 7a 70 8f d9 88 f4 8e -80 1e db 0b 70 39 df 8c 23 bb 3c 56 f4 e8 21 ac - -# Salt: -8b 2b dd 4b 40 fa f5 45 c7 78 dd f9 bc 1a 49 cb -57 f9 b7 1b - -# Signature: -14 ae 35 d9 dd 06 ba 92 f7 f3 b8 97 97 8a ed 7c -d4 bf 5f f0 b5 85 a4 0b d4 6c e1 b4 2c d2 70 30 -53 bb 90 44 d6 4e 81 3d 8f 96 db 2d d7 00 7d 10 -11 8f 6f 8f 84 96 09 7a d7 5e 1f f6 92 34 1b 28 -92 ad 55 a6 33 a1 c5 5e 7f 0a 0a d5 9a 0e 20 3a -5b 82 78 ae c5 4d d8 62 2e 28 31 d8 71 74 f8 ca -ff 43 ee 6c 46 44 53 45 d8 4a 59 65 9b fb 92 ec -d4 c8 18 66 86 95 f3 47 06 f6 68 28 a8 99 59 63 -7f 2b f3 e3 25 1c 24 bd ba 4d 4b 76 49 da 00 22 -21 8b 11 9c 84 e7 9a 65 27 ec 5b 8a 5f 86 1c 15 -99 52 e2 3e c0 5e 1e 71 73 46 fa ef e8 b1 68 68 -25 bd 2b 26 2f b2 53 10 66 c0 de 09 ac de 2e 42 -31 69 07 28 b5 d8 5e 11 5a 2f 6b 92 b7 9c 25 ab -c9 bd 93 99 ff 8b cf 82 5a 52 ea 1f 56 ea 76 dd -26 f4 3b aa fa 18 bf a9 2a 50 4c bd 35 69 9e 26 -d1 dc c5 a2 88 73 85 f3 c6 32 32 f0 6f 32 44 c3 - -# --------------------------------- -# RSASSA-PSS Signature Example 10.3 -# --------------------------------- - -# Message to be signed: -48 b2 b6 a5 7a 63 c8 4c ea 85 9d 65 c6 68 28 4b -08 d9 6b dc aa be 25 2d b0 e4 a9 6c b1 ba c6 01 -93 41 db 6f be fb 8d 10 6b 0e 90 ed a6 bc c6 c6 -26 2f 37 e7 ea 9c 7e 5d 22 6b d7 df 85 ec 5e 71 -ef ff 2f 54 c5 db 57 7f f7 29 ff 91 b8 42 49 1d -e2 74 1d 0c 63 16 07 df 58 6b 90 5b 23 b9 1a f1 -3d a1 23 04 bf 83 ec a8 a7 3e 87 1f f9 db - -# Salt: -4e 96 fc 1b 39 8f 92 b4 46 71 01 0c 0d c3 ef d6 -e2 0c 2d 73 - -# Signature: -6e 3e 4d 7b 6b 15 d2 fb 46 01 3b 89 00 aa 5b bb -39 39 cf 2c 09 57 17 98 70 42 02 6e e6 2c 74 c5 -4c ff d5 d7 d5 7e fb bf 95 0a 0f 5c 57 4f a0 9d -3f c1 c9 f5 13 b0 5b 4f f5 0d d8 df 7e df a2 01 -02 85 4c 35 e5 92 18 01 19 a7 0c e5 b0 85 18 2a -a0 2d 9e a2 aa 90 d1 df 03 f2 da ae 88 5b a2 f5 -d0 5a fd ac 97 47 6f 06 b9 3b 5b c9 4a 1a 80 aa -91 16 c4 d6 15 f3 33 b0 98 89 2b 25 ff ac e2 66 -f5 db 5a 5a 3b cc 10 a8 24 ed 55 aa d3 5b 72 78 -34 fb 8c 07 da 28 fc f4 16 a5 d9 b2 22 4f 1f 8b -44 2b 36 f9 1e 45 6f de a2 d7 cf e3 36 72 68 de -03 07 a4 c7 4e 92 41 59 ed 33 39 3d 5e 06 55 53 -1c 77 32 7b 89 82 1b de df 88 01 61 c7 8c d4 19 -6b 54 19 f7 ac c3 f1 3e 5e bf 16 1b 6e 7c 67 24 -71 6c a3 3b 85 c2 e2 56 40 19 2a c2 85 96 51 d5 -0b de 7e b9 76 e5 1c ec 82 8b 98 b6 56 3b 86 bb - -# --------------------------------- -# RSASSA-PSS Signature Example 10.4 -# --------------------------------- - -# Message to be signed: -0b 87 77 c7 f8 39 ba f0 a6 4b bb db c5 ce 79 75 -5c 57 a2 05 b8 45 c1 74 e2 d2 e9 05 46 a0 89 c4 -e6 ec 8a df fa 23 a7 ea 97 ba e6 b6 5d 78 2b 82 -db 5d 2b 5a 56 d2 2a 29 a0 5e 7c 44 33 e2 b8 2a -62 1a bb a9 0a dd 05 ce 39 3f c4 8a 84 05 42 45 -1a - -# Salt: -c7 cd 69 8d 84 b6 51 28 d8 83 5e 3a 8b 1e b0 e0 -1c b5 41 ec - -# Signature: -34 04 7f f9 6c 4d c0 dc 90 b2 d4 ff 59 a1 a3 61 -a4 75 4b 25 5d 2e e0 af 7d 8b f8 7c 9b c9 e7 dd -ee de 33 93 4c 63 ca 1c 0e 3d 26 2c b1 45 ef 93 -2a 1f 2c 0a 99 7a a6 a3 4f 8e ae e7 47 7d 82 cc -f0 90 95 a6 b8 ac ad 38 d4 ee c9 fb 7e ab 7a d0 -2d a1 d1 1d 8e 54 c1 82 5e 55 bf 58 c2 a2 32 34 -b9 02 be 12 4f 9e 90 38 a8 f6 8f a4 5d ab 72 f6 -6e 09 45 bf 1d 8b ac c9 04 4c 6f 07 09 8c 9f ce -c5 8a 3a ab 10 0c 80 51 78 15 5f 03 0a 12 4c 45 -0e 5a cb da 47 d0 e4 f1 0b 80 a2 3f 80 3e 77 4d -02 3b 00 15 c2 0b 9f 9b be 7c 91 29 63 38 d5 ec -b4 71 ca fb 03 20 07 b6 7a 60 be 5f 69 50 4a 9f -01 ab b3 cb 46 7b 26 0e 2b ce 86 0b e8 d9 5b f9 -2c 0c 8e 14 96 ed 1e 52 85 93 a4 ab b6 df 46 2d -de 8a 09 68 df fe 46 83 11 68 57 a2 32 f5 eb f6 -c8 5b e2 38 74 5a d0 f3 8f 76 7a 5f db f4 86 fb - -# --------------------------------- -# RSASSA-PSS Signature Example 10.5 -# --------------------------------- - -# Message to be signed: -f1 03 6e 00 8e 71 e9 64 da dc 92 19 ed 30 e1 7f -06 b4 b6 8a 95 5c 16 b3 12 b1 ed df 02 8b 74 97 -6b ed 6b 3f 6a 63 d4 e7 78 59 24 3c 9c cc dc 98 -01 65 23 ab b0 24 83 b3 55 91 c3 3a ad 81 21 3b -b7 c7 bb 1a 47 0a ab c1 0d 44 25 6c 4d 45 59 d9 -16 - -# Salt: -ef a8 bf f9 62 12 b2 f4 a3 f3 71 a1 0d 57 41 52 -65 5f 5d fb - -# Signature: -7e 09 35 ea 18 f4 d6 c1 d1 7c e8 2e b2 b3 83 6c -55 b3 84 58 9c e1 9d fe 74 33 63 ac 99 48 d1 f3 -46 b7 bf dd fe 92 ef d7 8a db 21 fa ef c8 9a de -42 b1 0f 37 40 03 fe 12 2e 67 42 9a 1c b8 cb d1 -f8 d9 01 45 64 c4 4d 12 01 16 f4 99 0f 1a 6e 38 -77 4c 19 4b d1 b8 21 32 86 b0 77 b0 49 9d 2e 7b -3f 43 4a b1 22 89 c5 56 68 4d ee d7 81 31 93 4b -b3 dd 65 37 23 6f 7c 6f 3d cb 09 d4 76 be 07 72 -1e 37 e1 ce ed 9b 2f 7b 40 68 87 bd 53 15 73 05 -e1 c8 b4 f8 4d 73 3b c1 e1 86 fe 06 cc 59 b6 ed -b8 f4 bd 7f fe fd f4 f7 ba 9c fb 9d 57 06 89 b5 -a1 a4 10 9a 74 6a 69 08 93 db 37 99 25 5a 0c b9 -21 5d 2d 1c d4 90 59 0e 95 2e 8c 87 86 aa 00 11 -26 52 52 47 0c 04 1d fb c3 ee c7 c3 cb f7 1c 24 -86 9d 11 5c 0c b4 a9 56 f5 6d 53 0b 80 ab 58 9a -cf ef c6 90 75 1d df 36 e8 d3 83 f8 3c ed d2 cc - -# --------------------------------- -# RSASSA-PSS Signature Example 10.6 -# --------------------------------- - -# Message to be signed: -25 f1 08 95 a8 77 16 c1 37 45 0b b9 51 9d fa a1 -f2 07 fa a9 42 ea 88 ab f7 1e 9c 17 98 00 85 b5 -55 ae ba b7 62 64 ae 2a 3a b9 3c 2d 12 98 11 91 -dd ac 6f b5 94 9e b3 6a ee 3c 5d a9 40 f0 07 52 -c9 16 d9 46 08 fa 7d 97 ba 6a 29 15 b6 88 f2 03 -23 d4 e9 d9 68 01 d8 9a 72 ab 58 92 dc 21 17 c0 -74 34 fc f9 72 e0 58 cf 8c 41 ca 4b 4f f5 54 f7 -d5 06 8a d3 15 5f ce d0 f3 12 5b c0 4f 91 93 37 -8a 8f 5c 4c 3b 8c b4 dd 6d 1c c6 9d 30 ec ca 6e -aa 51 e3 6a 05 73 0e 9e 34 2e 85 5b af 09 9d ef -b8 af d7 - -# Salt: -ad 8b 15 23 70 36 46 22 4b 66 0b 55 08 85 91 7c -a2 d1 df 28 - -# Signature: -6d 3b 5b 87 f6 7e a6 57 af 21 f7 54 41 97 7d 21 -80 f9 1b 2c 5f 69 2d e8 29 55 69 6a 68 67 30 d9 -b9 77 8d 97 07 58 cc b2 60 71 c2 20 9f fb d6 12 -5b e2 e9 6e a8 1b 67 cb 9b 93 08 23 9f da 17 f7 -b2 b6 4e cd a0 96 b6 b9 35 64 0a 5a 1c b4 2a 91 -55 b1 c9 ef 7a 63 3a 02 c5 9f 0d 6e e5 9b 85 2c -43 b3 50 29 e7 3c 94 0f f0 41 0e 8f 11 4e ed 46 -bb d0 fa e1 65 e4 2b e2 52 8a 40 1c 3b 28 fd 81 -8e f3 23 2d ca 9f 4d 2a 0f 51 66 ec 59 c4 23 96 -d6 c1 1d bc 12 15 a5 6f a1 71 69 db 95 75 34 3e -f3 4f 9d e3 2a 49 cd c3 17 49 22 f2 29 c2 3e 18 -e4 5d f9 35 31 19 ec 43 19 ce dc e7 a1 7c 64 08 -8c 1f 6f 52 be 29 63 41 00 b3 91 9d 38 f3 d1 ed -94 e6 89 1e 66 a7 3b 8f b8 49 f5 87 4d f5 94 59 -e2 98 c7 bb ce 2e ee 78 2a 19 5a a6 6f e2 d0 73 -2b 25 e5 95 f5 7d 3e 06 1b 1f c3 e4 06 3b f9 8f - --} - -- ================================== -- Example 2: A 1025-bit RSA Key Pair -- ================================== From 1d5947f055c235494c41f0393f227858e3bc89a2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Tue, 15 Jan 2019 21:24:31 +0100 Subject: [PATCH 038/176] Use any instead of not all --- Crypto/PubKey/RSA/PSS.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Crypto/PubKey/RSA/PSS.hs b/Crypto/PubKey/RSA/PSS.hs index 2f6ddf3..a8336aa 100644 --- a/Crypto/PubKey/RSA/PSS.hs +++ b/Crypto/PubKey/RSA/PSS.hs @@ -166,7 +166,7 @@ verifyDigest params pk digest s | B.length s /= k = False | B.any (/= 0) pre = False | B.last em /= pssTrailerField params = False - | not (B.all (== 0) ps0) = False + | B.any (/= 0) ps0 = False | b1 /= B.singleton 1 = False | otherwise = B.eq h h' where -- parameters From 69ef95b0de5a7bf9f2d0936cc6cb550321f11431 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 19 Jan 2019 08:54:31 +0100 Subject: [PATCH 039/176] Use GHC 8.6.3 for CI and bump versions --- .haskell-ci | 4 ++-- .travis.yml | 6 +++--- stack.yaml | 4 ++-- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/.haskell-ci b/.haskell-ci index bb9bd3f..fc2947c 100644 --- a/.haskell-ci +++ b/.haskell-ci @@ -1,8 +1,8 @@ # compiler supported and their equivalent LTS compiler: ghc-8.0 lts-9.21 compiler: ghc-8.2 lts-11.22 -compiler: ghc-8.4 lts-12.15 -compiler: ghc-8.6 nightly-2018-10-21 +compiler: ghc-8.4 lts-12.26 +compiler: ghc-8.6 lts-13.3 # options # option: alias x=y z=v diff --git a/.travis.yml b/.travis.yml index e542406..eb4f365 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,4 +1,4 @@ -# ~*~ auto-generated by haskell-ci with config : c5de1915986b17c62e2a4cbe1fb7b3d47a6b1dc45a8f4d4fa78654695dfd1f43 ~*~ +# ~*~ auto-generated by haskell-ci with config : 8f74deffc95fd794fa2996c167c6543bbfab1ae432f0a83e0898f0b5871a92eb ~*~ # Use new container infrastructure to enable caching sudo: false @@ -61,11 +61,11 @@ script: stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; ghc-8.4) - echo "{ resolver: lts-12.15, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml + echo "{ resolver: lts-12.26, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; ghc-8.6) - echo "{ resolver: nightly-2018-10-21, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml + echo "{ resolver: lts-13.3, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; esac diff --git a/stack.yaml b/stack.yaml index bd5b3a6..946d1a4 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1,3 @@ -# ~*~ auto-generated by haskell-ci with config : c5de1915986b17c62e2a4cbe1fb7b3d47a6b1dc45a8f4d4fa78654695dfd1f43 ~*~ -{ resolver: lts-12.15, packages: [ '.' ], extra-deps: [], flags: {} } +# ~*~ auto-generated by haskell-ci with config : 8f74deffc95fd794fa2996c167c6543bbfab1ae432f0a83e0898f0b5871a92eb ~*~ +{ resolver: lts-12.26, packages: [ '.' ], extra-deps: [], flags: {} } From d5003a46a64e9b95a3ba2121e51f626cf39117a1 Mon Sep 17 00:00:00 2001 From: Crockett Date: Sat, 26 Jan 2019 15:15:34 -0800 Subject: [PATCH 040/176] Fixed hash truncation bug in DSA; added more KATs from RFC 6979. --- Crypto/PubKey/DSA.hs | 39 +++++-- tests/KAT_PubKey/DSA.hs | 234 ++++++++++++++++++++++++++++++++++++++-- 2 files changed, 259 insertions(+), 14 deletions(-) diff --git a/Crypto/PubKey/DSA.hs b/Crypto/PubKey/DSA.hs index 1b91598..82d41c9 100644 --- a/Crypto/PubKey/DSA.hs +++ b/Crypto/PubKey/DSA.hs @@ -29,17 +29,17 @@ module Crypto.PubKey.DSA ) where import Crypto.Random.Types -import Data.Bits (testBit) +import qualified Data.Bits as Bits (shiftL, (.|.), shiftR) import Data.Data import Data.Maybe import Crypto.Number.Basic (numBits) import Crypto.Number.ModArithmetic (expFast, expSafe, inverse) import Crypto.Number.Serialize import Crypto.Number.Generate -import Crypto.Internal.ByteArray (ByteArrayAccess(length), convert, index, dropView, takeView) +import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, ScrubbedBytes, convert, index, dropView, takeView, pack, unpack) import Crypto.Internal.Imports import Crypto.Hash -import Prelude hiding (length) +import Prelude -- | DSA Public Number, usually embedded in DSA Public Key type PublicNumber = Integer @@ -126,7 +126,7 @@ signWith k pk hashAlg msg x = private_x pk -- compute r,s kInv = fromJust $ inverse k q - hm = os2ip $ hashWith hashAlg msg + hm = dsaHash q hashAlg msg r = expSafe g k p `mod` q s = (kInv * (hm + x * r)) `mod` q @@ -148,11 +148,36 @@ verify hashAlg pk (Signature r s) m | otherwise = v == r where (Params p g q) = public_params pk y = public_y pk - hm = os2ip . truncateHash $ hashWith hashAlg m + hm = dsaHash q hashAlg m w = fromJust $ inverse s q u1 = (hm*w) `mod` q u2 = (r*w) `mod` q v = ((expFast g u1 p) * (expFast y u2 p)) `mod` p `mod` q - -- if the hash is larger than the size of q, truncate it; FIXME: deal with the case of a q not evenly divisible by 8 - truncateHash h = if numBits (os2ip h) > numBits q then takeView h (numBits q `div` 8) else dropView h 0 + +dsaHash :: (ByteArrayAccess msg, HashAlgorithm hash) => Integer -> hash -> msg -> Integer +dsaHash q hashAlg msg = + -- if the hash is larger than the size of q, truncate it; FIXME: deal with the case of a q not evenly divisible by 8 + let numDropBits = (hashDigestSize hashAlg)*8 - numBits q + rawHash = hashWith hashAlg msg + in case compare numDropBits 0 of + GT -> -- hash output is larger than modulus + let (nq,nr) = numDropBits `divMod` 8 + in if nr == 0 -- difference is 0 mod 8 => numBits is 0 `mod` 8 + then os2ip $ takeView rawHash $ (numBits q) `div` 8 + else os2ip $ shiftR rawHash numDropBits + _ -> os2ip rawHash + +-- shift right by a given number of bits, dropping full bytes of leading zeros +-- based on code from the `bits-bytestring` package +shiftR :: (ByteArrayAccess m) => m -> Int -> ScrubbedBytes +shiftR bs i = + let ws = unpack bs + in pack $ go 0 $ take (length ws - q) ws + where + (q,r) = i `divMod` 8 + go _ [] = [] + go w1 (w2:wst) = (maskR w1 w2) : go w2 wst + -- given [w1,w2], constructs w2', which is left by j bits to get the + -- bottom j bits of w1 || top (8-j) bits of w2 + maskR w1 w2 = (Bits.shiftL w1 (8-r)) Bits..|. (Bits.shiftR w2 r) \ No newline at end of file diff --git a/tests/KAT_PubKey/DSA.hs b/tests/KAT_PubKey/DSA.hs index c8ab483..9bb8ff7 100644 --- a/tests/KAT_PubKey/DSA.hs +++ b/tests/KAT_PubKey/DSA.hs @@ -106,7 +106,43 @@ vectorsSHA1 = , r = 0x8c2fab489c34672140415d41a65cef1e70192e23 , s = 0x3df86a9e2efe944a1c7ea9c30cac331d00599a0e , pgq = dsaParams - } + } + , VectorDSA -- 1024-bit example from RFC 6979 with SHA-1 + { msg = "sample" + , x = 0x411602CB19A6CCC34494D79D98EF1E7ED5AF25F7 + , y = 0x5DF5E01DED31D0297E274E1691C192FE5868FEF9E19A84776454B100CF16F65392195A38B90523E2542EE61871C0440CB87C322FC4B4D2EC5E1E7EC766E1BE8D4CE935437DC11C3C8FD426338933EBFE739CB3465F4D3668C5E473508253B1E682F65CBDC4FAE93C2EA212390E54905A86E2223170B44EAA7DA5DD9FFCFB7F3B + , k = 0x7BDB6B0FF756E1BB5D53583EF979082F9AD5BD5B + , r = 0x2E1A0C2562B2912CAAF89186FB0F42001585DA55 + , s = 0x29EFB6B0AFF2D7A68EB70CA313022253B9A88DF5 + , pgq = rfc6979Params1024 + } + , VectorDSA -- 1024-bit example from RFC 6979 with SHA-1 + { msg = "test" + , x = 0x411602CB19A6CCC34494D79D98EF1E7ED5AF25F7 + , y = 0x5DF5E01DED31D0297E274E1691C192FE5868FEF9E19A84776454B100CF16F65392195A38B90523E2542EE61871C0440CB87C322FC4B4D2EC5E1E7EC766E1BE8D4CE935437DC11C3C8FD426338933EBFE739CB3465F4D3668C5E473508253B1E682F65CBDC4FAE93C2EA212390E54905A86E2223170B44EAA7DA5DD9FFCFB7F3B + , k = 0x5C842DF4F9E344EE09F056838B42C7A17F4A6433 + , r = 0x42AB2052FD43E123F0607F115052A67DCD9C5C77 + , s = 0x183916B0230D45B9931491D4C6B0BD2FB4AAF088 + , pgq = rfc6979Params1024 + } + , VectorDSA -- 2048-bit example from RFC 6979 with SHA-1 + { msg = "sample" + , x = 0x69C7548C21D0DFEA6B9A51C9EAD4E27C33D3B3F180316E5BCAB92C933F0E4DBC + , y = 0x667098C654426C78D7F8201EAC6C203EF030D43605032C2F1FA937E5237DBD949F34A0A2564FE126DC8B715C5141802CE0979C8246463C40E6B6BDAA2513FA611728716C2E4FD53BC95B89E69949D96512E873B9C8F8DFD499CC312882561ADECB31F658E934C0C197F2C4D96B05CBAD67381E7B768891E4DA3843D24D94CDFB5126E9B8BF21E8358EE0E0A30EF13FD6A664C0DCE3731F7FB49A4845A4FD8254687972A2D382599C9BAC4E0ED7998193078913032558134976410B89D2C171D123AC35FD977219597AA7D15C1A9A428E59194F75C721EBCBCFAE44696A499AFA74E04299F132026601638CB87AB79190D4A0986315DA8EEC6561C938996BEADF + , k = 0x888FA6F7738A41BDC9846466ABDB8174C0338250AE50CE955CA16230F9CBD53E + , r = 0x3A1B2DBD7489D6ED7E608FD036C83AF396E290DBD602408E8677DAABD6E7445A + , s = 0xD26FCBA19FA3E3058FFC02CA1596CDBB6E0D20CB37B06054F7E36DED0CDBBCCF + , pgq = rfc6979Params2048 + } + , VectorDSA -- 2048-bit example from RFC 6979 with SHA-1 + { msg = "test" + , x = 0x69C7548C21D0DFEA6B9A51C9EAD4E27C33D3B3F180316E5BCAB92C933F0E4DBC + , y = 0x667098C654426C78D7F8201EAC6C203EF030D43605032C2F1FA937E5237DBD949F34A0A2564FE126DC8B715C5141802CE0979C8246463C40E6B6BDAA2513FA611728716C2E4FD53BC95B89E69949D96512E873B9C8F8DFD499CC312882561ADECB31F658E934C0C197F2C4D96B05CBAD67381E7B768891E4DA3843D24D94CDFB5126E9B8BF21E8358EE0E0A30EF13FD6A664C0DCE3731F7FB49A4845A4FD8254687972A2D382599C9BAC4E0ED7998193078913032558134976410B89D2C171D123AC35FD977219597AA7D15C1A9A428E59194F75C721EBCBCFAE44696A499AFA74E04299F132026601638CB87AB79190D4A0986315DA8EEC6561C938996BEADF + , k = 0x6EEA486F9D41A037B2C640BC5645694FF8FF4B98D066A25F76BE641CCB24BA4F + , r = 0xC18270A93CFC6063F57A4DFA86024F700D980E4CF4E2CB65A504397273D98EA0 + , s = 0x414F22E5F31A8B6D33295C7539C1C1BA3A6160D7D68D50AC0D3A5BEAC2884FAA + , pgq = rfc6979Params2048 + } ] where -- (p,g,q) dsaParams = DSA.Params @@ -115,6 +151,174 @@ vectorsSHA1 = , DSA.params_q = 0xf85f0f83ac4df7ea0cdf8f469bfeeaea14156495 } +vectorsSHA224 = + [ VectorDSA + { msg = "sample" + , x = 0x411602CB19A6CCC34494D79D98EF1E7ED5AF25F7 + , y = 0x5DF5E01DED31D0297E274E1691C192FE5868FEF9E19A84776454B100CF16F65392195A38B90523E2542EE61871C0440CB87C322FC4B4D2EC5E1E7EC766E1BE8D4CE935437DC11C3C8FD426338933EBFE739CB3465F4D3668C5E473508253B1E682F65CBDC4FAE93C2EA212390E54905A86E2223170B44EAA7DA5DD9FFCFB7F3B + , k = 0x562097C06782D60C3037BA7BE104774344687649 + , r = 0x4BC3B686AEA70145856814A6F1BB53346F02101E + , s = 0x410697B92295D994D21EDD2F4ADA85566F6F94C1 + , pgq = rfc6979Params1024 + } + , VectorDSA + { msg = "test" + , x = 0x411602CB19A6CCC34494D79D98EF1E7ED5AF25F7 + , y = 0x5DF5E01DED31D0297E274E1691C192FE5868FEF9E19A84776454B100CF16F65392195A38B90523E2542EE61871C0440CB87C322FC4B4D2EC5E1E7EC766E1BE8D4CE935437DC11C3C8FD426338933EBFE739CB3465F4D3668C5E473508253B1E682F65CBDC4FAE93C2EA212390E54905A86E2223170B44EAA7DA5DD9FFCFB7F3B + , k = 0x4598B8EFC1A53BC8AECD58D1ABBB0C0C71E67297 + , r = 0x6868E9964E36C1689F6037F91F28D5F2C30610F2 + , s = 0x49CEC3ACDC83018C5BD2674ECAAD35B8CD22940F + , pgq = rfc6979Params1024 + } + , VectorDSA + { msg = "sample" + , x = 0x69C7548C21D0DFEA6B9A51C9EAD4E27C33D3B3F180316E5BCAB92C933F0E4DBC + , y = 0x667098C654426C78D7F8201EAC6C203EF030D43605032C2F1FA937E5237DBD949F34A0A2564FE126DC8B715C5141802CE0979C8246463C40E6B6BDAA2513FA611728716C2E4FD53BC95B89E69949D96512E873B9C8F8DFD499CC312882561ADECB31F658E934C0C197F2C4D96B05CBAD67381E7B768891E4DA3843D24D94CDFB5126E9B8BF21E8358EE0E0A30EF13FD6A664C0DCE3731F7FB49A4845A4FD8254687972A2D382599C9BAC4E0ED7998193078913032558134976410B89D2C171D123AC35FD977219597AA7D15C1A9A428E59194F75C721EBCBCFAE44696A499AFA74E04299F132026601638CB87AB79190D4A0986315DA8EEC6561C938996BEADF + , k = 0xBC372967702082E1AA4FCE892209F71AE4AD25A6DFD869334E6F153BD0C4D806 + , r = 0xDC9F4DEADA8D8FF588E98FED0AB690FFCE858DC8C79376450EB6B76C24537E2C + , s = 0xA65A9C3BC7BABE286B195D5DA68616DA8D47FA0097F36DD19F517327DC848CEC + , pgq = rfc6979Params2048 + } + , VectorDSA + { msg = "test" + , x = 0x69C7548C21D0DFEA6B9A51C9EAD4E27C33D3B3F180316E5BCAB92C933F0E4DBC + , y = 0x667098C654426C78D7F8201EAC6C203EF030D43605032C2F1FA937E5237DBD949F34A0A2564FE126DC8B715C5141802CE0979C8246463C40E6B6BDAA2513FA611728716C2E4FD53BC95B89E69949D96512E873B9C8F8DFD499CC312882561ADECB31F658E934C0C197F2C4D96B05CBAD67381E7B768891E4DA3843D24D94CDFB5126E9B8BF21E8358EE0E0A30EF13FD6A664C0DCE3731F7FB49A4845A4FD8254687972A2D382599C9BAC4E0ED7998193078913032558134976410B89D2C171D123AC35FD977219597AA7D15C1A9A428E59194F75C721EBCBCFAE44696A499AFA74E04299F132026601638CB87AB79190D4A0986315DA8EEC6561C938996BEADF + , k = 0x06BD4C05ED74719106223BE33F2D95DA6B3B541DAD7BFBD7AC508213B6DA6670 + , r = 0x272ABA31572F6CC55E30BF616B7A265312018DD325BE031BE0CC82AA17870EA3 + , s = 0xE9CC286A52CCE201586722D36D1E917EB96A4EBDB47932F9576AC645B3A60806 + , pgq = rfc6979Params2048 + } + ] + +vectorsSHA256 = + [ VectorDSA + { msg = "sample" + , x = 0x411602CB19A6CCC34494D79D98EF1E7ED5AF25F7 + , y = 0x5DF5E01DED31D0297E274E1691C192FE5868FEF9E19A84776454B100CF16F65392195A38B90523E2542EE61871C0440CB87C322FC4B4D2EC5E1E7EC766E1BE8D4CE935437DC11C3C8FD426338933EBFE739CB3465F4D3668C5E473508253B1E682F65CBDC4FAE93C2EA212390E54905A86E2223170B44EAA7DA5DD9FFCFB7F3B + , k = 0x519BA0546D0C39202A7D34D7DFA5E760B318BCFB + , r = 0x81F2F5850BE5BC123C43F71A3033E9384611C545 + , s = 0x4CDD914B65EB6C66A8AAAD27299BEE6B035F5E89 + , pgq = rfc6979Params1024 + } + , VectorDSA + { msg = "test" + , x = 0x411602CB19A6CCC34494D79D98EF1E7ED5AF25F7 + , y = 0x5DF5E01DED31D0297E274E1691C192FE5868FEF9E19A84776454B100CF16F65392195A38B90523E2542EE61871C0440CB87C322FC4B4D2EC5E1E7EC766E1BE8D4CE935437DC11C3C8FD426338933EBFE739CB3465F4D3668C5E473508253B1E682F65CBDC4FAE93C2EA212390E54905A86E2223170B44EAA7DA5DD9FFCFB7F3B + , k = 0x5A67592E8128E03A417B0484410FB72C0B630E1A + , r = 0x22518C127299B0F6FDC9872B282B9E70D0790812 + , s = 0x6837EC18F150D55DE95B5E29BE7AF5D01E4FE160 + , pgq = rfc6979Params1024 + } + , VectorDSA + { msg = "sample" + , x = 0x69C7548C21D0DFEA6B9A51C9EAD4E27C33D3B3F180316E5BCAB92C933F0E4DBC + , y = 0x667098C654426C78D7F8201EAC6C203EF030D43605032C2F1FA937E5237DBD949F34A0A2564FE126DC8B715C5141802CE0979C8246463C40E6B6BDAA2513FA611728716C2E4FD53BC95B89E69949D96512E873B9C8F8DFD499CC312882561ADECB31F658E934C0C197F2C4D96B05CBAD67381E7B768891E4DA3843D24D94CDFB5126E9B8BF21E8358EE0E0A30EF13FD6A664C0DCE3731F7FB49A4845A4FD8254687972A2D382599C9BAC4E0ED7998193078913032558134976410B89D2C171D123AC35FD977219597AA7D15C1A9A428E59194F75C721EBCBCFAE44696A499AFA74E04299F132026601638CB87AB79190D4A0986315DA8EEC6561C938996BEADF + , k = 0x8926A27C40484216F052F4427CFD5647338B7B3939BC6573AF4333569D597C52 + , r = 0xEACE8BDBBE353C432A795D9EC556C6D021F7A03F42C36E9BC87E4AC7932CC809 + , s = 0x7081E175455F9247B812B74583E9E94F9EA79BD640DC962533B0680793A38D53 + , pgq = rfc6979Params2048 + } + , VectorDSA + { msg = "test" + , x = 0x69C7548C21D0DFEA6B9A51C9EAD4E27C33D3B3F180316E5BCAB92C933F0E4DBC + , y = 0x667098C654426C78D7F8201EAC6C203EF030D43605032C2F1FA937E5237DBD949F34A0A2564FE126DC8B715C5141802CE0979C8246463C40E6B6BDAA2513FA611728716C2E4FD53BC95B89E69949D96512E873B9C8F8DFD499CC312882561ADECB31F658E934C0C197F2C4D96B05CBAD67381E7B768891E4DA3843D24D94CDFB5126E9B8BF21E8358EE0E0A30EF13FD6A664C0DCE3731F7FB49A4845A4FD8254687972A2D382599C9BAC4E0ED7998193078913032558134976410B89D2C171D123AC35FD977219597AA7D15C1A9A428E59194F75C721EBCBCFAE44696A499AFA74E04299F132026601638CB87AB79190D4A0986315DA8EEC6561C938996BEADF + , k = 0x1D6CE6DDA1C5D37307839CD03AB0A5CBB18E60D800937D67DFB4479AAC8DEAD7 + , r = 0x8190012A1969F9957D56FCCAAD223186F423398D58EF5B3CEFD5A4146A4476F0 + , s = 0x7452A53F7075D417B4B013B278D1BB8BBD21863F5E7B1CEE679CF2188E1AB19E + , pgq = rfc6979Params2048 + } + ] + +vectorsSHA384 = + [ VectorDSA + { msg = "sample" + , x = 0x411602CB19A6CCC34494D79D98EF1E7ED5AF25F7 + , y = 0x5DF5E01DED31D0297E274E1691C192FE5868FEF9E19A84776454B100CF16F65392195A38B90523E2542EE61871C0440CB87C322FC4B4D2EC5E1E7EC766E1BE8D4CE935437DC11C3C8FD426338933EBFE739CB3465F4D3668C5E473508253B1E682F65CBDC4FAE93C2EA212390E54905A86E2223170B44EAA7DA5DD9FFCFB7F3B + , k = 0x95897CD7BBB944AA932DBC579C1C09EB6FCFC595 + , r = 0x07F2108557EE0E3921BC1774F1CA9B410B4CE65A + , s = 0x54DF70456C86FAC10FAB47C1949AB83F2C6F7595 + , pgq = rfc6979Params1024 + } + , VectorDSA + { msg = "test" + , x = 0x411602CB19A6CCC34494D79D98EF1E7ED5AF25F7 + , y = 0x5DF5E01DED31D0297E274E1691C192FE5868FEF9E19A84776454B100CF16F65392195A38B90523E2542EE61871C0440CB87C322FC4B4D2EC5E1E7EC766E1BE8D4CE935437DC11C3C8FD426338933EBFE739CB3465F4D3668C5E473508253B1E682F65CBDC4FAE93C2EA212390E54905A86E2223170B44EAA7DA5DD9FFCFB7F3B + , k = 0x220156B761F6CA5E6C9F1B9CF9C24BE25F98CD89 + , r = 0x854CF929B58D73C3CBFDC421E8D5430CD6DB5E66 + , s = 0x91D0E0F53E22F898D158380676A871A157CDA622 + , pgq = rfc6979Params1024 + } + , VectorDSA + { msg = "sample" + , x = 0x69C7548C21D0DFEA6B9A51C9EAD4E27C33D3B3F180316E5BCAB92C933F0E4DBC + , y = 0x667098C654426C78D7F8201EAC6C203EF030D43605032C2F1FA937E5237DBD949F34A0A2564FE126DC8B715C5141802CE0979C8246463C40E6B6BDAA2513FA611728716C2E4FD53BC95B89E69949D96512E873B9C8F8DFD499CC312882561ADECB31F658E934C0C197F2C4D96B05CBAD67381E7B768891E4DA3843D24D94CDFB5126E9B8BF21E8358EE0E0A30EF13FD6A664C0DCE3731F7FB49A4845A4FD8254687972A2D382599C9BAC4E0ED7998193078913032558134976410B89D2C171D123AC35FD977219597AA7D15C1A9A428E59194F75C721EBCBCFAE44696A499AFA74E04299F132026601638CB87AB79190D4A0986315DA8EEC6561C938996BEADF + , k = 0xC345D5AB3DA0A5BCB7EC8F8FB7A7E96069E03B206371EF7D83E39068EC564920 + , r = 0xB2DA945E91858834FD9BF616EBAC151EDBC4B45D27D0DD4A7F6A22739F45C00B + , s = 0x19048B63D9FD6BCA1D9BAE3664E1BCB97F7276C306130969F63F38FA8319021B + , pgq = rfc6979Params2048 + } + , VectorDSA + { msg = "test" + , x = 0x69C7548C21D0DFEA6B9A51C9EAD4E27C33D3B3F180316E5BCAB92C933F0E4DBC + , y = 0x667098C654426C78D7F8201EAC6C203EF030D43605032C2F1FA937E5237DBD949F34A0A2564FE126DC8B715C5141802CE0979C8246463C40E6B6BDAA2513FA611728716C2E4FD53BC95B89E69949D96512E873B9C8F8DFD499CC312882561ADECB31F658E934C0C197F2C4D96B05CBAD67381E7B768891E4DA3843D24D94CDFB5126E9B8BF21E8358EE0E0A30EF13FD6A664C0DCE3731F7FB49A4845A4FD8254687972A2D382599C9BAC4E0ED7998193078913032558134976410B89D2C171D123AC35FD977219597AA7D15C1A9A428E59194F75C721EBCBCFAE44696A499AFA74E04299F132026601638CB87AB79190D4A0986315DA8EEC6561C938996BEADF + , k = 0x206E61F73DBE1B2DC8BE736B22B079E9DACD974DB00EEBBC5B64CAD39CF9F91C + , r = 0x239E66DDBE8F8C230A3D071D601B6FFBDFB5901F94D444C6AF56F732BEB954BE + , s = 0x6BD737513D5E72FE85D1C750E0F73921FE299B945AAD1C802F15C26A43D34961 + , pgq = rfc6979Params2048 + } + ] + +vectorsSHA512 = + [ VectorDSA + { msg = "sample" + , x = 0x411602CB19A6CCC34494D79D98EF1E7ED5AF25F7 + , y = 0x5DF5E01DED31D0297E274E1691C192FE5868FEF9E19A84776454B100CF16F65392195A38B90523E2542EE61871C0440CB87C322FC4B4D2EC5E1E7EC766E1BE8D4CE935437DC11C3C8FD426338933EBFE739CB3465F4D3668C5E473508253B1E682F65CBDC4FAE93C2EA212390E54905A86E2223170B44EAA7DA5DD9FFCFB7F3B + , k = 0x09ECE7CA27D0F5A4DD4E556C9DF1D21D28104F8B + , r = 0x16C3491F9B8C3FBBDD5E7A7B667057F0D8EE8E1B + , s = 0x02C36A127A7B89EDBB72E4FFBC71DABC7D4FC69C + , pgq = rfc6979Params1024 + } + , VectorDSA + { msg = "test" + , x = 0x411602CB19A6CCC34494D79D98EF1E7ED5AF25F7 + , y = 0x5DF5E01DED31D0297E274E1691C192FE5868FEF9E19A84776454B100CF16F65392195A38B90523E2542EE61871C0440CB87C322FC4B4D2EC5E1E7EC766E1BE8D4CE935437DC11C3C8FD426338933EBFE739CB3465F4D3668C5E473508253B1E682F65CBDC4FAE93C2EA212390E54905A86E2223170B44EAA7DA5DD9FFCFB7F3B + , k = 0x65D2C2EEB175E370F28C75BFCDC028D22C7DBE9C + , r = 0x8EA47E475BA8AC6F2D821DA3BD212D11A3DEB9A0 + , s = 0x7C670C7AD72B6C050C109E1790008097125433E8 + , pgq = rfc6979Params1024 + } + , VectorDSA + { msg = "sample" + , x = 0x69C7548C21D0DFEA6B9A51C9EAD4E27C33D3B3F180316E5BCAB92C933F0E4DBC + , y = 0x667098C654426C78D7F8201EAC6C203EF030D43605032C2F1FA937E5237DBD949F34A0A2564FE126DC8B715C5141802CE0979C8246463C40E6B6BDAA2513FA611728716C2E4FD53BC95B89E69949D96512E873B9C8F8DFD499CC312882561ADECB31F658E934C0C197F2C4D96B05CBAD67381E7B768891E4DA3843D24D94CDFB5126E9B8BF21E8358EE0E0A30EF13FD6A664C0DCE3731F7FB49A4845A4FD8254687972A2D382599C9BAC4E0ED7998193078913032558134976410B89D2C171D123AC35FD977219597AA7D15C1A9A428E59194F75C721EBCBCFAE44696A499AFA74E04299F132026601638CB87AB79190D4A0986315DA8EEC6561C938996BEADF + , k = 0x5A12994431785485B3F5F067221517791B85A597B7A9436995C89ED0374668FC + , r = 0x2016ED092DC5FB669B8EFB3D1F31A91EECB199879BE0CF78F02BA062CB4C942E + , s = 0xD0C76F84B5F091E141572A639A4FB8C230807EEA7D55C8A154A224400AFF2351 + , pgq = rfc6979Params2048 + } + , VectorDSA + { msg = "test" + , x = 0x69C7548C21D0DFEA6B9A51C9EAD4E27C33D3B3F180316E5BCAB92C933F0E4DBC + , y = 0x667098C654426C78D7F8201EAC6C203EF030D43605032C2F1FA937E5237DBD949F34A0A2564FE126DC8B715C5141802CE0979C8246463C40E6B6BDAA2513FA611728716C2E4FD53BC95B89E69949D96512E873B9C8F8DFD499CC312882561ADECB31F658E934C0C197F2C4D96B05CBAD67381E7B768891E4DA3843D24D94CDFB5126E9B8BF21E8358EE0E0A30EF13FD6A664C0DCE3731F7FB49A4845A4FD8254687972A2D382599C9BAC4E0ED7998193078913032558134976410B89D2C171D123AC35FD977219597AA7D15C1A9A428E59194F75C721EBCBCFAE44696A499AFA74E04299F132026601638CB87AB79190D4A0986315DA8EEC6561C938996BEADF + , k = 0xAFF1651E4CD6036D57AA8B2A05CCF1A9D5A40166340ECBBDC55BE10B568AA0AA + , r = 0x89EC4BB1400ECCFF8E7D9AA515CD1DE7803F2DAFF09693EE7FD1353E90A68307 + , s = 0xC9F0BDABCC0D880BB137A994CC7F3980CE91CC10FAF529FC46565B15CEA854E1 + , pgq = rfc6979Params2048 + } + ] + +rfc6979Params1024 = DSA.Params + { DSA.params_p = 0x86F5CA03DCFEB225063FF830A0C769B9DD9D6153AD91D7CE27F787C43278B447E6533B86B18BED6E8A48B784A14C252C5BE0DBF60B86D6385BD2F12FB763ED8873ABFD3F5BA2E0A8C0A59082EAC056935E529DAF7C610467899C77ADEDFC846C881870B7B19B2B58F9BE0521A17002E3BDD6B86685EE90B3D9A1B02B782B1779 + , DSA.params_g = 0x07B0F92546150B62514BB771E2A0C0CE387F03BDA6C56B505209FF25FD3C133D89BBCD97E904E09114D9A7DEFDEADFC9078EA544D2E401AEECC40BB9FBBF78FD87995A10A1C27CB7789B594BA7EFB5C4326A9FE59A070E136DB77175464ADCA417BE5DCE2F40D10A46A3A3943F26AB7FD9C0398FF8C76EE0A56826A8A88F1DBD + , DSA.params_q = 0x996F967F6C8E388D9E28D01E205FBA957A5698B1 + } + +rfc6979Params2048 = DSA.Params + { DSA.params_p = 0x9DB6FB5951B66BB6FE1E140F1D2CE5502374161FD6538DF1648218642F0B5C48C8F7A41AADFA187324B87674FA1822B00F1ECF8136943D7C55757264E5A1A44FFE012E9936E00C1D3E9310B01C7D179805D3058B2A9F4BB6F9716BFE6117C6B5B3CC4D9BE341104AD4A80AD6C94E005F4B993E14F091EB51743BF33050C38DE235567E1B34C3D6A5C0CEAA1A0F368213C3D19843D0B4B09DCB9FC72D39C8DE41F1BF14D4BB4563CA28371621CAD3324B6A2D392145BEBFAC748805236F5CA2FE92B871CD8F9C36D3292B5509CA8CAA77A2ADFC7BFD77DDA6F71125A7456FEA153E433256A2261C6A06ED3693797E7995FAD5AABBCFBE3EDA2741E375404AE25B + , DSA.params_g = 0x5C7FF6B06F8F143FE8288433493E4769C4D988ACE5BE25A0E24809670716C613D7B0CEE6932F8FAA7C44D2CB24523DA53FBE4F6EC3595892D1AA58C4328A06C46A15662E7EAA703A1DECF8BBB2D05DBE2EB956C142A338661D10461C0D135472085057F3494309FFA73C611F78B32ADBB5740C361C9F35BE90997DB2014E2EF5AA61782F52ABEB8BD6432C4DD097BC5423B285DAFB60DC364E8161F4A2A35ACA3A10B1C4D203CC76A470A33AFDCBDD92959859ABD8B56E1725252D78EAC66E71BA9AE3F1DD2487199874393CD4D832186800654760E1E34C09E4D155179F9EC0DC4473F996BDCE6EED1CABED8B6F116F7AD9CF505DF0F998E34AB27514B0FFE7 + , DSA.params_q = 0xF2C3119374CE76C9356990B465374A17F23F9ED35089BD969F61C6DDE9998C1F + } + vectorToPrivate :: VectorDSA -> DSA.PrivateKey vectorToPrivate vector = DSA.PrivateKey { DSA.private_x = x vector @@ -127,16 +331,32 @@ vectorToPublic vector = DSA.PublicKey , DSA.public_params = pgq vector } -doSignatureTest (i, vector) = testCase (show i) (expected @=? actual) +doSignatureTest hashAlg (i, vector) = testCase (show i) (expected @=? actual) where expected = Just $ DSA.Signature (r vector) (s vector) - actual = DSA.signWith (k vector) (vectorToPrivate vector) SHA1 (msg vector) + actual = DSA.signWith (k vector) (vectorToPrivate vector) hashAlg (msg vector) -doVerifyTest (i, vector) = testCase (show i) (True @=? actual) - where actual = DSA.verify SHA1 (vectorToPublic vector) (DSA.Signature (r vector) (s vector)) (msg vector) +doVerifyTest hashAlg (i, vector) = testCase (show i) (True @=? actual) + where actual = DSA.verify hashAlg (vectorToPublic vector) (DSA.Signature (r vector) (s vector)) (msg vector) dsaTests = testGroup "DSA" [ testGroup "SHA1" - [ testGroup "signature" $ map doSignatureTest (zip [katZero..] vectorsSHA1) - , testGroup "verify" $ map doVerifyTest (zip [katZero..] vectorsSHA1) + [ testGroup "signature" $ map (doSignatureTest SHA1) (zip [katZero..] vectorsSHA1) + , testGroup "verify" $ map (doVerifyTest SHA1) (zip [katZero..] vectorsSHA1) + ] + , testGroup "SHA224" + [ testGroup "signature" $ map (doSignatureTest SHA224) (zip [katZero..] vectorsSHA224) + , testGroup "verify" $ map (doVerifyTest SHA224) (zip [katZero..] vectorsSHA224) + ] + , testGroup "SHA256" + [ testGroup "signature" $ map (doSignatureTest SHA256) (zip [katZero..] vectorsSHA256) + , testGroup "verify" $ map (doVerifyTest SHA256) (zip [katZero..] vectorsSHA256) + ] + , testGroup "SHA384" + [ testGroup "signature" $ map (doSignatureTest SHA384) (zip [katZero..] vectorsSHA384) + , testGroup "verify" $ map (doVerifyTest SHA384) (zip [katZero..] vectorsSHA384) + ] + , testGroup "SHA512" + [ testGroup "signature" $ map (doSignatureTest SHA512) (zip [katZero..] vectorsSHA512) + , testGroup "verify" $ map (doVerifyTest SHA512) (zip [katZero..] vectorsSHA512) ] ] From c71a6733dd944ec213a888ef1a04cc2f28ae692a Mon Sep 17 00:00:00 2001 From: Crockett Date: Sun, 3 Feb 2019 13:30:56 -0800 Subject: [PATCH 041/176] Unified DSA and ECDSA truncate&hash function. --- Crypto/PubKey/DSA.hs | 33 +++------------------------------ Crypto/PubKey/ECC/ECDSA.hs | 13 +++---------- Crypto/PubKey/Internal.hs | 9 +++++++++ 3 files changed, 15 insertions(+), 40 deletions(-) diff --git a/Crypto/PubKey/DSA.hs b/Crypto/PubKey/DSA.hs index 82d41c9..2bb7ac3 100644 --- a/Crypto/PubKey/DSA.hs +++ b/Crypto/PubKey/DSA.hs @@ -39,6 +39,7 @@ import Crypto.Number.Generate import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, ScrubbedBytes, convert, index, dropView, takeView, pack, unpack) import Crypto.Internal.Imports import Crypto.Hash +import Crypto.PubKey.Internal (dsaTruncHash) import Prelude -- | DSA Public Number, usually embedded in DSA Public Key @@ -126,7 +127,7 @@ signWith k pk hashAlg msg x = private_x pk -- compute r,s kInv = fromJust $ inverse k q - hm = dsaHash q hashAlg msg + hm = dsaTruncHash hashAlg msg q r = expSafe g k p `mod` q s = (kInv * (hm + x * r)) `mod` q @@ -148,36 +149,8 @@ verify hashAlg pk (Signature r s) m | otherwise = v == r where (Params p g q) = public_params pk y = public_y pk - hm = dsaHash q hashAlg m - + hm = dsaTruncHash hashAlg m q w = fromJust $ inverse s q u1 = (hm*w) `mod` q u2 = (r*w) `mod` q v = ((expFast g u1 p) * (expFast y u2 p)) `mod` p `mod` q - -dsaHash :: (ByteArrayAccess msg, HashAlgorithm hash) => Integer -> hash -> msg -> Integer -dsaHash q hashAlg msg = - -- if the hash is larger than the size of q, truncate it; FIXME: deal with the case of a q not evenly divisible by 8 - let numDropBits = (hashDigestSize hashAlg)*8 - numBits q - rawHash = hashWith hashAlg msg - in case compare numDropBits 0 of - GT -> -- hash output is larger than modulus - let (nq,nr) = numDropBits `divMod` 8 - in if nr == 0 -- difference is 0 mod 8 => numBits is 0 `mod` 8 - then os2ip $ takeView rawHash $ (numBits q) `div` 8 - else os2ip $ shiftR rawHash numDropBits - _ -> os2ip rawHash - --- shift right by a given number of bits, dropping full bytes of leading zeros --- based on code from the `bits-bytestring` package -shiftR :: (ByteArrayAccess m) => m -> Int -> ScrubbedBytes -shiftR bs i = - let ws = unpack bs - in pack $ go 0 $ take (length ws - q) ws - where - (q,r) = i `divMod` 8 - go _ [] = [] - go w1 (w2:wst) = (maskR w1 w2) : go w2 wst - -- given [w1,w2], constructs w2', which is left by j bits to get the - -- bottom j bits of w1 || top (8-j) bits of w2 - maskR w1 w2 = (Bits.shiftL w1 (8-r)) Bits..|. (Bits.shiftR w2 r) \ No newline at end of file diff --git a/Crypto/PubKey/ECC/ECDSA.hs b/Crypto/PubKey/ECC/ECDSA.hs index bb12ce7..fb03a52 100644 --- a/Crypto/PubKey/ECC/ECDSA.hs +++ b/Crypto/PubKey/ECC/ECDSA.hs @@ -26,6 +26,7 @@ import Crypto.Number.Serialize import Crypto.Number.Generate import Crypto.PubKey.ECC.Types import Crypto.PubKey.ECC.Prim +import Crypto.PubKey.Internal (dsaTruncHash) import Crypto.Hash import Crypto.Hash.Types (hashDigestSize) @@ -69,7 +70,7 @@ signWith :: (ByteArrayAccess msg, HashAlgorithm hash) -> msg -- ^ message to sign -> Maybe Signature signWith k (PrivateKey curve d) hashAlg msg = do - let z = tHash hashAlg msg n + let z = dsaTruncHash hashAlg msg n CurveCommon _ _ g n _ = common_curve curve let point = pointMul curve k g r <- case point of @@ -99,7 +100,7 @@ verify hashAlg pk@(PublicKey curve q) (Signature r s) msg | r < 1 || r >= n || s < 1 || s >= n = False | otherwise = maybe False (r ==) $ do w <- inverse s n - let z = tHash hashAlg msg n + let z = dsaTruncHash hashAlg msg n u1 = z * w `mod` n u2 = r * w `mod` n x = pointAddTwoMuls curve u1 g u2 q @@ -109,11 +110,3 @@ verify hashAlg pk@(PublicKey curve q) (Signature r s) msg where n = ecc_n cc g = ecc_g cc cc = common_curve $ public_curve pk - --- | Truncate and hash. -tHash :: (ByteArrayAccess msg, HashAlgorithm hash) => hash -> msg -> Integer -> Integer -tHash hashAlg m n - | d > 0 = shiftR e d - | otherwise = e - where e = os2ip $ hashWith hashAlg m - d = hashDigestSize hashAlg * 8 - numBits n diff --git a/Crypto/PubKey/Internal.hs b/Crypto/PubKey/Internal.hs index d0be813..945f1f0 100644 --- a/Crypto/PubKey/Internal.hs +++ b/Crypto/PubKey/Internal.hs @@ -8,6 +8,7 @@ module Crypto.PubKey.Internal ( and' , (&&!) + , dsaTruncHash ) where import Data.List (foldl') @@ -22,3 +23,11 @@ True &&! True = True True &&! False = False False &&! True = False False &&! False = False + +-- | Truncate and hash for DSA and ECDSA. +dsaTruncHash :: (ByteArrayAccess msg, HashAlgorithm hash) => hash -> msg -> Integer -> Integer +dsaTruncHash hashAlg m n + | d > 0 = shiftR e d + | otherwise = e + where e = os2ip $ hashWith hashAlg m + d = hashDigestSize hashAlg * 8 - numBits n From 109600cec24e592198cbebbe3d7ad3035ba177e5 Mon Sep 17 00:00:00 2001 From: Crockett Date: Sun, 3 Feb 2019 13:43:54 -0800 Subject: [PATCH 042/176] Added missing imports and removed duplicate imports. Tests pass. --- Crypto/PubKey/DSA.hs | 5 +---- Crypto/PubKey/ECC/ECDSA.hs | 10 +++------- Crypto/PubKey/Internal.hs | 5 +++++ 3 files changed, 9 insertions(+), 11 deletions(-) diff --git a/Crypto/PubKey/DSA.hs b/Crypto/PubKey/DSA.hs index 2bb7ac3..b23df98 100644 --- a/Crypto/PubKey/DSA.hs +++ b/Crypto/PubKey/DSA.hs @@ -29,14 +29,11 @@ module Crypto.PubKey.DSA ) where import Crypto.Random.Types -import qualified Data.Bits as Bits (shiftL, (.|.), shiftR) import Data.Data import Data.Maybe -import Crypto.Number.Basic (numBits) import Crypto.Number.ModArithmetic (expFast, expSafe, inverse) -import Crypto.Number.Serialize import Crypto.Number.Generate -import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, ScrubbedBytes, convert, index, dropView, takeView, pack, unpack) +import Crypto.Internal.ByteArray (ByteArrayAccess) import Crypto.Internal.Imports import Crypto.Hash import Crypto.PubKey.Internal (dsaTruncHash) diff --git a/Crypto/PubKey/ECC/ECDSA.hs b/Crypto/PubKey/ECC/ECDSA.hs index fb03a52..3dab3dd 100644 --- a/Crypto/PubKey/ECC/ECDSA.hs +++ b/Crypto/PubKey/ECC/ECDSA.hs @@ -16,19 +16,15 @@ module Crypto.PubKey.ECC.ECDSA ) where import Control.Monad -import Crypto.Random.Types -import Data.Bits (shiftR) +import Crypto.Hash import Crypto.Internal.ByteArray (ByteArrayAccess) -import Data.Data -import Crypto.Number.Basic (numBits) import Crypto.Number.ModArithmetic (inverse) -import Crypto.Number.Serialize import Crypto.Number.Generate import Crypto.PubKey.ECC.Types import Crypto.PubKey.ECC.Prim import Crypto.PubKey.Internal (dsaTruncHash) -import Crypto.Hash -import Crypto.Hash.Types (hashDigestSize) +import Crypto.Random.Types +import Data.Data -- | Represent a ECDSA signature namely R and S. data Signature = Signature diff --git a/Crypto/PubKey/Internal.hs b/Crypto/PubKey/Internal.hs index 945f1f0..a1dd8b9 100644 --- a/Crypto/PubKey/Internal.hs +++ b/Crypto/PubKey/Internal.hs @@ -11,6 +11,11 @@ module Crypto.PubKey.Internal , dsaTruncHash ) where +import Crypto.Hash +import Crypto.Internal.ByteArray (ByteArrayAccess) +import Crypto.Number.Basic (numBits) +import Crypto.Number.Serialize +import Data.Bits (shiftR) import Data.List (foldl') -- | This is a strict version of and From 88596509f09e89c2a07d7a42df1c261427e8ba53 Mon Sep 17 00:00:00 2001 From: Crockett Date: Sun, 3 Feb 2019 13:51:01 -0800 Subject: [PATCH 043/176] Changed imports to match style of rest of library --- Crypto/PubKey/DSA.hs | 21 +++++++++++---------- Crypto/PubKey/ECC/ECDSA.hs | 3 ++- Crypto/PubKey/Internal.hs | 5 +++-- 3 files changed, 16 insertions(+), 13 deletions(-) diff --git a/Crypto/PubKey/DSA.hs b/Crypto/PubKey/DSA.hs index b23df98..35fbf37 100644 --- a/Crypto/PubKey/DSA.hs +++ b/Crypto/PubKey/DSA.hs @@ -28,16 +28,17 @@ module Crypto.PubKey.DSA , toPrivateKey ) where -import Crypto.Random.Types -import Data.Data -import Data.Maybe -import Crypto.Number.ModArithmetic (expFast, expSafe, inverse) -import Crypto.Number.Generate -import Crypto.Internal.ByteArray (ByteArrayAccess) -import Crypto.Internal.Imports -import Crypto.Hash -import Crypto.PubKey.Internal (dsaTruncHash) -import Prelude + +import Data.Data +import Data.Maybe + +import Crypto.Number.ModArithmetic (expFast, expSafe, inverse) +import Crypto.Number.Generate +import Crypto.Internal.ByteArray (ByteArrayAccess) +import Crypto.Internal.Imports +import Crypto.Hash +import Crypto.PubKey.Internal (dsaTruncHash) +import Crypto.Random.Types -- | DSA Public Number, usually embedded in DSA Public Key type PublicNumber = Integer diff --git a/Crypto/PubKey/ECC/ECDSA.hs b/Crypto/PubKey/ECC/ECDSA.hs index 3dab3dd..6c51242 100644 --- a/Crypto/PubKey/ECC/ECDSA.hs +++ b/Crypto/PubKey/ECC/ECDSA.hs @@ -16,6 +16,8 @@ module Crypto.PubKey.ECC.ECDSA ) where import Control.Monad +import Data.Data + import Crypto.Hash import Crypto.Internal.ByteArray (ByteArrayAccess) import Crypto.Number.ModArithmetic (inverse) @@ -24,7 +26,6 @@ import Crypto.PubKey.ECC.Types import Crypto.PubKey.ECC.Prim import Crypto.PubKey.Internal (dsaTruncHash) import Crypto.Random.Types -import Data.Data -- | Represent a ECDSA signature namely R and S. data Signature = Signature diff --git a/Crypto/PubKey/Internal.hs b/Crypto/PubKey/Internal.hs index a1dd8b9..b1631cc 100644 --- a/Crypto/PubKey/Internal.hs +++ b/Crypto/PubKey/Internal.hs @@ -11,12 +11,13 @@ module Crypto.PubKey.Internal , dsaTruncHash ) where +import Data.Bits (shiftR) +import Data.List (foldl') + import Crypto.Hash import Crypto.Internal.ByteArray (ByteArrayAccess) import Crypto.Number.Basic (numBits) import Crypto.Number.Serialize -import Data.Bits (shiftR) -import Data.List (foldl') -- | This is a strict version of and and' :: [Bool] -> Bool From 0fb8a73d3b1513ba50832fce1dc86465bc60ee1f Mon Sep 17 00:00:00 2001 From: Crockett Date: Sun, 3 Feb 2019 16:06:05 -0800 Subject: [PATCH 044/176] Fixed compiler warnings --- Crypto/Cipher/AES.hs | 2 -- Crypto/Cipher/ChaCha.hs | 2 +- Crypto/Cipher/Salsa.hs | 2 +- Crypto/Cipher/Twofish.hs | 1 - Crypto/Cipher/Twofish/Primitive.hs | 7 ++----- Crypto/Cipher/Types/Block.hs | 3 +-- Crypto/Cipher/Utils.hs | 1 - Crypto/Cipher/XSalsa.hs | 6 ++---- Crypto/Data/AFIS.hs | 2 +- Crypto/ECC.hs | 19 +++++++++---------- Crypto/ECC/Edwards25519.hs | 5 +---- Crypto/ECC/Simple/Prim.hs | 1 - Crypto/ECC/Simple/Types.hs | 12 ++++++------ Crypto/Error/Types.hs | 5 ++--- Crypto/Hash.hs | 3 +-- Crypto/Hash/Blake2.hs | 11 +++++------ Crypto/Hash/Blake2b.hs | 11 +++++------ Crypto/Hash/Blake2bp.hs | 3 +-- Crypto/Hash/Blake2s.hs | 7 +++---- Crypto/Hash/Blake2sp.hs | 5 ++--- Crypto/Hash/Keccak.hs | 9 ++++----- Crypto/Hash/MD2.hs | 3 +-- Crypto/Hash/MD4.hs | 3 +-- Crypto/Hash/MD5.hs | 3 +-- Crypto/Hash/RIPEMD160.hs | 3 +-- Crypto/Hash/SHA1.hs | 3 +-- Crypto/Hash/SHA224.hs | 3 +-- Crypto/Hash/SHA256.hs | 3 +-- Crypto/Hash/SHA3.hs | 9 ++++----- Crypto/Hash/SHA384.hs | 3 +-- Crypto/Hash/SHA512.hs | 3 +-- Crypto/Hash/SHA512t.hs | 5 ++--- Crypto/Hash/SHAKE.hs | 5 ++--- Crypto/Hash/Skein256.hs | 5 ++--- Crypto/Hash/Skein512.hs | 9 ++++----- Crypto/Hash/Tiger.hs | 3 +-- Crypto/Hash/Whirlpool.hs | 3 +-- Crypto/Internal/Nat.hs | 22 +++++++++++----------- Crypto/KDF/Argon2.hs | 2 +- Crypto/KDF/PBKDF2.hs | 4 ++-- Crypto/MAC/HMAC.hs | 3 +-- Crypto/Number/F2m.hs | 1 - Crypto/Number/ModArithmetic.hs | 3 +-- Crypto/Number/Prime.hs | 2 -- Crypto/OTP.hs | 9 ++++----- Crypto/PubKey/Curve25519.hs | 2 +- Crypto/PubKey/Curve448.hs | 1 - Crypto/PubKey/DH.hs | 2 +- Crypto/PubKey/DSA.hs | 10 +++++----- Crypto/PubKey/ECC/ECDSA.hs | 8 ++++---- Crypto/PubKey/ECC/Types.hs | 12 ++++++------ Crypto/PubKey/ECIES.hs | 1 - Crypto/PubKey/RSA.hs | 1 - Crypto/PubKey/RSA/Types.hs | 6 +++--- Crypto/PubKey/Rabin/Basic.hs | 9 ++++----- Crypto/PubKey/Rabin/Modified.hs | 8 +++----- Crypto/PubKey/Rabin/RW.hs | 7 +++---- Crypto/Random/ChaChaDRG.hs | 2 +- Crypto/Random/SystemDRG.hs | 1 - Crypto/Random/Types.hs | 5 ++--- stack.yaml | 2 +- tests/BlockCipher.hs | 4 ++-- tests/KAT_CAST5.hs | 1 - tests/KAT_HKDF.hs | 5 +---- tests/KAT_MiyaguchiPreneel.hs | 1 - tests/KAT_OTP.hs | 6 +++--- tests/Padding.hs | 1 - 67 files changed, 132 insertions(+), 192 deletions(-) diff --git a/Crypto/Cipher/AES.hs b/Crypto/Cipher/AES.hs index 97a1801..8ba303f 100644 --- a/Crypto/Cipher/AES.hs +++ b/Crypto/Cipher/AES.hs @@ -19,8 +19,6 @@ import Crypto.Cipher.Types.Block import Crypto.Cipher.AES.Primitive import Crypto.Internal.Imports -import Data.ByteArray as BA - -- | AES with 128 bit key newtype AES128 = AES128 AES deriving (NFData) diff --git a/Crypto/Cipher/ChaCha.hs b/Crypto/Cipher/ChaCha.hs index cd5c511..4dd70ad 100644 --- a/Crypto/Cipher/ChaCha.hs +++ b/Crypto/Cipher/ChaCha.hs @@ -48,7 +48,7 @@ initialize nbRounds key nonce stPtr <- B.alloc 132 $ \stPtr -> B.withByteArray nonce $ \noncePtr -> B.withByteArray key $ \keyPtr -> - ccryptonite_chacha_init stPtr (fromIntegral nbRounds) kLen keyPtr nonceLen noncePtr + ccryptonite_chacha_init stPtr nbRounds kLen keyPtr nonceLen noncePtr return $ State stPtr where kLen = B.length key nonceLen = B.length nonce diff --git a/Crypto/Cipher/Salsa.hs b/Crypto/Cipher/Salsa.hs index b6b188b..7d05e6c 100644 --- a/Crypto/Cipher/Salsa.hs +++ b/Crypto/Cipher/Salsa.hs @@ -40,7 +40,7 @@ initialize nbRounds key nonce stPtr <- B.alloc 132 $ \stPtr -> B.withByteArray nonce $ \noncePtr -> B.withByteArray key $ \keyPtr -> - ccryptonite_salsa_init stPtr (fromIntegral nbRounds) kLen keyPtr nonceLen noncePtr + ccryptonite_salsa_init stPtr nbRounds kLen keyPtr nonceLen noncePtr return $ State stPtr where kLen = B.length key nonceLen = B.length nonce diff --git a/Crypto/Cipher/Twofish.hs b/Crypto/Cipher/Twofish.hs index 40428ec..7fedd0e 100644 --- a/Crypto/Cipher/Twofish.hs +++ b/Crypto/Cipher/Twofish.hs @@ -7,7 +7,6 @@ module Crypto.Cipher.Twofish import Crypto.Cipher.Twofish.Primitive import Crypto.Cipher.Types import Crypto.Cipher.Utils -import Crypto.Internal.Imports newtype Twofish128 = Twofish128 Twofish diff --git a/Crypto/Cipher/Twofish/Primitive.hs b/Crypto/Cipher/Twofish/Primitive.hs index e998a5e..30c260d 100644 --- a/Crypto/Cipher/Twofish/Primitive.hs +++ b/Crypto/Cipher/Twofish/Primitive.hs @@ -8,15 +8,12 @@ module Crypto.Cipher.Twofish.Primitive ) where import Crypto.Error -import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, Bytes) +import Crypto.Internal.ByteArray (ByteArray) import qualified Crypto.Internal.ByteArray as B import Crypto.Internal.WordArray -import Crypto.Internal.Words import Data.Word -import Data.Int import Data.Bits import Data.List -import Control.Monad -- Based on the Golang referance implementation -- https://github.com/golang/crypto/blob/master/twofish/twofish.go @@ -206,7 +203,7 @@ sWords key = sWord data Column = Zero | One | Two | Three deriving (Show, Eq, Enum, Bounded) -genSboxes :: ByteArray ba => KeyPackage ba -> [Word8] -> (Array32, Array32, Array32, Array32) +genSboxes :: KeyPackage ba -> [Word8] -> (Array32, Array32, Array32, Array32) genSboxes keyPackage ws = (mkArray b0', mkArray b1', mkArray b2', mkArray b3') where range = [0..255] mkArray = array32 256 diff --git a/Crypto/Cipher/Types/Block.hs b/Crypto/Cipher/Types/Block.hs index 290b67b..a2ac2d2 100644 --- a/Crypto/Cipher/Types/Block.hs +++ b/Crypto/Cipher/Types/Block.hs @@ -37,7 +37,6 @@ module Crypto.Cipher.Types.Block ) where import Data.Word -import Data.Monoid import Crypto.Error import Crypto.Cipher.Types.Base import Crypto.Cipher.Types.GF @@ -164,7 +163,7 @@ nullIV = toIV undefined -- | Increment an IV by a number. -- -- Assume the IV is in Big Endian format. -ivAdd :: BlockCipher c => IV c -> Int -> IV c +ivAdd :: IV c -> Int -> IV c ivAdd (IV b) i = IV $ copy b where copy :: ByteArray bs => bs -> bs copy bs = B.copyAndFreeze bs $ loop i (B.length bs - 1) diff --git a/Crypto/Cipher/Utils.hs b/Crypto/Cipher/Utils.hs index e6c0c76..24e2e0a 100644 --- a/Crypto/Cipher/Utils.hs +++ b/Crypto/Cipher/Utils.hs @@ -4,7 +4,6 @@ module Crypto.Cipher.Utils import Crypto.Error import Crypto.Cipher.Types -import Crypto.Internal.Imports import Data.ByteArray as BA diff --git a/Crypto/Cipher/XSalsa.hs b/Crypto/Cipher/XSalsa.hs index 494760e..db8b919 100644 --- a/Crypto/Cipher/XSalsa.hs +++ b/Crypto/Cipher/XSalsa.hs @@ -17,13 +17,11 @@ module Crypto.Cipher.XSalsa , State ) where -import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, ScrubbedBytes) +import Crypto.Internal.ByteArray (ByteArrayAccess) import qualified Crypto.Internal.ByteArray as B import Crypto.Internal.Compat import Crypto.Internal.Imports import Foreign.Ptr -import Foreign.Storable -import Foreign.C.Types import Crypto.Cipher.Salsa hiding (initialize) -- | Initialize a new XSalsa context with the number of rounds, @@ -41,7 +39,7 @@ initialize nbRounds key nonce stPtr <- B.alloc 132 $ \stPtr -> B.withByteArray nonce $ \noncePtr -> B.withByteArray key $ \keyPtr -> - ccryptonite_xsalsa_init stPtr (fromIntegral nbRounds) kLen keyPtr nonceLen noncePtr + ccryptonite_xsalsa_init stPtr nbRounds kLen keyPtr nonceLen noncePtr return $ State stPtr where kLen = B.length key nonceLen = B.length nonce diff --git a/Crypto/Data/AFIS.hs b/Crypto/Data/AFIS.hs index bcf95cf..2312e9c 100644 --- a/Crypto/Data/AFIS.hs +++ b/Crypto/Data/AFIS.hs @@ -77,7 +77,7 @@ split hashAlg rng expandTimes src diffuse hashAlg lastBlock blockSize fillRandomBlock g blockPtr = do let (rand :: Bytes, g') = randomBytesGenerate blockSize g - B.withByteArray rand $ \randPtr -> memCopy blockPtr randPtr (fromIntegral blockSize) + B.withByteArray rand $ \randPtr -> memCopy blockPtr randPtr blockSize return g' -- | Merge previously diffused data back to the original data. diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index a272cd5..34a911f 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -38,10 +38,9 @@ import qualified Crypto.Internal.ByteArray as B import Crypto.Number.Serialize (i2ospOf_, os2ip) import qualified Crypto.PubKey.Curve25519 as X25519 import qualified Crypto.PubKey.Curve448 as X448 -import Data.Function (on) import Data.ByteArray (convert) import Data.Data (Data()) -import Data.Typeable (Typeable()) +import Data.Kind (Type) -- | An elliptic curve key pair composed of the private part (a scalar), and -- the associated point. @@ -55,10 +54,10 @@ newtype SharedSecret = SharedSecret ScrubbedBytes class EllipticCurve curve where -- | Point on an Elliptic Curve - type Point curve :: * + type Point curve :: Type -- | Scalar in the Elliptic Curve domain - type Scalar curve :: * + type Scalar curve :: Type -- | Generate a new random scalar on the curve. -- The scalar will represent a number between 1 and the order of the curve non included @@ -116,7 +115,7 @@ class EllipticCurve curve => EllipticCurveArith curve where -- -- also known as P256 data Curve_P256R1 = Curve_P256R1 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance EllipticCurve Curve_P256R1 where type Point Curve_P256R1 = P256.Point @@ -150,7 +149,7 @@ instance EllipticCurveDH Curve_P256R1 where ecdh prx s p = checkNonZeroDH (ecdhRaw prx s p) data Curve_P384R1 = Curve_P384R1 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance EllipticCurve Curve_P384R1 where type Point Curve_P384R1 = Simple.Point Simple.SEC_p384r1 @@ -173,7 +172,7 @@ instance EllipticCurveDH Curve_P384R1 where prx = Proxy :: Proxy Simple.SEC_p384r1 data Curve_P521R1 = Curve_P521R1 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance EllipticCurve Curve_P521R1 where type Point Curve_P521R1 = Simple.Point Simple.SEC_p521r1 @@ -196,7 +195,7 @@ instance EllipticCurveDH Curve_P521R1 where prx = Proxy :: Proxy Simple.SEC_p521r1 data Curve_X25519 = Curve_X25519 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance EllipticCurve Curve_X25519 where type Point Curve_X25519 = X25519.PublicKey @@ -215,7 +214,7 @@ instance EllipticCurveDH Curve_X25519 where ecdh prx s p = checkNonZeroDH (ecdhRaw prx s p) data Curve_X448 = Curve_X448 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance EllipticCurve Curve_X448 where type Point Curve_X448 = X448.PublicKey @@ -234,7 +233,7 @@ instance EllipticCurveDH Curve_X448 where ecdh prx s p = checkNonZeroDH (ecdhRaw prx s p) data Curve_Edwards25519 = Curve_Edwards25519 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance EllipticCurve Curve_Edwards25519 where type Point Curve_Edwards25519 = Edwards25519.Point diff --git a/Crypto/ECC/Edwards25519.hs b/Crypto/ECC/Edwards25519.hs index ebba8ca..92a0516 100644 --- a/Crypto/ECC/Edwards25519.hs +++ b/Crypto/ECC/Edwards25519.hs @@ -73,15 +73,12 @@ module Crypto.ECC.Edwards25519 , pointsMulVarTime ) where -import Data.Bits import Data.Word import Foreign.C.Types import Foreign.Ptr -import Foreign.Storable import Crypto.Error -import Crypto.Internal.ByteArray (ByteArrayAccess, Bytes, - ScrubbedBytes, withByteArray) +import Crypto.Internal.ByteArray (Bytes, ScrubbedBytes, withByteArray) import qualified Crypto.Internal.ByteArray as B import Crypto.Internal.Compat import Crypto.Internal.Imports diff --git a/Crypto/ECC/Simple/Prim.hs b/Crypto/ECC/Simple/Prim.hs index 7eebb4e..25d8fe1 100644 --- a/Crypto/ECC/Simple/Prim.hs +++ b/Crypto/ECC/Simple/Prim.hs @@ -17,7 +17,6 @@ module Crypto.ECC.Simple.Prim ) where import Data.Maybe -import Crypto.Internal.Imports import Crypto.Internal.Proxy import Crypto.Number.ModArithmetic import Crypto.Number.F2m diff --git a/Crypto/ECC/Simple/Types.hs b/Crypto/ECC/Simple/Types.hs index 814c256..b4984a5 100644 --- a/Crypto/ECC/Simple/Types.hs +++ b/Crypto/ECC/Simple/Types.hs @@ -84,28 +84,28 @@ data CurveParameters curve = CurveParameters , curveEccG :: Point curve -- ^ base point , curveEccN :: Integer -- ^ order of G , curveEccH :: Integer -- ^ cofactor - } deriving (Show,Eq,Data,Typeable) + } deriving (Show,Eq,Data) newtype CurveBinaryParam = CurveBinaryParam Integer - deriving (Show,Read,Eq,Data,Typeable) + deriving (Show,Read,Eq,Data) newtype CurvePrimeParam = CurvePrimeParam Integer - deriving (Show,Read,Eq,Data,Typeable) + deriving (Show,Read,Eq,Data) data CurveType = CurveBinary CurveBinaryParam | CurvePrime CurvePrimeParam - deriving (Show,Read,Eq,Data,Typeable) + deriving (Show,Read,Eq,Data) -- | ECC Private Number newtype Scalar curve = Scalar Integer - deriving (Show,Read,Eq,Data,Typeable,NFData) + deriving (Show,Read,Eq,Data,NFData) -- | Define a point on a curve. data Point curve = Point Integer Integer | PointO -- ^ Point at Infinity - deriving (Show,Read,Eq,Data,Typeable) + deriving (Show,Read,Eq,Data) instance NFData (Point curve) where rnf (Point x y) = x `seq` y `seq` () diff --git a/Crypto/Error/Types.hs b/Crypto/Error/Types.hs index 685e506..b72efad 100644 --- a/Crypto/Error/Types.hs +++ b/Crypto/Error/Types.hs @@ -23,7 +23,6 @@ import qualified Control.Exception as E import Data.Data import Basement.Monad (MonadFailure(..)) -import Crypto.Internal.Imports -- | Enumeration of all possible errors that can be found in this library data CryptoError = @@ -53,7 +52,7 @@ data CryptoError = | CryptoError_SaltTooSmall | CryptoError_OutputLengthTooSmall | CryptoError_OutputLengthTooBig - deriving (Show,Eq,Enum,Data,Typeable) + deriving (Show,Eq,Enum,Data) instance E.Exception CryptoError @@ -83,7 +82,7 @@ instance Applicative CryptoFailable where pure a = CryptoPassed a (<*>) fm m = fm >>= \p -> m >>= \r2 -> return (p r2) instance Monad CryptoFailable where - return a = CryptoPassed a + return = pure (>>=) m1 m2 = do case m1 of CryptoPassed a -> m2 a diff --git a/Crypto/Hash.hs b/Crypto/Hash.hs index f8b9637..37e6f9f 100644 --- a/Crypto/Hash.hs +++ b/Crypto/Hash.hs @@ -44,7 +44,6 @@ module Crypto.Hash import Basement.Types.OffsetSize (CountOf (..)) import Basement.Block (Block, unsafeFreeze) import Basement.Block.Mutable (copyFromPtr, new) -import Control.Monad import Crypto.Internal.Compat (unsafeDoIO) import Crypto.Hash.Types import Crypto.Hash.Algorithms @@ -110,7 +109,7 @@ hashWith _ = hash digestFromByteString :: forall a ba . (HashAlgorithm a, ByteArrayAccess ba) => ba -> Maybe (Digest a) digestFromByteString = from undefined where - from :: HashAlgorithm a => a -> ba -> Maybe (Digest a) + from :: a -> ba -> Maybe (Digest a) from alg bs | B.length bs == (hashDigestSize alg) = Just $ Digest $ unsafeDoIO $ copyBytes bs | otherwise = Nothing diff --git a/Crypto/Hash/Blake2.hs b/Crypto/Hash/Blake2.hs index 59769e2..1e06c40 100644 --- a/Crypto/Hash/Blake2.hs +++ b/Crypto/Hash/Blake2.hs @@ -42,9 +42,8 @@ module Crypto.Hash.Blake2 import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) -import GHC.TypeLits (Nat, KnownNat, natVal) +import GHC.TypeLits (Nat, KnownNat) import Crypto.Internal.Nat -- | Fast and secure alternative to SHA1 and HMAC-SHA1 @@ -58,7 +57,7 @@ import Crypto.Internal.Nat -- * Blake2s 256 -- data Blake2s (bitlen :: Nat) = Blake2s - deriving (Show, Typeable) + deriving (Show) instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost bitlen 256) => HashAlgorithm (Blake2s bitlen) @@ -93,7 +92,7 @@ foreign import ccall unsafe "cryptonite_blake2s_finalize" -- * Blake2b 512 -- data Blake2b (bitlen :: Nat) = Blake2b - deriving (Show, Typeable) + deriving (Show) instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost bitlen 512) => HashAlgorithm (Blake2b bitlen) @@ -116,7 +115,7 @@ foreign import ccall unsafe "cryptonite_blake2b_finalize" c_blake2b_finalize :: Ptr (Context a) -> Word32 -> Ptr (Digest a) -> IO () data Blake2sp (bitlen :: Nat) = Blake2sp - deriving (Show, Typeable) + deriving (Show) instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost bitlen 256) => HashAlgorithm (Blake2sp bitlen) @@ -139,7 +138,7 @@ foreign import ccall unsafe "cryptonite_blake2sp_finalize" c_blake2sp_finalize :: Ptr (Context a) -> Word32 -> Ptr (Digest a) -> IO () data Blake2bp (bitlen :: Nat) = Blake2bp - deriving (Show, Typeable) + deriving (Show) instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost bitlen 512) => HashAlgorithm (Blake2bp bitlen) diff --git a/Crypto/Hash/Blake2b.hs b/Crypto/Hash/Blake2b.hs index 6d81274..788db0b 100644 --- a/Crypto/Hash/Blake2b.hs +++ b/Crypto/Hash/Blake2b.hs @@ -19,13 +19,12 @@ module Crypto.Hash.Blake2b import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) -- | Blake2b (160 bits) cryptographic hash algorithm data Blake2b_160 = Blake2b_160 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Blake2b_160 where type HashBlockSize Blake2b_160 = 128 @@ -40,7 +39,7 @@ instance HashAlgorithm Blake2b_160 where -- | Blake2b (224 bits) cryptographic hash algorithm data Blake2b_224 = Blake2b_224 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Blake2b_224 where type HashBlockSize Blake2b_224 = 128 @@ -55,7 +54,7 @@ instance HashAlgorithm Blake2b_224 where -- | Blake2b (256 bits) cryptographic hash algorithm data Blake2b_256 = Blake2b_256 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Blake2b_256 where type HashBlockSize Blake2b_256 = 128 @@ -70,7 +69,7 @@ instance HashAlgorithm Blake2b_256 where -- | Blake2b (384 bits) cryptographic hash algorithm data Blake2b_384 = Blake2b_384 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Blake2b_384 where type HashBlockSize Blake2b_384 = 128 @@ -85,7 +84,7 @@ instance HashAlgorithm Blake2b_384 where -- | Blake2b (512 bits) cryptographic hash algorithm data Blake2b_512 = Blake2b_512 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Blake2b_512 where type HashBlockSize Blake2b_512 = 128 diff --git a/Crypto/Hash/Blake2bp.hs b/Crypto/Hash/Blake2bp.hs index fbd4eeb..35e556c 100644 --- a/Crypto/Hash/Blake2bp.hs +++ b/Crypto/Hash/Blake2bp.hs @@ -19,13 +19,12 @@ module Crypto.Hash.Blake2bp import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) -- | Blake2bp (512 bits) cryptographic hash algorithm data Blake2bp_512 = Blake2bp_512 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Blake2bp_512 where type HashBlockSize Blake2bp_512 = 128 diff --git a/Crypto/Hash/Blake2s.hs b/Crypto/Hash/Blake2s.hs index 7106eb5..c7426b0 100644 --- a/Crypto/Hash/Blake2s.hs +++ b/Crypto/Hash/Blake2s.hs @@ -19,13 +19,12 @@ module Crypto.Hash.Blake2s import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) -- | Blake2s (160 bits) cryptographic hash algorithm data Blake2s_160 = Blake2s_160 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Blake2s_160 where type HashBlockSize Blake2s_160 = 64 @@ -40,7 +39,7 @@ instance HashAlgorithm Blake2s_160 where -- | Blake2s (224 bits) cryptographic hash algorithm data Blake2s_224 = Blake2s_224 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Blake2s_224 where type HashBlockSize Blake2s_224 = 64 @@ -55,7 +54,7 @@ instance HashAlgorithm Blake2s_224 where -- | Blake2s (256 bits) cryptographic hash algorithm data Blake2s_256 = Blake2s_256 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Blake2s_256 where type HashBlockSize Blake2s_256 = 64 diff --git a/Crypto/Hash/Blake2sp.hs b/Crypto/Hash/Blake2sp.hs index 0931eb0..1a659f2 100644 --- a/Crypto/Hash/Blake2sp.hs +++ b/Crypto/Hash/Blake2sp.hs @@ -19,13 +19,12 @@ module Crypto.Hash.Blake2sp import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) -- | Blake2sp (224 bits) cryptographic hash algorithm data Blake2sp_224 = Blake2sp_224 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Blake2sp_224 where type HashBlockSize Blake2sp_224 = 64 @@ -40,7 +39,7 @@ instance HashAlgorithm Blake2sp_224 where -- | Blake2sp (256 bits) cryptographic hash algorithm data Blake2sp_256 = Blake2sp_256 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Blake2sp_256 where type HashBlockSize Blake2sp_256 = 64 diff --git a/Crypto/Hash/Keccak.hs b/Crypto/Hash/Keccak.hs index 234e3cf..371e284 100644 --- a/Crypto/Hash/Keccak.hs +++ b/Crypto/Hash/Keccak.hs @@ -19,13 +19,12 @@ module Crypto.Hash.Keccak import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) -- | Keccak (224 bits) cryptographic hash algorithm data Keccak_224 = Keccak_224 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Keccak_224 where type HashBlockSize Keccak_224 = 144 @@ -40,7 +39,7 @@ instance HashAlgorithm Keccak_224 where -- | Keccak (256 bits) cryptographic hash algorithm data Keccak_256 = Keccak_256 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Keccak_256 where type HashBlockSize Keccak_256 = 136 @@ -55,7 +54,7 @@ instance HashAlgorithm Keccak_256 where -- | Keccak (384 bits) cryptographic hash algorithm data Keccak_384 = Keccak_384 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Keccak_384 where type HashBlockSize Keccak_384 = 104 @@ -70,7 +69,7 @@ instance HashAlgorithm Keccak_384 where -- | Keccak (512 bits) cryptographic hash algorithm data Keccak_512 = Keccak_512 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Keccak_512 where type HashBlockSize Keccak_512 = 72 diff --git a/Crypto/Hash/MD2.hs b/Crypto/Hash/MD2.hs index f1919ce..c878662 100644 --- a/Crypto/Hash/MD2.hs +++ b/Crypto/Hash/MD2.hs @@ -17,12 +17,11 @@ module Crypto.Hash.MD2 ( MD2 (..) ) where import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) -- | MD2 cryptographic hash algorithm data MD2 = MD2 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm MD2 where type HashBlockSize MD2 = 16 diff --git a/Crypto/Hash/MD4.hs b/Crypto/Hash/MD4.hs index 543dd3b..0f39d58 100644 --- a/Crypto/Hash/MD4.hs +++ b/Crypto/Hash/MD4.hs @@ -17,12 +17,11 @@ module Crypto.Hash.MD4 ( MD4 (..) ) where import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) -- | MD4 cryptographic hash algorithm data MD4 = MD4 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm MD4 where type HashBlockSize MD4 = 64 diff --git a/Crypto/Hash/MD5.hs b/Crypto/Hash/MD5.hs index dc94a91..17a09ef 100644 --- a/Crypto/Hash/MD5.hs +++ b/Crypto/Hash/MD5.hs @@ -17,12 +17,11 @@ module Crypto.Hash.MD5 ( MD5 (..) ) where import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) -- | MD5 cryptographic hash algorithm data MD5 = MD5 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm MD5 where type HashBlockSize MD5 = 64 diff --git a/Crypto/Hash/RIPEMD160.hs b/Crypto/Hash/RIPEMD160.hs index 13334a3..ba2d413 100644 --- a/Crypto/Hash/RIPEMD160.hs +++ b/Crypto/Hash/RIPEMD160.hs @@ -17,12 +17,11 @@ module Crypto.Hash.RIPEMD160 ( RIPEMD160 (..) ) where import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) -- | RIPEMD160 cryptographic hash algorithm data RIPEMD160 = RIPEMD160 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm RIPEMD160 where type HashBlockSize RIPEMD160 = 64 diff --git a/Crypto/Hash/SHA1.hs b/Crypto/Hash/SHA1.hs index 8d1ed84..87e44a3 100644 --- a/Crypto/Hash/SHA1.hs +++ b/Crypto/Hash/SHA1.hs @@ -17,12 +17,11 @@ module Crypto.Hash.SHA1 ( SHA1 (..) ) where import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) -- | SHA1 cryptographic hash algorithm data SHA1 = SHA1 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm SHA1 where type HashBlockSize SHA1 = 64 diff --git a/Crypto/Hash/SHA224.hs b/Crypto/Hash/SHA224.hs index 9801a33..a609d57 100644 --- a/Crypto/Hash/SHA224.hs +++ b/Crypto/Hash/SHA224.hs @@ -17,12 +17,11 @@ module Crypto.Hash.SHA224 ( SHA224 (..) ) where import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) -- | SHA224 cryptographic hash algorithm data SHA224 = SHA224 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm SHA224 where type HashBlockSize SHA224 = 64 diff --git a/Crypto/Hash/SHA256.hs b/Crypto/Hash/SHA256.hs index d9102f9..eacd502 100644 --- a/Crypto/Hash/SHA256.hs +++ b/Crypto/Hash/SHA256.hs @@ -17,12 +17,11 @@ module Crypto.Hash.SHA256 ( SHA256 (..) ) where import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) -- | SHA256 cryptographic hash algorithm data SHA256 = SHA256 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm SHA256 where type HashBlockSize SHA256 = 64 diff --git a/Crypto/Hash/SHA3.hs b/Crypto/Hash/SHA3.hs index 9dada07..a5ca6a7 100644 --- a/Crypto/Hash/SHA3.hs +++ b/Crypto/Hash/SHA3.hs @@ -19,13 +19,12 @@ module Crypto.Hash.SHA3 import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) -- | SHA3 (224 bits) cryptographic hash algorithm data SHA3_224 = SHA3_224 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm SHA3_224 where type HashBlockSize SHA3_224 = 144 @@ -40,7 +39,7 @@ instance HashAlgorithm SHA3_224 where -- | SHA3 (256 bits) cryptographic hash algorithm data SHA3_256 = SHA3_256 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm SHA3_256 where type HashBlockSize SHA3_256 = 136 @@ -55,7 +54,7 @@ instance HashAlgorithm SHA3_256 where -- | SHA3 (384 bits) cryptographic hash algorithm data SHA3_384 = SHA3_384 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm SHA3_384 where type HashBlockSize SHA3_384 = 104 @@ -70,7 +69,7 @@ instance HashAlgorithm SHA3_384 where -- | SHA3 (512 bits) cryptographic hash algorithm data SHA3_512 = SHA3_512 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm SHA3_512 where type HashBlockSize SHA3_512 = 72 diff --git a/Crypto/Hash/SHA384.hs b/Crypto/Hash/SHA384.hs index 4bcc5fc..2b19f52 100644 --- a/Crypto/Hash/SHA384.hs +++ b/Crypto/Hash/SHA384.hs @@ -17,12 +17,11 @@ module Crypto.Hash.SHA384 ( SHA384 (..) ) where import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) -- | SHA384 cryptographic hash algorithm data SHA384 = SHA384 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm SHA384 where type HashBlockSize SHA384 = 128 diff --git a/Crypto/Hash/SHA512.hs b/Crypto/Hash/SHA512.hs index 14b82f2..20449b3 100644 --- a/Crypto/Hash/SHA512.hs +++ b/Crypto/Hash/SHA512.hs @@ -17,12 +17,11 @@ module Crypto.Hash.SHA512 ( SHA512 (..) ) where import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) -- | SHA512 cryptographic hash algorithm data SHA512 = SHA512 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm SHA512 where type HashBlockSize SHA512 = 128 diff --git a/Crypto/Hash/SHA512t.hs b/Crypto/Hash/SHA512t.hs index be88d3a..e1bd6e0 100644 --- a/Crypto/Hash/SHA512t.hs +++ b/Crypto/Hash/SHA512t.hs @@ -19,13 +19,12 @@ module Crypto.Hash.SHA512t import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) -- | SHA512t (224 bits) cryptographic hash algorithm data SHA512t_224 = SHA512t_224 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm SHA512t_224 where type HashBlockSize SHA512t_224 = 128 @@ -40,7 +39,7 @@ instance HashAlgorithm SHA512t_224 where -- | SHA512t (256 bits) cryptographic hash algorithm data SHA512t_256 = SHA512t_256 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm SHA512t_256 where type HashBlockSize SHA512t_256 = 128 diff --git a/Crypto/Hash/SHAKE.hs b/Crypto/Hash/SHAKE.hs index 63d19d8..3298816 100644 --- a/Crypto/Hash/SHAKE.hs +++ b/Crypto/Hash/SHAKE.hs @@ -26,7 +26,6 @@ import Foreign.Ptr (Ptr, castPtr) import Foreign.Storable (Storable(..)) import Data.Bits import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) import Data.Proxy (Proxy(..)) @@ -40,7 +39,7 @@ import Crypto.Internal.Nat -- correlated (one being a prefix of the other). Results are unrelated to -- 'SHAKE256' results. data SHAKE128 (bitlen :: Nat) = SHAKE128 - deriving (Show, Data, Typeable) + deriving (Show, Data) instance KnownNat bitlen => HashAlgorithm (SHAKE128 bitlen) where type HashBlockSize (SHAKE128 bitlen) = 168 @@ -60,7 +59,7 @@ instance KnownNat bitlen => HashAlgorithm (SHAKE128 bitlen) where -- correlated (one being a prefix of the other). Results are unrelated to -- 'SHAKE128' results. data SHAKE256 (bitlen :: Nat) = SHAKE256 - deriving (Show, Data, Typeable) + deriving (Show, Data) instance KnownNat bitlen => HashAlgorithm (SHAKE256 bitlen) where type HashBlockSize (SHAKE256 bitlen) = 136 diff --git a/Crypto/Hash/Skein256.hs b/Crypto/Hash/Skein256.hs index 9871d47..8e3bddc 100644 --- a/Crypto/Hash/Skein256.hs +++ b/Crypto/Hash/Skein256.hs @@ -19,13 +19,12 @@ module Crypto.Hash.Skein256 import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) -- | Skein256 (224 bits) cryptographic hash algorithm data Skein256_224 = Skein256_224 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Skein256_224 where type HashBlockSize Skein256_224 = 32 @@ -40,7 +39,7 @@ instance HashAlgorithm Skein256_224 where -- | Skein256 (256 bits) cryptographic hash algorithm data Skein256_256 = Skein256_256 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Skein256_256 where type HashBlockSize Skein256_256 = 32 diff --git a/Crypto/Hash/Skein512.hs b/Crypto/Hash/Skein512.hs index 75d2407..a666d5d 100644 --- a/Crypto/Hash/Skein512.hs +++ b/Crypto/Hash/Skein512.hs @@ -19,13 +19,12 @@ module Crypto.Hash.Skein512 import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) -- | Skein512 (224 bits) cryptographic hash algorithm data Skein512_224 = Skein512_224 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Skein512_224 where type HashBlockSize Skein512_224 = 64 @@ -40,7 +39,7 @@ instance HashAlgorithm Skein512_224 where -- | Skein512 (256 bits) cryptographic hash algorithm data Skein512_256 = Skein512_256 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Skein512_256 where type HashBlockSize Skein512_256 = 64 @@ -55,7 +54,7 @@ instance HashAlgorithm Skein512_256 where -- | Skein512 (384 bits) cryptographic hash algorithm data Skein512_384 = Skein512_384 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Skein512_384 where type HashBlockSize Skein512_384 = 64 @@ -70,7 +69,7 @@ instance HashAlgorithm Skein512_384 where -- | Skein512 (512 bits) cryptographic hash algorithm data Skein512_512 = Skein512_512 - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Skein512_512 where type HashBlockSize Skein512_512 = 64 diff --git a/Crypto/Hash/Tiger.hs b/Crypto/Hash/Tiger.hs index de74a75..dd69476 100644 --- a/Crypto/Hash/Tiger.hs +++ b/Crypto/Hash/Tiger.hs @@ -17,12 +17,11 @@ module Crypto.Hash.Tiger ( Tiger (..) ) where import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) -- | Tiger cryptographic hash algorithm data Tiger = Tiger - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Tiger where type HashBlockSize Tiger = 64 diff --git a/Crypto/Hash/Whirlpool.hs b/Crypto/Hash/Whirlpool.hs index 3780565..8246176 100644 --- a/Crypto/Hash/Whirlpool.hs +++ b/Crypto/Hash/Whirlpool.hs @@ -17,12 +17,11 @@ module Crypto.Hash.Whirlpool ( Whirlpool (..) ) where import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) -- | Whirlpool cryptographic hash algorithm data Whirlpool = Whirlpool - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm Whirlpool where type HashBlockSize Whirlpool = 64 diff --git a/Crypto/Internal/Nat.hs b/Crypto/Internal/Nat.hs index 3698a6b..dfa3a4d 100644 --- a/Crypto/Internal/Nat.hs +++ b/Crypto/Internal/Nat.hs @@ -22,7 +22,7 @@ integralNatVal :: (KnownNat bitlen, Num a) => proxy bitlen -> a integralNatVal = fromInteger . natVal type family IsLE (bitlen :: Nat) (n :: Nat) (c :: Bool) where - IsLE bitlen n 'True = 'True + IsLE _ _ 'True = 'True #if MIN_VERSION_base(4,9,0) IsLE bitlen n 'False = TypeError ( ('Text "bitlen " ':<>: 'ShowType bitlen ':<>: 'Text " is greater than " ':<>: 'ShowType n) @@ -37,7 +37,7 @@ type family IsLE (bitlen :: Nat) (n :: Nat) (c :: Bool) where type IsAtMost (bitlen :: Nat) (n :: Nat) = IsLE bitlen n (bitlen <=? n) ~ 'True type family IsGE (bitlen :: Nat) (n :: Nat) (c :: Bool) where - IsGE bitlen n 'True = 'True + IsGE _ _ 'True = 'True #if MIN_VERSION_base(4,9,0) IsGE bitlen n 'False = TypeError ( ('Text "bitlen " ':<>: 'ShowType bitlen ':<>: 'Text " is lesser than " ':<>: 'ShowType n) @@ -120,7 +120,7 @@ type family Div8 (bitLen :: Nat) where Div8 n = 8 + Div8 (n - 64) type family IsDiv8 (bitLen :: Nat) (n :: Nat) where - IsDiv8 bitLen 0 = 'True + IsDiv8 _ 0 = 'True #if MIN_VERSION_base(4,9,0) IsDiv8 bitLen 1 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8") IsDiv8 bitLen 2 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8") @@ -130,15 +130,15 @@ type family IsDiv8 (bitLen :: Nat) (n :: Nat) where IsDiv8 bitLen 6 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8") IsDiv8 bitLen 7 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8") #else - IsDiv8 bitLen 1 = 'False - IsDiv8 bitLen 2 = 'False - IsDiv8 bitLen 3 = 'False - IsDiv8 bitLen 4 = 'False - IsDiv8 bitLen 5 = 'False - IsDiv8 bitLen 6 = 'False - IsDiv8 bitLen 7 = 'False + IsDiv8 _ 1 = 'False + IsDiv8 _ 2 = 'False + IsDiv8 _ 3 = 'False + IsDiv8 _ 4 = 'False + IsDiv8 _ 5 = 'False + IsDiv8 _ 6 = 'False + IsDiv8 _ 7 = 'False #endif - IsDiv8 bitLen n = IsDiv8 n (Mod8 n) + IsDiv8 _ n = IsDiv8 n (Mod8 n) type family Mod8 (n :: Nat) where Mod8 0 = 0 diff --git a/Crypto/KDF/Argon2.hs b/Crypto/KDF/Argon2.hs index 53a8f89..044ba00 100644 --- a/Crypto/KDF/Argon2.hs +++ b/Crypto/KDF/Argon2.hs @@ -25,7 +25,7 @@ module Crypto.KDF.Argon2 , hash ) where -import Crypto.Internal.ByteArray (ScrubbedBytes, ByteArray, ByteArrayAccess) +import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess) import qualified Crypto.Internal.ByteArray as B import Crypto.Error import Control.Monad (when) diff --git a/Crypto/KDF/PBKDF2.hs b/Crypto/KDF/PBKDF2.hs index b18cc1a..7a3337c 100644 --- a/Crypto/KDF/PBKDF2.hs +++ b/Crypto/KDF/PBKDF2.hs @@ -24,7 +24,7 @@ import Data.Word import Data.Bits import Foreign.Marshal.Alloc import Foreign.Ptr (plusPtr, Ptr) -import Foreign.C.Types (CUInt(..), CInt(..), CSize(..)) +import Foreign.C.Types (CUInt(..), CSize(..)) import Crypto.Hash (HashAlgorithm) import qualified Crypto.MAC.HMAC as HMAC @@ -54,7 +54,7 @@ data Parameters = Parameters } -- | generate the pbkdf2 key derivation function from the output -generate :: (ByteArrayAccess password, ByteArrayAccess salt, ByteArray ba) +generate :: (ByteArrayAccess salt, ByteArray ba) => PRF password -> Parameters -> password diff --git a/Crypto/MAC/HMAC.hs b/Crypto/MAC/HMAC.hs index f44008a..4582703 100644 --- a/Crypto/MAC/HMAC.hs +++ b/Crypto/MAC/HMAC.hs @@ -24,11 +24,10 @@ module Crypto.MAC.HMAC import Crypto.Hash hiding (Context) import qualified Crypto.Hash as Hash (Context) import Crypto.Hash.IO -import Crypto.Internal.ByteArray (ScrubbedBytes, ByteArray, ByteArrayAccess) +import Crypto.Internal.ByteArray (ScrubbedBytes, ByteArrayAccess) import qualified Crypto.Internal.ByteArray as B import Data.Memory.PtrMethods import Crypto.Internal.Compat -import Crypto.Internal.Imports -- | Represent an HMAC that is a phantom type with the hash used to produce the mac. -- diff --git a/Crypto/Number/F2m.hs b/Crypto/Number/F2m.hs index 503c309..93b1f48 100644 --- a/Crypto/Number/F2m.hs +++ b/Crypto/Number/F2m.hs @@ -23,7 +23,6 @@ module Crypto.Number.F2m import Data.Bits (xor, shift, testBit, setBit) import Data.List -import Crypto.Internal.Imports import Crypto.Number.Basic -- | Binary Polynomial represented by an integer diff --git a/Crypto/Number/ModArithmetic.hs b/Crypto/Number/ModArithmetic.hs index ef59d7e..dcd8663 100644 --- a/Crypto/Number/ModArithmetic.hs +++ b/Crypto/Number/ModArithmetic.hs @@ -19,13 +19,12 @@ module Crypto.Number.ModArithmetic ) where import Control.Exception (throw, Exception) -import Data.Typeable import Crypto.Number.Basic import Crypto.Number.Compat -- | Raised when two numbers are supposed to be coprimes but are not. data CoprimesAssertionError = CoprimesAssertionError - deriving (Show,Typeable) + deriving (Show) instance Exception CoprimesAssertionError diff --git a/Crypto/Number/Prime.hs b/Crypto/Number/Prime.hs index 19faaa9..e48477d 100644 --- a/Crypto/Number/Prime.hs +++ b/Crypto/Number/Prime.hs @@ -19,8 +19,6 @@ module Crypto.Number.Prime , isCoprime ) where -import Crypto.Internal.Imports - import Crypto.Number.Compat import Crypto.Number.Generate import Crypto.Number.Basic (sqrti, gcde) diff --git a/Crypto/OTP.hs b/Crypto/OTP.hs index 71c1e74..9b5b383 100644 --- a/Crypto/OTP.hs +++ b/Crypto/OTP.hs @@ -42,15 +42,14 @@ module Crypto.OTP ) where -import Data.Bits (shiftL, shiftR, (.&.), (.|.)) +import Data.Bits (shiftL, (.&.), (.|.)) import Data.ByteArray.Mapping (fromW64BE) import Data.List (elemIndex) import Data.Word -import Foreign.Storable (poke) import Control.Monad (unless) import Crypto.Hash (HashAlgorithm, SHA1(..)) import Crypto.MAC.HMAC -import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, Bytes) +import Crypto.Internal.ByteArray (ByteArrayAccess, Bytes) import qualified Crypto.Internal.ByteArray as B @@ -130,8 +129,8 @@ defaultTOTPParams :: TOTPParams SHA1 defaultTOTPParams = TP SHA1 0 30 OTP6 TwoSteps -- | Create a TOTP configuration with customized parameters. -mkTOTPParams :: (HashAlgorithm hash) - => hash +mkTOTPParams :: + hash -> OTPTime -- ^ The T0 parameter in seconds. This is the Unix time from which to start -- counting steps (default 0). Must be before the current time. diff --git a/Crypto/PubKey/Curve25519.hs b/Crypto/PubKey/Curve25519.hs index 720ff9a..d85de91 100644 --- a/Crypto/PubKey/Curve25519.hs +++ b/Crypto/PubKey/Curve25519.hs @@ -33,7 +33,7 @@ import GHC.Ptr import Crypto.Error import Crypto.Internal.Compat import Crypto.Internal.Imports -import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, ScrubbedBytes, Bytes, withByteArray) +import Crypto.Internal.ByteArray (ByteArrayAccess, ScrubbedBytes, Bytes, withByteArray) import qualified Crypto.Internal.ByteArray as B import Crypto.Error (CryptoFailable(..)) import Crypto.Random diff --git a/Crypto/PubKey/Curve448.hs b/Crypto/PubKey/Curve448.hs index 0900773..7146e56 100644 --- a/Crypto/PubKey/Curve448.hs +++ b/Crypto/PubKey/Curve448.hs @@ -28,7 +28,6 @@ module Crypto.PubKey.Curve448 import Data.Word import Foreign.Ptr -import GHC.Ptr import Crypto.Error import Crypto.Random diff --git a/Crypto/PubKey/DH.hs b/Crypto/PubKey/DH.hs index 152b1b5..db4de76 100644 --- a/Crypto/PubKey/DH.hs +++ b/Crypto/PubKey/DH.hs @@ -33,7 +33,7 @@ data Params = Params { params_p :: Integer , params_g :: Integer , params_bits :: Int - } deriving (Show,Read,Eq,Data,Typeable) + } deriving (Show,Read,Eq,Data) instance NFData Params where rnf (Params p g bits) = rnf p `seq` rnf g `seq` bits `seq` () diff --git a/Crypto/PubKey/DSA.hs b/Crypto/PubKey/DSA.hs index 35fbf37..0f8c0b5 100644 --- a/Crypto/PubKey/DSA.hs +++ b/Crypto/PubKey/DSA.hs @@ -51,7 +51,7 @@ data Params = Params { params_p :: Integer -- ^ DSA p , params_g :: Integer -- ^ DSA g , params_q :: Integer -- ^ DSA q - } deriving (Show,Read,Eq,Data,Typeable) + } deriving (Show,Read,Eq,Data) instance NFData Params where rnf (Params p g q) = p `seq` g `seq` q `seq` () @@ -60,7 +60,7 @@ instance NFData Params where data Signature = Signature { sign_r :: Integer -- ^ DSA r , sign_s :: Integer -- ^ DSA s - } deriving (Show,Read,Eq,Data,Typeable) + } deriving (Show,Read,Eq,Data) instance NFData Signature where rnf (Signature r s) = r `seq` s `seq` () @@ -69,7 +69,7 @@ instance NFData Signature where data PublicKey = PublicKey { public_params :: Params -- ^ DSA parameters , public_y :: PublicNumber -- ^ DSA public Y - } deriving (Show,Read,Eq,Data,Typeable) + } deriving (Show,Read,Eq,Data) instance NFData PublicKey where rnf (PublicKey params y) = y `seq` params `seq` () @@ -81,14 +81,14 @@ instance NFData PublicKey where data PrivateKey = PrivateKey { private_params :: Params -- ^ DSA parameters , private_x :: PrivateNumber -- ^ DSA private X - } deriving (Show,Read,Eq,Data,Typeable) + } deriving (Show,Read,Eq,Data) instance NFData PrivateKey where rnf (PrivateKey params x) = x `seq` params `seq` () -- | Represent a DSA key pair data KeyPair = KeyPair Params PublicNumber PrivateNumber - deriving (Show,Read,Eq,Data,Typeable) + deriving (Show,Read,Eq,Data) instance NFData KeyPair where rnf (KeyPair params y x) = x `seq` y `seq` params `seq` () diff --git a/Crypto/PubKey/ECC/ECDSA.hs b/Crypto/PubKey/ECC/ECDSA.hs index 6c51242..4cfc4b8 100644 --- a/Crypto/PubKey/ECC/ECDSA.hs +++ b/Crypto/PubKey/ECC/ECDSA.hs @@ -31,23 +31,23 @@ import Crypto.Random.Types data Signature = Signature { sign_r :: Integer -- ^ ECDSA r , sign_s :: Integer -- ^ ECDSA s - } deriving (Show,Read,Eq,Data,Typeable) + } deriving (Show,Read,Eq,Data) -- | ECDSA Private Key. data PrivateKey = PrivateKey { private_curve :: Curve , private_d :: PrivateNumber - } deriving (Show,Read,Eq,Data,Typeable) + } deriving (Show,Read,Eq,Data) -- | ECDSA Public Key. data PublicKey = PublicKey { public_curve :: Curve , public_q :: PublicPoint - } deriving (Show,Read,Eq,Data,Typeable) + } deriving (Show,Read,Eq,Data) -- | ECDSA Key Pair. data KeyPair = KeyPair Curve PublicPoint PrivateNumber - deriving (Show,Read,Eq,Data,Typeable) + deriving (Show,Read,Eq,Data) -- | Public key of a ECDSA Key pair. toPublicKey :: KeyPair -> PublicKey diff --git a/Crypto/PubKey/ECC/Types.hs b/Crypto/PubKey/ECC/Types.hs index 4f34f2e..ac2c9f5 100644 --- a/Crypto/PubKey/ECC/Types.hs +++ b/Crypto/PubKey/ECC/Types.hs @@ -33,7 +33,7 @@ import Crypto.Number.Basic (numBits) -- | Define either a binary curve or a prime curve. data Curve = CurveF2m CurveBinary -- ^ 𝔽(2^m) | CurveFP CurvePrime -- ^ 𝔽p - deriving (Show,Read,Eq,Data,Typeable) + deriving (Show,Read,Eq,Data) -- | ECC Public Point type PublicPoint = Point @@ -44,7 +44,7 @@ type PrivateNumber = Integer -- | Define a point on a curve. data Point = Point Integer Integer | PointO -- ^ Point at Infinity - deriving (Show,Read,Eq,Data,Typeable) + deriving (Show,Read,Eq,Data) instance NFData Point where rnf (Point x y) = x `seq` y `seq` () @@ -53,7 +53,7 @@ instance NFData Point where -- | Define an elliptic curve in 𝔽(2^m). -- The firt parameter is the Integer representatioin of the irreducible polynomial f(x). data CurveBinary = CurveBinary Integer CurveCommon - deriving (Show,Read,Eq,Data,Typeable) + deriving (Show,Read,Eq,Data) instance NFData CurveBinary where rnf (CurveBinary i cc) = i `seq` cc `seq` () @@ -61,7 +61,7 @@ instance NFData CurveBinary where -- | Define an elliptic curve in 𝔽p. -- The first parameter is the Prime Number. data CurvePrime = CurvePrime Integer CurveCommon - deriving (Show,Read,Eq,Data,Typeable) + deriving (Show,Read,Eq,Data) -- | Parameters in common between binary and prime curves. common_curve :: Curve -> CurveCommon @@ -84,7 +84,7 @@ data CurveCommon = CurveCommon , ecc_g :: Point -- ^ base point , ecc_n :: Integer -- ^ order of G , ecc_h :: Integer -- ^ cofactor - } deriving (Show,Read,Eq,Data,Typeable) + } deriving (Show,Read,Eq,Data) -- | Define names for known recommended curves. data CurveName = @@ -121,7 +121,7 @@ data CurveName = | SEC_t409r1 | SEC_t571k1 | SEC_t571r1 - deriving (Show,Read,Eq,Ord,Enum,Bounded,Data,Typeable) + deriving (Show,Read,Eq,Ord,Enum,Bounded,Data) {- curvesOIDs :: [ (CurveName, [Integer]) ] diff --git a/Crypto/PubKey/ECIES.hs b/Crypto/PubKey/ECIES.hs index 7c9c3aa..c6b92ec 100644 --- a/Crypto/PubKey/ECIES.hs +++ b/Crypto/PubKey/ECIES.hs @@ -27,7 +27,6 @@ module Crypto.PubKey.ECIES import Crypto.ECC import Crypto.Error import Crypto.Random -import Crypto.Internal.Proxy -- | Generate random a new Shared secret and the associated point -- to do a ECIES style encryption diff --git a/Crypto/PubKey/RSA.hs b/Crypto/PubKey/RSA.hs index 131da3d..3ce15da 100644 --- a/Crypto/PubKey/RSA.hs +++ b/Crypto/PubKey/RSA.hs @@ -16,7 +16,6 @@ module Crypto.PubKey.RSA , generateBlinder ) where -import Crypto.Internal.Imports import Crypto.Random.Types import Crypto.Number.ModArithmetic (inverse, inverseCoprimes) import Crypto.Number.Generate (generateMax) diff --git a/Crypto/PubKey/RSA/Types.hs b/Crypto/PubKey/RSA/Types.hs index d3ac487..ae29d27 100644 --- a/Crypto/PubKey/RSA/Types.hs +++ b/Crypto/PubKey/RSA/Types.hs @@ -42,7 +42,7 @@ data PublicKey = PublicKey { public_size :: Int -- ^ size of key in bytes , public_n :: Integer -- ^ public p*q , public_e :: Integer -- ^ public exponent e - } deriving (Show,Read,Eq,Data,Typeable) + } deriving (Show,Read,Eq,Data) instance NFData PublicKey where rnf (PublicKey sz n e) = rnf n `seq` rnf e `seq` sz `seq` () @@ -65,7 +65,7 @@ data PrivateKey = PrivateKey , private_dP :: Integer -- ^ d mod (p-1) , private_dQ :: Integer -- ^ d mod (q-1) , private_qinv :: Integer -- ^ q^(-1) mod p - } deriving (Show,Read,Eq,Data,Typeable) + } deriving (Show,Read,Eq,Data) instance NFData PrivateKey where rnf (PrivateKey pub d p q dp dq qinv) = @@ -87,7 +87,7 @@ private_e = public_e . private_pub -- -- note the RSA private key contains already an instance of public key for efficiency newtype KeyPair = KeyPair PrivateKey - deriving (Show,Read,Eq,Data,Typeable,NFData) + deriving (Show,Read,Eq,Data,NFData) -- | Public key of a RSA KeyPair toPublicKey :: KeyPair -> PublicKey diff --git a/Crypto/PubKey/Rabin/Basic.hs b/Crypto/PubKey/Rabin/Basic.hs index bcce97a..b05269a 100644 --- a/Crypto/PubKey/Rabin/Basic.hs +++ b/Crypto/PubKey/Rabin/Basic.hs @@ -27,9 +27,8 @@ import Data.Data import Data.Either (rights) import Crypto.Hash -import Crypto.Number.Basic (gcde, numBytes, asPowerOf2AndOdd) +import Crypto.Number.Basic (gcde, numBytes) import Crypto.Number.ModArithmetic (expSafe, jacobi) -import Crypto.Number.Prime (isProbablyPrime) import Crypto.Number.Serialize (i2osp, i2ospOf_, os2ip) import Crypto.PubKey.Rabin.OAEP import Crypto.PubKey.Rabin.Types @@ -39,7 +38,7 @@ import Crypto.Random (MonadRandom, getRandomBytes) data PublicKey = PublicKey { public_size :: Int -- ^ size of key in bytes , public_n :: Integer -- ^ public p*q - } deriving (Show, Read, Eq, Data, Typeable) + } deriving (Show, Read, Eq, Data) -- | Represent a Rabin private key. data PrivateKey = PrivateKey @@ -48,10 +47,10 @@ data PrivateKey = PrivateKey , private_q :: Integer -- ^ q prime number , private_a :: Integer , private_b :: Integer - } deriving (Show, Read, Eq, Data, Typeable) + } deriving (Show, Read, Eq, Data) -- | Rabin Signature. -data Signature = Signature (Integer, Integer) deriving (Show, Read, Eq, Data, Typeable) +data Signature = Signature (Integer, Integer) deriving (Show, Read, Eq, Data) -- | Generate a pair of (private, public) key of size in bytes. -- Primes p and q are both congruent 3 mod 4. diff --git a/Crypto/PubKey/Rabin/Modified.hs b/Crypto/PubKey/Rabin/Modified.hs index f3836ab..e7ea7d7 100644 --- a/Crypto/PubKey/Rabin/Modified.hs +++ b/Crypto/PubKey/Rabin/Modified.hs @@ -18,13 +18,11 @@ module Crypto.PubKey.Rabin.Modified ) where import Data.ByteString -import qualified Data.ByteString as B import Data.Data import Crypto.Hash -import Crypto.Number.Basic (gcde) import Crypto.Number.ModArithmetic (expSafe, jacobi) -import Crypto.Number.Serialize (i2osp, os2ip) +import Crypto.Number.Serialize (os2ip) import Crypto.PubKey.Rabin.Types import Crypto.Random.Types @@ -32,7 +30,7 @@ import Crypto.Random.Types data PublicKey = PublicKey { public_size :: Int -- ^ size of key in bytes , public_n :: Integer -- ^ public p*q - } deriving (Show, Read, Eq, Data, Typeable) + } deriving (Show, Read, Eq, Data) -- | Represent a Modified-Rabin private key. data PrivateKey = PrivateKey @@ -40,7 +38,7 @@ data PrivateKey = PrivateKey , private_p :: Integer -- ^ p prime number , private_q :: Integer -- ^ q prime number , private_d :: Integer - } deriving (Show, Read, Eq, Data, Typeable) + } deriving (Show, Read, Eq, Data) -- | Generate a pair of (private, public) key of size in bytes. -- Prime p is congruent 3 mod 8 and prime q is congruent 7 mod 8. diff --git a/Crypto/PubKey/Rabin/RW.hs b/Crypto/PubKey/Rabin/RW.hs index 7b0bcaa..1aec25c 100644 --- a/Crypto/PubKey/Rabin/RW.hs +++ b/Crypto/PubKey/Rabin/RW.hs @@ -22,11 +22,10 @@ module Crypto.PubKey.Rabin.RW ) where import Data.ByteString -import qualified Data.ByteString as B import Data.Data import Crypto.Hash -import Crypto.Number.Basic (numBytes, gcde) +import Crypto.Number.Basic (numBytes) import Crypto.Number.ModArithmetic (expSafe, jacobi) import Crypto.Number.Serialize (i2osp, i2ospOf_, os2ip) import Crypto.PubKey.Rabin.OAEP @@ -37,7 +36,7 @@ import Crypto.Random.Types data PublicKey = PublicKey { public_size :: Int -- ^ size of key in bytes , public_n :: Integer -- ^ public p*q - } deriving (Show, Read, Eq, Data, Typeable) + } deriving (Show, Read, Eq, Data) -- | Represent a Rabin-Williams private key. data PrivateKey = PrivateKey @@ -45,7 +44,7 @@ data PrivateKey = PrivateKey , private_p :: Integer -- ^ p prime number , private_q :: Integer -- ^ q prime number , private_d :: Integer - } deriving (Show, Read, Eq, Data, Typeable) + } deriving (Show, Read, Eq, Data) -- | Generate a pair of (private, public) key of size in bytes. -- Prime p is congruent 3 mod 8 and prime q is congruent 7 mod 8. diff --git a/Crypto/Random/ChaChaDRG.hs b/Crypto/Random/ChaChaDRG.hs index e23a444..5062b59 100644 --- a/Crypto/Random/ChaChaDRG.hs +++ b/Crypto/Random/ChaChaDRG.hs @@ -29,7 +29,7 @@ newtype ChaChaDRG = ChaChaDRG C.StateSimple -- | Initialize a new ChaCha context with the number of rounds, -- the key and the nonce associated. -initialize :: B.ByteArrayAccess seed +initialize :: ByteArrayAccess seed => seed -- ^ 40 bytes of seed -> ChaChaDRG -- ^ the initial ChaCha state initialize seed = ChaChaDRG $ C.initializeSimple seed diff --git a/Crypto/Random/SystemDRG.hs b/Crypto/Random/SystemDRG.hs index 50872f2..4f401ca 100644 --- a/Crypto/Random/SystemDRG.hs +++ b/Crypto/Random/SystemDRG.hs @@ -14,7 +14,6 @@ module Crypto.Random.SystemDRG import Crypto.Random.Types import Crypto.Random.Entropy.Unsafe import Crypto.Internal.Compat -import Crypto.Internal.Imports import Data.ByteArray (ScrubbedBytes, ByteArray) import Data.Memory.PtrMethods as B (memCopy) import Data.Maybe (catMaybes) diff --git a/Crypto/Random/Types.hs b/Crypto/Random/Types.hs index 8bcee6f..2806fc3 100644 --- a/Crypto/Random/Types.hs +++ b/Crypto/Random/Types.hs @@ -15,7 +15,6 @@ module Crypto.Random.Types import Crypto.Random.Entropy import Crypto.Internal.ByteArray -import Crypto.Internal.Imports -- | A monad constraint that allows to generate random bytes class (Functor m, Monad m) => MonadRandom m where @@ -47,7 +46,7 @@ instance DRG gen => Applicative (MonadPseudoRandom gen) where in (f a, g3) instance DRG gen => Monad (MonadPseudoRandom gen) where - return a = MonadPseudoRandom $ \g -> (a, g) + return = pure (>>=) m1 m2 = MonadPseudoRandom $ \g1 -> let (a, g2) = runPseudoRandom m1 g1 in runPseudoRandom (m2 a) g2 @@ -57,5 +56,5 @@ instance DRG gen => MonadRandom (MonadPseudoRandom gen) where -- | Run a pure computation with a Deterministic Random Generator -- in the 'MonadPseudoRandom' -withDRG :: DRG gen => gen -> MonadPseudoRandom gen a -> (a, gen) +withDRG :: gen -> MonadPseudoRandom gen a -> (a, gen) withDRG gen m = runPseudoRandom m gen diff --git a/stack.yaml b/stack.yaml index 946d1a4..bf246bb 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1,3 @@ # ~*~ auto-generated by haskell-ci with config : 8f74deffc95fd794fa2996c167c6543bbfab1ae432f0a83e0898f0b5871a92eb ~*~ -{ resolver: lts-12.26, packages: [ '.' ], extra-deps: [], flags: {} } +{ resolver: lts-13.2, packages: [ '.' ], extra-deps: [], flags: {} } diff --git a/tests/BlockCipher.hs b/tests/BlockCipher.hs index 2fc1248..38adcb2 100644 --- a/tests/BlockCipher.hs +++ b/tests/BlockCipher.hs @@ -307,7 +307,7 @@ generateIvAEAD :: Gen B.ByteString generateIvAEAD = choose (12,90) >>= \sz -> (B.pack <$> replicateM sz arbitrary) -- | Generate a plaintext multiple of blocksize bytes -generatePlaintextMultipleBS :: BlockCipher a => Gen (PlaintextBS a) +generatePlaintextMultipleBS :: Gen (PlaintextBS a) generatePlaintextMultipleBS = choose (1,128) >>= \size -> replicateM (size * 16) arbitrary >>= return . PlaintextBS . B.pack -- | Generate any sized plaintext @@ -474,7 +474,7 @@ testBlockCipher kats cipher = testGroup (cipherName cipher) ++ testModes cipher ++ testIvArith cipher ) -cipherMakeKey :: Cipher cipher => cipher -> ByteString -> Key cipher +cipherMakeKey :: cipher -> ByteString -> Key cipher cipherMakeKey _ bs = Key bs cipherMakeIV :: BlockCipher cipher => cipher -> ByteString -> IV cipher diff --git a/tests/KAT_CAST5.hs b/tests/KAT_CAST5.hs index c220760..6d35862 100644 --- a/tests/KAT_CAST5.hs +++ b/tests/KAT_CAST5.hs @@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} module KAT_CAST5 (tests) where -import Imports import BlockCipher import qualified Crypto.Cipher.CAST5 as CAST5 diff --git a/tests/KAT_HKDF.hs b/tests/KAT_HKDF.hs index 1593cf9..cb72892 100644 --- a/tests/KAT_HKDF.hs +++ b/tests/KAT_HKDF.hs @@ -2,10 +2,7 @@ module KAT_HKDF (tests) where import qualified Crypto.KDF.HKDF as HKDF -import Crypto.Hash (MD5(..), SHA1(..), SHA256(..) - , Keccak_224(..), Keccak_256(..), Keccak_384(..), Keccak_512(..) - , SHA3_224(..), SHA3_256(..), SHA3_384(..), SHA3_512(..) - , HashAlgorithm, digestFromByteString) +import Crypto.Hash (SHA256(..), HashAlgorithm) import qualified Data.ByteString as B import Imports diff --git a/tests/KAT_MiyaguchiPreneel.hs b/tests/KAT_MiyaguchiPreneel.hs index 163e434..9928622 100644 --- a/tests/KAT_MiyaguchiPreneel.hs +++ b/tests/KAT_MiyaguchiPreneel.hs @@ -6,7 +6,6 @@ import Crypto.ConstructHash.MiyaguchiPreneel as MiyaguchiPreneel import Imports -import Data.Char (digitToInt) import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteArray as B import Data.ByteArray.Encoding (Base (Base16), convertFromBase) diff --git a/tests/KAT_OTP.hs b/tests/KAT_OTP.hs index d4d946f..f6fc1b6 100644 --- a/tests/KAT_OTP.hs +++ b/tests/KAT_OTP.hs @@ -94,9 +94,9 @@ tests = testGroup "OTP" ] , testGroup "TOTP" [ testGroup "KATs" - [ testGroup "SHA1" (makeKATs (totp totpSHA1Params otpKey . fromIntegral) totpSHA1Expected) - , testGroup "SHA256" (makeKATs (totp totpSHA256Params totpSHA256Key . fromIntegral) totpSHA256Expected) - , testGroup "SHA512" (makeKATs (totp totpSHA512Params totpSHA512Key . fromIntegral) totpSHA512Expected) + [ testGroup "SHA1" (makeKATs (totp totpSHA1Params otpKey) totpSHA1Expected) + , testGroup "SHA256" (makeKATs (totp totpSHA256Params totpSHA256Key) totpSHA256Expected) + , testGroup "SHA512" (makeKATs (totp totpSHA512Params totpSHA512Key) totpSHA512Expected) ] ] ] diff --git a/tests/Padding.hs b/tests/Padding.hs index f7be773..cc4dcf6 100644 --- a/tests/Padding.hs +++ b/tests/Padding.hs @@ -3,7 +3,6 @@ module Padding (tests) where import qualified Data.ByteString as B import Imports -import Crypto.Error import Crypto.Data.Padding From af9f9548d6c6fb5dad335c8bcdb66156a70ab2e8 Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Thu, 21 Feb 2019 17:16:00 +0530 Subject: [PATCH 045/176] Update reference blake2 implementation with upstream --- cbits/blake2/ref/blake2-impl.h | 4 ++-- cbits/blake2/ref/blake2s-ref.c | 2 +- cbits/blake2/sse/blake2-impl.h | 4 ++-- cryptonite.externals | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/cbits/blake2/ref/blake2-impl.h b/cbits/blake2/ref/blake2-impl.h index 5dff7fc..c1df82e 100644 --- a/cbits/blake2/ref/blake2-impl.h +++ b/cbits/blake2/ref/blake2-impl.h @@ -72,8 +72,8 @@ static BLAKE2_INLINE uint16_t load16( const void *src ) return w; #else const uint8_t *p = ( const uint8_t * )src; - return (( uint16_t )( p[0] ) << 0) | - (( uint16_t )( p[1] ) << 8) ; + return ( uint16_t )((( uint32_t )( p[0] ) << 0) | + (( uint32_t )( p[1] ) << 8)); #endif } diff --git a/cbits/blake2/ref/blake2s-ref.c b/cbits/blake2/ref/blake2s-ref.c index fbf4265..c8b035f 100644 --- a/cbits/blake2/ref/blake2s-ref.c +++ b/cbits/blake2/ref/blake2s-ref.c @@ -294,7 +294,7 @@ int blake2s( void *out, size_t outlen, const void *in, size_t inlen, const void #if defined(SUPERCOP) int crypto_hash( unsigned char *out, unsigned char *in, unsigned long long inlen ) { - return blake2s( out, BLAKE2S_OUTBYTES in, inlen, NULL, 0 ); + return blake2s( out, BLAKE2S_OUTBYTES, in, inlen, NULL, 0 ); } #endif diff --git a/cbits/blake2/sse/blake2-impl.h b/cbits/blake2/sse/blake2-impl.h index 5dff7fc..c1df82e 100644 --- a/cbits/blake2/sse/blake2-impl.h +++ b/cbits/blake2/sse/blake2-impl.h @@ -72,8 +72,8 @@ static BLAKE2_INLINE uint16_t load16( const void *src ) return w; #else const uint8_t *p = ( const uint8_t * )src; - return (( uint16_t )( p[0] ) << 0) | - (( uint16_t )( p[1] ) << 8) ; + return ( uint16_t )((( uint32_t )( p[0] ) << 0) | + (( uint32_t )( p[1] ) << 8)); #endif } diff --git a/cryptonite.externals b/cryptonite.externals index 55c81d2..abf5d81 100644 --- a/cryptonite.externals +++ b/cryptonite.externals @@ -1 +1 @@ -cbits/blake2,7728c30896d3fa0c3b4df52c2bd5a1e36f8f1287,https://github.com/blake2/blake2 +cbits/blake2,320c325437539ae91091ce62efec1913cd8093c2,https://github.com/blake2/blake2 From dee3782a83b3b4b891a80bbff7561fd36c006ce5 Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Fri, 22 Feb 2019 03:28:57 +0530 Subject: [PATCH 046/176] Add Changelog --- CHANGELOG.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 88071ad..97c5f52 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +## 0.26 + +* Update blake2 to latest upstream version + ## 0.25 * Improve digest binary conversion efficiency From 133c6e1b2d159b9170c0a50587534dff69a6e557 Mon Sep 17 00:00:00 2001 From: Crockett Date: Sun, 24 Feb 2019 17:04:10 -0800 Subject: [PATCH 047/176] Added some redundant constraints for documentation/consistency. Added an INLINABLE pragma to i2ospOf to hopefully increase specializations. --- Crypto/KDF/PBKDF2.hs | 2 +- Crypto/Number/Serialize.hs | 1 + Crypto/OTP.hs | 4 ++-- Crypto/Random/Types.hs | 2 +- tests/BlockCipher.hs | 4 ++-- 5 files changed, 7 insertions(+), 6 deletions(-) diff --git a/Crypto/KDF/PBKDF2.hs b/Crypto/KDF/PBKDF2.hs index 7a3337c..027086e 100644 --- a/Crypto/KDF/PBKDF2.hs +++ b/Crypto/KDF/PBKDF2.hs @@ -54,7 +54,7 @@ data Parameters = Parameters } -- | generate the pbkdf2 key derivation function from the output -generate :: (ByteArrayAccess salt, ByteArray ba) +generate :: (ByteArrayAccess password, ByteArrayAccess salt, ByteArray ba) => PRF password -> Parameters -> password diff --git a/Crypto/Number/Serialize.hs b/Crypto/Number/Serialize.hs index 9855c5b..858e848 100644 --- a/Crypto/Number/Serialize.hs +++ b/Crypto/Number/Serialize.hs @@ -35,6 +35,7 @@ i2osp m = B.allocAndFreeze sz (\p -> Internal.i2osp m p sz >> return ()) -- | Just like 'i2osp', but takes an extra parameter for size. -- If the number is too big to fit in @len@ bytes, 'Nothing' is returned -- otherwise the number is padded with 0 to fit the @len@ required. +{-# INLINABLE i2ospOf #-} i2ospOf :: B.ByteArray ba => Int -> Integer -> Maybe ba i2ospOf len m | len <= 0 = Nothing diff --git a/Crypto/OTP.hs b/Crypto/OTP.hs index 9b5b383..44503ff 100644 --- a/Crypto/OTP.hs +++ b/Crypto/OTP.hs @@ -129,8 +129,8 @@ defaultTOTPParams :: TOTPParams SHA1 defaultTOTPParams = TP SHA1 0 30 OTP6 TwoSteps -- | Create a TOTP configuration with customized parameters. -mkTOTPParams :: - hash +mkTOTPParams :: (HashAlgorithm hash) + => hash -> OTPTime -- ^ The T0 parameter in seconds. This is the Unix time from which to start -- counting steps (default 0). Must be before the current time. diff --git a/Crypto/Random/Types.hs b/Crypto/Random/Types.hs index 2806fc3..961be8a 100644 --- a/Crypto/Random/Types.hs +++ b/Crypto/Random/Types.hs @@ -56,5 +56,5 @@ instance DRG gen => MonadRandom (MonadPseudoRandom gen) where -- | Run a pure computation with a Deterministic Random Generator -- in the 'MonadPseudoRandom' -withDRG :: gen -> MonadPseudoRandom gen a -> (a, gen) +withDRG :: DRG gen => gen -> MonadPseudoRandom gen a -> (a, gen) withDRG gen m = runPseudoRandom m gen diff --git a/tests/BlockCipher.hs b/tests/BlockCipher.hs index 38adcb2..2fc1248 100644 --- a/tests/BlockCipher.hs +++ b/tests/BlockCipher.hs @@ -307,7 +307,7 @@ generateIvAEAD :: Gen B.ByteString generateIvAEAD = choose (12,90) >>= \sz -> (B.pack <$> replicateM sz arbitrary) -- | Generate a plaintext multiple of blocksize bytes -generatePlaintextMultipleBS :: Gen (PlaintextBS a) +generatePlaintextMultipleBS :: BlockCipher a => Gen (PlaintextBS a) generatePlaintextMultipleBS = choose (1,128) >>= \size -> replicateM (size * 16) arbitrary >>= return . PlaintextBS . B.pack -- | Generate any sized plaintext @@ -474,7 +474,7 @@ testBlockCipher kats cipher = testGroup (cipherName cipher) ++ testModes cipher ++ testIvArith cipher ) -cipherMakeKey :: cipher -> ByteString -> Key cipher +cipherMakeKey :: Cipher cipher => cipher -> ByteString -> Key cipher cipherMakeKey _ bs = Key bs cipherMakeIV :: BlockCipher cipher => cipher -> ByteString -> IV cipher From 65932e5a7eda3e57947d2587a5804153b926eb11 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Mon, 25 Feb 2019 06:40:53 +0100 Subject: [PATCH 048/176] Add missing Data instances in Crypto.Hash.Blake2 --- Crypto/Hash/Blake2.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Crypto/Hash/Blake2.hs b/Crypto/Hash/Blake2.hs index 1e06c40..1ad666a 100644 --- a/Crypto/Hash/Blake2.hs +++ b/Crypto/Hash/Blake2.hs @@ -57,7 +57,7 @@ import Crypto.Internal.Nat -- * Blake2s 256 -- data Blake2s (bitlen :: Nat) = Blake2s - deriving (Show) + deriving (Show,Data) instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost bitlen 256) => HashAlgorithm (Blake2s bitlen) @@ -92,7 +92,7 @@ foreign import ccall unsafe "cryptonite_blake2s_finalize" -- * Blake2b 512 -- data Blake2b (bitlen :: Nat) = Blake2b - deriving (Show) + deriving (Show,Data) instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost bitlen 512) => HashAlgorithm (Blake2b bitlen) @@ -115,7 +115,7 @@ foreign import ccall unsafe "cryptonite_blake2b_finalize" c_blake2b_finalize :: Ptr (Context a) -> Word32 -> Ptr (Digest a) -> IO () data Blake2sp (bitlen :: Nat) = Blake2sp - deriving (Show) + deriving (Show,Data) instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost bitlen 256) => HashAlgorithm (Blake2sp bitlen) @@ -138,7 +138,7 @@ foreign import ccall unsafe "cryptonite_blake2sp_finalize" c_blake2sp_finalize :: Ptr (Context a) -> Word32 -> Ptr (Digest a) -> IO () data Blake2bp (bitlen :: Nat) = Blake2bp - deriving (Show) + deriving (Show,Data) instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost bitlen 512) => HashAlgorithm (Blake2bp bitlen) From 8c77f0c1ea2f9ba87d34af2f311f24a1434928b1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Mon, 25 Feb 2019 06:42:44 +0100 Subject: [PATCH 049/176] Update generation templates per latest changes --- gen/template/hash-len.hs | 5 ++--- gen/template/hash.hs | 5 ++--- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/gen/template/hash-len.hs b/gen/template/hash-len.hs index 5ddff85..bbdb46a 100644 --- a/gen/template/hash-len.hs +++ b/gen/template/hash-len.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- %%MODULENAME%% cryptographic hash. -- {-# LANGUAGE ForeignFunctionInterface #-} @@ -19,13 +19,12 @@ module Crypto.Hash.%%MODULENAME%% import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) %{CUSTOMIZABLE%} -- | %%MODULENAME%% (%%CUSTOM_BITSIZE%% bits) cryptographic hash algorithm data %%MODULENAME%%_%%CUSTOM_BITSIZE%% = %%MODULENAME%%_%%CUSTOM_BITSIZE%% - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm %%MODULENAME%%_%%CUSTOM_BITSIZE%% where type HashBlockSize %%MODULENAME%%_%%CUSTOM_BITSIZE%% = %%CUSTOM_BLOCK_SIZE_BYTES%% diff --git a/gen/template/hash.hs b/gen/template/hash.hs index c602b54..4748054 100644 --- a/gen/template/hash.hs +++ b/gen/template/hash.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- %%MODULENAME%% cryptographic hash. -- {-# LANGUAGE ForeignFunctionInterface #-} @@ -17,12 +17,11 @@ module Crypto.Hash.%%MODULENAME%% ( %%MODULENAME%% (..) ) where import Crypto.Hash.Types import Foreign.Ptr (Ptr) import Data.Data -import Data.Typeable import Data.Word (Word8, Word32) -- | %%MODULENAME%% cryptographic hash algorithm data %%MODULENAME%% = %%MODULENAME%% - deriving (Show,Data,Typeable) + deriving (Show,Data) instance HashAlgorithm %%MODULENAME%% where type HashBlockSize %%MODULENAME%% = %%BLOCK_SIZE_BYTES%% From eccbc118243385626e15a2512c9f67df22baa5c5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 26 Oct 2018 20:51:01 +0200 Subject: [PATCH 050/176] Remove Crypto.Internal.Proxy Data.Proxy can be used instead now that GHC >= 8.0. In Data.Proxy the Proxy type is poly-kinded. --- Crypto/ECC.hs | 2 +- Crypto/ECC/Simple/Prim.hs | 2 +- Crypto/Internal/Proxy.hs | 13 ------------- Crypto/Random/Entropy/Backend.hs | 2 +- cryptonite.cabal | 1 - 5 files changed, 3 insertions(+), 17 deletions(-) delete mode 100644 Crypto/Internal/Proxy.hs diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index 34a911f..8391b5a 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -31,7 +31,6 @@ import qualified Crypto.ECC.Simple.Types as Simple import qualified Crypto.ECC.Simple.Prim as Simple import Crypto.Random import Crypto.Error -import Crypto.Internal.Proxy import Crypto.Internal.Imports import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes) import qualified Crypto.Internal.ByteArray as B @@ -41,6 +40,7 @@ import qualified Crypto.PubKey.Curve448 as X448 import Data.ByteArray (convert) import Data.Data (Data()) import Data.Kind (Type) +import Data.Proxy -- | An elliptic curve key pair composed of the private part (a scalar), and -- the associated point. diff --git a/Crypto/ECC/Simple/Prim.hs b/Crypto/ECC/Simple/Prim.hs index 25d8fe1..48e94cb 100644 --- a/Crypto/ECC/Simple/Prim.hs +++ b/Crypto/ECC/Simple/Prim.hs @@ -17,7 +17,7 @@ module Crypto.ECC.Simple.Prim ) where import Data.Maybe -import Crypto.Internal.Proxy +import Data.Proxy import Crypto.Number.ModArithmetic import Crypto.Number.F2m import Crypto.Number.Generate (generateBetween) diff --git a/Crypto/Internal/Proxy.hs b/Crypto/Internal/Proxy.hs deleted file mode 100644 index 1873b2b..0000000 --- a/Crypto/Internal/Proxy.hs +++ /dev/null @@ -1,13 +0,0 @@ --- | --- Module : Crypto.Internal.Proxy --- License : BSD-style --- Maintainer : Vincent Hanquez --- Stability : experimental --- Portability : Good --- -module Crypto.Internal.Proxy - ( Proxy(..) - ) where - --- | A type witness for 'a' as phantom type -data Proxy a = Proxy diff --git a/Crypto/Random/Entropy/Backend.hs b/Crypto/Random/Entropy/Backend.hs index eb2a92e..ca2acc2 100644 --- a/Crypto/Random/Entropy/Backend.hs +++ b/Crypto/Random/Entropy/Backend.hs @@ -14,8 +14,8 @@ module Crypto.Random.Entropy.Backend ) where import Foreign.Ptr +import Data.Proxy import Data.Word (Word8) -import Crypto.Internal.Proxy import Crypto.Random.Entropy.Source #ifdef SUPPORT_RDRAND import Crypto.Random.Entropy.RDRand diff --git a/cryptonite.cabal b/cryptonite.cabal index 2c09c5c..35c8dc6 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -220,7 +220,6 @@ Library Crypto.PubKey.ElGamal Crypto.ECC.Simple.Types Crypto.ECC.Simple.Prim - Crypto.Internal.Proxy Crypto.Internal.ByteArray Crypto.Internal.Compat Crypto.Internal.CompatPrim From 3c41966b9a9ff7f48c23dcc5cce9810b1726c75f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 27 Oct 2018 08:27:59 +0200 Subject: [PATCH 051/176] Add module Crypto.Number.Nat This new module exposes type constraints required by some hash algorithms and provides functions to check whether the constraints are satisfied with runtime values. Resolves #256. --- Crypto/Internal/Nat.hs | 3 ++ Crypto/Number/Nat.hs | 63 ++++++++++++++++++++++++++++++++++++++++++ cryptonite.cabal | 1 + 3 files changed, 67 insertions(+) create mode 100644 Crypto/Number/Nat.hs diff --git a/Crypto/Internal/Nat.hs b/Crypto/Internal/Nat.hs index dfa3a4d..03b75c0 100644 --- a/Crypto/Internal/Nat.hs +++ b/Crypto/Internal/Nat.hs @@ -9,6 +9,7 @@ module Crypto.Internal.Nat , type IsAtMost, type IsAtLeast , byteLen , integralNatVal + , type IsDiv8 , type Div8 , type Mod8 ) where @@ -207,4 +208,6 @@ type family Mod8 (n :: Nat) where Mod8 63 = 7 Mod8 n = Mod8 (n - 64) +-- | ensure the given `bitlen` is divisible by 8 +-- type IsDivisibleBy8 bitLen = IsDiv8 bitLen bitLen ~ 'True diff --git a/Crypto/Number/Nat.hs b/Crypto/Number/Nat.hs new file mode 100644 index 0000000..8620bf4 --- /dev/null +++ b/Crypto/Number/Nat.hs @@ -0,0 +1,63 @@ +-- | +-- Module : Crypto.Number.Nat +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : Good +-- +-- Numbers at type level. +-- +-- This module provides extensions to "GHC.TypeLits" and "GHC.TypeNats" useful +-- to work with cryptographic algorithms parameterized with a variable bit +-- length. Constraints like @'IsDivisibleBy8' n@ ensure that the type-level +-- parameter is applicable to the algorithm. +-- +-- Functions are also provided to test whether constraints are satisfied from +-- values known at runtime. The following example shows how to discharge +-- 'IsDivisibleBy8' in a computation @fn@ requiring this constraint: +-- +-- > withDivisibleBy8 :: Integer +-- > -> (forall proxy n . (KnownNat n, IsDivisibleBy8 n) => proxy n -> a) +-- > -> Maybe a +-- > withDivisibleBy8 len fn = do +-- > SomeNat p <- someNatVal len +-- > Refl <- isDivisibleBy8 p +-- > pure (fn p) +-- +-- Function @withDivisibleBy8@ above returns 'Nothing' when the argument @len@ +-- is negative or not divisible by 8. +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +module Crypto.Number.Nat + ( type IsDivisibleBy8 + , type IsAtMost, type IsAtLeast + , isDivisibleBy8 + , isAtMost + , isAtLeast + ) where + +import Data.Type.Equality +import GHC.TypeLits +import Unsafe.Coerce (unsafeCoerce) + +import Crypto.Internal.Nat + +-- | get a runtime proof that the constraint @'IsDivisibleBy8' n@ is satified +isDivisibleBy8 :: KnownNat n => proxy n -> Maybe (IsDiv8 n n :~: 'True) +isDivisibleBy8 n + | mod (natVal n) 8 == 0 = Just (unsafeCoerce Refl) + | otherwise = Nothing + +-- | get a runtime proof that the constraint @'IsAtMost' value bound@ is +-- satified +isAtMost :: (KnownNat value, KnownNat bound) + => proxy value -> proxy' bound -> Maybe ((value <=? bound) :~: 'True) +isAtMost x y + | natVal x <= natVal y = Just (unsafeCoerce Refl) + | otherwise = Nothing + +-- | get a runtime proof that the constraint @'IsAtLeast' value bound@ is +-- satified +isAtLeast :: (KnownNat value, KnownNat bound) + => proxy value -> proxy' bound -> Maybe ((bound <=? value) :~: 'True) +isAtLeast = flip isAtMost diff --git a/cryptonite.cabal b/cryptonite.cabal index 35c8dc6..7bb1c5c 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -130,6 +130,7 @@ Library Crypto.Number.F2m Crypto.Number.Generate Crypto.Number.ModArithmetic + Crypto.Number.Nat Crypto.Number.Prime Crypto.Number.Serialize Crypto.Number.Serialize.Internal From b55a93dfdc13b758cbd00770b70c4684fdd486e7 Mon Sep 17 00:00:00 2001 From: Baojun Wang Date: Mon, 4 Jun 2018 18:13:29 -0700 Subject: [PATCH 052/176] add ECDSA sign/verify digest APIs (rebased from commit 045793427e8d46594b0b2afedb314d027ec707ab) --- Crypto/PubKey/ECC/ECDSA.hs | 65 ++++++++++++++++++++++++++------------ Crypto/PubKey/Internal.hs | 9 ++++-- 2 files changed, 52 insertions(+), 22 deletions(-) diff --git a/Crypto/PubKey/ECC/ECDSA.hs b/Crypto/PubKey/ECC/ECDSA.hs index 4cfc4b8..24c6e15 100644 --- a/Crypto/PubKey/ECC/ECDSA.hs +++ b/Crypto/PubKey/ECC/ECDSA.hs @@ -10,9 +10,12 @@ module Crypto.PubKey.ECC.ECDSA , KeyPair(..) , toPublicKey , toPrivateKey + , signWithDigest , signWith + , signDigest , sign , verify + , verifyDigest ) where import Control.Monad @@ -24,7 +27,7 @@ import Crypto.Number.ModArithmetic (inverse) import Crypto.Number.Generate import Crypto.PubKey.ECC.Types import Crypto.PubKey.ECC.Prim -import Crypto.PubKey.Internal (dsaTruncHash) +import Crypto.PubKey.Internal (dsaTruncHashDigest) import Crypto.Random.Types -- | Represent a ECDSA signature namely R and S. @@ -57,17 +60,17 @@ toPublicKey (KeyPair curve pub _) = PublicKey curve pub toPrivateKey :: KeyPair -> PrivateKey toPrivateKey (KeyPair curve _ priv) = PrivateKey curve priv --- | Sign message using the private key and an explicit k number. +-- | Sign digest using the private key and an explicit k number. -- -- /WARNING:/ Vulnerable to timing attacks. -signWith :: (ByteArrayAccess msg, HashAlgorithm hash) - => Integer -- ^ k random number - -> PrivateKey -- ^ private key - -> hash -- ^ hash function - -> msg -- ^ message to sign +signWithDigest :: HashAlgorithm hash + => Integer -- ^ k random number + -> PrivateKey -- ^ private key + -> hash -- ^ hash function + -> Digest hash -- ^ digest to sign -> Maybe Signature -signWith k (PrivateKey curve d) hashAlg msg = do - let z = dsaTruncHash hashAlg msg n +signWithDigest k (PrivateKey curve d) hashAlg digest = do + let z = dsaTruncHashDigest hashAlg digest n CurveCommon _ _ g n _ = common_curve curve let point = pointMul curve k g r <- case point of @@ -78,26 +81,44 @@ signWith k (PrivateKey curve d) hashAlg msg = do when (r == 0 || s == 0) Nothing return $ Signature r s +-- | Sign message using the private key and an explicit k number. +-- +-- /WARNING:/ Vulnerable to timing attacks. +signWith :: (ByteArrayAccess msg, HashAlgorithm hash) + => Integer -- ^ k random number + -> PrivateKey -- ^ private key + -> hash -- ^ hash function + -> msg -- ^ message to sign + -> Maybe Signature +signWith k pk hashAlg msg = signWithDigest k pk hashAlg (hashWith hashAlg msg) + +-- | Sign digst using the private key. +-- +-- /WARNING:/ Vulnerable to timing attacks. +signDigest :: (HashAlgorithm hash, MonadRandom m) + => PrivateKey -> hash -> Digest hash -> m Signature +signDigest pk hashAlg digest = do + k <- generateBetween 1 (n - 1) + case signWithDigest k pk hashAlg digest of + Nothing -> signDigest pk hashAlg digest + Just sig -> return sig + where n = ecc_n . common_curve $ private_curve pk + -- | Sign message using the private key. -- -- /WARNING:/ Vulnerable to timing attacks. sign :: (ByteArrayAccess msg, HashAlgorithm hash, MonadRandom m) => PrivateKey -> hash -> msg -> m Signature -sign pk hashAlg msg = do - k <- generateBetween 1 (n - 1) - case signWith k pk hashAlg msg of - Nothing -> sign pk hashAlg msg - Just sig -> return sig - where n = ecc_n . common_curve $ private_curve pk +sign pk hashAlg msg = signDigest pk hashAlg (hashWith hashAlg msg) --- | Verify a bytestring using the public key. -verify :: (ByteArrayAccess msg, HashAlgorithm hash) => hash -> PublicKey -> Signature -> msg -> Bool -verify _ (PublicKey _ PointO) _ _ = False -verify hashAlg pk@(PublicKey curve q) (Signature r s) msg +-- | Verify a digest using the public key. +verifyDigest :: HashAlgorithm hash => hash -> PublicKey -> Signature -> Digest hash -> Bool +verifyDigest _ (PublicKey _ PointO) _ _ = False +verifyDigest hashAlg pk@(PublicKey curve q) (Signature r s) digest | r < 1 || r >= n || s < 1 || s >= n = False | otherwise = maybe False (r ==) $ do w <- inverse s n - let z = dsaTruncHash hashAlg msg n + let z = dsaTruncHashDigest hashAlg digest n u1 = z * w `mod` n u2 = r * w `mod` n x = pointAddTwoMuls curve u1 g u2 q @@ -107,3 +128,7 @@ verify hashAlg pk@(PublicKey curve q) (Signature r s) msg where n = ecc_n cc g = ecc_g cc cc = common_curve $ public_curve pk + +-- | Verify a bytestring using the public key. +verify :: (ByteArrayAccess msg, HashAlgorithm hash) => hash -> PublicKey -> Signature -> msg -> Bool +verify hashAlg pk sig msg = verifyDigest hashAlg pk sig (hashWith hashAlg msg) diff --git a/Crypto/PubKey/Internal.hs b/Crypto/PubKey/Internal.hs index b1631cc..5e0629f 100644 --- a/Crypto/PubKey/Internal.hs +++ b/Crypto/PubKey/Internal.hs @@ -9,6 +9,7 @@ module Crypto.PubKey.Internal ( and' , (&&!) , dsaTruncHash + , dsaTruncHashDigest ) where import Data.Bits (shiftR) @@ -32,8 +33,12 @@ False &&! False = False -- | Truncate and hash for DSA and ECDSA. dsaTruncHash :: (ByteArrayAccess msg, HashAlgorithm hash) => hash -> msg -> Integer -> Integer -dsaTruncHash hashAlg m n +dsaTruncHash hashAlg = dsaTruncHashDigest hashAlg . hashWith hashAlg + +-- | Truncate a digest for DSA and ECDSA. +dsaTruncHashDigest :: HashAlgorithm hash => hash -> Digest hash -> Integer -> Integer +dsaTruncHashDigest hashAlg digest n | d > 0 = shiftR e d | otherwise = e - where e = os2ip $ hashWith hashAlg m + where e = os2ip digest d = hashDigestSize hashAlg * 8 - numBits n From 997cea369b7b520a91178a3fa3968267cb97bcd9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Thu, 28 Feb 2019 21:14:18 +0100 Subject: [PATCH 053/176] Rename to signDigestWith --- Crypto/PubKey/ECC/ECDSA.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/Crypto/PubKey/ECC/ECDSA.hs b/Crypto/PubKey/ECC/ECDSA.hs index 24c6e15..98b1ac4 100644 --- a/Crypto/PubKey/ECC/ECDSA.hs +++ b/Crypto/PubKey/ECC/ECDSA.hs @@ -10,10 +10,10 @@ module Crypto.PubKey.ECC.ECDSA , KeyPair(..) , toPublicKey , toPrivateKey - , signWithDigest , signWith - , signDigest + , signDigestWith , sign + , signDigest , verify , verifyDigest ) where @@ -63,13 +63,13 @@ toPrivateKey (KeyPair curve _ priv) = PrivateKey curve priv -- | Sign digest using the private key and an explicit k number. -- -- /WARNING:/ Vulnerable to timing attacks. -signWithDigest :: HashAlgorithm hash +signDigestWith :: HashAlgorithm hash => Integer -- ^ k random number -> PrivateKey -- ^ private key -> hash -- ^ hash function -> Digest hash -- ^ digest to sign -> Maybe Signature -signWithDigest k (PrivateKey curve d) hashAlg digest = do +signDigestWith k (PrivateKey curve d) hashAlg digest = do let z = dsaTruncHashDigest hashAlg digest n CurveCommon _ _ g n _ = common_curve curve let point = pointMul curve k g @@ -90,16 +90,16 @@ signWith :: (ByteArrayAccess msg, HashAlgorithm hash) -> hash -- ^ hash function -> msg -- ^ message to sign -> Maybe Signature -signWith k pk hashAlg msg = signWithDigest k pk hashAlg (hashWith hashAlg msg) +signWith k pk hashAlg msg = signDigestWith k pk hashAlg (hashWith hashAlg msg) --- | Sign digst using the private key. +-- | Sign digest using the private key. -- -- /WARNING:/ Vulnerable to timing attacks. signDigest :: (HashAlgorithm hash, MonadRandom m) => PrivateKey -> hash -> Digest hash -> m Signature signDigest pk hashAlg digest = do k <- generateBetween 1 (n - 1) - case signWithDigest k pk hashAlg digest of + case signDigestWith k pk hashAlg digest of Nothing -> signDigest pk hashAlg digest Just sig -> return sig where n = ecc_n . common_curve $ private_curve pk From 299140f884300dc465e75c3d4085d1bd69a0e9de Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Thu, 28 Feb 2019 21:26:00 +0100 Subject: [PATCH 054/176] Remove unnecessary hash arguments We don't need to give the hash algorithm as a separate argument since it is already available from the digest value itself. --- Crypto/PubKey/ECC/ECDSA.hs | 35 +++++++++++++++++------------------ Crypto/PubKey/Internal.hs | 11 +++++++---- 2 files changed, 24 insertions(+), 22 deletions(-) diff --git a/Crypto/PubKey/ECC/ECDSA.hs b/Crypto/PubKey/ECC/ECDSA.hs index 98b1ac4..175f75c 100644 --- a/Crypto/PubKey/ECC/ECDSA.hs +++ b/Crypto/PubKey/ECC/ECDSA.hs @@ -64,13 +64,12 @@ toPrivateKey (KeyPair curve _ priv) = PrivateKey curve priv -- -- /WARNING:/ Vulnerable to timing attacks. signDigestWith :: HashAlgorithm hash - => Integer -- ^ k random number - -> PrivateKey -- ^ private key - -> hash -- ^ hash function - -> Digest hash -- ^ digest to sign - -> Maybe Signature -signDigestWith k (PrivateKey curve d) hashAlg digest = do - let z = dsaTruncHashDigest hashAlg digest n + => Integer -- ^ k random number + -> PrivateKey -- ^ private key + -> Digest hash -- ^ digest to sign + -> Maybe Signature +signDigestWith k (PrivateKey curve d) digest = do + let z = dsaTruncHashDigest digest n CurveCommon _ _ g n _ = common_curve curve let point = pointMul curve k g r <- case point of @@ -90,17 +89,17 @@ signWith :: (ByteArrayAccess msg, HashAlgorithm hash) -> hash -- ^ hash function -> msg -- ^ message to sign -> Maybe Signature -signWith k pk hashAlg msg = signDigestWith k pk hashAlg (hashWith hashAlg msg) +signWith k pk hashAlg msg = signDigestWith k pk (hashWith hashAlg msg) -- | Sign digest using the private key. -- -- /WARNING:/ Vulnerable to timing attacks. signDigest :: (HashAlgorithm hash, MonadRandom m) - => PrivateKey -> hash -> Digest hash -> m Signature -signDigest pk hashAlg digest = do + => PrivateKey -> Digest hash -> m Signature +signDigest pk digest = do k <- generateBetween 1 (n - 1) - case signDigestWith k pk hashAlg digest of - Nothing -> signDigest pk hashAlg digest + case signDigestWith k pk digest of + Nothing -> signDigest pk digest Just sig -> return sig where n = ecc_n . common_curve $ private_curve pk @@ -109,16 +108,16 @@ signDigest pk hashAlg digest = do -- /WARNING:/ Vulnerable to timing attacks. sign :: (ByteArrayAccess msg, HashAlgorithm hash, MonadRandom m) => PrivateKey -> hash -> msg -> m Signature -sign pk hashAlg msg = signDigest pk hashAlg (hashWith hashAlg msg) +sign pk hashAlg msg = signDigest pk (hashWith hashAlg msg) -- | Verify a digest using the public key. -verifyDigest :: HashAlgorithm hash => hash -> PublicKey -> Signature -> Digest hash -> Bool -verifyDigest _ (PublicKey _ PointO) _ _ = False -verifyDigest hashAlg pk@(PublicKey curve q) (Signature r s) digest +verifyDigest :: HashAlgorithm hash => PublicKey -> Signature -> Digest hash -> Bool +verifyDigest (PublicKey _ PointO) _ _ = False +verifyDigest pk@(PublicKey curve q) (Signature r s) digest | r < 1 || r >= n || s < 1 || s >= n = False | otherwise = maybe False (r ==) $ do w <- inverse s n - let z = dsaTruncHashDigest hashAlg digest n + let z = dsaTruncHashDigest digest n u1 = z * w `mod` n u2 = r * w `mod` n x = pointAddTwoMuls curve u1 g u2 q @@ -131,4 +130,4 @@ verifyDigest hashAlg pk@(PublicKey curve q) (Signature r s) digest -- | Verify a bytestring using the public key. verify :: (ByteArrayAccess msg, HashAlgorithm hash) => hash -> PublicKey -> Signature -> msg -> Bool -verify hashAlg pk sig msg = verifyDigest hashAlg pk sig (hashWith hashAlg msg) +verify hashAlg pk sig msg = verifyDigest pk sig (hashWith hashAlg msg) diff --git a/Crypto/PubKey/Internal.hs b/Crypto/PubKey/Internal.hs index 5e0629f..3951d06 100644 --- a/Crypto/PubKey/Internal.hs +++ b/Crypto/PubKey/Internal.hs @@ -33,12 +33,15 @@ False &&! False = False -- | Truncate and hash for DSA and ECDSA. dsaTruncHash :: (ByteArrayAccess msg, HashAlgorithm hash) => hash -> msg -> Integer -> Integer -dsaTruncHash hashAlg = dsaTruncHashDigest hashAlg . hashWith hashAlg +dsaTruncHash hashAlg = dsaTruncHashDigest . hashWith hashAlg -- | Truncate a digest for DSA and ECDSA. -dsaTruncHashDigest :: HashAlgorithm hash => hash -> Digest hash -> Integer -> Integer -dsaTruncHashDigest hashAlg digest n +dsaTruncHashDigest :: HashAlgorithm hash => Digest hash -> Integer -> Integer +dsaTruncHashDigest digest n | d > 0 = shiftR e d | otherwise = e where e = os2ip digest - d = hashDigestSize hashAlg * 8 - numBits n + d = hashDigestSize (getHashAlg digest) * 8 - numBits n + +getHashAlg :: Digest hash -> hash +getHashAlg _ = undefined From 0f8dc3588da9988c96b3075881b6f69da0577573 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Mon, 4 Mar 2019 06:39:46 +0100 Subject: [PATCH 055/176] Add BCrypt benchmark --- benchs/Bench.hs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/benchs/Bench.hs b/benchs/Bench.hs index 50d281b..180bafa 100644 --- a/benchs/Bench.hs +++ b/benchs/Bench.hs @@ -15,6 +15,7 @@ import Crypto.Cipher.Types import Crypto.ECC import Crypto.Error import Crypto.Hash +import qualified Crypto.KDF.BCrypt as BCrypt import qualified Crypto.KDF.PBKDF2 as PBKDF2 import Crypto.Number.Basic (numBits) import Crypto.Number.Generate @@ -104,6 +105,19 @@ benchPBKDF2 = params n iter = PBKDF2.Parameters iter n +benchBCrypt = + [ bench "cryptonite-BCrypt-4" $ nf bcrypt 4 + , bench "cryptonite-BCrypt-5" $ nf bcrypt 5 + , bench "cryptonite-BCrypt-7" $ nf bcrypt 7 + , bench "cryptonite-BCrypt-11" $ nf bcrypt 11 + ] + where + bcrypt :: Int -> B.ByteString + bcrypt cost = BCrypt.bcrypt cost mysalt mypass + + mypass, mysalt :: B.ByteString + mypass = "password" + mysalt = "saltsaltsaltsalt" benchBlockCipher = [ bgroup "ECB" benchECB @@ -233,6 +247,7 @@ main = defaultMain , bgroup "block-cipher" benchBlockCipher , bgroup "AE" benchAE , bgroup "pbkdf2" benchPBKDF2 + , bgroup "bcrypt" benchBCrypt , bgroup "ECC" benchECC , bgroup "DH" [ bgroup "FFDH" benchFFDH From 107317c84de854abb010e88302bb23afcaa9f284 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Mon, 4 Mar 2019 06:39:55 +0100 Subject: [PATCH 056/176] Improve strictness in Blowfish rounds --- Crypto/Cipher/Blowfish/Primitive.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Crypto/Cipher/Blowfish/Primitive.hs b/Crypto/Cipher/Blowfish/Primitive.hs index 572a5ec..705a41e 100644 --- a/Crypto/Cipher/Blowfish/Primitive.hs +++ b/Crypto/Cipher/Blowfish/Primitive.hs @@ -11,7 +11,7 @@ -- Crypto.Cipher.Blowfish.Primitive, copyright (c) 2012 Stijn van Drongelen -- based on: BlowfishAux.hs (C) 2002 HardCore SoftWare, Doug Hoyte -- (as found in Crypto-4.2.4) - +{-# LANGUAGE BangPatterns #-} module Crypto.Cipher.Blowfish.Primitive ( Context , initBlowfish @@ -154,7 +154,7 @@ cipherBlock (Context ar) inverse input = doRound input 0 where -- | Transform the input over 16 rounds doRound :: Word64 -> Int -> Word64 - doRound i roundIndex + doRound !i roundIndex | roundIndex == 16 = let final = (fromIntegral (p 16) `shiftL` 32) .|. fromIntegral (p 17) in rotateL (i `xor` final) 32 @@ -187,7 +187,7 @@ cipherBlockMutable :: KeySchedule -> Word64 -> IO Word64 cipherBlockMutable (KeySchedule ma) input = doRound input 0 where -- | Transform the input over 16 rounds - doRound i roundIndex + doRound !i roundIndex | roundIndex == 16 = do pVal1 <- mutableArrayRead32 ma 16 pVal2 <- mutableArrayRead32 ma 17 From d67a21f95fb6446638e8fbf1c0af8e50bf480b5d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Thu, 7 Mar 2019 21:35:04 +0100 Subject: [PATCH 057/176] Remove unnecessary imports and calls --- Crypto/Cipher/Blowfish/Primitive.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/Crypto/Cipher/Blowfish/Primitive.hs b/Crypto/Cipher/Blowfish/Primitive.hs index 705a41e..b3708cd 100644 --- a/Crypto/Cipher/Blowfish/Primitive.hs +++ b/Crypto/Cipher/Blowfish/Primitive.hs @@ -31,12 +31,11 @@ import Data.Word import Crypto.Cipher.Blowfish.Box import Crypto.Error -import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, Bytes) +import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess) import qualified Crypto.Internal.ByteArray as B import Crypto.Internal.Compat import Crypto.Internal.Imports import Crypto.Internal.WordArray -import Crypto.Internal.Words newtype Context = Context Array32 @@ -179,8 +178,8 @@ cipherBlock (Context ar) inverse input = doRound input 0 s2 i = arrayRead32 ar (fromIntegral i + 530) s3 i = arrayRead32 ar (fromIntegral i + 786) p :: Int -> Word32 - p i | inverse = arrayRead32 ar (17 - fromIntegral i) - | otherwise = arrayRead32 ar (fromIntegral i) + p i | inverse = arrayRead32 ar (17 - i) + | otherwise = arrayRead32 ar i -- | Blowfish encrypt a Word using the current state of the key schedule cipherBlockMutable :: KeySchedule -> Word64 -> IO Word64 From 0ce2e5f32527e8cfaef17f01c54006b37c369257 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 8 Mar 2019 06:37:25 +0100 Subject: [PATCH 058/176] Remove -fno-warn-unused-imports Changing the build so that we don't diverge again after cleanup done in #267. --- cryptonite.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cryptonite.cabal b/cryptonite.cabal index 7bb1c5c..c939c33 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -238,7 +238,7 @@ Library , memory >= 0.14.14 , basement >= 0.0.6 , ghc-prim - ghc-options: -Wall -fwarn-tabs -optc-O3 -fno-warn-unused-imports + ghc-options: -Wall -fwarn-tabs -optc-O3 if os(linux) extra-libraries: pthread default-language: Haskell2010 @@ -434,7 +434,7 @@ Test-Suite test-cryptonite , tasty-hunit , tasty-kat , cryptonite - ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures -fno-warn-unused-imports -rtsopts + ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures -rtsopts default-language: Haskell2010 Benchmark bench-cryptonite From 2a26202a32a0e2ff9c786e10314f940216ff19bd Mon Sep 17 00:00:00 2001 From: Lars Petersen Date: Thu, 14 Mar 2019 20:19:35 +0100 Subject: [PATCH 059/176] Add implementation of bcrypt_pbkdf --- Crypto/Cipher/Blowfish/Box.hs | 16 ++- Crypto/Cipher/Blowfish/Primitive.hs | 1 + Crypto/KDF/BCryptPBKDF.hs | 187 ++++++++++++++++++++++++++++ cryptonite.cabal | 4 +- tests/BCryptPBKDF.hs | 75 +++++++++++ tests/Tests.hs | 2 + 6 files changed, 283 insertions(+), 2 deletions(-) create mode 100644 Crypto/KDF/BCryptPBKDF.hs create mode 100644 tests/BCryptPBKDF.hs diff --git a/Crypto/Cipher/Blowfish/Box.hs b/Crypto/Cipher/Blowfish/Box.hs index 34414a7..62f1adc 100644 --- a/Crypto/Cipher/Blowfish/Box.hs +++ b/Crypto/Cipher/Blowfish/Box.hs @@ -7,13 +7,27 @@ module Crypto.Cipher.Blowfish.Box ( KeySchedule(..) , createKeySchedule + , copyKeySchedule ) where import Crypto.Internal.WordArray (MutableArray32, - mutableArray32FromAddrBE) + mutableArray32FromAddrBE, + mutableArrayRead32, + mutableArrayWrite32) newtype KeySchedule = KeySchedule MutableArray32 +-- | Copy the state of one key schedule into the other. +-- The first parameter is the destination and the second the source. +copyKeySchedule :: KeySchedule -> KeySchedule -> IO () +copyKeySchedule (KeySchedule dst) (KeySchedule src) = loop 0 + where + loop 1042 = return () + loop i = do + w32 <-mutableArrayRead32 src i + mutableArrayWrite32 dst i w32 + loop (i + 1) + -- | Create a key schedule mutable array of the pbox followed by -- all the sboxes. createKeySchedule :: IO KeySchedule diff --git a/Crypto/Cipher/Blowfish/Primitive.hs b/Crypto/Cipher/Blowfish/Primitive.hs index b3708cd..8ce7cbe 100644 --- a/Crypto/Cipher/Blowfish/Primitive.hs +++ b/Crypto/Cipher/Blowfish/Primitive.hs @@ -22,6 +22,7 @@ module Crypto.Cipher.Blowfish.Primitive , freezeKeySchedule , expandKey , expandKeyWithSalt + , cipherBlockMutable ) where import Control.Monad (when) diff --git a/Crypto/KDF/BCryptPBKDF.hs b/Crypto/KDF/BCryptPBKDF.hs new file mode 100644 index 0000000..7a2fa8b --- /dev/null +++ b/Crypto/KDF/BCryptPBKDF.hs @@ -0,0 +1,187 @@ +-- | +-- Module : Crypto.KDF.BCryptPBKDF +-- License : BSD-style +-- Stability : experimental +-- Portability : Good +-- +-- Port of the bcrypt_pbkdf key derivation function from OpenBSD +-- as described at . +module Crypto.KDF.BCryptPBKDF + ( Parameters (..) + , generate + , hashInternal + ) +where + +import Basement.Block (MutableBlock) +import qualified Basement.Block as Block +import qualified Basement.Block.Mutable as Block +import Basement.Monad (PrimState) +import Basement.Types.OffsetSize (CountOf (..), Offset (..)) +import Control.Exception (finally) +import Control.Monad (when) +import qualified Crypto.Cipher.Blowfish.Box as Blowfish +import qualified Crypto.Cipher.Blowfish.Primitive as Blowfish +import Crypto.Hash.Algorithms (SHA512 (..)) +import Crypto.Hash.Types (Context, + hashDigestSize, + hashInternalContextSize, + hashInternalFinalize, + hashInternalInit, + hashInternalUpdate) +import Crypto.Internal.Compat (unsafeDoIO) +import Data.Bits +import qualified Data.ByteArray as B +import Data.Foldable (forM_) +import Data.Memory.PtrMethods (memCopy, memSet, memXor) +import Data.Word +import Foreign.Ptr (Ptr, castPtr) +import Foreign.Storable (peekByteOff, pokeByteOff) + +data Parameters = Parameters + { iterCounts :: Int -- ^ The number of user-defined iterations for the algorithm + -- (must be > 0) + , outputLength :: Int -- ^ The number of bytes to generate out of BCryptPBKDF + -- (must be in 1..1024) + } deriving (Eq, Ord, Show) + +-- | Derive a key of specified length using the bcrypt_pbkdf algorithm. +generate :: (B.ByteArray pass, B.ByteArray salt, B.ByteArray output) + => Parameters + -> pass + -> salt + -> output +generate params pass salt + | iterCounts params < 1 = error "BCryptPBKDF: iterCounts must be > 0" + | keyLen < 1 || keyLen > 1024 = error "BCryptPBKDF: outputLength must be in 1..1024" + | otherwise = B.unsafeCreate keyLen deriveKey + where + outLen, tmpLen, blkLen, keyLen, passLen, saltLen, ctxLen, hashLen, blocks :: Int + outLen = 32 + tmpLen = 32 + blkLen = 4 + passLen = B.length pass + saltLen = B.length salt + keyLen = outputLength params + ctxLen = hashInternalContextSize SHA512 + hashLen = hashDigestSize SHA512 -- 64 + blocks = (keyLen + outLen - 1) `div` outLen + + deriveKey :: Ptr Word8 -> IO () + deriveKey keyPtr = do + -- Allocate all necessary memory. The algorihm shall not allocate + -- any more dynamic memory after this point. Blocks need to be pinned + -- as pointers to them are passed to the SHA512 implementation. + ksClean <- Blowfish.createKeySchedule + ksDirty <- Blowfish.createKeySchedule + ctxMBlock <- Block.newPinned (CountOf ctxLen :: CountOf Word8) + outMBlock <- Block.newPinned (CountOf outLen :: CountOf Word8) + tmpMBlock <- Block.newPinned (CountOf tmpLen :: CountOf Word8) + blkMBlock <- Block.newPinned (CountOf blkLen :: CountOf Word8) + passHashMBlock <- Block.newPinned (CountOf hashLen :: CountOf Word8) + saltHashMBlock <- Block.newPinned (CountOf hashLen :: CountOf Word8) + -- Finally erase all memory areas that contain information from + -- which the derived key could be reconstructed. + -- As all MutableBlocks are pinned it shall be guaranteed that + -- no temporary trampoline buffers are allocated. + finallyErase outMBlock $ finallyErase passHashMBlock $ + B.withByteArray pass $ \passPtr-> + B.withByteArray salt $ \saltPtr-> + Block.withMutablePtr ctxMBlock $ \ctxPtr-> + Block.withMutablePtr outMBlock $ \outPtr-> + Block.withMutablePtr tmpMBlock $ \tmpPtr-> + Block.withMutablePtr blkMBlock $ \blkPtr-> + Block.withMutablePtr passHashMBlock $ \passHashPtr-> + Block.withMutablePtr saltHashMBlock $ \saltHashPtr-> do + -- Hash the password. + let shaPtr = castPtr ctxPtr :: Ptr (Context SHA512) + hashInternalInit shaPtr + hashInternalUpdate shaPtr passPtr (fromIntegral passLen) + hashInternalFinalize shaPtr (castPtr passHashPtr) + passHashBlock <- Block.unsafeFreeze passHashMBlock + forM_ [1..blocks] $ \block-> do + -- Poke the increased block counter. + Block.unsafeWrite blkMBlock 0 (fromIntegral $ block `shiftR` 24) + Block.unsafeWrite blkMBlock 1 (fromIntegral $ block `shiftR` 16) + Block.unsafeWrite blkMBlock 2 (fromIntegral $ block `shiftR` 8) + Block.unsafeWrite blkMBlock 3 (fromIntegral $ block `shiftR` 0) + -- First round (slightly different). + hashInternalInit shaPtr + hashInternalUpdate shaPtr saltPtr (fromIntegral saltLen) + hashInternalUpdate shaPtr blkPtr (fromIntegral blkLen) + hashInternalFinalize shaPtr (castPtr saltHashPtr) + Block.unsafeFreeze saltHashMBlock >>= \x-> do + Blowfish.copyKeySchedule ksDirty ksClean + hashInternalMutable ksDirty passHashBlock x tmpMBlock + memCopy outPtr tmpPtr outLen + -- Remaining rounds. + forM_ [2..iterCounts params] $ const $ do + hashInternalInit shaPtr + hashInternalUpdate shaPtr tmpPtr (fromIntegral tmpLen) + hashInternalFinalize shaPtr (castPtr saltHashPtr) + Block.unsafeFreeze saltHashMBlock >>= \x-> do + Blowfish.copyKeySchedule ksDirty ksClean + hashInternalMutable ksDirty passHashBlock x tmpMBlock + memXor outPtr outPtr tmpPtr outLen + -- Spread the current out buffer evenly over the key buffer. + -- After both loops have run every byte of the key buffer + -- will have been written to exactly once and every byte + -- of the output will have been used. + forM_ [0..outLen - 1] $ \outIdx-> do + let keyIdx = outIdx * blocks + block - 1 + when (keyIdx < keyLen) $ do + w8 <- peekByteOff outPtr outIdx :: IO Word8 + pokeByteOff keyPtr keyIdx w8 + +-- | Internal hash function used by `generate`. +-- +-- Normal users should not need this. +hashInternal :: (B.ByteArrayAccess pass, B.ByteArrayAccess salt, B.ByteArray output) + => pass + -> salt + -> output +hashInternal passHash saltHash + | B.length passHash /= 64 = error "passHash must be 512 bits" + | B.length saltHash /= 64 = error "saltHash must be 512 bits" + | otherwise = unsafeDoIO $ do + ks0 <- Blowfish.createKeySchedule + outMBlock <- Block.newPinned 32 + hashInternalMutable ks0 passHash saltHash outMBlock + B.convert `fmap` Block.freeze outMBlock + +hashInternalMutable :: (B.ByteArrayAccess pass, B.ByteArrayAccess salt) + => Blowfish.KeySchedule + -> pass + -> salt + -> MutableBlock Word8 (PrimState IO) + -> IO () +hashInternalMutable bfks passHash saltHash outMBlock = do + Blowfish.expandKeyWithSalt bfks passHash saltHash + forM_ [0..63 :: Int] $ const $ do + Blowfish.expandKey bfks saltHash + Blowfish.expandKey bfks passHash + -- "OxychromaticBlowfishSwatDynamite" represented as 4 Word64 in big-endian. + store 0 =<< cipher 64 0x4f78796368726f6d + store 8 =<< cipher 64 0x61746963426c6f77 + store 16 =<< cipher 64 0x6669736853776174 + store 24 =<< cipher 64 0x44796e616d697465 + where + store :: Offset Word8 -> Word64 -> IO () + store o w64 = do + Block.unsafeWrite outMBlock (o + 0) (fromIntegral $ w64 `shiftR` 32) + Block.unsafeWrite outMBlock (o + 1) (fromIntegral $ w64 `shiftR` 40) + Block.unsafeWrite outMBlock (o + 2) (fromIntegral $ w64 `shiftR` 48) + Block.unsafeWrite outMBlock (o + 3) (fromIntegral $ w64 `shiftR` 56) + Block.unsafeWrite outMBlock (o + 4) (fromIntegral $ w64 `shiftR` 0) + Block.unsafeWrite outMBlock (o + 5) (fromIntegral $ w64 `shiftR` 8) + Block.unsafeWrite outMBlock (o + 6) (fromIntegral $ w64 `shiftR` 16) + Block.unsafeWrite outMBlock (o + 7) (fromIntegral $ w64 `shiftR` 24) + cipher :: Int -> Word64 -> IO Word64 + cipher 0 block = return block + cipher i block = Blowfish.cipherBlockMutable bfks block >>= cipher (i - 1) + +finallyErase :: MutableBlock Word8 (PrimState IO) -> IO () -> IO () +finallyErase mblock action = + action `finally` Block.withMutablePtr mblock (\ptr-> memSet ptr 0 len) + where + CountOf len = Block.mutableLengthBytes mblock diff --git a/cryptonite.cabal b/cryptonite.cabal index c939c33..22f16c4 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -12,7 +12,7 @@ Description: . * Asymmetric crypto: DSA, RSA, DH, ECDH, ECDSA, ECC, Curve25519, Curve448, Ed25519, Ed448 . - * Key Derivation Function: PBKDF2, Scrypt, HKDF, Argon2 + * Key Derivation Function: PBKDF2, Scrypt, HKDF, Argon2, BCrypt, BCryptPBKDF . * Cryptographic Random generation: System Entropy, Deterministic Random Generator . @@ -138,6 +138,7 @@ Library Crypto.KDF.PBKDF2 Crypto.KDF.Scrypt Crypto.KDF.BCrypt + Crypto.KDF.BCryptPBKDF Crypto.KDF.HKDF Crypto.Hash Crypto.Hash.IO @@ -378,6 +379,7 @@ Test-Suite test-cryptonite Other-modules: BlockCipher ChaCha BCrypt + BCryptPBKDF ECC ECC.Edwards25519 Hash diff --git a/tests/BCryptPBKDF.hs b/tests/BCryptPBKDF.hs new file mode 100644 index 0000000..2554d80 --- /dev/null +++ b/tests/BCryptPBKDF.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE OverloadedStrings #-} + +module BCryptPBKDF (tests) where + +import qualified Data.ByteString as B + +import Test.Tasty +import Test.Tasty.HUnit + +import Crypto.KDF.BCryptPBKDF (Parameters (..), generate, + hashInternal) + +tests :: TestTree +tests = testGroup "BCryptPBKDF" + [ testGroup "generate" + [ testCase "1" generate1 + , testCase "2" generate2 + , testCase "3" generate3 + ] + , testGroup "hashInternal" + [ testCase "1" hashInternal1 + ] + ] + where + -- test vector taken from the go implementation by @dchest + generate1 = expected @=? generate params pass salt + where + params = Parameters 12 32 + pass = "password" :: B.ByteString + salt = "salt" :: B.ByteString + expected = B.pack + [ 0x1a, 0xe4, 0x2c, 0x05, 0xd4, 0x87, 0xbc, 0x02 + , 0xf6, 0x49, 0x21, 0xa4, 0xeb, 0xe4, 0xea, 0x93 + , 0xbc, 0xac, 0xfe, 0x13, 0x5f, 0xda, 0x99, 0x97 + , 0x4c, 0x06, 0xb7, 0xb0, 0x1f, 0xae, 0x14, 0x9a + ] :: B.ByteString + + -- test vector generated with the go implemenation by @dchest + generate2 = expected @=? generate params pass salt + where + params = Parameters 7 71 + pass = "DieWuerdeDesMenschenIstUnantastbar" :: B.ByteString + salt = "Tafelsalz" :: B.ByteString + expected = B.pack + [ 0x17, 0xb4, 0x76, 0xaa, 0xd7, 0x42, 0x33, 0x49 + , 0x5c, 0xe8, 0x79, 0x49, 0x15, 0x74, 0x4c, 0x71 + , 0xf9, 0x99, 0x66, 0x89, 0x7a, 0x60, 0xc3, 0x70 + , 0xb4, 0x3c, 0xa8, 0x83, 0x80, 0x5a, 0x56, 0xde + , 0x38, 0xbc, 0x51, 0x8c, 0xd4, 0xeb, 0xd1, 0xcf + , 0x46, 0x0a, 0x68, 0x3d, 0xc8, 0x12, 0xcf, 0xf8 + , 0x43, 0xce, 0x21, 0x9d, 0x98, 0x81, 0x20, 0x26 + , 0x6e, 0x42, 0x0f, 0xaa, 0x75, 0x5d, 0x09, 0x8d + , 0x45, 0xda, 0xd5, 0x15, 0x6e, 0x65, 0x1d + ] :: B.ByteString + + -- test vector generated with the go implemenation by @dchest + generate3 = expected @=? generate params pass salt + where + params = Parameters 5 5 + pass = "ABC" :: B.ByteString + salt = "DEF" :: B.ByteString + expected = B.pack + [ 0xdd, 0x6e, 0xa0, 0x69, 0x29 + ] :: B.ByteString + + hashInternal1 = expected @=? hashInternal passHash saltHash + where + passHash = B.pack [ 0 .. 63 ] :: B.ByteString + saltHash = B.pack [ 64 .. 127 ] :: B.ByteString + expected = B.pack + [ 0x87, 0x90, 0x48, 0x70, 0xee, 0xf9, 0xde, 0xdd + , 0xf8, 0xe7, 0x61, 0x1a, 0x14, 0x01, 0x06, 0xe6 + , 0xaa, 0xf1, 0xa3, 0x63, 0xd9, 0xa2, 0xc5, 0x04 + , 0xdb, 0x35, 0x64, 0x43, 0x72, 0x1e, 0xb5, 0x55 + ] :: B.ByteString diff --git a/tests/Tests.hs b/tests/Tests.hs index 2f973c9..bd64ecc 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -6,6 +6,7 @@ import Imports import qualified Number import qualified Number.F2m import qualified BCrypt +import qualified BCryptPBKDF import qualified ECC import qualified ECC.Edwards25519 import qualified Hash @@ -63,6 +64,7 @@ tests = testGroup "cryptonite" [ KAT_PBKDF2.tests , KAT_Scrypt.tests , BCrypt.tests + , BCryptPBKDF.tests , KAT_HKDF.tests , KAT_Argon2.tests ] From 32535011664d6f1634d78e2783d829db130751df Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Tue, 21 Nov 2017 19:25:41 +0100 Subject: [PATCH 060/176] Time-constant P256.scalarAdd and P256.scalarSub --- Crypto/PubKey/ECC/P256.hs | 29 ++++++++--------------------- cbits/p256/p256.c | 20 ++++++++++++++++++++ 2 files changed, 28 insertions(+), 21 deletions(-) diff --git a/Crypto/PubKey/ECC/P256.hs b/Crypto/PubKey/ECC/P256.hs index 9259f8e..0a3d704 100644 --- a/Crypto/PubKey/ECC/P256.hs +++ b/Crypto/PubKey/ECC/P256.hs @@ -222,34 +222,21 @@ scalarIsZero s = unsafeDoIO $ withScalar s $ \d -> do result <- ccryptonite_p256_is_zero d return $ result /= 0 -scalarNeedReducing :: Ptr P256Scalar -> IO Bool -scalarNeedReducing d = do - c <- ccryptonite_p256_cmp d ccryptonite_SECP256r1_n - return (c >= 0) - -- | Perform addition between two scalars -- -- > a + b scalarAdd :: Scalar -> Scalar -> Scalar scalarAdd a b = - withNewScalarFreeze $ \d -> withScalar a $ \pa -> withScalar b $ \pb -> do - carry <- ccryptonite_p256_add pa pb d - when (carry /= 0) $ void $ ccryptonite_p256_sub d ccryptonite_SECP256r1_n d - needReducing <- scalarNeedReducing d - when needReducing $ do - ccryptonite_p256_mod ccryptonite_SECP256r1_n d d + withNewScalarFreeze $ \d -> withScalar a $ \pa -> withScalar b $ \pb -> + ccryptonite_p256e_modadd ccryptonite_SECP256r1_n pa pb d -- | Perform subtraction between two scalars -- -- > a - b scalarSub :: Scalar -> Scalar -> Scalar scalarSub a b = - withNewScalarFreeze $ \d -> withScalar a $ \pa -> withScalar b $ \pb -> do - borrow <- ccryptonite_p256_sub pa pb d - when (borrow /= 0) $ void $ ccryptonite_p256_add d ccryptonite_SECP256r1_n d - --needReducing <- scalarNeedReducing d - --when needReducing $ do - -- ccryptonite_p256_mod ccryptonite_SECP256r1_n d d + withNewScalarFreeze $ \d -> withScalar a $ \pa -> withScalar b $ \pb -> + ccryptonite_p256e_modsub ccryptonite_SECP256r1_n pa pb d -- | Give the inverse of the scalar -- @@ -352,12 +339,12 @@ foreign import ccall "cryptonite_p256_is_zero" ccryptonite_p256_is_zero :: Ptr P256Scalar -> IO CInt foreign import ccall "cryptonite_p256_clear" ccryptonite_p256_clear :: Ptr P256Scalar -> IO () -foreign import ccall "cryptonite_p256_add" - ccryptonite_p256_add :: Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> IO CInt +foreign import ccall "cryptonite_p256e_modadd" + ccryptonite_p256e_modadd :: Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> IO () foreign import ccall "cryptonite_p256_add_d" ccryptonite_p256_add_d :: Ptr P256Scalar -> P256Digit -> Ptr P256Scalar -> IO CInt -foreign import ccall "cryptonite_p256_sub" - ccryptonite_p256_sub :: Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> IO CInt +foreign import ccall "cryptonite_p256e_modsub" + ccryptonite_p256e_modsub :: Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> IO () foreign import ccall "cryptonite_p256_cmp" ccryptonite_p256_cmp :: Ptr P256Scalar -> Ptr P256Scalar -> IO CInt foreign import ccall "cryptonite_p256_mod" diff --git a/cbits/p256/p256.c b/cbits/p256/p256.c index 4f6a573..ec69f64 100644 --- a/cbits/p256/p256.c +++ b/cbits/p256/p256.c @@ -386,3 +386,23 @@ void cryptonite_p256_to_bin(const cryptonite_p256_int* src, uint8_t dst[P256_NBY p += 4; } } + +/* + "p256e" functions are not part of the original source +*/ + +// c = a + b mod MOD +void cryptonite_p256e_modadd(const cryptonite_p256_int* MOD, const cryptonite_p256_int* a, const cryptonite_p256_int* b, cryptonite_p256_int* c) { + int carry = cryptonite_p256_add(a, b, c); + + // same as cryptonite_p256_mod, but with top = carry + addM(MOD, 0, P256_DIGITS(c), subM(MOD, carry, P256_DIGITS(c), -1)); +} + +// c = a - b mod MOD +void cryptonite_p256e_modsub(const cryptonite_p256_int* MOD, const cryptonite_p256_int* a, const cryptonite_p256_int* b, cryptonite_p256_int* c) { + int borrow = cryptonite_p256_sub(a, b, c); + + // use borrow as mask in order to make difference positive when necessary + addM(MOD, 0, P256_DIGITS(c), borrow); +} From e3edc100c32db586955e87c86be8f0e6d53972ed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 23 Mar 2019 07:54:23 +0100 Subject: [PATCH 061/176] Remove unnecessary import --- Crypto/PubKey/ECC/P256.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/Crypto/PubKey/ECC/P256.hs b/Crypto/PubKey/ECC/P256.hs index 0a3d704..3c350cd 100644 --- a/Crypto/PubKey/ECC/P256.hs +++ b/Crypto/PubKey/ECC/P256.hs @@ -45,7 +45,6 @@ module Crypto.PubKey.ECC.P256 import Data.Word import Foreign.Ptr import Foreign.C.Types -import Control.Monad import Crypto.Internal.Compat import Crypto.Internal.Imports From 47123ed97a5103d7240f0d78825d3a9010b8ca7e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 24 Mar 2019 08:02:42 +0100 Subject: [PATCH 062/176] Better P256 scalar primitives Allows scalars in full range [ 0 .. 2^256-1 ]. Modular reduction is added a few more operations with conditional selection. --- cbits/p256/p256.c | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/cbits/p256/p256.c b/cbits/p256/p256.c index ec69f64..bd94f6a 100644 --- a/cbits/p256/p256.c +++ b/cbits/p256/p256.c @@ -391,18 +391,20 @@ void cryptonite_p256_to_bin(const cryptonite_p256_int* src, uint8_t dst[P256_NBY "p256e" functions are not part of the original source */ +#define MSB_COMPLEMENT(x) (((x) >> (P256_BITSPERDIGIT - 1)) - 1) + // c = a + b mod MOD void cryptonite_p256e_modadd(const cryptonite_p256_int* MOD, const cryptonite_p256_int* a, const cryptonite_p256_int* b, cryptonite_p256_int* c) { - int carry = cryptonite_p256_add(a, b, c); - - // same as cryptonite_p256_mod, but with top = carry - addM(MOD, 0, P256_DIGITS(c), subM(MOD, carry, P256_DIGITS(c), -1)); + cryptonite_p256_digit top = cryptonite_p256_add(a, b, c); + top = subM(MOD, top, P256_DIGITS(c), -1); + top = subM(MOD, top, P256_DIGITS(c), MSB_COMPLEMENT(top)); + addM(MOD, 0, P256_DIGITS(c), top); } // c = a - b mod MOD void cryptonite_p256e_modsub(const cryptonite_p256_int* MOD, const cryptonite_p256_int* a, const cryptonite_p256_int* b, cryptonite_p256_int* c) { - int borrow = cryptonite_p256_sub(a, b, c); - - // use borrow as mask in order to make difference positive when necessary - addM(MOD, 0, P256_DIGITS(c), borrow); + cryptonite_p256_digit top = cryptonite_p256_sub(a, b, c); + top = addM(MOD, top, P256_DIGITS(c), ~MSB_COMPLEMENT(top)); + top = subM(MOD, top, P256_DIGITS(c), MSB_COMPLEMENT(top)); + addM(MOD, 0, P256_DIGITS(c), top); } From 399fc891daf2bdaff1ecac7ac1dcf8bb08d101d9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 24 Mar 2019 08:05:49 +0100 Subject: [PATCH 063/176] Test P256 primitives will full scalar range --- tests/KAT_PubKey/P256.hs | 33 ++++++++++++++++++++++----------- 1 file changed, 22 insertions(+), 11 deletions(-) diff --git a/tests/KAT_PubKey/P256.hs b/tests/KAT_PubKey/P256.hs index 2d6bb2b..9e43ecd 100644 --- a/tests/KAT_PubKey/P256.hs +++ b/tests/KAT_PubKey/P256.hs @@ -17,7 +17,19 @@ newtype P256Scalar = P256Scalar Integer deriving (Show,Eq,Ord) instance Arbitrary P256Scalar where - arbitrary = P256Scalar . getQAInteger <$> arbitrary + -- Cover the full range up to 2^256-1 except 0 and curveN. To test edge + -- cases with arithmetic functions, some values close to 0, curveN and + -- 2^256 are given higher frequency. + arbitrary = P256Scalar <$> oneof + [ choose (1, w) + , choose (w + 1, curveN - w - 1) + , choose (curveN - w, curveN - 1) + , choose (curveN + 1, curveN + w) + , choose (curveN + w + 1, high - w - 1) + , choose (high - w, high - 1) + ] + where high = 2^(256 :: Int) + w = 100 curve = ECC.getCurveByName ECC.SEC_p256r1 curveN = ECC.ecc_n . ECC.common_curve $ curve @@ -27,9 +39,8 @@ pointP256ToECC :: P256.Point -> ECC.Point pointP256ToECC = uncurry ECC.Point . P256.pointToIntegers unP256Scalar :: P256Scalar -> P256.Scalar -unP256Scalar (P256Scalar r') = - let r = if r' == 0 then 0x2901 else (r' `mod` curveN) - rBytes = i2ospScalar r +unP256Scalar (P256Scalar r) = + let rBytes = i2ospScalar r in case P256.scalarFromBinary rBytes of CryptoFailed err -> error ("cannot convert scalar: " ++ show err) CryptoPassed scalar -> scalar @@ -41,7 +52,7 @@ unP256Scalar (P256Scalar r') = Just b -> b unP256 :: P256Scalar -> Integer -unP256 (P256Scalar r') = if r' == 0 then 0x2901 else (r' `mod` curveN) +unP256 (P256Scalar r) = r p256ScalarToInteger :: P256.Scalar -> Integer p256ScalarToInteger s = os2ip (P256.scalarToBinary s :: Bytes) @@ -55,9 +66,8 @@ yR = 0x8d585cbb2e1327d75241a8a122d7620dc33b13315aa5c9d46d013011744ac264 tests = testGroup "P256" [ testGroup "scalar" - [ testProperty "marshalling" $ \(QAInteger r') -> - let r = r' `mod` curveN - rBytes = i2ospScalar r + [ testProperty "marshalling" $ \(QAInteger r) -> + let rBytes = i2ospScalar r in case P256.scalarFromBinary rBytes of CryptoFailed err -> error (show err) CryptoPassed scalar -> rBytes `propertyEq` P256.scalarToBinary scalar @@ -66,12 +76,12 @@ tests = testGroup "P256" r' = P256.scalarAdd (unP256Scalar r1) (unP256Scalar r2) in r `propertyEq` p256ScalarToInteger r' , testProperty "add0" $ \r -> - let v = unP256 r + let v = unP256 r `mod` curveN v' = P256.scalarAdd (unP256Scalar r) P256.scalarZero in v `propertyEq` p256ScalarToInteger v' , testProperty "add-n-1" $ \r -> let nm1 = throwCryptoError $ P256.scalarFromInteger (curveN - 1) - v = unP256 r + v = unP256 r `mod` curveN v' = P256.scalarAdd (unP256Scalar r) nm1 in (((curveN - 1) + v) `mod` curveN) `propertyEq` p256ScalarToInteger v' , testProperty "sub" $ \r1 r2 -> @@ -133,7 +143,8 @@ tests = testGroup "P256" pe2 = ECC.pointMul curve (unP256 r2) curveGen pR = P256.toPoint (P256.scalarAdd (unP256Scalar r1) (unP256Scalar r2)) peR = ECC.pointAdd curve pe1 pe2 - in propertyHold [ eqTest "p256" pR (P256.pointAdd p1 p2) + in (unP256 r1 + unP256 r2) `mod` curveN /= 0 ==> + propertyHold [ eqTest "p256" pR (P256.pointAdd p1 p2) , eqTest "ecc" peR (pointP256ToECC pR) ] From 15f117d9c3793a0bf8ea2b6a298bafe394b55a2e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Mon, 25 Mar 2019 06:47:21 +0100 Subject: [PATCH 064/176] Remove tests add-n-1 and sub-n-1 Operation with value close to the curve order is now tested in other tests. This tests substraction with 0 instead. --- tests/KAT_PubKey/P256.hs | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/tests/KAT_PubKey/P256.hs b/tests/KAT_PubKey/P256.hs index 9e43ecd..7d5e95f 100644 --- a/tests/KAT_PubKey/P256.hs +++ b/tests/KAT_PubKey/P256.hs @@ -79,11 +79,6 @@ tests = testGroup "P256" let v = unP256 r `mod` curveN v' = P256.scalarAdd (unP256Scalar r) P256.scalarZero in v `propertyEq` p256ScalarToInteger v' - , testProperty "add-n-1" $ \r -> - let nm1 = throwCryptoError $ P256.scalarFromInteger (curveN - 1) - v = unP256 r `mod` curveN - v' = P256.scalarAdd (unP256Scalar r) nm1 - in (((curveN - 1) + v) `mod` curveN) `propertyEq` p256ScalarToInteger v' , testProperty "sub" $ \r1 r2 -> let r = (unP256 r1 - unP256 r2) `mod` curveN r' = P256.scalarSub (unP256Scalar r1) (unP256Scalar r2) @@ -93,11 +88,10 @@ tests = testGroup "P256" [ eqTest "r1-r2" r (p256ScalarToInteger r') , eqTest "r2-r1" v (p256ScalarToInteger v') ] - , testProperty "sub-n-1" $ \r -> - let nm1 = throwCryptoError $ P256.scalarFromInteger (curveN - 1) - v = unP256 r - v' = P256.scalarSub (unP256Scalar r) nm1 - in ((v - (curveN - 1)) `mod` curveN) `propertyEq` p256ScalarToInteger v' + , testProperty "sub0" $ \r -> + let v = unP256 r `mod` curveN + v' = P256.scalarSub (unP256Scalar r) P256.scalarZero + in v `propertyEq` p256ScalarToInteger v' , testProperty "inv" $ \r' -> let inv = inverseCoprimes (unP256 r') curveN inv' = P256.scalarInv (unP256Scalar r') From 6f67cefa3dca6cc8c2de12339cb8d297754b183f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Tue, 26 Mar 2019 06:24:00 +0100 Subject: [PATCH 065/176] Remove code duplication --- tests/KAT_PubKey/P256.hs | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/tests/KAT_PubKey/P256.hs b/tests/KAT_PubKey/P256.hs index 7d5e95f..c570548 100644 --- a/tests/KAT_PubKey/P256.hs +++ b/tests/KAT_PubKey/P256.hs @@ -38,18 +38,18 @@ curveGen = ECC.ecc_g . ECC.common_curve $ curve pointP256ToECC :: P256.Point -> ECC.Point pointP256ToECC = uncurry ECC.Point . P256.pointToIntegers +i2ospScalar :: Integer -> Bytes +i2ospScalar i = + case i2ospOf 32 i of + Nothing -> error "invalid size of P256 scalar" + Just b -> b + unP256Scalar :: P256Scalar -> P256.Scalar unP256Scalar (P256Scalar r) = let rBytes = i2ospScalar r in case P256.scalarFromBinary rBytes of CryptoFailed err -> error ("cannot convert scalar: " ++ show err) CryptoPassed scalar -> scalar - where - i2ospScalar :: Integer -> Bytes - i2ospScalar i = - case i2ospOf 32 i of - Nothing -> error "invalid size of P256 scalar" - Just b -> b unP256 :: P256Scalar -> Integer unP256 (P256Scalar r) = r @@ -147,9 +147,3 @@ tests = testGroup "P256" pe = ECC.pointMul curve (unP256 r) curveGen pR = P256.pointNegate p in ECC.pointNegate curve pe `propertyEq` (pointP256ToECC pR) - - i2ospScalar :: Integer -> Bytes - i2ospScalar i = - case i2ospOf 32 i of - Nothing -> error "invalid size of P256 scalar" - Just b -> b From 7e5dbeb146655261546cb599417237e31d470f3e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Tue, 26 Mar 2019 06:25:45 +0100 Subject: [PATCH 066/176] Use vector/vectorOf from QuickCheck and simplify --- tests/Utils.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/tests/Utils.hs b/tests/Utils.hs index 11622c4..03ba521 100644 --- a/tests/Utils.hs +++ b/tests/Utils.hs @@ -2,7 +2,6 @@ module Utils where import Control.Applicative -import Control.Monad (replicateM) import Data.Char import Data.Word import Data.List @@ -28,13 +27,13 @@ newtype ChunkingLen = ChunkingLen [Int] deriving (Show,Eq) instance Arbitrary ChunkingLen where - arbitrary = ChunkingLen `fmap` replicateM 16 (choose (0,14)) + arbitrary = ChunkingLen `fmap` vectorOf 16 (choose (0,14)) newtype ChunkingLen0_127 = ChunkingLen0_127 [Int] deriving (Show,Eq) instance Arbitrary ChunkingLen0_127 where - arbitrary = ChunkingLen0_127 `fmap` replicateM 16 (choose (0,127)) + arbitrary = ChunkingLen0_127 `fmap` vectorOf 16 (choose (0,127)) newtype ArbitraryBS0_2901 = ArbitraryBS0_2901 ByteString @@ -63,7 +62,7 @@ instance Arbitrary QAInteger where arbitrary = oneof [ QAInteger . fromIntegral <$> (choose (0, 65536) :: Gen Int) -- small integer , larger <$> choose (0,4096) <*> choose (0, 65536) -- medium integer - , QAInteger . os2ip . B.pack <$> (choose (0,32) >>= \n -> replicateM n arbitrary) -- [ 0 .. 2^32 ] sized integer + , QAInteger . os2ip <$> arbitraryBSof 0 32 -- [ 0 .. 2^32 ] sized integer ] where larger :: Int -> Int -> QAInteger @@ -73,10 +72,10 @@ instance Arbitrary QAInteger where somePrime = 18446744073709551557 arbitraryBS :: Int -> Gen ByteString -arbitraryBS n = B.pack `fmap` replicateM n arbitrary +arbitraryBS = fmap B.pack . vector arbitraryBSof :: Int -> Int -> Gen ByteString -arbitraryBSof minSize maxSize = choose (minSize, maxSize) >>= \n -> (B.pack `fmap` replicateM n arbitrary) +arbitraryBSof minSize maxSize = choose (minSize, maxSize) >>= arbitraryBS chunkS :: ChunkingLen -> ByteString -> [ByteString] chunkS (ChunkingLen originalChunks) = loop originalChunks From 155143611159e56792219989778d990817df543b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 7 Apr 2019 09:49:31 +0200 Subject: [PATCH 067/176] Add KMAC --- Crypto/Hash/SHAKE.hs | 30 ++++++++- Crypto/MAC/KMAC.hs | 134 ++++++++++++++++++++++++++++++++++++++++ cbits/cryptonite_sha3.c | 17 +++-- cbits/cryptonite_sha3.h | 1 + cryptonite.cabal | 4 +- tests/KAT_KMAC.hs | 129 ++++++++++++++++++++++++++++++++++++++ tests/Tests.hs | 2 + 7 files changed, 311 insertions(+), 6 deletions(-) create mode 100644 Crypto/MAC/KMAC.hs create mode 100644 tests/KAT_KMAC.hs diff --git a/Crypto/Hash/SHAKE.hs b/Crypto/Hash/SHAKE.hs index 3298816..8639cdb 100644 --- a/Crypto/Hash/SHAKE.hs +++ b/Crypto/Hash/SHAKE.hs @@ -17,7 +17,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} module Crypto.Hash.SHAKE - ( SHAKE128 (..), SHAKE256 (..) + ( SHAKE128 (..), SHAKE256 (..), HashSHAKE (..) ) where import Control.Monad (when) @@ -32,6 +32,13 @@ import Data.Proxy (Proxy(..)) import GHC.TypeLits (Nat, KnownNat, type (+)) import Crypto.Internal.Nat +-- | Type class of SHAKE algorithms. +class HashAlgorithm a => HashSHAKE a where + -- | Alternate finalization needed for cSHAKE + cshakeInternalFinalize :: Ptr (Context a) -> Ptr (Digest a) -> IO () + -- | Get the digest bit length + cshakeOutputLength :: a -> Int + -- | SHAKE128 (128 bits) extendable output function. Supports an arbitrary -- digest size, to be specified as a type parameter of kind 'Nat'. -- @@ -52,6 +59,10 @@ instance KnownNat bitlen => HashAlgorithm (SHAKE128 bitlen) where hashInternalUpdate = c_sha3_update hashInternalFinalize = shakeFinalizeOutput (Proxy :: Proxy bitlen) +instance KnownNat bitlen => HashSHAKE (SHAKE128 bitlen) where + cshakeInternalFinalize = cshakeFinalizeOutput (Proxy :: Proxy bitlen) + cshakeOutputLength _ = integralNatVal (Proxy :: Proxy bitlen) + -- | SHAKE256 (256 bits) extendable output function. Supports an arbitrary -- digest size, to be specified as a type parameter of kind 'Nat'. -- @@ -72,6 +83,10 @@ instance KnownNat bitlen => HashAlgorithm (SHAKE256 bitlen) where hashInternalUpdate = c_sha3_update hashInternalFinalize = shakeFinalizeOutput (Proxy :: Proxy bitlen) +instance KnownNat bitlen => HashSHAKE (SHAKE256 bitlen) where + cshakeInternalFinalize = cshakeFinalizeOutput (Proxy :: Proxy bitlen) + cshakeOutputLength _ = integralNatVal (Proxy :: Proxy bitlen) + shakeFinalizeOutput :: KnownNat bitlen => proxy bitlen -> Ptr (Context a) @@ -82,6 +97,16 @@ shakeFinalizeOutput d ctx dig = do c_sha3_output ctx dig (byteLen d) shakeTruncate d (castPtr dig) +cshakeFinalizeOutput :: KnownNat bitlen + => proxy bitlen + -> Ptr (Context a) + -> Ptr (Digest a) + -> IO () +cshakeFinalizeOutput d ctx dig = do + c_sha3_finalize_cshake ctx + c_sha3_output ctx dig (byteLen d) + shakeTruncate d (castPtr dig) + shakeTruncate :: KnownNat bitlen => proxy bitlen -> Ptr Word8 -> IO () shakeTruncate d ptr = when (bits > 0) $ do @@ -100,5 +125,8 @@ foreign import ccall "cryptonite_sha3_update" foreign import ccall unsafe "cryptonite_sha3_finalize_shake" c_sha3_finalize_shake :: Ptr (Context a) -> IO () +foreign import ccall unsafe "cryptonite_sha3_finalize_cshake" + c_sha3_finalize_cshake :: Ptr (Context a) -> IO () + foreign import ccall unsafe "cryptonite_sha3_output" c_sha3_output :: Ptr (Context a) -> Ptr (Digest a) -> Word32 -> IO () diff --git a/Crypto/MAC/KMAC.hs b/Crypto/MAC/KMAC.hs new file mode 100644 index 0000000..25e640a --- /dev/null +++ b/Crypto/MAC/KMAC.hs @@ -0,0 +1,134 @@ +-- | +-- Module : Crypto.MAC.KMAC +-- License : BSD-style +-- Maintainer : Olivier Chéron +-- Stability : experimental +-- Portability : unknown +-- +-- Provide the KMAC (Keccak Message Authentication Code) algorithm, derived from +-- the SHA-3 base algorithm Keccak and defined in NIST SP800-185. +-- +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Crypto.MAC.KMAC + ( HashSHAKE + , kmac + , KMAC(..) + -- * Incremental + , Context + , initialize + , update + , updates + , finalize + ) where + +import qualified Crypto.Hash as H +import Crypto.Hash.SHAKE (HashSHAKE(..)) +import Crypto.Hash.Types (HashAlgorithm(..), Digest(..)) +import qualified Crypto.Hash.Types as H +import Crypto.Number.Serialize +import Foreign.Ptr (Ptr) +import Data.ByteArray (ByteArray, ByteArrayAccess) +import qualified Data.ByteArray as B + + +-- cSHAKE + +cshakeInit :: forall a name string . (HashSHAKE a, ByteArrayAccess name, ByteArrayAccess string) + => name -> string -> H.Context a +cshakeInit n s = H.Context $ B.allocAndFreeze c $ \(ptr :: Ptr (H.Context a)) -> do + hashInternalInit ptr + B.withByteArray b $ \d -> hashInternalUpdate ptr d (fromIntegral $ B.length b) + where + c = hashInternalContextSize (undefined :: a) + w = hashBlockSize (undefined :: a) + x = encodeString n `B.append` encodeString s :: B.Bytes + b = bytepad x w + +cshakeUpdate :: (HashSHAKE a, ByteArrayAccess ba) + => H.Context a -> ba -> H.Context a +cshakeUpdate = H.hashUpdate + +cshakeUpdates :: (HashSHAKE a, ByteArrayAccess ba) + => H.Context a -> [ba] -> H.Context a +cshakeUpdates = H.hashUpdates + +cshakeFinalize :: forall a . HashSHAKE a => H.Context a -> Digest a +cshakeFinalize !c = + Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \dig -> do + ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (H.Context a)) -> + cshakeInternalFinalize ctx dig + return () + + +-- KMAC + +-- | Represent a KMAC that is a phantom type with the hash used to produce the +-- mac. +-- +-- The Eq instance is constant time. No Show instance is provided, to avoid +-- printing by mistake. +newtype KMAC a = KMAC { kmacGetDigest :: Digest a } + deriving ByteArrayAccess + +instance Eq (KMAC a) where + (KMAC b1) == (KMAC b2) = B.constEq b1 b2 + +-- | Compute a KMAC using the supplied customization string and key. +kmac :: (HashSHAKE a, ByteArrayAccess string, ByteArrayAccess key, ByteArrayAccess ba) + => string -> key -> ba -> KMAC a +kmac str key msg = finalize $ updates (initialize str key) [msg] + +-- | Represent an ongoing KMAC state, that can be appended with 'update' and +-- finalized to a 'KMAC' with 'finalize'. +newtype Context a = Context (H.Context a) + +-- | Initialize a new incremental KMAC context with the supplied customization +-- string and key. +initialize :: forall a string key . (HashSHAKE a, ByteArrayAccess string, ByteArrayAccess key) + => string -> key -> Context a +initialize str key = Context $ cshakeUpdate (cshakeInit n str) prefix + where + n = B.pack [75,77,65,67] :: B.Bytes -- "KMAC" + w = hashBlockSize (undefined :: a) + prefix = bytepad (encodeString key) w :: B.Bytes + +-- | Incrementally update a KMAC context. +update :: (HashSHAKE a, ByteArrayAccess ba) => Context a -> ba -> Context a +update (Context ctx) = Context . cshakeUpdate ctx + +-- | Incrementally update a KMAC context with multiple inputs. +updates :: (HashSHAKE a, ByteArrayAccess ba) => Context a -> [ba] -> Context a +updates (Context ctx) = Context . cshakeUpdates ctx + +-- | Finalize a KMAC context and return the KMAC. +finalize :: forall a . HashSHAKE a => Context a -> KMAC a +finalize (Context ctx) = KMAC $ cshakeFinalize $ cshakeUpdate ctx suffix + where + l = cshakeOutputLength (undefined :: a) + suffix = rightEncode l :: B.Bytes + + +-- Utilities + +bytepad :: ByteArray ba => ba -> Int -> ba +bytepad x w = B.concat [ prefix, x, B.zero padLen ] + where + prefix = leftEncode w + padLen = (w - B.length prefix - B.length x) `mod` w + +encodeString :: (ByteArrayAccess bin, ByteArray bout) => bin -> bout +encodeString s = leftEncode (8 * B.length s) `B.append` B.convert s + +leftEncode :: ByteArray ba => Int -> ba +leftEncode x = B.cons len digits + where + digits = i2osp (toInteger x) + len = fromIntegral (B.length digits) + +rightEncode :: ByteArray ba => Int -> ba +rightEncode x = B.snoc digits len + where + digits = i2osp (toInteger x) + len = fromIntegral (B.length digits) diff --git a/cbits/cryptonite_sha3.c b/cbits/cryptonite_sha3.c index 02278e2..93f411a 100644 --- a/cbits/cryptonite_sha3.c +++ b/cbits/cryptonite_sha3.c @@ -99,8 +99,11 @@ static inline void sha3_do_chunk(uint64_t state[25], uint64_t buf[], int bufsz) } /* - * Initialize a SHA-3 / SHAKE context: hashlen is the security level (and - * half the capacity) in bits + * Initialize a SHA-3 / SHAKE / cSHAKE context: hashlen is the security level + * (and half the capacity) in bits. + * + * In case of cSHAKE, the message prefix with encoded N and S must be added with + * cryptonite_sha3_update. */ void cryptonite_sha3_init(struct sha3_ctx *ctx, uint32_t hashlen) { @@ -110,7 +113,7 @@ void cryptonite_sha3_init(struct sha3_ctx *ctx, uint32_t hashlen) ctx->bufsz = bufsz; } -/* Update a SHA-3 / SHAKE context */ +/* Update a SHA-3 / SHAKE / cSHAKE context */ void cryptonite_sha3_update(struct sha3_ctx *ctx, const uint8_t *data, uint32_t len) { uint32_t to_fill; @@ -171,7 +174,7 @@ void cryptonite_sha3_finalize_with_pad_byte(struct sha3_ctx *ctx, uint8_t pad_by } /* - * Extract some bytes from a finalized SHA-3 / SHAKE context. + * Extract some bytes from a finalized SHA-3 / SHAKE / cSHAKE context. * May be called multiple times. */ void cryptonite_sha3_output(struct sha3_ctx *ctx, uint8_t *out, uint32_t len) @@ -226,6 +229,12 @@ void cryptonite_sha3_finalize_shake(struct sha3_ctx *ctx) cryptonite_sha3_finalize_with_pad_byte(ctx, 0x1F); } +/* Finalize a cSHAKE context. Output is read using cryptonite_sha3_output. */ +void cryptonite_sha3_finalize_cshake(struct sha3_ctx *ctx) +{ + cryptonite_sha3_finalize_with_pad_byte(ctx, 0x04); +} + void cryptonite_keccak_init(struct sha3_ctx *ctx, uint32_t hashlen) { cryptonite_sha3_init(ctx, hashlen); diff --git a/cbits/cryptonite_sha3.h b/cbits/cryptonite_sha3.h index 4fe02eb..fbb2413 100644 --- a/cbits/cryptonite_sha3.h +++ b/cbits/cryptonite_sha3.h @@ -57,6 +57,7 @@ void cryptonite_sha3_update(struct sha3_ctx *ctx, const uint8_t *data, uint32_t void cryptonite_sha3_finalize(struct sha3_ctx *ctx, uint32_t hashlen, uint8_t *out); void cryptonite_sha3_finalize_shake(struct sha3_ctx *ctx); +void cryptonite_sha3_finalize_cshake(struct sha3_ctx *ctx); void cryptonite_sha3_output(struct sha3_ctx *ctx, uint8_t *out, uint32_t len); void cryptonite_keccak_init(struct sha3_ctx *ctx, uint32_t hashlen); diff --git a/cryptonite.cabal b/cryptonite.cabal index 22f16c4..0c9b036 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -8,7 +8,7 @@ Description: . * Hash: SHA1, SHA2, SHA3, SHAKE, MD2, MD4, MD5, Keccak, Skein, Ripemd, Tiger, Whirlpool, Blake2 . - * MAC: HMAC, Poly1305 + * MAC: HMAC, KMAC, Poly1305 . * Asymmetric crypto: DSA, RSA, DH, ECDH, ECDSA, ECC, Curve25519, Curve448, Ed25519, Ed448 . @@ -126,6 +126,7 @@ Library Crypto.MAC.CMAC Crypto.MAC.Poly1305 Crypto.MAC.HMAC + Crypto.MAC.KMAC Crypto.Number.Basic Crypto.Number.F2m Crypto.Number.Generate @@ -404,6 +405,7 @@ Test-Suite test-cryptonite KAT_CMAC KAT_HKDF KAT_HMAC + KAT_KMAC KAT_MiyaguchiPreneel KAT_PBKDF2 KAT_OTP diff --git a/tests/KAT_KMAC.hs b/tests/KAT_KMAC.hs new file mode 100644 index 0000000..e5fa83c --- /dev/null +++ b/tests/KAT_KMAC.hs @@ -0,0 +1,129 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +module KAT_KMAC (tests) where + +import Crypto.Hash (SHAKE128(..), SHAKE256(..), + HashAlgorithm, digestFromByteString) +import qualified Crypto.MAC.KMAC as KMAC + +import qualified Data.ByteString as B + +import Imports + +data MACVector hash = MACVector + { macString :: ByteString + , macKey :: ByteString + , macSecret :: ByteString + , macResult :: KMAC.KMAC hash + } + +instance Show (KMAC.KMAC a) where + show (KMAC.KMAC d) = show d + +digest :: HashAlgorithm hash => ByteString -> KMAC.KMAC hash +digest = maybe (error "cannot get digest") KMAC.KMAC . digestFromByteString + +vectors128 :: [MACVector (SHAKE128 256)] +vectors128 = + [ MACVector + { macString = "" + , macKey = B.pack [ 0x40 .. 0x5f ] + , macSecret = B.pack [ 0x00 .. 0x03 ] + , macResult = digest "\xe5\x78\x0b\x0d\x3e\xa6\xf7\xd3\xa4\x29\xc5\x70\x6a\xa4\x3a\x00\xfa\xdb\xd7\xd4\x96\x28\x83\x9e\x31\x87\x24\x3f\x45\x6e\xe1\x4e" + } + , MACVector + { macString = "My Tagged Application" + , macKey = B.pack [ 0x40 .. 0x5f ] + , macSecret = B.pack [ 0x00 .. 0x03 ] + , macResult = digest "\x3b\x1f\xba\x96\x3c\xd8\xb0\xb5\x9e\x8c\x1a\x6d\x71\x88\x8b\x71\x43\x65\x1a\xf8\xba\x0a\x70\x70\xc0\x97\x9e\x28\x11\x32\x4a\xa5" + } + , MACVector + { macString = "My Tagged Application" + , macKey = B.pack [ 0x40 .. 0x5f ] + , macSecret = B.pack [ 0x00 .. 0xc7 ] + , macResult = digest "\x1f\x5b\x4e\x6c\xca\x02\x20\x9e\x0d\xcb\x5c\xa6\x35\xb8\x9a\x15\xe2\x71\xec\xc7\x60\x07\x1d\xfd\x80\x5f\xaa\x38\xf9\x72\x92\x30" + } + ] + +vectors256 :: [MACVector (SHAKE256 512)] +vectors256 = + [ MACVector + { macString = "My Tagged Application" + , macKey = B.pack [ 0x40 .. 0x5f ] + , macSecret = B.pack [ 0x00 .. 0x03 ] + , macResult = digest "\x20\xc5\x70\xc3\x13\x46\xf7\x03\xc9\xac\x36\xc6\x1c\x03\xcb\x64\xc3\x97\x0d\x0c\xfc\x78\x7e\x9b\x79\x59\x9d\x27\x3a\x68\xd2\xf7\xf6\x9d\x4c\xc3\xde\x9d\x10\x4a\x35\x16\x89\xf2\x7c\xf6\xf5\x95\x1f\x01\x03\xf3\x3f\x4f\x24\x87\x10\x24\xd9\xc2\x77\x73\xa8\xdd" + } + , MACVector + { macString = "" + , macKey = B.pack [ 0x40 .. 0x5f ] + , macSecret = B.pack [ 0x00 .. 0xc7 ] + , macResult = digest "\x75\x35\x8c\xf3\x9e\x41\x49\x4e\x94\x97\x07\x92\x7c\xee\x0a\xf2\x0a\x3f\xf5\x53\x90\x4c\x86\xb0\x8f\x21\xcc\x41\x4b\xcf\xd6\x91\x58\x9d\x27\xcf\x5e\x15\x36\x9c\xbb\xff\x8b\x9a\x4c\x2e\xb1\x78\x00\x85\x5d\x02\x35\xff\x63\x5d\xa8\x25\x33\xec\x6b\x75\x9b\x69" + } + , MACVector + { macString = "My Tagged Application" + , macKey = B.pack [ 0x40 .. 0x5f ] + , macSecret = B.pack [ 0x00 .. 0xc7 ] + , macResult = digest "\xb5\x86\x18\xf7\x1f\x92\xe1\xd5\x6c\x1b\x8c\x55\xdd\xd7\xcd\x18\x8b\x97\xb4\xca\x4d\x99\x83\x1e\xb2\x69\x9a\x83\x7d\xa2\xe4\xd9\x70\xfb\xac\xfd\xe5\x00\x33\xae\xa5\x85\xf1\xa2\x70\x85\x10\xc3\x2d\x07\x88\x08\x01\xbd\x18\x28\x98\xfe\x47\x68\x76\xfc\x89\x65" + } + ] + +macTests :: [TestTree] +macTests = + [ testGroup "SHAKE128" (concatMap toMACTest $ zip is vectors128) + , testGroup "SHAKE256" (concatMap toMACTest $ zip is vectors256) + ] + where toMACTest (i, MACVector{..}) = + [ testCase (show i) (macResult @=? KMAC.kmac macString macKey macSecret) + , testCase ("incr-" ++ show i) (macResult @=? + KMAC.finalize (KMAC.update (KMAC.initialize macString macKey) macSecret)) + ] + is :: [Int] + is = [1..] + +data MacIncremental a = MacIncremental ByteString ByteString ByteString (KMAC.KMAC a) + deriving (Show,Eq) + +instance KMAC.HashSHAKE a => Arbitrary (MacIncremental a) where + arbitrary = do + str <- arbitraryBSof 0 49 + key <- arbitraryBSof 1 89 + msg <- arbitraryBSof 1 99 + return $ MacIncremental str key msg (KMAC.kmac str key msg) + +data MacIncrementalList a = MacIncrementalList ByteString ByteString [ByteString] (KMAC.KMAC a) + deriving (Show,Eq) + +instance KMAC.HashSHAKE a => Arbitrary (MacIncrementalList a) where + arbitrary = do + str <- arbitraryBSof 0 49 + key <- arbitraryBSof 1 89 + msgs <- choose (1,20) >>= \n -> replicateM n (arbitraryBSof 1 99) + return $ MacIncrementalList str key msgs (KMAC.kmac str key (B.concat msgs)) + +macIncrementalTests :: [TestTree] +macIncrementalTests = + [ testIncrProperties "SHAKE128_256" (SHAKE128 :: SHAKE128 256) + , testIncrProperties "SHAKE256_512" (SHAKE256 :: SHAKE256 512) + ] + where + testIncrProperties :: KMAC.HashSHAKE a => TestName -> a -> TestTree + testIncrProperties name a = testGroup name + [ testProperty "list-one" (prop_inc0 a) + , testProperty "list-multi" (prop_inc1 a) + ] + + prop_inc0 :: KMAC.HashSHAKE a => a -> MacIncremental a -> Bool + prop_inc0 _ (MacIncremental str secret msg result) = + result `assertEq` KMAC.finalize (KMAC.update (KMAC.initialize str secret) msg) + + prop_inc1 :: KMAC.HashSHAKE a => a -> MacIncrementalList a -> Bool + prop_inc1 _ (MacIncrementalList str secret msgs result) = + result `assertEq` KMAC.finalize (foldl' KMAC.update (KMAC.initialize str secret) msgs) + +tests = testGroup "KMAC" + [ testGroup "KATs" macTests + , testGroup "properties" macIncrementalTests + ] diff --git a/tests/Tests.hs b/tests/Tests.hs index bd64ecc..3b9a09f 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -18,6 +18,7 @@ import qualified ChaChaPoly1305 import qualified KAT_MiyaguchiPreneel import qualified KAT_CMAC import qualified KAT_HMAC +import qualified KAT_KMAC import qualified KAT_HKDF import qualified KAT_Argon2 import qualified KAT_PBKDF2 @@ -53,6 +54,7 @@ tests = testGroup "cryptonite" [ Poly1305.tests , KAT_CMAC.tests , KAT_HMAC.tests + , KAT_KMAC.tests ] , KAT_Curve25519.tests , KAT_Curve448.tests From 14093ac2981301f2c2fb8d66b15153239dddf8c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 7 Apr 2019 11:23:42 +0200 Subject: [PATCH 068/176] Optimize KMAC allocations Adds a minimalist Builder type to merge intermediate allocations into a single ByteArray. Key is now copied to a ScrubbedBytes only. --- Crypto/MAC/KMAC.hs | 71 +++++++++++++++++++++++++++++++++------------- 1 file changed, 51 insertions(+), 20 deletions(-) diff --git a/Crypto/MAC/KMAC.hs b/Crypto/MAC/KMAC.hs index 25e640a..2bfe2a2 100644 --- a/Crypto/MAC/KMAC.hs +++ b/Crypto/MAC/KMAC.hs @@ -27,10 +27,13 @@ import qualified Crypto.Hash as H import Crypto.Hash.SHAKE (HashSHAKE(..)) import Crypto.Hash.Types (HashAlgorithm(..), Digest(..)) import qualified Crypto.Hash.Types as H -import Crypto.Number.Serialize -import Foreign.Ptr (Ptr) +import Foreign.Ptr (Ptr, plusPtr) +import Foreign.Storable (poke) +import Data.Bits (shiftR) import Data.ByteArray (ByteArray, ByteArrayAccess) import qualified Data.ByteArray as B +import Data.Word (Word8) +import Data.Memory.PtrMethods (memSet) -- cSHAKE @@ -43,8 +46,8 @@ cshakeInit n s = H.Context $ B.allocAndFreeze c $ \(ptr :: Ptr (H.Context a)) -> where c = hashInternalContextSize (undefined :: a) w = hashBlockSize (undefined :: a) - x = encodeString n `B.append` encodeString s :: B.Bytes - b = bytepad x w + x = encodeString n <+> encodeString s + b = builderAllocAndFreeze (bytepad x w) :: B.Bytes cshakeUpdate :: (HashSHAKE a, ByteArrayAccess ba) => H.Context a -> ba -> H.Context a @@ -88,11 +91,11 @@ newtype Context a = Context (H.Context a) -- string and key. initialize :: forall a string key . (HashSHAKE a, ByteArrayAccess string, ByteArrayAccess key) => string -> key -> Context a -initialize str key = Context $ cshakeUpdate (cshakeInit n str) prefix +initialize str key = Context $ cshakeUpdate (cshakeInit n str) p where n = B.pack [75,77,65,67] :: B.Bytes -- "KMAC" w = hashBlockSize (undefined :: a) - prefix = bytepad (encodeString key) w :: B.Bytes + p = builderAllocAndFreeze (bytepad (encodeString key) w) :: B.ScrubbedBytes -- | Incrementally update a KMAC context. update :: (HashSHAKE a, ByteArrayAccess ba) => Context a -> ba -> Context a @@ -107,28 +110,56 @@ finalize :: forall a . HashSHAKE a => Context a -> KMAC a finalize (Context ctx) = KMAC $ cshakeFinalize $ cshakeUpdate ctx suffix where l = cshakeOutputLength (undefined :: a) - suffix = rightEncode l :: B.Bytes + suffix = builderAllocAndFreeze (rightEncode l) :: B.Bytes -- Utilities -bytepad :: ByteArray ba => ba -> Int -> ba -bytepad x w = B.concat [ prefix, x, B.zero padLen ] +bytepad :: Builder -> Int -> Builder +bytepad x w = prefix <+> x <+> zero padLen where prefix = leftEncode w - padLen = (w - B.length prefix - B.length x) `mod` w + padLen = (w - builderLength prefix - builderLength x) `mod` w -encodeString :: (ByteArrayAccess bin, ByteArray bout) => bin -> bout -encodeString s = leftEncode (8 * B.length s) `B.append` B.convert s +encodeString :: ByteArrayAccess bin => bin -> Builder +encodeString s = leftEncode (8 * B.length s) <+> bytes s -leftEncode :: ByteArray ba => Int -> ba -leftEncode x = B.cons len digits +leftEncode :: Int -> Builder +leftEncode x = byte len <+> digits where - digits = i2osp (toInteger x) - len = fromIntegral (B.length digits) + digits = i2osp x + len = fromIntegral (builderLength digits) -rightEncode :: ByteArray ba => Int -> ba -rightEncode x = B.snoc digits len +rightEncode :: Int -> Builder +rightEncode x = digits <+> byte len where - digits = i2osp (toInteger x) - len = fromIntegral (B.length digits) + digits = i2osp x + len = fromIntegral (builderLength digits) + +i2osp :: Int -> Builder +i2osp i | i >= 256 = i2osp (shiftR i 8) <+> byte (fromIntegral i) + | otherwise = byte (fromIntegral i) + + +-- Delaying and merging ByteArray allocations + +data Builder = Builder !Int (Ptr Word8 -> IO ()) -- size and initializer + +(<+>) :: Builder -> Builder -> Builder +(Builder s1 f1) <+> (Builder s2 f2) = Builder (s1 + s2) f + where f p = f1 p >> f2 (p `plusPtr` s1) + +builderLength :: Builder -> Int +builderLength (Builder s _) = s + +builderAllocAndFreeze :: ByteArray ba => Builder -> ba +builderAllocAndFreeze (Builder s f) = B.allocAndFreeze s f + +byte :: Word8 -> Builder +byte !b = Builder 1 (`poke` b) + +bytes :: ByteArrayAccess ba => ba -> Builder +bytes bs = Builder (B.length bs) (B.copyByteArrayToPtr bs) + +zero :: Int -> Builder +zero s = Builder s (\p -> memSet p 0 s) From 8b235612bee288113ba8b3552339549952061980 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 7 Apr 2019 11:38:16 +0200 Subject: [PATCH 069/176] Merge cshakeInit with first cshakeUpdate --- Crypto/MAC/KMAC.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/Crypto/MAC/KMAC.hs b/Crypto/MAC/KMAC.hs index 2bfe2a2..e48d26a 100644 --- a/Crypto/MAC/KMAC.hs +++ b/Crypto/MAC/KMAC.hs @@ -38,11 +38,12 @@ import Data.Memory.PtrMethods (memSet) -- cSHAKE -cshakeInit :: forall a name string . (HashSHAKE a, ByteArrayAccess name, ByteArrayAccess string) - => name -> string -> H.Context a -cshakeInit n s = H.Context $ B.allocAndFreeze c $ \(ptr :: Ptr (H.Context a)) -> do +cshakeInit :: forall a name string prefix . (HashSHAKE a, ByteArrayAccess name, ByteArrayAccess string, ByteArrayAccess prefix) + => name -> string -> prefix -> H.Context a +cshakeInit n s p = H.Context $ B.allocAndFreeze c $ \(ptr :: Ptr (H.Context a)) -> do hashInternalInit ptr B.withByteArray b $ \d -> hashInternalUpdate ptr d (fromIntegral $ B.length b) + B.withByteArray p $ \d -> hashInternalUpdate ptr d (fromIntegral $ B.length p) where c = hashInternalContextSize (undefined :: a) w = hashBlockSize (undefined :: a) @@ -91,7 +92,7 @@ newtype Context a = Context (H.Context a) -- string and key. initialize :: forall a string key . (HashSHAKE a, ByteArrayAccess string, ByteArrayAccess key) => string -> key -> Context a -initialize str key = Context $ cshakeUpdate (cshakeInit n str) p +initialize str key = Context $ cshakeInit n str p where n = B.pack [75,77,65,67] :: B.Bytes -- "KMAC" w = hashBlockSize (undefined :: a) From ae107a928583af8599a132fa9302f9e72dfe12d3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Wed, 1 May 2019 07:03:45 +0200 Subject: [PATCH 070/176] Merge last cshakeUpdate with cshakeFinalize --- Crypto/MAC/KMAC.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/Crypto/MAC/KMAC.hs b/Crypto/MAC/KMAC.hs index e48d26a..f07e9e9 100644 --- a/Crypto/MAC/KMAC.hs +++ b/Crypto/MAC/KMAC.hs @@ -58,10 +58,13 @@ cshakeUpdates :: (HashSHAKE a, ByteArrayAccess ba) => H.Context a -> [ba] -> H.Context a cshakeUpdates = H.hashUpdates -cshakeFinalize :: forall a . HashSHAKE a => H.Context a -> Digest a -cshakeFinalize !c = +cshakeFinalize :: forall a suffix . (HashSHAKE a, ByteArrayAccess suffix) + => H.Context a -> suffix -> Digest a +cshakeFinalize !c s = Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \dig -> do - ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (H.Context a)) -> + ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (H.Context a)) -> do + B.withByteArray s $ \d -> + hashInternalUpdate ctx d (fromIntegral $ B.length s) cshakeInternalFinalize ctx dig return () @@ -108,7 +111,7 @@ updates (Context ctx) = Context . cshakeUpdates ctx -- | Finalize a KMAC context and return the KMAC. finalize :: forall a . HashSHAKE a => Context a -> KMAC a -finalize (Context ctx) = KMAC $ cshakeFinalize $ cshakeUpdate ctx suffix +finalize (Context ctx) = KMAC $ cshakeFinalize ctx suffix where l = cshakeOutputLength (undefined :: a) suffix = builderAllocAndFreeze (rightEncode l) :: B.Bytes From 158d8dfd0caceb6ae8eea70c10079753fdd193b4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Wed, 8 May 2019 10:09:06 +0200 Subject: [PATCH 071/176] Remove unnecessary imports --- Crypto/Hash/SHAKE.hs | 1 - Crypto/PubKey/Curve25519.hs | 1 - tests/ECC.hs | 1 - tests/KAT_OTP.hs | 1 - 4 files changed, 4 deletions(-) diff --git a/Crypto/Hash/SHAKE.hs b/Crypto/Hash/SHAKE.hs index 8639cdb..24b30fb 100644 --- a/Crypto/Hash/SHAKE.hs +++ b/Crypto/Hash/SHAKE.hs @@ -28,7 +28,6 @@ import Data.Bits import Data.Data import Data.Word (Word8, Word32) -import Data.Proxy (Proxy(..)) import GHC.TypeLits (Nat, KnownNat, type (+)) import Crypto.Internal.Nat diff --git a/Crypto/PubKey/Curve25519.hs b/Crypto/PubKey/Curve25519.hs index d85de91..9cd4f62 100644 --- a/Crypto/PubKey/Curve25519.hs +++ b/Crypto/PubKey/Curve25519.hs @@ -35,7 +35,6 @@ import Crypto.Internal.Compat import Crypto.Internal.Imports import Crypto.Internal.ByteArray (ByteArrayAccess, ScrubbedBytes, Bytes, withByteArray) import qualified Crypto.Internal.ByteArray as B -import Crypto.Error (CryptoFailable(..)) import Crypto.Random -- | A Curve25519 Secret key diff --git a/tests/ECC.hs b/tests/ECC.hs index e16e4de..c00dedc 100644 --- a/tests/ECC.hs +++ b/tests/ECC.hs @@ -7,7 +7,6 @@ import Crypto.Error import qualified Crypto.ECC as ECC import Data.ByteArray.Encoding -import Data.ByteString (ByteString) import Imports diff --git a/tests/KAT_OTP.hs b/tests/KAT_OTP.hs index f6fc1b6..8ea8854 100644 --- a/tests/KAT_OTP.hs +++ b/tests/KAT_OTP.hs @@ -8,7 +8,6 @@ where import Crypto.Hash.Algorithms (SHA1(..), SHA256(..), SHA512(..)) import Crypto.OTP -import Data.ByteString (ByteString) import Imports -- | Test values from Appendix D of http://tools.ietf.org/html/rfc4226 From 3161630390804be4394fc5bd039da070c734bf1c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Wed, 8 May 2019 10:09:51 +0200 Subject: [PATCH 072/176] Update CHANGELOG --- CHANGELOG.md | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 97c5f52..fd21840 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,22 @@ ## 0.26 +* Add Rabin cryptosystem (and variants) +* Add bcrypt_pbkdf key derivation function +* Optimize Blowfish implementation +* Add KMAC (Keccak Message Authentication Code) +* Add ECDSA sign/verify digest APIs +* Hash algorithms with runtime output length * Update blake2 to latest upstream version +* RSA-PSS with arbitrary key size +* SHAKE with output length not divisible by 8 +* Add Read and Data instances for Digest type +* Improve P256 scalar primitives +* Fix hash truncation bug in DSA +* Fix cost parsing for bcrypt +* Fix ECC failures on arm64 +* Correction to PKCS#1 v1.5 padding +* Use powModSecInteger when available +* Drop GHC 7.8 and GHC 7.10 support, refer to pkg-guidelines ## 0.25 From 6e1b6fdb907a4786f30c683996ed86c747524762 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 2 Jun 2018 09:23:54 +0200 Subject: [PATCH 073/176] Little-endian integer serialization --- Crypto/Number/Compat.hs | 32 ++++++++++- Crypto/Number/Serialize/Internal.hs | 2 +- Crypto/Number/Serialize/Internal/LE.hs | 75 ++++++++++++++++++++++++++ Crypto/Number/Serialize/LE.hs | 53 ++++++++++++++++++ cryptonite.cabal | 2 + 5 files changed, 161 insertions(+), 3 deletions(-) create mode 100644 Crypto/Number/Serialize/Internal/LE.hs create mode 100644 Crypto/Number/Serialize/LE.hs diff --git a/Crypto/Number/Compat.hs b/Crypto/Number/Compat.hs index 6a77c22..01e0455 100644 --- a/Crypto/Number/Compat.hs +++ b/Crypto/Number/Compat.hs @@ -22,7 +22,9 @@ module Crypto.Number.Compat , gmpSizeInBytes , gmpSizeInBits , gmpExportInteger + , gmpExportIntegerLE , gmpImportInteger + , gmpImportIntegerLE ) where #ifndef MIN_VERSION_integer_gmp @@ -134,7 +136,7 @@ gmpSizeInBits n = GmpSupported (I# (word2Int# (sizeInBaseInteger n 2#))) gmpSizeInBits _ = GmpUnsupported #endif --- | Export an integer to a memory +-- | Export an integer to a memory (big-endian) gmpExportInteger :: Integer -> Ptr Word8 -> GmpSupported (IO ()) #if MIN_VERSION_integer_gmp(1,0,0) gmpExportInteger n (Ptr addr) = GmpSupported $ do @@ -148,7 +150,21 @@ gmpExportInteger n (Ptr addr) = GmpSupported $ IO $ \s -> gmpExportInteger _ _ = GmpUnsupported #endif --- | Import an integer from a memory +-- | Export an integer to a memory (little-endian) +gmpExportIntegerLE :: Integer -> Ptr Word8 -> GmpSupported (IO ()) +#if MIN_VERSION_integer_gmp(1,0,0) +gmpExportIntegerLE n (Ptr addr) = GmpSupported $ do + _ <- exportIntegerToAddr n addr 0# + return () +#elif MIN_VERSION_integer_gmp(0,5,1) +gmpExportIntegerLE n (Ptr addr) = GmpSupported $ IO $ \s -> + case exportIntegerToAddr n addr 0# s of + (# s2, _ #) -> (# s2, () #) +#else +gmpExportIntegerLE _ _ = GmpUnsupported +#endif + +-- | Import an integer from a memory (big-endian) gmpImportInteger :: Int -> Ptr Word8 -> GmpSupported (IO Integer) #if MIN_VERSION_integer_gmp(1,0,0) gmpImportInteger (I# n) (Ptr addr) = GmpSupported $ @@ -159,3 +175,15 @@ gmpImportInteger (I# n) (Ptr addr) = GmpSupported $ IO $ \s -> #else gmpImportInteger _ _ = GmpUnsupported #endif + +-- | Import an integer from a memory (little-endian) +gmpImportIntegerLE :: Int -> Ptr Word8 -> GmpSupported (IO Integer) +#if MIN_VERSION_integer_gmp(1,0,0) +gmpImportIntegerLE (I# n) (Ptr addr) = GmpSupported $ + importIntegerFromAddr addr (int2Word# n) 0# +#elif MIN_VERSION_integer_gmp(0,5,1) +gmpImportIntegerLE (I# n) (Ptr addr) = GmpSupported $ IO $ \s -> + importIntegerFromAddr addr (int2Word# n) 0# s +#else +gmpImportIntegerLE _ _ = GmpUnsupported +#endif diff --git a/Crypto/Number/Serialize/Internal.hs b/Crypto/Number/Serialize/Internal.hs index 2f86380..b691edf 100644 --- a/Crypto/Number/Serialize/Internal.hs +++ b/Crypto/Number/Serialize/Internal.hs @@ -23,7 +23,7 @@ import Foreign.Storable -- | Fill a pointer with the big endian binary representation of an integer -- --- If the room available @ptrSz is less than the number of bytes needed, +-- If the room available @ptrSz@ is less than the number of bytes needed, -- 0 is returned. Likewise if a parameter is invalid, 0 is returned. -- -- Returns the number of bytes written diff --git a/Crypto/Number/Serialize/Internal/LE.hs b/Crypto/Number/Serialize/Internal/LE.hs new file mode 100644 index 0000000..52c5658 --- /dev/null +++ b/Crypto/Number/Serialize/Internal/LE.hs @@ -0,0 +1,75 @@ +-- | +-- Module : Crypto.Number.Serialize.Internal.LE +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : Good +-- +-- Fast serialization primitives for integer using raw pointers (little endian) +{-# LANGUAGE BangPatterns #-} +module Crypto.Number.Serialize.Internal.LE + ( i2osp + , i2ospOf + , os2ip + ) where + +import Crypto.Number.Compat +import Crypto.Number.Basic +import Data.Bits +import Data.Memory.PtrMethods +import Data.Word (Word8) +import Foreign.Ptr +import Foreign.Storable + +-- | Fill a pointer with the little endian binary representation of an integer +-- +-- If the room available @ptrSz@ is less than the number of bytes needed, +-- 0 is returned. Likewise if a parameter is invalid, 0 is returned. +-- +-- Returns the number of bytes written +i2osp :: Integer -> Ptr Word8 -> Int -> IO Int +i2osp m ptr ptrSz + | ptrSz <= 0 = return 0 + | m < 0 = return 0 + | m == 0 = pokeByteOff ptr (sz-1) (0 :: Word8) >> return 1 + | ptrSz < sz = return 0 + | otherwise = fillPtr ptr sz m >> return sz + where + !sz = numBytes m + +-- | Similar to 'i2osp', except it will pad any remaining space with zero. +i2ospOf :: Integer -> Ptr Word8 -> Int -> IO Int +i2ospOf m ptr ptrSz + | ptrSz <= 0 = return 0 + | m < 0 = return 0 + | ptrSz < sz = return 0 + | otherwise = do + memSet ptr 0 ptrSz + fillPtr ptr sz m + return ptrSz + where + !sz = numBytes m + +fillPtr :: Ptr Word8 -> Int -> Integer -> IO () +fillPtr p sz m = gmpExportIntegerLE m p `onGmpUnsupported` export 0 m + where + export ofs i + | ofs >= sz = return () + | otherwise = do + let (i', b) = i `divMod` 256 + pokeByteOff p ofs (fromIntegral b :: Word8) + export (ofs+1) i' + +-- | Transform a little endian binary integer representation pointed by a +-- pointer and a size into an integer +os2ip :: Ptr Word8 -> Int -> IO Integer +os2ip ptr ptrSz + | ptrSz <= 0 = return 0 + | otherwise = gmpImportIntegerLE ptrSz ptr `onGmpUnsupported` loop 0 (ptrSz-1) ptr + where + loop :: Integer -> Int -> Ptr Word8 -> IO Integer + loop !acc i p + | i < 0 = return acc + | otherwise = do + w <- peekByteOff p i :: IO Word8 + loop ((acc `shiftL` 8) .|. fromIntegral w) (i-1) p diff --git a/Crypto/Number/Serialize/LE.hs b/Crypto/Number/Serialize/LE.hs new file mode 100644 index 0000000..f396442 --- /dev/null +++ b/Crypto/Number/Serialize/LE.hs @@ -0,0 +1,53 @@ +-- | +-- Module : Crypto.Number.Serialize.LE +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : Good +-- +-- Fast serialization primitives for integer (little endian) +{-# LANGUAGE BangPatterns #-} +module Crypto.Number.Serialize.LE + ( i2osp + , os2ip + , i2ospOf + , i2ospOf_ + ) where + +import Crypto.Number.Basic +import Crypto.Internal.Compat (unsafeDoIO) +import qualified Crypto.Internal.ByteArray as B +import qualified Crypto.Number.Serialize.Internal.LE as Internal + +-- | @os2ip@ converts a byte string into a positive integer. +os2ip :: B.ByteArrayAccess ba => ba -> Integer +os2ip bs = unsafeDoIO $ B.withByteArray bs (\p -> Internal.os2ip p (B.length bs)) + +-- | @i2osp@ converts a positive integer into a byte string. +-- +-- The first byte is LSB (least significant byte); the last byte is the MSB (most significant byte) +i2osp :: B.ByteArray ba => Integer -> ba +i2osp 0 = B.allocAndFreeze 1 (\p -> Internal.i2osp 0 p 1 >> return ()) +i2osp m = B.allocAndFreeze sz (\p -> Internal.i2osp m p sz >> return ()) + where + !sz = numBytes m + +-- | Just like 'i2osp', but takes an extra parameter for size. +-- If the number is too big to fit in @len@ bytes, 'Nothing' is returned +-- otherwise the number is padded with 0 to fit the @len@ required. +i2ospOf :: B.ByteArray ba => Int -> Integer -> Maybe ba +i2ospOf len m + | len <= 0 = Nothing + | m < 0 = Nothing + | sz > len = Nothing + | otherwise = Just $ B.unsafeCreate len (\p -> Internal.i2ospOf m p len >> return ()) + where + !sz = numBytes m + +-- | Just like 'i2ospOf' except that it doesn't expect a failure: i.e. +-- an integer larger than the number of output bytes requested. +-- +-- For example if you just took a modulo of the number that represent +-- the size (example the RSA modulo n). +i2ospOf_ :: B.ByteArray ba => Int -> Integer -> ba +i2ospOf_ len = maybe (error "i2ospOf_: integer is larger than expected") id . i2ospOf len diff --git a/cryptonite.cabal b/cryptonite.cabal index 0c9b036..2dd7688 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -134,7 +134,9 @@ Library Crypto.Number.Nat Crypto.Number.Prime Crypto.Number.Serialize + Crypto.Number.Serialize.LE Crypto.Number.Serialize.Internal + Crypto.Number.Serialize.Internal.LE Crypto.KDF.Argon2 Crypto.KDF.PBKDF2 Crypto.KDF.Scrypt From 393aeac8cdc14a11efedd96e12f9daaa8a18c627 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 2 Jun 2018 09:24:41 +0200 Subject: [PATCH 074/176] Test LE serialization --- .haskell-ci | 4 ++-- .travis.yml | 8 ++++---- cryptonite.cabal | 2 +- stack.yaml | 4 ++-- tests/Number.hs | 22 +++++++++++++++++----- 5 files changed, 26 insertions(+), 14 deletions(-) diff --git a/.haskell-ci b/.haskell-ci index fc2947c..a7571c5 100644 --- a/.haskell-ci +++ b/.haskell-ci @@ -7,10 +7,10 @@ compiler: ghc-8.6 lts-13.3 # options # option: alias x=y z=v option: gaugedeps extradep=gauge-0.2.1 -option: basementmin extradep=basement-0.0.6 extradep=foundation-0.0.19 extradep=memory-0.14.14 +option: basementmin extradep=basement-0.0.8 extradep=memory-0.14.18 # builds -build: ghc-8.2 +build: ghc-8.2 basementmin build: ghc-8.0 basementmin gaugedeps build: ghc-8.0 basementmin gaugedeps os=osx build: ghc-8.4 diff --git a/.travis.yml b/.travis.yml index eb4f365..f32a94c 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,4 +1,4 @@ -# ~*~ auto-generated by haskell-ci with config : 8f74deffc95fd794fa2996c167c6543bbfab1ae432f0a83e0898f0b5871a92eb ~*~ +# ~*~ auto-generated by haskell-ci with config : 68149dea5ea6ea0dcbeebc12e2f77fd3f4f0166e8666f9dccd49bae65e2df32c ~*~ # Use new container infrastructure to enable caching sudo: false @@ -49,15 +49,15 @@ script: # create the build stack.yaml case "$RESOLVER" in ghc-8.2) - echo "{ resolver: lts-11.22, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml + echo "{ resolver: lts-11.22, packages: [ '.' ], extra-deps: [ basement-0.0.8, memory-0.14.18 ], flags: {} }" > stack.yaml stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; ghc-8.0) - echo "{ resolver: lts-9.21, packages: [ '.' ], extra-deps: [ basement-0.0.6, foundation-0.0.19, memory-0.14.14, gauge-0.2.1 ], flags: {} }" > stack.yaml + echo "{ resolver: lts-9.21, packages: [ '.' ], extra-deps: [ basement-0.0.8, memory-0.14.18, gauge-0.2.1 ], flags: {} }" > stack.yaml stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; ghc-8.0) - echo "{ resolver: lts-9.21, packages: [ '.' ], extra-deps: [ basement-0.0.6, foundation-0.0.19, memory-0.14.14, gauge-0.2.1 ], flags: {} }" > stack.yaml + echo "{ resolver: lts-9.21, packages: [ '.' ], extra-deps: [ basement-0.0.8, memory-0.14.18, gauge-0.2.1 ], flags: {} }" > stack.yaml stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; ghc-8.4) diff --git a/cryptonite.cabal b/cryptonite.cabal index 2dd7688..650094b 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -239,7 +239,7 @@ Library Build-depends: base Build-depends: bytestring - , memory >= 0.14.14 + , memory >= 0.14.18 , basement >= 0.0.6 , ghc-prim ghc-options: -Wall -fwarn-tabs -optc-O3 diff --git a/stack.yaml b/stack.yaml index bf246bb..9b882d2 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1,3 @@ -# ~*~ auto-generated by haskell-ci with config : 8f74deffc95fd794fa2996c167c6543bbfab1ae432f0a83e0898f0b5871a92eb ~*~ -{ resolver: lts-13.2, packages: [ '.' ], extra-deps: [], flags: {} } +# ~*~ auto-generated by haskell-ci with config : 68149dea5ea6ea0dcbeebc12e2f77fd3f4f0166e8666f9dccd49bae65e2df32c ~*~ +{ resolver: lts-13.3, packages: [ '.' ], extra-deps: [], flags: {} } diff --git a/tests/Number.hs b/tests/Number.hs index fd77fa7..0b8f654 100644 --- a/tests/Number.hs +++ b/tests/Number.hs @@ -4,9 +4,11 @@ module Number (tests) where import Imports import Data.ByteArray (Bytes) +import qualified Data.ByteArray as B import Crypto.Number.Basic import Crypto.Number.Generate -import Crypto.Number.Serialize +import qualified Crypto.Number.Serialize as BE +import qualified Crypto.Number.Serialize.LE as LE import Crypto.Number.Prime import Data.Bits @@ -50,14 +52,24 @@ tests = testGroup "number" bits = 6 + baseBits prime = withTestDRG testDRG $ generateSafePrime bits in bits == numBits prime - , testProperty "marshalling" $ \qaInt -> - getQAInteger qaInt == os2ip (i2osp (getQAInteger qaInt) :: Bytes) , testProperty "as-power-of-2-and-odd" $ \n -> let (e, a1) = asPowerOf2AndOdd n in n == (2^e)*a1 + , testProperty "marshalling-be" $ \qaInt -> + getQAInteger qaInt == BE.os2ip (BE.i2osp (getQAInteger qaInt) :: Bytes) + , testProperty "marshalling-le" $ \qaInt -> + getQAInteger qaInt == LE.os2ip (LE.i2osp (getQAInteger qaInt) :: Bytes) + , testProperty "be-rev-le" $ \qaInt -> + getQAInteger qaInt == LE.os2ip (B.reverse (BE.i2osp (getQAInteger qaInt) :: Bytes)) + , testProperty "be-rev-le-40" $ \qaInt -> + getQAInteger qaInt == LE.os2ip (B.reverse (BE.i2ospOf_ 40 (getQAInteger qaInt) :: Bytes)) + , testProperty "le-rev-be" $ \qaInt -> + getQAInteger qaInt == BE.os2ip (B.reverse (LE.i2osp (getQAInteger qaInt) :: Bytes)) + , testProperty "le-rev-be-40" $ \qaInt -> + getQAInteger qaInt == BE.os2ip (B.reverse (LE.i2ospOf_ 40 (getQAInteger qaInt) :: Bytes)) , testGroup "marshalling-kat-to-bytearray" $ map toSerializationKat $ zip [katZero..] serializationVectors , testGroup "marshalling-kat-to-integer" $ map toSerializationKatInteger $ zip [katZero..] serializationVectors ] where - toSerializationKat (i, (sz, n, ba)) = testCase (show i) (ba @=? i2ospOf_ sz n) - toSerializationKatInteger (i, (_, n, ba)) = testCase (show i) (n @=? os2ip ba) + toSerializationKat (i, (sz, n, ba)) = testCase (show i) (ba @=? BE.i2ospOf_ sz n) + toSerializationKatInteger (i, (_, n, ba)) = testCase (show i) (n @=? BE.os2ip ba) From 6893eae70aea6f7c6762c9bea8c4cc9a81a7b71f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 4 May 2019 15:06:07 +0200 Subject: [PATCH 075/176] Make os2ip loop argument strict --- Crypto/Number/Serialize/Internal.hs | 2 +- Crypto/Number/Serialize/Internal/LE.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Crypto/Number/Serialize/Internal.hs b/Crypto/Number/Serialize/Internal.hs index b691edf..bfa9622 100644 --- a/Crypto/Number/Serialize/Internal.hs +++ b/Crypto/Number/Serialize/Internal.hs @@ -69,7 +69,7 @@ os2ip ptr ptrSz | otherwise = gmpImportInteger ptrSz ptr `onGmpUnsupported` loop 0 0 ptr where loop :: Integer -> Int -> Ptr Word8 -> IO Integer - loop !acc i p + loop !acc i !p | i == ptrSz = return acc | otherwise = do w <- peekByteOff p i :: IO Word8 diff --git a/Crypto/Number/Serialize/Internal/LE.hs b/Crypto/Number/Serialize/Internal/LE.hs index 52c5658..473d1de 100644 --- a/Crypto/Number/Serialize/Internal/LE.hs +++ b/Crypto/Number/Serialize/Internal/LE.hs @@ -68,7 +68,7 @@ os2ip ptr ptrSz | otherwise = gmpImportIntegerLE ptrSz ptr `onGmpUnsupported` loop 0 (ptrSz-1) ptr where loop :: Integer -> Int -> Ptr Word8 -> IO Integer - loop !acc i p + loop !acc i !p | i < 0 = return acc | otherwise = do w <- peekByteOff p i :: IO Word8 From 7ecb259aaefc9179f4e59015b6d85497e699e01f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Tue, 7 May 2019 06:38:28 +0200 Subject: [PATCH 076/176] Fix LE.i2osp 0 Little-endian bytes are stored at the beginning of the buffer. --- Crypto/Number/Serialize/Internal/LE.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Crypto/Number/Serialize/Internal/LE.hs b/Crypto/Number/Serialize/Internal/LE.hs index 473d1de..d4c2594 100644 --- a/Crypto/Number/Serialize/Internal/LE.hs +++ b/Crypto/Number/Serialize/Internal/LE.hs @@ -31,7 +31,7 @@ i2osp :: Integer -> Ptr Word8 -> Int -> IO Int i2osp m ptr ptrSz | ptrSz <= 0 = return 0 | m < 0 = return 0 - | m == 0 = pokeByteOff ptr (sz-1) (0 :: Word8) >> return 1 + | m == 0 = pokeByteOff ptr 0 (0 :: Word8) >> return 1 | ptrSz < sz = return 0 | otherwise = fillPtr ptr sz m >> return sz where From af98a837d1f1e66fa5d1080e9956ae53bdd006b7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Wed, 8 May 2019 07:39:39 +0200 Subject: [PATCH 077/176] Add missing INLINABLE pragma --- Crypto/Number/Serialize/LE.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/Crypto/Number/Serialize/LE.hs b/Crypto/Number/Serialize/LE.hs index f396442..9f7fbae 100644 --- a/Crypto/Number/Serialize/LE.hs +++ b/Crypto/Number/Serialize/LE.hs @@ -35,6 +35,7 @@ i2osp m = B.allocAndFreeze sz (\p -> Internal.i2osp m p sz >> return ()) -- | Just like 'i2osp', but takes an extra parameter for size. -- If the number is too big to fit in @len@ bytes, 'Nothing' is returned -- otherwise the number is padded with 0 to fit the @len@ required. +{-# INLINABLE i2ospOf #-} i2ospOf :: B.ByteArray ba => Int -> Integer -> Maybe ba i2ospOf len m | len <= 0 = Nothing From 5b4845dd0ee58111aff4b53180ad89be06716f3a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Thu, 16 May 2019 06:55:01 +0200 Subject: [PATCH 078/176] Use GHC 8.6.5 for CI and bump versions --- .haskell-ci | 2 +- .travis.yml | 4 ++-- cryptonite.cabal | 2 +- stack.yaml | 4 ++-- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/.haskell-ci b/.haskell-ci index a7571c5..17cb6a3 100644 --- a/.haskell-ci +++ b/.haskell-ci @@ -2,7 +2,7 @@ compiler: ghc-8.0 lts-9.21 compiler: ghc-8.2 lts-11.22 compiler: ghc-8.4 lts-12.26 -compiler: ghc-8.6 lts-13.3 +compiler: ghc-8.6 lts-13.21 # options # option: alias x=y z=v diff --git a/.travis.yml b/.travis.yml index f32a94c..4aa5de8 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,4 +1,4 @@ -# ~*~ auto-generated by haskell-ci with config : 68149dea5ea6ea0dcbeebc12e2f77fd3f4f0166e8666f9dccd49bae65e2df32c ~*~ +# ~*~ auto-generated by haskell-ci with config : cb76551db808ad3472d36865246ef3849351a6c78535dd987bd37bc95bfd47c0 ~*~ # Use new container infrastructure to enable caching sudo: false @@ -65,7 +65,7 @@ script: stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; ghc-8.6) - echo "{ resolver: lts-13.3, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml + echo "{ resolver: lts-13.21, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; esac diff --git a/cryptonite.cabal b/cryptonite.cabal index 650094b..7a97a0c 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -36,7 +36,7 @@ Build-Type: Simple Homepage: https://github.com/haskell-crypto/cryptonite Bug-reports: https://github.com/haskell-crypto/cryptonite/issues Cabal-Version: >=1.18 -tested-with: GHC==8.6.1, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 +tested-with: GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 extra-doc-files: README.md CHANGELOG.md extra-source-files: cbits/*.h cbits/aes/*.h diff --git a/stack.yaml b/stack.yaml index 9b882d2..85bc4e8 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1,3 @@ -# ~*~ auto-generated by haskell-ci with config : 68149dea5ea6ea0dcbeebc12e2f77fd3f4f0166e8666f9dccd49bae65e2df32c ~*~ -{ resolver: lts-13.3, packages: [ '.' ], extra-deps: [], flags: {} } +# ~*~ auto-generated by haskell-ci with config : cb76551db808ad3472d36865246ef3849351a6c78535dd987bd37bc95bfd47c0 ~*~ +{ resolver: lts-13.21, packages: [ '.' ], extra-deps: [], flags: {} } From 76ba39fc954c873ddbd34207c1b54cb604d995cb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 19 May 2019 09:07:38 +0200 Subject: [PATCH 079/176] Add benchmark with AES GCM and CCM --- Crypto/Cipher/Types/Base.hs | 3 ++- benchs/Bench.hs | 19 ++++++++++++++++--- 2 files changed, 18 insertions(+), 4 deletions(-) diff --git a/Crypto/Cipher/Types/Base.hs b/Crypto/Cipher/Types/Base.hs index 03a20f8..37d9028 100644 --- a/Crypto/Cipher/Types/Base.hs +++ b/Crypto/Cipher/Types/Base.hs @@ -22,6 +22,7 @@ module Crypto.Cipher.Types.Base import Data.Word import Crypto.Internal.ByteArray (Bytes, ByteArrayAccess, ByteArray) import qualified Crypto.Internal.ByteArray as B +import Crypto.Internal.DeepSeq import Crypto.Error -- | Different specifier for key size in bytes @@ -36,7 +37,7 @@ type DataUnitOffset = Word32 -- | Authentication Tag for AE cipher mode newtype AuthTag = AuthTag { unAuthTag :: Bytes } - deriving (Show, ByteArrayAccess) + deriving (Show, ByteArrayAccess, NFData) instance Eq AuthTag where (AuthTag a) == (AuthTag b) = B.constEq a b diff --git a/benchs/Bench.hs b/benchs/Bench.hs index 180bafa..92e7e62 100644 --- a/benchs/Bench.hs +++ b/benchs/Bench.hs @@ -162,14 +162,27 @@ benchBlockCipher = iv16 = maybe (error "iv size 16") id $ makeIV key16 benchAE = - [ bench "ChaChaPoly1305" $ nf (run key32) (input64, input1024) + [ bench "ChaChaPoly1305" $ nf (cp key32) (input64, input1024) + , bench "AES-GCM" $ nf (gcm key32) (input64, input1024) + , bench "AES-CCM" $ nf (ccm key32) (input64, input1024) ] - where run k (ini, plain) = + where cp k (ini, plain) = let iniState = throwCryptoError $ CP.initialize k (throwCryptoError $ CP.nonce12 nonce12) afterAAD = CP.finalizeAAD (CP.appendAAD ini iniState) (out, afterEncrypt) = CP.encrypt plain afterAAD outtag = CP.finalize afterEncrypt - in (out, outtag) + in (outtag, out) + + gcm k (ini, plain) = + let ctx = throwCryptoError (cipherInit k) :: AES256 + state = throwCryptoError $ aeadInit AEAD_GCM ctx nonce12 + in aeadSimpleEncrypt state ini plain 16 + + ccm k (ini, plain) = + let ctx = throwCryptoError (cipherInit k) :: AES256 + mode = AEAD_CCM 1024 CCM_M16 CCM_L3 + state = throwCryptoError $ aeadInit mode ctx nonce12 + in aeadSimpleEncrypt state ini plain 16 input64 = B.replicate 64 0 input1024 = B.replicate 1024 0 From cddbc2cef93ca8cd4adf9366f59d1267ff36c8e7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 19 May 2019 09:08:06 +0200 Subject: [PATCH 080/176] Remove unopt_gf_mul --- cbits/aes/x86ni.c | 25 ++----------------------- 1 file changed, 2 insertions(+), 23 deletions(-) diff --git a/cbits/aes/x86ni.c b/cbits/aes/x86ni.c index a639fab..2b8eeb6 100644 --- a/cbits/aes/x86ni.c +++ b/cbits/aes/x86ni.c @@ -35,6 +35,7 @@ #include #include #include +#include #include #include @@ -157,28 +158,6 @@ static __m128i gfmulx(__m128i v) return v; } -static void unopt_gf_mul(block128 *a, block128 *b) -{ - uint64_t a0, a1, v0, v1; - int i, j; - - a0 = a1 = 0; - v0 = cpu_to_be64(a->q[0]); - v1 = cpu_to_be64(a->q[1]); - - for (i = 0; i < 16; i++) - for (j = 0x80; j != 0; j >>= 1) { - uint8_t x = b->b[i] & j; - a0 ^= x ? v0 : 0; - a1 ^= x ? v1 : 0; - x = (uint8_t) v1 & 1; - v1 = (v1 >> 1) | (v0 << 63); - v0 = (v0 >> 1) ^ (x ? (0xe1ULL << 56) : 0); - } - a->q[0] = cpu_to_be64(a0); - a->q[1] = cpu_to_be64(a1); -} - static __m128i ghash_add(__m128i tag, __m128i h, __m128i m) { aes_block _t, _h; @@ -186,7 +165,7 @@ static __m128i ghash_add(__m128i tag, __m128i h, __m128i m) _mm_store_si128((__m128i *) &_t, tag); _mm_store_si128((__m128i *) &_h, h); - unopt_gf_mul(&_t, &_h); + cryptonite_gf_mul(&_t, &_h); tag = _mm_load_si128((__m128i *) &_t); return tag; } From d25e44ea6169ef362ab0269140cb5aa492aa197b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 19 May 2019 11:18:40 +0200 Subject: [PATCH 081/176] Add GHASH implementation with PCLMULQDQ --- cbits/aes/gf.c | 4 +- cbits/aes/gf.h | 4 +- cbits/aes/x86ni.c | 93 ++++++++++++++++++++++++++++++++++++++++-- cbits/aes/x86ni.h | 5 ++- cbits/cryptonite_aes.c | 23 +++++++++-- 5 files changed, 116 insertions(+), 13 deletions(-) diff --git a/cbits/aes/gf.c b/cbits/aes/gf.c index 7aeccf6..7dcc12c 100644 --- a/cbits/aes/gf.c +++ b/cbits/aes/gf.c @@ -39,7 +39,7 @@ * to speed up the multiplication. * TODO: optimise with tables */ -void cryptonite_gf_mul(block128 *a, block128 *b) +void cryptonite_aes_generic_gf_mul(block128 *a, block128 *b) { uint64_t a0, a1, v0, v1; int i, j; @@ -62,7 +62,7 @@ void cryptonite_gf_mul(block128 *a, block128 *b) } /* inplace GFMUL for xts mode */ -void cryptonite_gf_mulx(block128 *a) +void cryptonite_aes_generic_gf_mulx(block128 *a) { const uint64_t gf_mask = cpu_to_le64(0x8000000000000000ULL); uint64_t r = ((a->q[1] & gf_mask) ? cpu_to_le64(0x87) : 0); diff --git a/cbits/aes/gf.h b/cbits/aes/gf.h index 329d290..21b542c 100644 --- a/cbits/aes/gf.h +++ b/cbits/aes/gf.h @@ -32,7 +32,7 @@ #include "aes/block128.h" -void cryptonite_gf_mul(block128 *a, block128 *b); -void cryptonite_gf_mulx(block128 *a); +void cryptonite_aes_generic_gf_mul(block128 *a, block128 *b); +void cryptonite_aes_generic_gf_mulx(block128 *a); #endif diff --git a/cbits/aes/x86ni.c b/cbits/aes/x86ni.c index 2b8eeb6..556bde1 100644 --- a/cbits/aes/x86ni.c +++ b/cbits/aes/x86ni.c @@ -158,18 +158,103 @@ static __m128i gfmulx(__m128i v) return v; } -static __m128i ghash_add(__m128i tag, __m128i h, __m128i m) +static __m128i gfmul_generic(__m128i tag, __m128i h) { aes_block _t, _h; - tag = _mm_xor_si128(tag, m); - _mm_store_si128((__m128i *) &_t, tag); _mm_store_si128((__m128i *) &_h, h); - cryptonite_gf_mul(&_t, &_h); + cryptonite_aes_generic_gf_mul(&_t, &_h); tag = _mm_load_si128((__m128i *) &_t); return tag; } +#ifdef WITH_PCLMUL + +__m128i (*gfmul_branch_ptr)(__m128i a, __m128i b) = gfmul_generic; +#define gfmul(a,b) ((*gfmul_branch_ptr)(a,b)) + +/* See Intel carry-less-multiplication-instruction-in-gcm-mode-paper.pdf + * + * Adapted from figure 5, with additional byte swapping so that interface + * is simimar to cryptonite_aes_generic_gf_mul. + */ +static __m128i gfmul_pclmuldq(__m128i a, __m128i b) +{ + __m128i tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7, tmp8, tmp9; + __m128i bswap_mask = _mm_set_epi8(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15); + + a = _mm_shuffle_epi8(a, bswap_mask); + b = _mm_shuffle_epi8(b, bswap_mask); + + tmp3 = _mm_clmulepi64_si128(a, b, 0x00); + tmp4 = _mm_clmulepi64_si128(a, b, 0x10); + tmp5 = _mm_clmulepi64_si128(a, b, 0x01); + tmp6 = _mm_clmulepi64_si128(a, b, 0x11); + + tmp4 = _mm_xor_si128(tmp4, tmp5); + tmp5 = _mm_slli_si128(tmp4, 8); + tmp4 = _mm_srli_si128(tmp4, 8); + tmp3 = _mm_xor_si128(tmp3, tmp5); + tmp6 = _mm_xor_si128(tmp6, tmp4); + + tmp7 = _mm_srli_epi32(tmp3, 31); + tmp8 = _mm_srli_epi32(tmp6, 31); + tmp3 = _mm_slli_epi32(tmp3, 1); + tmp6 = _mm_slli_epi32(tmp6, 1); + + tmp9 = _mm_srli_si128(tmp7, 12); + tmp8 = _mm_slli_si128(tmp8, 4); + tmp7 = _mm_slli_si128(tmp7, 4); + tmp3 = _mm_or_si128(tmp3, tmp7); + tmp6 = _mm_or_si128(tmp6, tmp8); + tmp6 = _mm_or_si128(tmp6, tmp9); + + tmp7 = _mm_slli_epi32(tmp3, 31); + tmp8 = _mm_slli_epi32(tmp3, 30); + tmp9 = _mm_slli_epi32(tmp3, 25); + + tmp7 = _mm_xor_si128(tmp7, tmp8); + tmp7 = _mm_xor_si128(tmp7, tmp9); + tmp8 = _mm_srli_si128(tmp7, 4); + tmp7 = _mm_slli_si128(tmp7, 12); + tmp3 = _mm_xor_si128(tmp3, tmp7); + + tmp2 = _mm_srli_epi32(tmp3, 1); + tmp4 = _mm_srli_epi32(tmp3, 2); + tmp5 = _mm_srli_epi32(tmp3, 7); + tmp2 = _mm_xor_si128(tmp2, tmp4); + tmp2 = _mm_xor_si128(tmp2, tmp5); + tmp2 = _mm_xor_si128(tmp2, tmp8); + tmp3 = _mm_xor_si128(tmp3, tmp2); + tmp6 = _mm_xor_si128(tmp6, tmp3); + + return _mm_shuffle_epi8(tmp6, bswap_mask); +} + +void cryptonite_aesni_gf_mul(block128 *a, block128 *b) +{ + __m128i _a, _b, _c; + _a = _mm_loadu_si128((__m128i *) a); + _b = _mm_loadu_si128((__m128i *) b); + _c = gfmul_pclmuldq(_a, _b); + _mm_storeu_si128((__m128i *) a, _c); +} + +void cryptonite_aesni_init_pclmul() +{ + gfmul_branch_ptr = gfmul_pclmuldq; +} + +#else +#define gfmul(a,b) (gfmul_generic(a,b)) +#endif + +static inline __m128i ghash_add(__m128i tag, __m128i h, __m128i m) +{ + tag = _mm_xor_si128(tag, m); + return gfmul(tag, h); +} + #define PRELOAD_ENC_KEYS128(k) \ __m128i K0 = _mm_loadu_si128(((__m128i *) k)+0); \ __m128i K1 = _mm_loadu_si128(((__m128i *) k)+1); \ diff --git a/cbits/aes/x86ni.h b/cbits/aes/x86ni.h index f71ee0f..b9a568a 100644 --- a/cbits/aes/x86ni.h +++ b/cbits/aes/x86ni.h @@ -72,7 +72,10 @@ void cryptonite_aesni_encrypt_xts256(aes_block *out, aes_key *key1, aes_key *key void cryptonite_aesni_gcm_encrypt128(uint8_t *out, aes_gcm *gcm, aes_key *key, uint8_t *in, uint32_t length); void cryptonite_aesni_gcm_encrypt256(uint8_t *out, aes_gcm *gcm, aes_key *key, uint8_t *in, uint32_t length); -void gf_mul_x86ni(block128 *res, block128 *a_, block128 *b_); +#ifdef WITH_PCLMUL +void cryptonite_aesni_init_pclmul(); +void cryptonite_aesni_gf_mul(block128 *a, block128 *b); +#endif #endif diff --git a/cbits/cryptonite_aes.c b/cbits/cryptonite_aes.c index 0b017fc..b5ce004 100644 --- a/cbits/cryptonite_aes.c +++ b/cbits/cryptonite_aes.c @@ -81,6 +81,8 @@ enum { /* ccm */ ENCRYPT_CCM_128, ENCRYPT_CCM_192, ENCRYPT_CCM_256, DECRYPT_CCM_128, DECRYPT_CCM_192, DECRYPT_CCM_256, + /* ghash */ + GHASH_GF_MUL, }; void *cryptonite_aes_branch_table[] = { @@ -141,6 +143,8 @@ void *cryptonite_aes_branch_table[] = { [DECRYPT_CCM_128] = cryptonite_aes_generic_ccm_decrypt, [DECRYPT_CCM_192] = cryptonite_aes_generic_ccm_decrypt, [DECRYPT_CCM_256] = cryptonite_aes_generic_ccm_decrypt, + /* GHASH */ + [GHASH_GF_MUL] = cryptonite_aes_generic_gf_mul, }; typedef void (*init_f)(aes_key *, uint8_t *, uint8_t); @@ -152,6 +156,7 @@ typedef void (*gcm_crypt_f)(uint8_t *output, aes_gcm *gcm, aes_key *key, uint8_t typedef void (*ocb_crypt_f)(uint8_t *output, aes_ocb *ocb, aes_key *key, uint8_t *input, uint32_t length); typedef void (*ccm_crypt_f)(uint8_t *output, aes_ccm *ccm, aes_key *key, uint8_t *input, uint32_t length); typedef void (*block_f)(aes_block *output, aes_key *key, aes_block *input); +typedef void (*gf_mul_f)(aes_block *a, aes_block *b); #ifdef WITH_AESNI #define GET_INIT(strength) \ @@ -186,6 +191,8 @@ typedef void (*block_f)(aes_block *output, aes_key *key, aes_block *input); (((block_f) (cryptonite_aes_branch_table[ENCRYPT_BLOCK_128 + k->strength]))(o,k,i)) #define cryptonite_aes_decrypt_block(o,k,i) \ (((block_f) (cryptonite_aes_branch_table[DECRYPT_BLOCK_128 + k->strength]))(o,k,i)) +#define cryptonite_gf_mul(a,b) \ + (((gf_mul_f) (cryptonite_aes_branch_table[GHASH_GF_MUL]))(a,b)) #else #define GET_INIT(strenght) cryptonite_aes_generic_init #define GET_ECB_ENCRYPT(strength) cryptonite_aes_generic_encrypt_ecb @@ -203,6 +210,7 @@ typedef void (*block_f)(aes_block *output, aes_key *key, aes_block *input); #define GET_CCM_DECRYPT(strength) cryptonite_aes_generic_ccm_decrypt #define cryptonite_aes_encrypt_block(o,k,i) cryptonite_aes_generic_encrypt_block(o,k,i) #define cryptonite_aes_decrypt_block(o,k,i) cryptonite_aes_generic_decrypt_block(o,k,i) +#define cryptonite_gf_mul(a,b) cryptonite_aes_generic_gf_mul(a,b) #endif #if defined(ARCH_X86) && defined(WITH_AESNI) @@ -241,6 +249,13 @@ static void initialize_table_ni(int aesni, int pclmul) cryptonite_aes_branch_table[ENCRYPT_OCB_128] = cryptonite_aesni_ocb_encrypt128; cryptonite_aes_branch_table[ENCRYPT_OCB_256] = cryptonite_aesni_ocb_encrypt256; */ +#ifdef WITH_PCLMUL + if (!pclmul) + return; + /* GHASH */ + cryptonite_aes_branch_table[GHASH_GF_MUL] = cryptonite_aesni_gf_mul; + cryptonite_aesni_init_pclmul(); +#endif } #endif @@ -761,9 +776,9 @@ void cryptonite_aes_generic_encrypt_xts(aes_block *output, aes_key *k1, aes_key /* TO OPTIMISE: this is really inefficient way to do that */ while (spoint-- > 0) - cryptonite_gf_mulx(&tweak); + cryptonite_aes_generic_gf_mulx(&tweak); - for ( ; nb_blocks-- > 0; input++, output++, cryptonite_gf_mulx(&tweak)) { + for ( ; nb_blocks-- > 0; input++, output++, cryptonite_aes_generic_gf_mulx(&tweak)) { block128_vxor(&block, input, &tweak); cryptonite_aes_encrypt_block(&block, k1, &block); block128_vxor(output, &block, &tweak); @@ -781,9 +796,9 @@ void cryptonite_aes_generic_decrypt_xts(aes_block *output, aes_key *k1, aes_key /* TO OPTIMISE: this is really inefficient way to do that */ while (spoint-- > 0) - cryptonite_gf_mulx(&tweak); + cryptonite_aes_generic_gf_mulx(&tweak); - for ( ; nb_blocks-- > 0; input++, output++, cryptonite_gf_mulx(&tweak)) { + for ( ; nb_blocks-- > 0; input++, output++, cryptonite_aes_generic_gf_mulx(&tweak)) { block128_vxor(&block, input, &tweak); cryptonite_aes_decrypt_block(&block, k1, &block); block128_vxor(output, &block, &tweak); From 7596e2959d58cbd1bf70ce3af57c0a5db4967add Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Tue, 21 May 2019 08:49:16 +0100 Subject: [PATCH 082/176] release 0.26 --- CHANGELOG.md | 2 ++ cryptonite.cabal | 6 +++--- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index fd21840..cd23f2a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,6 +17,8 @@ * Correction to PKCS#1 v1.5 padding * Use powModSecInteger when available * Drop GHC 7.8 and GHC 7.10 support, refer to pkg-guidelines +* Optimise GCM mode +* Add little endian serialization of integer ## 0.25 diff --git a/cryptonite.cabal b/cryptonite.cabal index 7a97a0c..00baa72 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -1,5 +1,5 @@ Name: cryptonite -version: 0.25 +version: 0.26 Synopsis: Cryptography Primitives sink Description: A repository of cryptographic primitives. @@ -35,7 +35,7 @@ Stability: experimental Build-Type: Simple Homepage: https://github.com/haskell-crypto/cryptonite Bug-reports: https://github.com/haskell-crypto/cryptonite/issues -Cabal-Version: >=1.18 +Cabal-Version: 1.18 tested-with: GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 extra-doc-files: README.md CHANGELOG.md extra-source-files: cbits/*.h @@ -432,7 +432,7 @@ Test-Suite test-cryptonite Salsa Utils XSalsa - Build-Depends: base + Build-Depends: base >= 0 && < 10 , bytestring , memory , tasty From c8a4e48e0c077e47ccd85d0acd5a27d02a320203 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 26 May 2019 11:47:23 +0200 Subject: [PATCH 083/176] Remove unused variables --- cbits/aes/x86ni.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cbits/aes/x86ni.c b/cbits/aes/x86ni.c index 556bde1..bc3af2d 100644 --- a/cbits/aes/x86ni.c +++ b/cbits/aes/x86ni.c @@ -180,7 +180,7 @@ __m128i (*gfmul_branch_ptr)(__m128i a, __m128i b) = gfmul_generic; */ static __m128i gfmul_pclmuldq(__m128i a, __m128i b) { - __m128i tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7, tmp8, tmp9; + __m128i tmp2, tmp3, tmp4, tmp5, tmp6, tmp7, tmp8, tmp9; __m128i bswap_mask = _mm_set_epi8(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15); a = _mm_shuffle_epi8(a, bswap_mask); From 5b39ae3e4830f188d23eeecc552874dcf2e1616f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 26 May 2019 11:48:02 +0200 Subject: [PATCH 084/176] Add missing void and const --- cbits/aes/gf.c | 2 +- cbits/aes/gf.h | 2 +- cbits/aes/x86ni.c | 4 ++-- cbits/aes/x86ni.h | 4 ++-- cbits/cryptonite_aes.c | 2 +- 5 files changed, 7 insertions(+), 7 deletions(-) diff --git a/cbits/aes/gf.c b/cbits/aes/gf.c index 7dcc12c..3d872ae 100644 --- a/cbits/aes/gf.c +++ b/cbits/aes/gf.c @@ -39,7 +39,7 @@ * to speed up the multiplication. * TODO: optimise with tables */ -void cryptonite_aes_generic_gf_mul(block128 *a, block128 *b) +void cryptonite_aes_generic_gf_mul(block128 *a, const block128 *b) { uint64_t a0, a1, v0, v1; int i, j; diff --git a/cbits/aes/gf.h b/cbits/aes/gf.h index 21b542c..4a65edb 100644 --- a/cbits/aes/gf.h +++ b/cbits/aes/gf.h @@ -32,7 +32,7 @@ #include "aes/block128.h" -void cryptonite_aes_generic_gf_mul(block128 *a, block128 *b); +void cryptonite_aes_generic_gf_mul(block128 *a, const block128 *b); void cryptonite_aes_generic_gf_mulx(block128 *a); #endif diff --git a/cbits/aes/x86ni.c b/cbits/aes/x86ni.c index bc3af2d..7049fd1 100644 --- a/cbits/aes/x86ni.c +++ b/cbits/aes/x86ni.c @@ -231,7 +231,7 @@ static __m128i gfmul_pclmuldq(__m128i a, __m128i b) return _mm_shuffle_epi8(tmp6, bswap_mask); } -void cryptonite_aesni_gf_mul(block128 *a, block128 *b) +void cryptonite_aesni_gf_mul(block128 *a, const block128 *b) { __m128i _a, _b, _c; _a = _mm_loadu_si128((__m128i *) a); @@ -240,7 +240,7 @@ void cryptonite_aesni_gf_mul(block128 *a, block128 *b) _mm_storeu_si128((__m128i *) a, _c); } -void cryptonite_aesni_init_pclmul() +void cryptonite_aesni_init_pclmul(void) { gfmul_branch_ptr = gfmul_pclmuldq; } diff --git a/cbits/aes/x86ni.h b/cbits/aes/x86ni.h index b9a568a..9e2898e 100644 --- a/cbits/aes/x86ni.h +++ b/cbits/aes/x86ni.h @@ -73,8 +73,8 @@ void cryptonite_aesni_gcm_encrypt128(uint8_t *out, aes_gcm *gcm, aes_key *key, u void cryptonite_aesni_gcm_encrypt256(uint8_t *out, aes_gcm *gcm, aes_key *key, uint8_t *in, uint32_t length); #ifdef WITH_PCLMUL -void cryptonite_aesni_init_pclmul(); -void cryptonite_aesni_gf_mul(block128 *a, block128 *b); +void cryptonite_aesni_init_pclmul(void); +void cryptonite_aesni_gf_mul(block128 *a, const block128 *b); #endif #endif diff --git a/cbits/cryptonite_aes.c b/cbits/cryptonite_aes.c index b5ce004..f04fbc7 100644 --- a/cbits/cryptonite_aes.c +++ b/cbits/cryptonite_aes.c @@ -156,7 +156,7 @@ typedef void (*gcm_crypt_f)(uint8_t *output, aes_gcm *gcm, aes_key *key, uint8_t typedef void (*ocb_crypt_f)(uint8_t *output, aes_ocb *ocb, aes_key *key, uint8_t *input, uint32_t length); typedef void (*ccm_crypt_f)(uint8_t *output, aes_ccm *ccm, aes_key *key, uint8_t *input, uint32_t length); typedef void (*block_f)(aes_block *output, aes_key *key, aes_block *input); -typedef void (*gf_mul_f)(aes_block *a, aes_block *b); +typedef void (*gf_mul_f)(aes_block *a, const aes_block *b); #ifdef WITH_AESNI #define GET_INIT(strength) \ From 4df2a95276707f8313406313afd9211615e50445 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 2 Jun 2019 17:08:55 +0200 Subject: [PATCH 085/176] AES GCM: use Shoup's method with 4-bit table --- Crypto/Cipher/AES/Primitive.hs | 2 +- cbits/aes/gf.c | 128 ++++++++++++++++++++++++++------- cbits/aes/gf.h | 6 +- cbits/aes/x86ni.c | 42 ++++++----- cbits/aes/x86ni.h | 3 +- cbits/aes/x86ni_impl.c | 5 +- cbits/cryptonite_aes.c | 32 +++++---- cbits/cryptonite_aes.h | 4 +- 8 files changed, 158 insertions(+), 64 deletions(-) diff --git a/Crypto/Cipher/AES/Primitive.hs b/Crypto/Cipher/AES/Primitive.hs index 8241013..d8a8490 100644 --- a/Crypto/Cipher/AES/Primitive.hs +++ b/Crypto/Cipher/AES/Primitive.hs @@ -128,7 +128,7 @@ newtype AESCCM = AESCCM ScrubbedBytes deriving (NFData) sizeGCM :: Int -sizeGCM = 80 +sizeGCM = 320 sizeOCB :: Int sizeOCB = 160 diff --git a/cbits/aes/gf.c b/cbits/aes/gf.c index 3d872ae..b750e3c 100644 --- a/cbits/aes/gf.c +++ b/cbits/aes/gf.c @@ -34,33 +34,6 @@ #include #include -/* this is a really inefficient way to GF multiply. - * the alternative without hw accel is building small tables - * to speed up the multiplication. - * TODO: optimise with tables - */ -void cryptonite_aes_generic_gf_mul(block128 *a, const block128 *b) -{ - uint64_t a0, a1, v0, v1; - int i, j; - - a0 = a1 = 0; - v0 = cpu_to_be64(a->q[0]); - v1 = cpu_to_be64(a->q[1]); - - for (i = 0; i < 16; i++) - for (j = 0x80; j != 0; j >>= 1) { - uint8_t x = b->b[i] & j; - a0 ^= x ? v0 : 0; - a1 ^= x ? v1 : 0; - x = (uint8_t) v1 & 1; - v1 = (v1 >> 1) | (v0 << 63); - v0 = (v0 >> 1) ^ (x ? (0xe1ULL << 56) : 0); - } - a->q[0] = cpu_to_be64(a0); - a->q[1] = cpu_to_be64(a1); -} - /* inplace GFMUL for xts mode */ void cryptonite_aes_generic_gf_mulx(block128 *a) { @@ -70,3 +43,104 @@ void cryptonite_aes_generic_gf_mulx(block128 *a) a->q[0] = cpu_to_le64(le64_to_cpu(a->q[0]) << 1) ^ r; } + +/* + * GF multiplication with Shoup's method and 4-bit table. + * + * We precompute the products of H with all 4-bit polynomials and store them in + * a 'table_4bit' array. To avoid unnecessary byte swapping, the 16 blocks are + * written to the table with qwords already converted to CPU order. Table + * indices use the reflected bit ordering, i.e. polynomials X^0, X^1, X^2, X^3 + * map to bit positions 3, 2, 1, 0 respectively. + * + * To multiply an arbitrary block with H, the input block is decomposed in 4-bit + * segments. We get the final result after 32 table lookups and additions, one + * for each segment, interleaving multiplication by P(X)=X^4. + */ + +/* convert block128 qwords between BE and CPU order */ +static inline void block128_cpu_swap_be(block128 *a, const block128 *b) +{ + a->q[1] = cpu_to_be64(b->q[1]); + a->q[0] = cpu_to_be64(b->q[0]); +} + +/* multiplication by P(X)=X, assuming qwords already in CPU order */ +static inline void cpu_gf_mulx(block128 *a, const block128 *b) +{ + uint64_t v0 = b->q[0]; + uint64_t v1 = b->q[1]; + a->q[1] = v1 >> 1 | v0 << 63; + a->q[0] = v0 >> 1 ^ ((0-(v1 & 1)) & 0xe100000000000000ULL); +} + +const static uint64_t r4_0[] = + { 0x0000000000000000ULL, 0x1c20000000000000ULL + , 0x3840000000000000ULL, 0x2460000000000000ULL + , 0x7080000000000000ULL, 0x6ca0000000000000ULL + , 0x48c0000000000000ULL, 0x54e0000000000000ULL + , 0xe100000000000000ULL, 0xfd20000000000000ULL + , 0xd940000000000000ULL, 0xc560000000000000ULL + , 0x9180000000000000ULL, 0x8da0000000000000ULL + , 0xa9c0000000000000ULL, 0xb5e0000000000000ULL + }; + +/* multiplication by P(X)=X^4, assuming qwords already in CPU order */ +static inline void cpu_gf_mulx4(block128 *a, const block128 *b) +{ + uint64_t v0 = b->q[0]; + uint64_t v1 = b->q[1]; + a->q[1] = v1 >> 4 | v0 << 60; + a->q[0] = v0 >> 4 ^ r4_0[v1 & 0xf]; +} + +/* initialize the 4-bit table given H */ +void cryptonite_aes_generic_hinit(table_4bit htable, const block128 *h) +{ + block128 v, *p; + int i, j; + + /* multiplication by 0 is 0 */ + block128_zero(&htable[0]); + + /* at index 8=2^3 we have H.X^0 = H */ + i = 8; + block128_cpu_swap_be(&htable[i], h); /* in CPU order */ + p = &htable[i]; + + /* for other powers of 2, repeat multiplication by P(X)=X */ + for (i = 4; i > 0; i >>= 1) + { + cpu_gf_mulx(&htable[i], p); + p = &htable[i]; + } + + /* remaining elements are linear combinations */ + for (i = 2; i < 16; i <<= 1) { + p = &htable[i]; + v = *p; + for (j = 1; j < i; j++) { + p[j] = v; + block128_xor_aligned(&p[j], &htable[j]); + } + } +} + +/* multiply a block with H */ +void cryptonite_aes_generic_gf_mul(block128 *a, const table_4bit htable) +{ + block128 b; + int i; + block128_zero(&b); + for (i = 15; i >= 0; i--) + { + uint8_t v = a->b[i]; + block128_xor_aligned(&b, &htable[v & 0xf]); /* high bits (reflected) */ + cpu_gf_mulx4(&b, &b); + block128_xor_aligned(&b, &htable[v >> 4]); /* low bits (reflected) */ + if (i > 0) + cpu_gf_mulx4(&b, &b); + else + block128_cpu_swap_be(a, &b); /* restore BE order when done */ + } +} diff --git a/cbits/aes/gf.h b/cbits/aes/gf.h index 4a65edb..59f73bc 100644 --- a/cbits/aes/gf.h +++ b/cbits/aes/gf.h @@ -32,7 +32,11 @@ #include "aes/block128.h" -void cryptonite_aes_generic_gf_mul(block128 *a, const block128 *b); +typedef block128 table_4bit[16]; + void cryptonite_aes_generic_gf_mulx(block128 *a); +void cryptonite_aes_generic_hinit(table_4bit htable, const block128 *h); +void cryptonite_aes_generic_gf_mul(block128 *a, const table_4bit htable); + #endif diff --git a/cbits/aes/x86ni.c b/cbits/aes/x86ni.c index 7049fd1..590a897 100644 --- a/cbits/aes/x86ni.c +++ b/cbits/aes/x86ni.c @@ -158,33 +158,32 @@ static __m128i gfmulx(__m128i v) return v; } -static __m128i gfmul_generic(__m128i tag, __m128i h) +static __m128i gfmul_generic(__m128i tag, const table_4bit htable) { - aes_block _t, _h; + aes_block _t; _mm_store_si128((__m128i *) &_t, tag); - _mm_store_si128((__m128i *) &_h, h); - cryptonite_aes_generic_gf_mul(&_t, &_h); + cryptonite_aes_generic_gf_mul(&_t, htable); tag = _mm_load_si128((__m128i *) &_t); return tag; } #ifdef WITH_PCLMUL -__m128i (*gfmul_branch_ptr)(__m128i a, __m128i b) = gfmul_generic; -#define gfmul(a,b) ((*gfmul_branch_ptr)(a,b)) +__m128i (*gfmul_branch_ptr)(__m128i a, const table_4bit t) = gfmul_generic; +#define gfmul(a,t) ((*gfmul_branch_ptr)(a,t)) /* See Intel carry-less-multiplication-instruction-in-gcm-mode-paper.pdf * * Adapted from figure 5, with additional byte swapping so that interface * is simimar to cryptonite_aes_generic_gf_mul. */ -static __m128i gfmul_pclmuldq(__m128i a, __m128i b) +static __m128i gfmul_pclmuldq(__m128i a, const table_4bit htable) { - __m128i tmp2, tmp3, tmp4, tmp5, tmp6, tmp7, tmp8, tmp9; + __m128i b, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7, tmp8, tmp9; __m128i bswap_mask = _mm_set_epi8(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15); a = _mm_shuffle_epi8(a, bswap_mask); - b = _mm_shuffle_epi8(b, bswap_mask); + b = _mm_loadu_si128((__m128i *) htable); tmp3 = _mm_clmulepi64_si128(a, b, 0x00); tmp4 = _mm_clmulepi64_si128(a, b, 0x10); @@ -231,13 +230,22 @@ static __m128i gfmul_pclmuldq(__m128i a, __m128i b) return _mm_shuffle_epi8(tmp6, bswap_mask); } -void cryptonite_aesni_gf_mul(block128 *a, const block128 *b) +void cryptonite_aesni_hinit_pclmul(table_4bit htable, const block128 *h) { - __m128i _a, _b, _c; + /* When pclmul is active we don't need to fill the table. Instead we just + * store H at index 0. It is written in reverse order, so function + * gfmul_pclmuldq will not byte-swap this value. + */ + htable->q[0] = bitfn_swap64(h->q[1]); + htable->q[1] = bitfn_swap64(h->q[0]); +} + +void cryptonite_aesni_gf_mul_pclmul(block128 *a, const table_4bit htable) +{ + __m128i _a, _b; _a = _mm_loadu_si128((__m128i *) a); - _b = _mm_loadu_si128((__m128i *) b); - _c = gfmul_pclmuldq(_a, _b); - _mm_storeu_si128((__m128i *) a, _c); + _b = gfmul_pclmuldq(_a, htable); + _mm_storeu_si128((__m128i *) a, _b); } void cryptonite_aesni_init_pclmul(void) @@ -246,13 +254,13 @@ void cryptonite_aesni_init_pclmul(void) } #else -#define gfmul(a,b) (gfmul_generic(a,b)) +#define gfmul(a,t) (gfmul_generic(a,t)) #endif -static inline __m128i ghash_add(__m128i tag, __m128i h, __m128i m) +static inline __m128i ghash_add(__m128i tag, const table_4bit htable, __m128i m) { tag = _mm_xor_si128(tag, m); - return gfmul(tag, h); + return gfmul(tag, htable); } #define PRELOAD_ENC_KEYS128(k) \ diff --git a/cbits/aes/x86ni.h b/cbits/aes/x86ni.h index 9e2898e..2ef2615 100644 --- a/cbits/aes/x86ni.h +++ b/cbits/aes/x86ni.h @@ -74,7 +74,8 @@ void cryptonite_aesni_gcm_encrypt256(uint8_t *out, aes_gcm *gcm, aes_key *key, u #ifdef WITH_PCLMUL void cryptonite_aesni_init_pclmul(void); -void cryptonite_aesni_gf_mul(block128 *a, const block128 *b); +void cryptonite_aesni_hinit_pclmul(table_4bit htable, const block128 *h); +void cryptonite_aesni_gf_mul_pclmul(block128 *a, const table_4bit htable); #endif #endif diff --git a/cbits/aes/x86ni_impl.c b/cbits/aes/x86ni_impl.c index d019a2a..3eedaff 100644 --- a/cbits/aes/x86ni_impl.c +++ b/cbits/aes/x86ni_impl.c @@ -191,7 +191,6 @@ void SIZED(cryptonite_aesni_gcm_encrypt)(uint8_t *output, aes_gcm *gcm, aes_key gcm->length_input += length; - __m128i h = _mm_loadu_si128((__m128i *) &gcm->h); __m128i tag = _mm_loadu_si128((__m128i *) &gcm->tag); __m128i iv = _mm_loadu_si128((__m128i *) &gcm->civ); iv = _mm_shuffle_epi8(iv, bswap_mask); @@ -209,7 +208,7 @@ void SIZED(cryptonite_aesni_gcm_encrypt)(uint8_t *output, aes_gcm *gcm, aes_key __m128i m = _mm_loadu_si128((__m128i *) input); m = _mm_xor_si128(m, tmp); - tag = ghash_add(tag, h, m); + tag = ghash_add(tag, gcm->htable, m); /* store it out */ _mm_storeu_si128((__m128i *) output, m); @@ -250,7 +249,7 @@ void SIZED(cryptonite_aesni_gcm_encrypt)(uint8_t *output, aes_gcm *gcm, aes_key m = _mm_xor_si128(m, tmp); m = _mm_shuffle_epi8(m, mask); - tag = ghash_add(tag, h, m); + tag = ghash_add(tag, gcm->htable, m); /* make output */ _mm_storeu_si128((__m128i *) &block.b, m); diff --git a/cbits/cryptonite_aes.c b/cbits/cryptonite_aes.c index f04fbc7..b078d57 100644 --- a/cbits/cryptonite_aes.c +++ b/cbits/cryptonite_aes.c @@ -82,7 +82,7 @@ enum { ENCRYPT_CCM_128, ENCRYPT_CCM_192, ENCRYPT_CCM_256, DECRYPT_CCM_128, DECRYPT_CCM_192, DECRYPT_CCM_256, /* ghash */ - GHASH_GF_MUL, + GHASH_HINIT, GHASH_GF_MUL, }; void *cryptonite_aes_branch_table[] = { @@ -144,6 +144,7 @@ void *cryptonite_aes_branch_table[] = { [DECRYPT_CCM_192] = cryptonite_aes_generic_ccm_decrypt, [DECRYPT_CCM_256] = cryptonite_aes_generic_ccm_decrypt, /* GHASH */ + [GHASH_HINIT] = cryptonite_aes_generic_hinit, [GHASH_GF_MUL] = cryptonite_aes_generic_gf_mul, }; @@ -156,7 +157,8 @@ typedef void (*gcm_crypt_f)(uint8_t *output, aes_gcm *gcm, aes_key *key, uint8_t typedef void (*ocb_crypt_f)(uint8_t *output, aes_ocb *ocb, aes_key *key, uint8_t *input, uint32_t length); typedef void (*ccm_crypt_f)(uint8_t *output, aes_ccm *ccm, aes_key *key, uint8_t *input, uint32_t length); typedef void (*block_f)(aes_block *output, aes_key *key, aes_block *input); -typedef void (*gf_mul_f)(aes_block *a, const aes_block *b); +typedef void (*hinit_f)(table_4bit htable, const block128 *h); +typedef void (*gf_mul_f)(block128 *a, const table_4bit htable); #ifdef WITH_AESNI #define GET_INIT(strength) \ @@ -191,8 +193,10 @@ typedef void (*gf_mul_f)(aes_block *a, const aes_block *b); (((block_f) (cryptonite_aes_branch_table[ENCRYPT_BLOCK_128 + k->strength]))(o,k,i)) #define cryptonite_aes_decrypt_block(o,k,i) \ (((block_f) (cryptonite_aes_branch_table[DECRYPT_BLOCK_128 + k->strength]))(o,k,i)) -#define cryptonite_gf_mul(a,b) \ - (((gf_mul_f) (cryptonite_aes_branch_table[GHASH_GF_MUL]))(a,b)) +#define cryptonite_hinit(t,h) \ + (((hinit_f) (cryptonite_aes_branch_table[GHASH_HINIT]))(t,h)) +#define cryptonite_gf_mul(a,t) \ + (((gf_mul_f) (cryptonite_aes_branch_table[GHASH_GF_MUL]))(a,t)) #else #define GET_INIT(strenght) cryptonite_aes_generic_init #define GET_ECB_ENCRYPT(strength) cryptonite_aes_generic_encrypt_ecb @@ -210,7 +214,8 @@ typedef void (*gf_mul_f)(aes_block *a, const aes_block *b); #define GET_CCM_DECRYPT(strength) cryptonite_aes_generic_ccm_decrypt #define cryptonite_aes_encrypt_block(o,k,i) cryptonite_aes_generic_encrypt_block(o,k,i) #define cryptonite_aes_decrypt_block(o,k,i) cryptonite_aes_generic_decrypt_block(o,k,i) -#define cryptonite_gf_mul(a,b) cryptonite_aes_generic_gf_mul(a,b) +#define cryptonite_hinit(t,h) cryptonite_aes_generic_hinit(t,h) +#define cryptonite_gf_mul(a,t) cryptonite_aes_generic_gf_mul(a,t) #endif #if defined(ARCH_X86) && defined(WITH_AESNI) @@ -253,7 +258,8 @@ static void initialize_table_ni(int aesni, int pclmul) if (!pclmul) return; /* GHASH */ - cryptonite_aes_branch_table[GHASH_GF_MUL] = cryptonite_aesni_gf_mul; + cryptonite_aes_branch_table[GHASH_HINIT] = cryptonite_aesni_hinit_pclmul, + cryptonite_aes_branch_table[GHASH_GF_MUL] = cryptonite_aesni_gf_mul_pclmul, cryptonite_aesni_init_pclmul(); #endif } @@ -382,20 +388,22 @@ void cryptonite_aes_ocb_decrypt(uint8_t *output, aes_ocb *ocb, aes_key *key, uin static void gcm_ghash_add(aes_gcm *gcm, block128 *b) { block128_xor(&gcm->tag, b); - cryptonite_gf_mul(&gcm->tag, &gcm->h); + cryptonite_gf_mul(&gcm->tag, gcm->htable); } void cryptonite_aes_gcm_init(aes_gcm *gcm, aes_key *key, uint8_t *iv, uint32_t len) { + block128 h; gcm->length_aad = 0; gcm->length_input = 0; - block128_zero(&gcm->h); + block128_zero(&h); block128_zero(&gcm->tag); block128_zero(&gcm->iv); /* prepare H : encrypt_K(0^128) */ - cryptonite_aes_encrypt_block(&gcm->h, key, &gcm->h); + cryptonite_aes_encrypt_block(&h, key, &h); + cryptonite_hinit(gcm->htable, &h); if (len == 12) { block128_copy_bytes(&gcm->iv, iv, 12); @@ -405,15 +413,15 @@ void cryptonite_aes_gcm_init(aes_gcm *gcm, aes_key *key, uint8_t *iv, uint32_t l int i; for (; len >= 16; len -= 16, iv += 16) { block128_xor(&gcm->iv, (block128 *) iv); - cryptonite_gf_mul(&gcm->iv, &gcm->h); + cryptonite_gf_mul(&gcm->iv, gcm->htable); } if (len > 0) { block128_xor_bytes(&gcm->iv, iv, len); - cryptonite_gf_mul(&gcm->iv, &gcm->h); + cryptonite_gf_mul(&gcm->iv, gcm->htable); } for (i = 15; origlen; --i, origlen >>= 8) gcm->iv.b[i] ^= (uint8_t) origlen; - cryptonite_gf_mul(&gcm->iv, &gcm->h); + cryptonite_gf_mul(&gcm->iv, gcm->htable); } block128_copy_aligned(&gcm->civ, &gcm->iv); diff --git a/cbits/cryptonite_aes.h b/cbits/cryptonite_aes.h index 05e147d..fd648f3 100644 --- a/cbits/cryptonite_aes.h +++ b/cbits/cryptonite_aes.h @@ -45,10 +45,10 @@ typedef struct { uint8_t data[16*14*2]; } aes_key; -/* size = 4*16+2*8= 80 */ +/* size = 19*16+2*8= 320 */ typedef struct { aes_block tag; - aes_block h; + aes_block htable[16]; aes_block iv; aes_block civ; uint64_t length_aad; From 2cf3b7563667e07e53c1b0bcc4675df621396296 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Mon, 3 Jun 2019 06:40:49 +0200 Subject: [PATCH 086/176] AES CCM: use AESNI in CBC-MAC computation when possible --- cbits/cryptonite_aes.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cbits/cryptonite_aes.c b/cbits/cryptonite_aes.c index b078d57..8859a23 100644 --- a/cbits/cryptonite_aes.c +++ b/cbits/cryptonite_aes.c @@ -515,7 +515,7 @@ static void ccm_encode_ctr(block128* out, aes_ccm* ccm, unsigned int cnt) static void ccm_cbcmac_add(aes_ccm* ccm, aes_key* key, block128* bi) { block128_xor_aligned(&ccm->xi, bi); - cryptonite_aes_generic_encrypt_block(&ccm->xi, key, &ccm->xi); + cryptonite_aes_encrypt_block(&ccm->xi, key, &ccm->xi); } /* even though it is possible to support message size as large as 2^64, we support up to 2^32 only */ From 91c87deae109c9dcda73cb701bca825654aeef45 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Mon, 10 Jun 2019 08:27:36 +0200 Subject: [PATCH 087/176] Add Crypto.System.CPU --- Crypto/System/CPU.hs | 64 ++++++++++++++++++++++++++++++++++++++++++ cbits/cryptonite_aes.c | 22 +++++++++++++-- cbits/cryptonite_aes.h | 2 ++ cryptonite.cabal | 1 + 4 files changed, 86 insertions(+), 3 deletions(-) create mode 100644 Crypto/System/CPU.hs diff --git a/Crypto/System/CPU.hs b/Crypto/System/CPU.hs new file mode 100644 index 0000000..47e9eb6 --- /dev/null +++ b/Crypto/System/CPU.hs @@ -0,0 +1,64 @@ +-- | +-- Module : Crypto.System.CPU +-- License : BSD-style +-- Maintainer : Olivier Chéron +-- Stability : experimental +-- Portability : unknown +-- +-- Gives information about cryptonite runtime environment. +-- +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE ForeignFunctionInterface #-} +module Crypto.System.CPU + ( ProcessorOption (..) + , processorOptions + ) where + +import Data.Data +import Data.List (findIndices) +#ifdef SUPPORT_RDRAND +import Data.Maybe (isJust) +#endif +import Data.Word (Word8) +import Foreign.Ptr +import Foreign.Storable + +import Crypto.Internal.Compat + +#ifdef SUPPORT_RDRAND +import Crypto.Random.Entropy.RDRand +import Crypto.Random.Entropy.Source +#endif + +-- | CPU options impacting cryptography implementation and libary performance. +data ProcessorOption + = AESNI -- ^ Support for AES instructions, with flag @support_aesni@ + | PCLMUL -- ^ Support for CLMUL instructions, with flag @support_pclmuldq@ + | RDRAND -- ^ Support for RDRAND instruction, with flag @support_rdrand@ + deriving (Show,Eq,Enum,Data) + +-- | Options which have been enabled at compile time and are supported by the +-- current CPU. +processorOptions :: [ProcessorOption] +processorOptions = unsafeDoIO $ do + p <- cryptonite_aes_cpu_init + options <- traverse (getOption p) aesOptions + rdrand <- hasRDRand + return (decodeOptions options ++ [ RDRAND | rdrand ]) + where + aesOptions = [ AESNI .. PCLMUL ] + getOption p = peekElemOff p . fromEnum + decodeOptions = map toEnum . findIndices (> 0) +{-# NOINLINE processorOptions #-} + +hasRDRand :: IO Bool +#ifdef SUPPORT_RDRAND +hasRDRand = fmap isJust getRDRand + where getRDRand = entropyOpen :: IO (Maybe RDRand) +#else +hasRDRand = return False +#endif + +foreign import ccall unsafe "cryptonite_aes_cpu_init" + cryptonite_aes_cpu_init :: IO (Ptr Word8) diff --git a/cbits/cryptonite_aes.c b/cbits/cryptonite_aes.c index 8859a23..67953e4 100644 --- a/cbits/cryptonite_aes.c +++ b/cbits/cryptonite_aes.c @@ -218,11 +218,19 @@ typedef void (*gf_mul_f)(block128 *a, const table_4bit htable); #define cryptonite_gf_mul(a,t) cryptonite_aes_generic_gf_mul(a,t) #endif +#define CPU_AESNI 0 +#define CPU_PCLMUL 1 +#define CPU_OPTION_COUNT 2 + +static uint8_t cryptonite_aes_cpu_options[CPU_OPTION_COUNT] = {}; + #if defined(ARCH_X86) && defined(WITH_AESNI) static void initialize_table_ni(int aesni, int pclmul) { if (!aesni) return; + cryptonite_aes_cpu_options[CPU_AESNI] = 1; + cryptonite_aes_branch_table[INIT_128] = cryptonite_aesni_init; cryptonite_aes_branch_table[INIT_256] = cryptonite_aesni_init; @@ -257,6 +265,8 @@ static void initialize_table_ni(int aesni, int pclmul) #ifdef WITH_PCLMUL if (!pclmul) return; + cryptonite_aes_cpu_options[CPU_PCLMUL] = 1; + /* GHASH */ cryptonite_aes_branch_table[GHASH_HINIT] = cryptonite_aesni_hinit_pclmul, cryptonite_aes_branch_table[GHASH_GF_MUL] = cryptonite_aesni_gf_mul_pclmul, @@ -265,6 +275,14 @@ static void initialize_table_ni(int aesni, int pclmul) } #endif +uint8_t *cryptonite_aes_cpu_init(void) +{ +#if defined(ARCH_X86) && defined(WITH_AESNI) + cryptonite_aesni_initialize_hw(initialize_table_ni); +#endif + return cryptonite_aes_cpu_options; +} + void cryptonite_aes_initkey(aes_key *key, uint8_t *origkey, uint8_t size) { switch (size) { @@ -272,9 +290,7 @@ void cryptonite_aes_initkey(aes_key *key, uint8_t *origkey, uint8_t size) case 24: key->nbr = 12; key->strength = 1; break; case 32: key->nbr = 14; key->strength = 2; break; } -#if defined(ARCH_X86) && defined(WITH_AESNI) - cryptonite_aesni_initialize_hw(initialize_table_ni); -#endif + cryptonite_aes_cpu_init(); init_f _init = GET_INIT(key->strength); _init(key, origkey, size); } diff --git a/cbits/cryptonite_aes.h b/cbits/cryptonite_aes.h index fd648f3..509ff16 100644 --- a/cbits/cryptonite_aes.h +++ b/cbits/cryptonite_aes.h @@ -115,4 +115,6 @@ void cryptonite_aes_ccm_encrypt(uint8_t *output, aes_ccm *ccm, aes_key *key, uin void cryptonite_aes_ccm_decrypt(uint8_t *output, aes_ccm *ccm, aes_key *key, uint8_t *input, uint32_t length); void cryptonite_aes_ccm_finish(uint8_t *tag, aes_ccm *ccm, aes_key *key); +uint8_t *cryptonite_aes_cpu_init(void); + #endif diff --git a/cryptonite.cabal b/cryptonite.cabal index 00baa72..f32a239 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -177,6 +177,7 @@ Library Crypto.Random.Entropy Crypto.Random.EntropyPool Crypto.Random.Entropy.Unsafe + Crypto.System.CPU Crypto.Tutorial Other-modules: Crypto.Cipher.AES.Primitive Crypto.Cipher.Blowfish.Box From 53a1bf7ebf75e1de783d5aab3b846b6609c2d6a7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Mon, 10 Jun 2019 08:27:40 +0200 Subject: [PATCH 088/176] Report info about runtime environment in the test suite --- tests/Tests.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/tests/Tests.hs b/tests/Tests.hs index 3b9a09f..7f4f6ce 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -3,6 +3,8 @@ module Main where import Imports +import Crypto.System.CPU + import qualified Number import qualified Number.F2m import qualified BCrypt @@ -43,7 +45,10 @@ import qualified KAT_AFIS import qualified Padding tests = testGroup "cryptonite" - [ Number.tests + [ testGroup "runtime" + [ testCaseInfo "CPU" (return $ show processorOptions) + ] + , Number.tests , Number.F2m.tests , Hash.tests , Padding.tests From 71184beb15f49e20c8d4acdcce7684e62782d8ac Mon Sep 17 00:00:00 2001 From: tom-audm Date: Thu, 11 Jul 2019 16:36:27 -0400 Subject: [PATCH 089/176] Fix typo ("strive" -> "strives") --- cryptonite.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cryptonite.cabal b/cryptonite.cabal index f32a239..f1475e2 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -19,7 +19,7 @@ Description: * Data related: Anti-Forensic Information Splitter (AFIS) . If anything cryptographic related is missing from here, submit - a pull request to have it added. This package strive to be a + a pull request to have it added. This package strives to be a cryptographic kitchen sink that provides cryptography for everyone. . Evaluate the security related to your requirements before using. From 7ca1f2e4d69942fa27dd2ad574df75dc96d5c81f Mon Sep 17 00:00:00 2001 From: root <287494524@qq.com> Date: Mon, 15 Jul 2019 10:47:58 +0800 Subject: [PATCH 090/176] bench for P256.pointAdd and P256.pointMul --- benchs/Bench.hs | 37 +++++++++++++++++++++++++++++++++++-- 1 file changed, 35 insertions(+), 2 deletions(-) diff --git a/benchs/Bench.hs b/benchs/Bench.hs index 92e7e62..268f991 100644 --- a/benchs/Bench.hs +++ b/benchs/Bench.hs @@ -28,6 +28,8 @@ import Control.DeepSeq (NFData) import Data.ByteArray (ByteArray, Bytes) import qualified Data.ByteString as B +import qualified Crypto.PubKey.ECC.P256 as P256 + import Number.F2m data HashAlg = forall alg . HashAlgorithm alg => HashAlg alg @@ -195,20 +197,50 @@ benchAE = benchECC = [ bench "pointAddTwoMuls-baseline" $ nf run_b (n1, p1, n2, p2) , bench "pointAddTwoMuls-optimized" $ nf run_o (n1, p1, n2, p2) + , bench "pointAdd-ECC" $ nf run_c (p1, p2) + , bench "pointMul-ECC" $ nf run_d (n1, p2) ] where run_b (n, p, k, q) = ECC.pointAdd c (ECC.pointMul c n p) (ECC.pointMul c k q) run_o (n, p, k, q) = ECC.pointAddTwoMuls c n p k q + run_c (p, q) = ECC.pointAdd c p q + run_d (n, p) = ECC.pointMul c n p c = ECC.getCurveByName ECC.SEC_p256r1 r1 = 7 r2 = 11 - p1 = ECC.pointBaseMul c r1 - p2 = ECC.pointBaseMul c r2 + -- p1 = ECC.pointBaseMul c r1 + -- p2 = ECC.pointBaseMul c r2 + p1 = ECC.pointBaseMul c n1 + p2 = ECC.pointBaseMul c n2 n1 = 0x2ba9daf2363b2819e69b34a39cf496c2458a9b2a21505ea9e7b7cbca42dc7435 n2 = 0xf054a7f60d10b8c2cf847ee90e9e029f8b0e971b09ca5f55c4d49921a11fadc1 +benchP256 = + [ bench "pointAddTwoMuls-P256" $ nf run_p (n1, s, n2, t) + , bench "pointAdd-P256" $ nf run_q (s, t) + , bench "pointMul-P256" $ nf run_t (n1, s) + ] + where run_p (n1, s, n2, t) = P256.pointAdd (P256.pointMul n1 s) (P256.pointMul n2 t) + run_q (s, t) = P256.pointAdd s t + run_t (n1, s) = P256.pointMul n1 s + + xS = 0xde2444bebc8d36e682edd27e0f271508617519b3221a8fa0b77cab3989da97c9 + yS = 0xc093ae7ff36e5380fc01a5aad1e66659702de80f53cec576b6350b243042a256 + xT = 0x55a8b00f8da1d44e62f6b3b25316212e39540dc861c89575bb8cf92e35e0986b + yT = 0x5421c3209c2d6c704835d82ac4c3dd90f61a8a52598b9e7ab656e9d8c8b24316 + s = P256.pointFromIntegers (xS, yS) + t = P256.pointFromIntegers (xT, yT) + r1 = throwCryptoError $ P256.scalarFromInteger 7 + r2 = throwCryptoError $ P256.scalarFromInteger 11 + -- s = P256.pointMul r1 P256.pointBase + -- t = P256.pointMul r2 P256.pointBase + n1 = throwCryptoError $ P256.scalarFromInteger 0x2ba9daf2363b2819e69b34a39cf496c2458a9b2a21505ea9e7b7cbca42dc7435 + n2 = throwCryptoError $ P256.scalarFromInteger 0xf054a7f60d10b8c2cf847ee90e9e029f8b0e971b09ca5f55c4d49921a11fadc1 + + + benchFFDH = map doFFDHBench primes where doFFDHBench (e, p) = @@ -262,6 +294,7 @@ main = defaultMain , bgroup "pbkdf2" benchPBKDF2 , bgroup "bcrypt" benchBCrypt , bgroup "ECC" benchECC + , bgroup "P256" benchP256 , bgroup "DH" [ bgroup "FFDH" benchFFDH , bgroup "ECDH" benchECDH From d3a60abf2896a1a651a7396c0fa15d3e58823c49 Mon Sep 17 00:00:00 2001 From: root <287494524@qq.com> Date: Tue, 23 Jul 2019 10:57:33 +0800 Subject: [PATCH 091/176] warning remove --- benchs/Bench.hs | 25 ++++++++----------------- stack.yaml.lock | 12 ++++++++++++ 2 files changed, 20 insertions(+), 17 deletions(-) create mode 100644 stack.yaml.lock diff --git a/benchs/Bench.hs b/benchs/Bench.hs index 268f991..7b96e57 100644 --- a/benchs/Bench.hs +++ b/benchs/Bench.hs @@ -30,7 +30,6 @@ import qualified Data.ByteString as B import qualified Crypto.PubKey.ECC.P256 as P256 -import Number.F2m data HashAlg = forall alg . HashAlgorithm alg => HashAlg alg @@ -208,34 +207,26 @@ benchECC = run_d (n, p) = ECC.pointMul c n p c = ECC.getCurveByName ECC.SEC_p256r1 - r1 = 7 - r2 = 11 - -- p1 = ECC.pointBaseMul c r1 - -- p2 = ECC.pointBaseMul c r2 p1 = ECC.pointBaseMul c n1 p2 = ECC.pointBaseMul c n2 n1 = 0x2ba9daf2363b2819e69b34a39cf496c2458a9b2a21505ea9e7b7cbca42dc7435 n2 = 0xf054a7f60d10b8c2cf847ee90e9e029f8b0e971b09ca5f55c4d49921a11fadc1 benchP256 = - [ bench "pointAddTwoMuls-P256" $ nf run_p (n1, s, n2, t) - , bench "pointAdd-P256" $ nf run_q (s, t) - , bench "pointMul-P256" $ nf run_t (n1, s) + [ bench "pointAddTwoMuls-P256" $ nf run_p (n1, p1, n2, p2) + , bench "pointAdd-P256" $ nf run_q (p1, p2) + , bench "pointMul-P256" $ nf run_t (n1, p1) ] - where run_p (n1, s, n2, t) = P256.pointAdd (P256.pointMul n1 s) (P256.pointMul n2 t) - run_q (s, t) = P256.pointAdd s t - run_t (n1, s) = P256.pointMul n1 s + where run_p (n, p, k, q) = P256.pointAdd (P256.pointMul n p) (P256.pointMul k q) + run_q (p, q) = P256.pointAdd p q + run_t (n, p) = P256.pointMul n p xS = 0xde2444bebc8d36e682edd27e0f271508617519b3221a8fa0b77cab3989da97c9 yS = 0xc093ae7ff36e5380fc01a5aad1e66659702de80f53cec576b6350b243042a256 xT = 0x55a8b00f8da1d44e62f6b3b25316212e39540dc861c89575bb8cf92e35e0986b yT = 0x5421c3209c2d6c704835d82ac4c3dd90f61a8a52598b9e7ab656e9d8c8b24316 - s = P256.pointFromIntegers (xS, yS) - t = P256.pointFromIntegers (xT, yT) - r1 = throwCryptoError $ P256.scalarFromInteger 7 - r2 = throwCryptoError $ P256.scalarFromInteger 11 - -- s = P256.pointMul r1 P256.pointBase - -- t = P256.pointMul r2 P256.pointBase + p1 = P256.pointFromIntegers (xS, yS) + p2 = P256.pointFromIntegers (xT, yT) n1 = throwCryptoError $ P256.scalarFromInteger 0x2ba9daf2363b2819e69b34a39cf496c2458a9b2a21505ea9e7b7cbca42dc7435 n2 = throwCryptoError $ P256.scalarFromInteger 0xf054a7f60d10b8c2cf847ee90e9e029f8b0e971b09ca5f55c4d49921a11fadc1 diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..fcc2f5f --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,12 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + size: 498180 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/21.yaml + sha256: eff2de19a6d4691ccbf6edc1fba858f1918683047dce0f09adede874bbd2a8f3 + original: lts-13.21 From a64a058153dbde831ad3b9f290108ac470295216 Mon Sep 17 00:00:00 2001 From: root <287494524@qq.com> Date: Tue, 23 Jul 2019 11:14:09 +0800 Subject: [PATCH 092/176] warning remove and benchF2m okay --- benchs/Bench.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/benchs/Bench.hs b/benchs/Bench.hs index 7b96e57..10c91d5 100644 --- a/benchs/Bench.hs +++ b/benchs/Bench.hs @@ -30,6 +30,7 @@ import qualified Data.ByteString as B import qualified Crypto.PubKey.ECC.P256 as P256 +import Number.F2m data HashAlg = forall alg . HashAlgorithm alg => HashAlg alg From 00221a494c68d91dbaf5148b6947e72d7f9bc65d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 28 Jul 2019 08:46:18 +0200 Subject: [PATCH 093/176] Ignore stack.yaml.lock --- .gitignore | 1 + benchs/Bench.hs | 6 +++--- stack.yaml.lock | 12 ------------ 3 files changed, 4 insertions(+), 15 deletions(-) delete mode 100644 stack.yaml.lock diff --git a/.gitignore b/.gitignore index a213015..f51721e 100644 --- a/.gitignore +++ b/.gitignore @@ -12,3 +12,4 @@ benchs/Hash *.sublime-workspace .cabal-sandbox/ cabal.sandbox.config +stack.yaml.lock diff --git a/benchs/Bench.hs b/benchs/Bench.hs index 10c91d5..b6d034e 100644 --- a/benchs/Bench.hs +++ b/benchs/Bench.hs @@ -125,7 +125,7 @@ benchBlockCipher = [ bgroup "ECB" benchECB , bgroup "CBC" benchCBC ] - where + where benchECB = [ bench "DES-input=1024" $ nf (run (undefined :: DES) cipherInit key8) input1024 , bench "Blowfish128-input=1024" $ nf (run (undefined :: Blowfish128) cipherInit key16) input1024 @@ -215,8 +215,8 @@ benchECC = benchP256 = [ bench "pointAddTwoMuls-P256" $ nf run_p (n1, p1, n2, p2) - , bench "pointAdd-P256" $ nf run_q (p1, p2) - , bench "pointMul-P256" $ nf run_t (n1, p1) + , bench "pointAdd-P256" $ nf run_q (p1, p2) + , bench "pointMul-P256" $ nf run_t (n1, p1) ] where run_p (n, p, k, q) = P256.pointAdd (P256.pointMul n p) (P256.pointMul k q) run_q (p, q) = P256.pointAdd p q diff --git a/stack.yaml.lock b/stack.yaml.lock deleted file mode 100644 index fcc2f5f..0000000 --- a/stack.yaml.lock +++ /dev/null @@ -1,12 +0,0 @@ -# This file was autogenerated by Stack. -# You should not edit this file by hand. -# For more information, please see the documentation at: -# https://docs.haskellstack.org/en/stable/lock_files - -packages: [] -snapshots: -- completed: - size: 498180 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/21.yaml - sha256: eff2de19a6d4691ccbf6edc1fba858f1918683047dce0f09adede874bbd2a8f3 - original: lts-13.21 From 7e6aeaa8dad8aa344f0729d11a10b2c58bfd2912 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Mon, 12 Aug 2019 21:10:47 +0200 Subject: [PATCH 094/176] Add Crypto.System.CPU to QA --- QA.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/QA.hs b/QA.hs index 09bb60e..bf6b2e2 100644 --- a/QA.hs +++ b/QA.hs @@ -48,6 +48,7 @@ perModuleAllowedExtensions = , ("Crypto/Cipher/Twofish/Primitive.hs", [MagicHash]) , ("Crypto/PubKey/Curve25519.hs", [MagicHash]) , ("Crypto/Number/Compat.hs", [UnboxedTuples,MagicHash,CPP]) + , ("Crypto/System/CPU.hs", [CPP]) ] disallowedModules = From 0d32f9b8332bdcdb07eb298b28e03a54097e197c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Mon, 12 Aug 2019 21:11:01 +0200 Subject: [PATCH 095/176] Remove unused variables --- cbits/cryptonite_chacha.c | 1 - cbits/cryptonite_salsa.c | 1 - cbits/cryptonite_skein256.c | 1 - cbits/cryptonite_skein512.c | 1 - cbits/cryptonite_whirlpool.c | 1 - 5 files changed, 5 deletions(-) diff --git a/cbits/cryptonite_chacha.c b/cbits/cryptonite_chacha.c index 80ba7da..bfc5d87 100644 --- a/cbits/cryptonite_chacha.c +++ b/cbits/cryptonite_chacha.c @@ -98,7 +98,6 @@ void cryptonite_chacha_init_core(cryptonite_chacha_state *st, uint32_t ivlen, const uint8_t *iv) { const uint8_t *constants = (keylen == 32) ? sigma : tau; - int i; ASSERT_ALIGNMENT(constants, 4); diff --git a/cbits/cryptonite_salsa.c b/cbits/cryptonite_salsa.c index bb6243e..7b42103 100644 --- a/cbits/cryptonite_salsa.c +++ b/cbits/cryptonite_salsa.c @@ -120,7 +120,6 @@ void cryptonite_salsa_init_core(cryptonite_salsa_state *st, uint32_t ivlen, const uint8_t *iv) { const uint8_t *constants = (keylen == 32) ? sigma : tau; - int i; st->d[0] = load_le32_aligned(constants + 0); st->d[5] = load_le32_aligned(constants + 4); diff --git a/cbits/cryptonite_skein256.c b/cbits/cryptonite_skein256.c index 7e0d5c4..f333350 100644 --- a/cbits/cryptonite_skein256.c +++ b/cbits/cryptonite_skein256.c @@ -167,7 +167,6 @@ void cryptonite_skein256_update(struct skein256_ctx *ctx, const uint8_t *data, u void cryptonite_skein256_finalize(struct skein256_ctx *ctx, uint32_t hashlen, uint8_t *out) { uint32_t outsize; - uint64_t *p = (uint64_t *) out; uint64_t x[4]; int i, j, n; diff --git a/cbits/cryptonite_skein512.c b/cbits/cryptonite_skein512.c index fcbe58c..129e947 100644 --- a/cbits/cryptonite_skein512.c +++ b/cbits/cryptonite_skein512.c @@ -185,7 +185,6 @@ void cryptonite_skein512_update(struct skein512_ctx *ctx, const uint8_t *data, u void cryptonite_skein512_finalize(struct skein512_ctx *ctx, uint32_t hashlen, uint8_t *out) { uint32_t outsize; - uint64_t *p = (uint64_t *) out; uint64_t x[8]; int i, j, n; diff --git a/cbits/cryptonite_whirlpool.c b/cbits/cryptonite_whirlpool.c index c63df7e..3cdffac 100644 --- a/cbits/cryptonite_whirlpool.c +++ b/cbits/cryptonite_whirlpool.c @@ -777,7 +777,6 @@ static void processBuffer(whirlpool_ctx * const ctx) uint64_t K[8]; /* the round key */ uint64_t block[8]; /* mu(buffer) */ uint64_t state[8]; /* the cipher state */ - uint64_t L[8]; uint8_t *buffer = ctx->buffer; /* From fc07a8b931035ff113a7835e966ced33e9aa98e7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Tue, 20 Aug 2019 10:34:40 +0200 Subject: [PATCH 096/176] Fix counter wrapping in AES GCM The generic and AESNI implementations used different conventions regarding counter wrapping in GCM. The generic code was based on function block128_inc_be, for which the counter is a 128-bit value. Whereas the AESNI code used intrinsic function _mm_add_epi64, and therefore wrapping at 2^64. In NIST.SP.800-38d the GCM specification mandates to use incrementing function inc32, wrapping after 2^32 blocks. This commit changes both generic and AESNI implementations to align to the specification and adds a test vector specially crafted to start encryption with IV block 0xfffffffffffffffffffffffffffffffe. --- cbits/aes/block128.h | 5 +++++ cbits/aes/x86ni_impl.c | 4 ++-- cbits/cryptonite_aes.c | 8 ++++---- tests/KAT_AES/KATGCM.hs | 8 ++++++++ 4 files changed, 19 insertions(+), 6 deletions(-) diff --git a/cbits/aes/block128.h b/cbits/aes/block128.h index b054cd4..8513b94 100644 --- a/cbits/aes/block128.h +++ b/cbits/aes/block128.h @@ -118,6 +118,11 @@ static inline void block128_inc_be(block128 *b) b->q[1] = cpu_to_be64(v); } +static inline void block128_inc32_be(block128 *b) +{ + b->d[3] = cpu_to_be32(be32_to_cpu(b->d[3]) + 1); +} + #ifdef IMPL_DEBUG #include static inline void block128_print(block128 *b) diff --git a/cbits/aes/x86ni_impl.c b/cbits/aes/x86ni_impl.c index 3eedaff..219e8e6 100644 --- a/cbits/aes/x86ni_impl.c +++ b/cbits/aes/x86ni_impl.c @@ -199,7 +199,7 @@ void SIZED(cryptonite_aesni_gcm_encrypt)(uint8_t *output, aes_gcm *gcm, aes_key for (; nb_blocks-- > 0; output += 16, input += 16) { /* iv += 1 */ - iv = _mm_add_epi64(iv, one); + iv = _mm_add_epi32(iv, one); /* put back iv in big endian, encrypt it, * and xor it to input */ @@ -239,7 +239,7 @@ void SIZED(cryptonite_aesni_gcm_encrypt)(uint8_t *output, aes_gcm *gcm, aes_key block128_copy_bytes(&block, input, part_block_len); /* iv += 1 */ - iv = _mm_add_epi64(iv, one); + iv = _mm_add_epi32(iv, one); /* put back iv in big endian mode, encrypt it and xor it with input */ __m128i tmp = _mm_shuffle_epi8(iv, bswap_mask); diff --git a/cbits/cryptonite_aes.c b/cbits/cryptonite_aes.c index 67953e4..e35ced9 100644 --- a/cbits/cryptonite_aes.c +++ b/cbits/cryptonite_aes.c @@ -835,7 +835,7 @@ void cryptonite_aes_generic_gcm_encrypt(uint8_t *output, aes_gcm *gcm, aes_key * gcm->length_input += length; for (; length >= 16; input += 16, output += 16, length -= 16) { - block128_inc_be(&gcm->civ); + block128_inc32_be(&gcm->civ); cryptonite_aes_encrypt_block(&out, key, &gcm->civ); block128_xor(&out, (block128 *) input); @@ -846,7 +846,7 @@ void cryptonite_aes_generic_gcm_encrypt(uint8_t *output, aes_gcm *gcm, aes_key * aes_block tmp; int i; - block128_inc_be(&gcm->civ); + block128_inc32_be(&gcm->civ); /* create e(civ) in out */ cryptonite_aes_encrypt_block(&out, key, &gcm->civ); /* initialize a tmp as input and xor it to e(civ) */ @@ -868,7 +868,7 @@ void cryptonite_aes_generic_gcm_decrypt(uint8_t *output, aes_gcm *gcm, aes_key * gcm->length_input += length; for (; length >= 16; input += 16, output += 16, length -= 16) { - block128_inc_be(&gcm->civ); + block128_inc32_be(&gcm->civ); cryptonite_aes_encrypt_block(&out, key, &gcm->civ); gcm_ghash_add(gcm, (block128 *) input); @@ -879,7 +879,7 @@ void cryptonite_aes_generic_gcm_decrypt(uint8_t *output, aes_gcm *gcm, aes_key * aes_block tmp; int i; - block128_inc_be(&gcm->civ); + block128_inc32_be(&gcm->civ); block128_zero(&tmp); block128_copy_bytes(&tmp, input, length); diff --git a/tests/KAT_AES/KATGCM.hs b/tests/KAT_AES/KATGCM.hs index 0b543a6..a06d240 100644 --- a/tests/KAT_AES/KATGCM.hs +++ b/tests/KAT_AES/KATGCM.hs @@ -56,6 +56,14 @@ vectors_aes128_enc = , {-out = -}"\xe4\x42\xf8\xc4\xc6\x67\x84\x86\x4a\x5a\x6e\xc7\xe0\xca\x68\xac\x16\xbc\x5b\xbf\xf7\xd5\xf3\xfa\xf3\xb2\xcb\xb0\xa2\x14\xa1" , {-taglen = -}16 , {-tag = -}"\x94\xd1\x47\xc3\xa2\xca\x93\xe9\x66\x93\x1e\x3b\xb3\xbb\x67\x01") + -- vector 6 tests 32-bit counter wrapping + , ( {-key = -}"\x01\x02\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , {-iv = -}"\xe8\x38\x84\x1d\x75\xae\x33\xb5\x4b\x51\x57\x89\xc9\x5f\xbe\x65" + , {-aad = -}"\x54\x68\x65\x20\x66\x69\x76\x65\x20\x62\x6f\x78\x69\x6e\x67\x20\x77\x69\x7a\x61\x72\x64\x73\x20\x6a\x75\x6d\x70\x20\x71\x75\x69\x63\x6b\x6c\x79\x2e" + , {-input = -}"\x54\x68\x65\x20\x71\x75\x69\x63\x6b\x20\x62\x72\x6f\x77\x6e\x20\x66\x6f\x78\x20\x6a\x75\x6d\x70\x73\x20\x6f\x76\x65\x72\x20\x74\x68\x65\x20\x6c\x61\x7a\x79\x20\x64\x6f\x67" + , {-out = -}"\x82\x31\x9e\x5a\x6a\x7f\x43\xd0\x42\x8c\xf1\x01\xcf\x0c\x75\xf1\x5d\xda\x4f\xa1\x28\x95\xcd\xd7\x7b\xd5\x42\x68\x2f\xcd\x10\x1b\x0c\x75\x05\x54\xf4\x2f\x2b\xf6\x69\x96\x29" + , {-taglen = -}16 + , {-tag = -}"\x9a\xfa\xf4\xea\xae\x2e\x6f\x40\x00\xf4\x89\x77\xd0\x1e\xd5\x14") ] vectors_aes256_enc :: [KATGCM] From 4ca77b8cf5c12d284ad7b5b774154a090c9387c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Wed, 21 Aug 2019 09:32:53 +0200 Subject: [PATCH 097/176] Faster P256.pointAdd Convert to projective coordinates without expansive calls to function 'scalar_mult'. --- cbits/p256/p256_ec.c | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/cbits/p256/p256_ec.c b/cbits/p256/p256_ec.c index bee8ff0..2d1650a 100644 --- a/cbits/p256/p256_ec.c +++ b/cbits/p256/p256_ec.c @@ -1287,19 +1287,16 @@ void cryptonite_p256e_point_add( const cryptonite_p256_int *in_x2, const cryptonite_p256_int *in_y2, cryptonite_p256_int *out_x, cryptonite_p256_int *out_y) { - felem x1, y1, z1, x2, y2, z2, px1, py1, px2, py2; - const cryptonite_p256_int one = P256_ONE; + felem x, y, z, px1, py1, px2, py2; to_montgomery(px1, in_x1); to_montgomery(py1, in_y1); to_montgomery(px2, in_x2); to_montgomery(py2, in_y2); - scalar_mult(x1, y1, z1, px1, py1, &one); - scalar_mult(x2, y2, z2, px2, py2, &one); - point_add_or_double_vartime(x1, y1, z1, x1, y1, z1, x2, y2, z2); + point_add_or_double_vartime(x, y, z, px1, py1, kOne, px2, py2, kOne); - point_to_affine(px1, py1, x1, y1, z1); + point_to_affine(px1, py1, x, y, z); from_montgomery(out_x, px1); from_montgomery(out_y, py1); } From 0075b57f90be524ed5063b452e4448722e62a01c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 25 Aug 2019 08:55:49 +0200 Subject: [PATCH 098/176] Add internal AES CTR variant with 32-bit counter This variant of CTR mode is used by AES-GCM-SIV. The counter is in little-endian format and uses the first four bytes of the IV only. --- Crypto/Cipher/AES/Primitive.hs | 21 +++++++++++++++++ cbits/aes/block128.h | 5 ++++ cbits/aes/x86ni.h | 2 ++ cbits/aes/x86ni_impl.c | 41 ++++++++++++++++++++++++++++++++ cbits/cryptonite_aes.c | 43 ++++++++++++++++++++++++++++++++++ 5 files changed, 112 insertions(+) diff --git a/Crypto/Cipher/AES/Primitive.hs b/Crypto/Cipher/AES/Primitive.hs index d8a8490..5c03a93 100644 --- a/Crypto/Cipher/AES/Primitive.hs +++ b/Crypto/Cipher/AES/Primitive.hs @@ -37,6 +37,9 @@ module Crypto.Cipher.AES.Primitive , decryptCTR , decryptXTS + -- * CTR with 32-bit wrapping + , combineC32 + -- * Incremental GCM , gcmMode , gcmInit @@ -317,6 +320,21 @@ decryptXTS :: ByteArray ba -> ba -- ^ output decrypted decryptXTS = doXTS c_aes_decrypt_xts +-- | encrypt/decrypt using Counter mode (32-bit wrapping used in AES-GCM-SIV) +{-# NOINLINE combineC32 #-} +combineC32 :: ByteArray ba + => AES -- ^ AES Context + -> IV AES -- ^ initial vector of AES block size (usually representing a 128 bit integer) + -> ba -- ^ plaintext input + -> ba -- ^ ciphertext output +combineC32 ctx iv input + | len <= 0 = B.empty + | B.length iv /= 16 = error $ "AES error: IV length must be block size (16). Its length is: " ++ show (B.length iv) + | otherwise = B.allocAndFreeze len doEncrypt + where doEncrypt o = withKeyAndIV ctx iv $ \k v -> withByteArray input $ \i -> + c_aes_encrypt_c32 (castPtr o) k v i (fromIntegral len) + len = B.length input + {-# INLINE doECB #-} doECB :: ByteArray ba => (Ptr b -> Ptr AES -> CString -> CUInt -> IO ()) @@ -578,6 +596,9 @@ foreign import ccall unsafe "cryptonite_aes.h cryptonite_aes_gen_ctr_cont" foreign import ccall "cryptonite_aes.h cryptonite_aes_encrypt_ctr" c_aes_encrypt_ctr :: CString -> Ptr AES -> Ptr Word8 -> CString -> CUInt -> IO () +foreign import ccall "cryptonite_aes.h cryptonite_aes_encrypt_c32" + c_aes_encrypt_c32 :: CString -> Ptr AES -> Ptr Word8 -> CString -> CUInt -> IO () + foreign import ccall "cryptonite_aes.h cryptonite_aes_gcm_init" c_aes_gcm_init :: Ptr AESGCM -> Ptr AES -> Ptr Word8 -> CUInt -> IO () diff --git a/cbits/aes/block128.h b/cbits/aes/block128.h index 8513b94..12d842f 100644 --- a/cbits/aes/block128.h +++ b/cbits/aes/block128.h @@ -123,6 +123,11 @@ static inline void block128_inc32_be(block128 *b) b->d[3] = cpu_to_be32(be32_to_cpu(b->d[3]) + 1); } +static inline void block128_inc32_le(block128 *b) +{ + b->d[0] = cpu_to_le32(le32_to_cpu(b->d[0]) + 1); +} + #ifdef IMPL_DEBUG #include static inline void block128_print(block128 *b) diff --git a/cbits/aes/x86ni.h b/cbits/aes/x86ni.h index 2ef2615..6ffe74c 100644 --- a/cbits/aes/x86ni.h +++ b/cbits/aes/x86ni.h @@ -64,6 +64,8 @@ void cryptonite_aesni_decrypt_cbc128(aes_block *out, aes_key *key, aes_block *_i void cryptonite_aesni_decrypt_cbc256(aes_block *out, aes_key *key, aes_block *_iv, aes_block *in, uint32_t blocks); void cryptonite_aesni_encrypt_ctr128(uint8_t *out, aes_key *key, aes_block *_iv, uint8_t *in, uint32_t length); void cryptonite_aesni_encrypt_ctr256(uint8_t *out, aes_key *key, aes_block *_iv, uint8_t *in, uint32_t length); +void cryptonite_aesni_encrypt_c32_128(uint8_t *out, aes_key *key, aes_block *_iv, uint8_t *in, uint32_t length); +void cryptonite_aesni_encrypt_c32_256(uint8_t *out, aes_key *key, aes_block *_iv, uint8_t *in, uint32_t length); void cryptonite_aesni_encrypt_xts128(aes_block *out, aes_key *key1, aes_key *key2, aes_block *_tweak, uint32_t spoint, aes_block *in, uint32_t blocks); void cryptonite_aesni_encrypt_xts256(aes_block *out, aes_key *key1, aes_key *key2, diff --git a/cbits/aes/x86ni_impl.c b/cbits/aes/x86ni_impl.c index 219e8e6..ba8d762 100644 --- a/cbits/aes/x86ni_impl.c +++ b/cbits/aes/x86ni_impl.c @@ -151,6 +151,47 @@ void SIZED(cryptonite_aesni_encrypt_ctr)(uint8_t *output, aes_key *key, aes_bloc return ; } +void SIZED(cryptonite_aesni_encrypt_c32_)(uint8_t *output, aes_key *key, aes_block *_iv, uint8_t *input, uint32_t len) +{ + __m128i *k = (__m128i *) key->data; + __m128i one = _mm_set_epi32(0,0,0,1); + uint32_t nb_blocks = len / 16; + uint32_t part_block_len = len % 16; + + /* get the IV */ + __m128i iv = _mm_loadu_si128((__m128i *) _iv); + + PRELOAD_ENC(k); + + for (; nb_blocks-- > 0; output += 16, input += 16) { + /* encrypt the iv and and xor it the input block */ + __m128i tmp = iv; + DO_ENC_BLOCK(tmp); + __m128i m = _mm_loadu_si128((__m128i *) input); + m = _mm_xor_si128(m, tmp); + + _mm_storeu_si128((__m128i *) output, m); + /* iv += 1 */ + iv = _mm_add_epi32(iv, one); + } + + if (part_block_len != 0) { + aes_block block; + memset(&block.b, 0, 16); + memcpy(&block.b, input, part_block_len); + + __m128i m = _mm_loadu_si128((__m128i *) &block); + __m128i tmp = iv; + + DO_ENC_BLOCK(tmp); + m = _mm_xor_si128(m, tmp); + _mm_storeu_si128((__m128i *) &block.b, m); + memcpy(output, &block.b, part_block_len); + } + + return ; +} + void SIZED(cryptonite_aesni_encrypt_xts)(aes_block *out, aes_key *key1, aes_key *key2, aes_block *_tweak, uint32_t spoint, aes_block *in, uint32_t blocks) { diff --git a/cbits/cryptonite_aes.c b/cbits/cryptonite_aes.c index e35ced9..e70aa07 100644 --- a/cbits/cryptonite_aes.c +++ b/cbits/cryptonite_aes.c @@ -44,6 +44,7 @@ void cryptonite_aes_generic_decrypt_ecb(aes_block *output, aes_key *key, aes_blo void cryptonite_aes_generic_encrypt_cbc(aes_block *output, aes_key *key, aes_block *iv, aes_block *input, uint32_t nb_blocks); void cryptonite_aes_generic_decrypt_cbc(aes_block *output, aes_key *key, aes_block *iv, aes_block *input, uint32_t nb_blocks); void cryptonite_aes_generic_encrypt_ctr(uint8_t *output, aes_key *key, aes_block *iv, uint8_t *input, uint32_t length); +void cryptonite_aes_generic_encrypt_c32(uint8_t *output, aes_key *key, aes_block *iv, uint8_t *input, uint32_t length); void cryptonite_aes_generic_encrypt_xts(aes_block *output, aes_key *k1, aes_key *k2, aes_block *dataunit, uint32_t spoint, aes_block *input, uint32_t nb_blocks); void cryptonite_aes_generic_decrypt_xts(aes_block *output, aes_key *k1, aes_key *k2, aes_block *dataunit, @@ -69,6 +70,8 @@ enum { DECRYPT_CBC_128, DECRYPT_CBC_192, DECRYPT_CBC_256, /* ctr */ ENCRYPT_CTR_128, ENCRYPT_CTR_192, ENCRYPT_CTR_256, + /* ctr with 32-bit wrapping */ + ENCRYPT_C32_128, ENCRYPT_C32_192, ENCRYPT_C32_256, /* xts */ ENCRYPT_XTS_128, ENCRYPT_XTS_192, ENCRYPT_XTS_256, DECRYPT_XTS_128, DECRYPT_XTS_192, DECRYPT_XTS_256, @@ -115,6 +118,10 @@ void *cryptonite_aes_branch_table[] = { [ENCRYPT_CTR_128] = cryptonite_aes_generic_encrypt_ctr, [ENCRYPT_CTR_192] = cryptonite_aes_generic_encrypt_ctr, [ENCRYPT_CTR_256] = cryptonite_aes_generic_encrypt_ctr, + /* CTR with 32-bit wrapping */ + [ENCRYPT_C32_128] = cryptonite_aes_generic_encrypt_c32, + [ENCRYPT_C32_192] = cryptonite_aes_generic_encrypt_c32, + [ENCRYPT_C32_256] = cryptonite_aes_generic_encrypt_c32, /* XTS */ [ENCRYPT_XTS_128] = cryptonite_aes_generic_encrypt_xts, [ENCRYPT_XTS_192] = cryptonite_aes_generic_encrypt_xts, @@ -173,6 +180,8 @@ typedef void (*gf_mul_f)(block128 *a, const table_4bit htable); ((cbc_f) (cryptonite_aes_branch_table[DECRYPT_CBC_128 + strength])) #define GET_CTR_ENCRYPT(strength) \ ((ctr_f) (cryptonite_aes_branch_table[ENCRYPT_CTR_128 + strength])) +#define GET_C32_ENCRYPT(strength) \ + ((ctr_f) (cryptonite_aes_branch_table[ENCRYPT_C32_128 + strength])) #define GET_XTS_ENCRYPT(strength) \ ((xts_f) (cryptonite_aes_branch_table[ENCRYPT_XTS_128 + strength])) #define GET_XTS_DECRYPT(strength) \ @@ -204,6 +213,7 @@ typedef void (*gf_mul_f)(block128 *a, const table_4bit htable); #define GET_CBC_ENCRYPT(strength) cryptonite_aes_generic_encrypt_cbc #define GET_CBC_DECRYPT(strength) cryptonite_aes_generic_decrypt_cbc #define GET_CTR_ENCRYPT(strength) cryptonite_aes_generic_encrypt_ctr +#define GET_C32_ENCRYPT(strength) cryptonite_aes_generic_encrypt_c32 #define GET_XTS_ENCRYPT(strength) cryptonite_aes_generic_encrypt_xts #define GET_XTS_DECRYPT(strength) cryptonite_aes_generic_decrypt_xts #define GET_GCM_ENCRYPT(strength) cryptonite_aes_generic_gcm_encrypt @@ -251,6 +261,9 @@ static void initialize_table_ni(int aesni, int pclmul) /* CTR */ cryptonite_aes_branch_table[ENCRYPT_CTR_128] = cryptonite_aesni_encrypt_ctr128; cryptonite_aes_branch_table[ENCRYPT_CTR_256] = cryptonite_aesni_encrypt_ctr256; + /* CTR with 32-bit wrapping */ + cryptonite_aes_branch_table[ENCRYPT_C32_128] = cryptonite_aesni_encrypt_c32_128; + cryptonite_aes_branch_table[ENCRYPT_C32_256] = cryptonite_aesni_encrypt_c32_256; /* XTS */ cryptonite_aes_branch_table[ENCRYPT_XTS_128] = cryptonite_aesni_encrypt_xts128; cryptonite_aes_branch_table[ENCRYPT_XTS_256] = cryptonite_aesni_encrypt_xts256; @@ -352,6 +365,12 @@ void cryptonite_aes_encrypt_ctr(uint8_t *output, aes_key *key, aes_block *iv, ui e(output, key, iv, input, len); } +void cryptonite_aes_encrypt_c32(uint8_t *output, aes_key *key, aes_block *iv, uint8_t *input, uint32_t len) +{ + ctr_f e = GET_C32_ENCRYPT(key->strength); + e(output, key, iv, input, len); +} + void cryptonite_aes_encrypt_xts(aes_block *output, aes_key *k1, aes_key *k2, aes_block *dataunit, uint32_t spoint, aes_block *input, uint32_t nb_blocks) { @@ -789,6 +808,30 @@ void cryptonite_aes_generic_encrypt_ctr(uint8_t *output, aes_key *key, aes_block } } +void cryptonite_aes_generic_encrypt_c32(uint8_t *output, aes_key *key, aes_block *iv, uint8_t *input, uint32_t len) +{ + aes_block block, o; + uint32_t nb_blocks = len / 16; + int i; + + /* preload IV in block */ + block128_copy(&block, iv); + + for ( ; nb_blocks-- > 0; block128_inc32_le(&block), output += 16, input += 16) { + cryptonite_aes_encrypt_block(&o, key, &block); + block128_vxor((block128 *) output, &o, (block128 *) input); + } + + if ((len % 16) != 0) { + cryptonite_aes_encrypt_block(&o, key, &block); + for (i = 0; i < (len % 16); i++) { + *output = ((uint8_t *) &o)[i] ^ *input; + output++; + input++; + } + } +} + void cryptonite_aes_generic_encrypt_xts(aes_block *output, aes_key *k1, aes_key *k2, aes_block *dataunit, uint32_t spoint, aes_block *input, uint32_t nb_blocks) { From 908f979d44467d61b3fabef9f06e77417b2bf1bd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 25 Aug 2019 08:55:52 +0200 Subject: [PATCH 099/176] Add AES-GCM-SIV --- Crypto/Cipher/AESGCMSIV.hs | 187 +++++++++++++++++++++++++++++++++++++ cbits/aes/block128.h | 7 ++ cbits/cryptonite_aes.c | 52 +++++++++++ cbits/cryptonite_aes.h | 10 ++ cryptonite.cabal | 1 + 5 files changed, 257 insertions(+) create mode 100644 Crypto/Cipher/AESGCMSIV.hs diff --git a/Crypto/Cipher/AESGCMSIV.hs b/Crypto/Cipher/AESGCMSIV.hs new file mode 100644 index 0000000..81a8c76 --- /dev/null +++ b/Crypto/Cipher/AESGCMSIV.hs @@ -0,0 +1,187 @@ +-- | +-- Module : Crypto.Cipher.AESGCMSIV +-- License : BSD-style +-- Maintainer : Olivier Chéron +-- Stability : experimental +-- Portability : unknown +-- +-- Implementation of AES-GCM-SIV, an AEAD scheme with nonce misuse resistance +-- defined in . +-- +-- To achieve the nonce misuse-resistance property, encryption requires two +-- passes on the plaintext, hence no streaming API is provided. This AEAD +-- operates on complete inputs held in memory. For simplicity, the +-- implementation of decryption uses a similar pattern, with performance +-- penalty compared to an implementation which is able to merge both passes. +-- +-- The specification allows inputs up to 2^36 bytes but this implementation +-- requires AAD and plaintext/ciphertext to be both smaller than 2^32 bytes. +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Crypto.Cipher.AESGCMSIV + ( Nonce + , nonce + , encrypt + , decrypt + ) where + +import Data.Bits +import Data.Word + +import Foreign.C.Types +import Foreign.C.String +import Foreign.Ptr (Ptr, plusPtr) +import Foreign.Storable (peekElemOff, poke, pokeElemOff) + +import Data.ByteArray +import qualified Data.ByteArray as B +import Data.Memory.Endian (toLE) +import Data.Memory.PtrMethods (memXor) + +import Crypto.Cipher.AES.Primitive +import Crypto.Cipher.Types +import Crypto.Error +import Crypto.Internal.Compat (unsafeDoIO) + + +-- 12-byte nonces + +-- | Nonce value for AES-GCM-SIV, always 12 bytes. +newtype Nonce = Nonce Bytes deriving (Show, Eq, ByteArrayAccess) + +-- | Nonce smart constructor. Accepts only 12-byte inputs. +nonce :: ByteArrayAccess iv => iv -> CryptoFailable Nonce +nonce iv + | B.length iv == 12 = CryptoPassed (Nonce $ B.convert iv) + | otherwise = CryptoFailed CryptoError_IvSizeInvalid + + +-- POLYVAL (mutable context) + +newtype Polyval = Polyval Bytes + +polyvalInit :: ScrubbedBytes -> IO Polyval +polyvalInit h = Polyval <$> doInit + where doInit = B.alloc 272 $ \pctx -> B.withByteArray h $ \ph -> + c_aes_polyval_init pctx ph + +polyvalUpdate :: ByteArrayAccess ba => Polyval -> ba -> IO () +polyvalUpdate (Polyval ctx) bs = B.withByteArray ctx $ \pctx -> + B.withByteArray bs $ \pbs -> c_aes_polyval_update pctx pbs sz + where sz = fromIntegral (B.length bs) + +polyvalFinalize :: Polyval -> IO ScrubbedBytes +polyvalFinalize (Polyval ctx) = B.alloc 16 $ \dst -> + B.withByteArray ctx $ \pctx -> c_aes_polyval_finalize pctx dst + +foreign import ccall unsafe "cryptonite_aes.h cryptonite_aes_polyval_init" + c_aes_polyval_init :: Ptr Polyval -> CString -> IO () + +foreign import ccall "cryptonite_aes.h cryptonite_aes_polyval_update" + c_aes_polyval_update :: Ptr Polyval -> CString -> CUInt -> IO () + +foreign import ccall unsafe "cryptonite_aes.h cryptonite_aes_polyval_finalize" + c_aes_polyval_finalize :: Ptr Polyval -> CString -> IO () + + +-- Key Generation + +le32iv :: Word32 -> Nonce -> Bytes +le32iv n (Nonce iv) = B.allocAndFreeze 16 $ \ptr -> do + poke ptr (toLE n) + copyByteArrayToPtr iv (ptr `plusPtr` 4) + +deriveKeys :: BlockCipher128 aes => aes -> Nonce -> (ScrubbedBytes, AES) +deriveKeys aes iv = + case cipherKeySize aes of + KeySizeFixed sz | sz `mod` 8 == 0 -> + let mak = buildKey [0 .. 1] + key = buildKey [2 .. fromIntegral (sz `div` 8) + 1] + mek = throwCryptoError (cipherInit key) + in (mak, mek) + _ -> error "AESGCMSIV: invalid cipher" + where + idx n = ecbEncrypt aes (le32iv n iv) `takeView` 8 + buildKey = B.concat . map idx + + +-- Encryption and decryption + +lengthInvalid :: ByteArrayAccess ba => ba -> Bool +lengthInvalid bs + | finiteBitSize len > 32 = len >= 1 `unsafeShiftL` 32 + | otherwise = False + where len = B.length bs + +-- | AEAD encryption with the specified key and nonce. The key must be given +-- as an initialized 'Crypto.Cipher.AES.AES128' or 'Crypto.Cipher.AES.AES256' +-- cipher. +-- +-- Lengths of additional data and plaintext must be less than 2^32 bytes, +-- otherwise an exception is thrown. +encrypt :: (BlockCipher128 aes, ByteArrayAccess aad, ByteArray ba) + => aes -> Nonce -> aad -> ba -> (AuthTag, ba) +encrypt aes iv aad plaintext + | lengthInvalid aad = error "AESGCMSIV: aad is too large" + | lengthInvalid plaintext = error "AESGCMSIV: plaintext is too large" + | otherwise = (AuthTag tag, ciphertext) + where + (mak, mek) = deriveKeys aes iv + ss = getSs mak aad plaintext + tag = buildTag mek ss iv + ciphertext = combineC32 mek (transformTag tag) plaintext + +-- | AEAD decryption with the specified key and nonce. The key must be given +-- as an initialized 'Crypto.Cipher.AES.AES128' or 'Crypto.Cipher.AES.AES256' +-- cipher. +-- +-- Lengths of additional data and ciphertext must be less than 2^32 bytes, +-- otherwise an exception is thrown. +decrypt :: (BlockCipher128 aes, ByteArrayAccess aad, ByteArray ba) + => aes -> Nonce -> aad -> ba -> AuthTag -> Maybe ba +decrypt aes iv aad ciphertext (AuthTag tag) + | lengthInvalid aad = error "AESGCMSIV: aad is too large" + | lengthInvalid ciphertext = error "AESGCMSIV: ciphertext is too large" + | tag `constEq` buildTag mek ss iv = Just plaintext + | otherwise = Nothing + where + (mak, mek) = deriveKeys aes iv + ss = getSs mak aad plaintext + plaintext = combineC32 mek (transformTag tag) ciphertext + +-- Calculate S_s = POLYVAL(mak, X_1, X_2, ...). +getSs :: (ByteArrayAccess aad, ByteArrayAccess ba) + => ScrubbedBytes -> aad -> ba -> ScrubbedBytes +getSs mak aad plaintext = unsafeDoIO $ do + ctx <- polyvalInit mak + polyvalUpdate ctx aad + polyvalUpdate ctx plaintext + polyvalUpdate ctx (lb :: Bytes) -- the "length block" + polyvalFinalize ctx + where + lb = B.allocAndFreeze 16 $ \ptr -> do + pokeElemOff ptr 0 (toLE64 $ B.length aad) + pokeElemOff ptr 1 (toLE64 $ B.length plaintext) + toLE64 x = toLE (fromIntegral x * 8 :: Word64) + +-- XOR the first 12 bytes of S_s with the nonce and clear the most significant +-- bit of the last byte. +tagInput :: ScrubbedBytes -> Nonce -> Bytes +tagInput ss (Nonce iv) = + B.copyAndFreeze ss $ \ptr -> + B.withByteArray iv $ \ivPtr -> do + memXor ptr ptr ivPtr 12 + b <- peekElemOff ptr 15 + pokeElemOff ptr 15 (b .&. (0x7f :: Word8)) + +-- Encrypt the result with AES using the message-encryption key to produce the +-- tag. +buildTag :: BlockCipher128 aes => aes -> ScrubbedBytes -> Nonce -> Bytes +buildTag mek ss iv = ecbEncrypt mek (tagInput ss iv) + +-- The initial counter block is the tag with the most significant bit of the +-- last byte set to one. +transformTag :: Bytes -> IV AES +transformTag tag = toIV $ B.copyAndFreeze tag $ \ptr -> + peekElemOff ptr 15 >>= pokeElemOff ptr 15 . (.|. (0x80 :: Word8)) + where toIV bs = let Just iv = makeIV (bs :: Bytes) in iv diff --git a/cbits/aes/block128.h b/cbits/aes/block128.h index 12d842f..f09fcf2 100644 --- a/cbits/aes/block128.h +++ b/cbits/aes/block128.h @@ -108,6 +108,13 @@ static inline void block128_vxor(block128 *d, const block128 *s1, const block128 } } +static inline void block128_byte_reverse(block128 *a) +{ + uint64_t s0 = a->q[0], s1 = a->q[1]; + a->q[0] = bitfn_swap64(s1); + a->q[1] = bitfn_swap64(s0); +} + static inline void block128_inc_be(block128 *b) { uint64_t v = be64_to_cpu(b->q[1]); diff --git a/cbits/cryptonite_aes.c b/cbits/cryptonite_aes.c index e70aa07..ab88fd8 100644 --- a/cbits/cryptonite_aes.c +++ b/cbits/cryptonite_aes.c @@ -1055,3 +1055,55 @@ void cryptonite_aes_generic_ocb_decrypt(uint8_t *output, aes_ocb *ocb, aes_key * { ocb_generic_crypt(output, ocb, key, input, length, 0); } + +static inline void gf_mulx_rev(block128 *a, const block128 *h) +{ + uint64_t v1 = cpu_to_le64(h->q[0]); + uint64_t v0 = cpu_to_le64(h->q[1]); + a->q[1] = cpu_to_be64(v1 >> 1 | v0 << 63); + a->q[0] = cpu_to_be64(v0 >> 1 ^ ((0-(v1 & 1)) & 0xe100000000000000ULL)); +} + +void cryptonite_aes_polyval_init(aes_polyval *ctx, const aes_block *h) +{ + aes_block r; + + /* ByteReverse(S_0) = 0 */ + block128_zero(&ctx->s); + + /* ByteReverse(H) * x */ + gf_mulx_rev(&r, h); + cryptonite_hinit(ctx->htable, &r); +} + +void cryptonite_aes_polyval_update(aes_polyval *ctx, const uint8_t *input, uint32_t length) +{ + aes_block r; + const uint8_t *p; + uint32_t sz; + + /* This automatically pads with zeros if input is not a multiple of the + block size. */ + for (p = input; length > 0; p += 16, length -= sz) + { + sz = length < 16 ? length : 16; + + /* ByteReverse(X_j) */ + block128_zero(&r); + memcpy(&r, p, sz); + block128_byte_reverse(&r); + + /* ByteReverse(S_{j-1}) + ByteReverse(X_j) */ + block128_xor_aligned(&ctx->s, &r); + + /* ByteReverse(S_j) */ + cryptonite_gf_mul(&ctx->s, ctx->htable); + } +} + +void cryptonite_aes_polyval_finalize(aes_polyval *ctx, aes_block *dst) +{ + /* S_s */ + block128_copy_aligned(dst, &ctx->s); + block128_byte_reverse(dst); +} diff --git a/cbits/cryptonite_aes.h b/cbits/cryptonite_aes.h index 509ff16..feff121 100644 --- a/cbits/cryptonite_aes.h +++ b/cbits/cryptonite_aes.h @@ -77,6 +77,12 @@ typedef struct { block128 li[4]; } aes_ocb; +/* size = 17*16= 272 */ +typedef struct { + aes_block htable[16]; + aes_block s; +} aes_polyval; + /* in bytes: either 16,24,32 */ void cryptonite_aes_initkey(aes_key *ctx, uint8_t *key, uint8_t size); @@ -117,4 +123,8 @@ void cryptonite_aes_ccm_finish(uint8_t *tag, aes_ccm *ccm, aes_key *key); uint8_t *cryptonite_aes_cpu_init(void); +void cryptonite_aes_polyval_init(aes_polyval *ctx, const aes_block *h); +void cryptonite_aes_polyval_update(aes_polyval *ctx, const uint8_t *input, uint32_t length); +void cryptonite_aes_polyval_finalize(aes_polyval *ctx, aes_block *dst); + #endif diff --git a/cryptonite.cabal b/cryptonite.cabal index f1475e2..416c847 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -104,6 +104,7 @@ Flag check_alignment Library Exposed-modules: Crypto.Cipher.AES + Crypto.Cipher.AESGCMSIV Crypto.Cipher.Blowfish Crypto.Cipher.CAST5 Crypto.Cipher.Camellia From 73719cbe8806c7179fbd4e9a6b4e7be62813cf94 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 25 Aug 2019 08:55:54 +0200 Subject: [PATCH 100/176] Add AES-GCM-SIV to AEAD benchmarks --- benchs/Bench.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/benchs/Bench.hs b/benchs/Bench.hs index b6d034e..bc1d668 100644 --- a/benchs/Bench.hs +++ b/benchs/Bench.hs @@ -6,6 +6,7 @@ module Main where import Gauge.Main import Crypto.Cipher.AES +import qualified Crypto.Cipher.AESGCMSIV as AESGCMSIV import Crypto.Cipher.Blowfish import Crypto.Cipher.CAST5 import qualified Crypto.Cipher.ChaChaPoly1305 as CP @@ -167,6 +168,7 @@ benchAE = [ bench "ChaChaPoly1305" $ nf (cp key32) (input64, input1024) , bench "AES-GCM" $ nf (gcm key32) (input64, input1024) , bench "AES-CCM" $ nf (ccm key32) (input64, input1024) + , bench "AES-GCM-SIV" $ nf (gcmsiv key32) (input64, input1024) ] where cp k (ini, plain) = let iniState = throwCryptoError $ CP.initialize k (throwCryptoError $ CP.nonce12 nonce12) @@ -186,6 +188,11 @@ benchAE = state = throwCryptoError $ aeadInit mode ctx nonce12 in aeadSimpleEncrypt state ini plain 16 + gcmsiv k (ini, plain) = + let ctx = throwCryptoError (cipherInit k) :: AES256 + iv = throwCryptoError (AESGCMSIV.nonce nonce12) + in AESGCMSIV.encrypt ctx iv ini plain + input64 = B.replicate 64 0 input1024 = B.replicate 1024 0 From 29f0fd1b7ab062956c5c36d369a4a55346c69049 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 25 Aug 2019 08:55:55 +0200 Subject: [PATCH 101/176] Test AES-GCM-SIV Includes the test vectors from RFC 8452 and QuickCheck properties with encryption-decryption round trip. --- cryptonite.cabal | 1 + tests/KAT_AESGCMSIV.hs | 494 +++++++++++++++++++++++++++++++++++++++++ tests/Tests.hs | 2 + 3 files changed, 497 insertions(+) create mode 100644 tests/KAT_AESGCMSIV.hs diff --git a/cryptonite.cabal b/cryptonite.cabal index 416c847..f7372c9 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -396,6 +396,7 @@ Test-Suite test-cryptonite KAT_AES.KATOCB3 KAT_AES.KATXTS KAT_AES + KAT_AESGCMSIV KAT_AFIS KAT_Argon2 KAT_Blowfish diff --git a/tests/KAT_AESGCMSIV.hs b/tests/KAT_AESGCMSIV.hs new file mode 100644 index 0000000..8bd88e4 --- /dev/null +++ b/tests/KAT_AESGCMSIV.hs @@ -0,0 +1,494 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE RecordWildCards #-} +module KAT_AESGCMSIV (tests) where + +import Imports + +import Data.Proxy +import qualified Data.ByteArray as B + +import Crypto.Cipher.AES +import Crypto.Cipher.AESGCMSIV +import Crypto.Cipher.Types +import Crypto.Error + +data Vector c = Vector + { vecPlaintext :: ByteString + , vecAAD :: ByteString + , vecKey :: ByteString + , vecNonce :: ByteString + , vecTag :: ByteString + , vecCiphertext :: ByteString + } + +vecCipher :: Cipher c => Vector c -> c +vecCipher = throwCryptoError . cipherInit . vecKey + +vectors128 :: [Vector AES128] +vectors128 = + [ Vector + { vecPlaintext = "" + , vecAAD = "" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\xdc\x20\xe2\xd8\x3f\x25\x70\x5b\xb4\x9e\x43\x9e\xca\x56\xde\x25" + , vecCiphertext = "" + } + , Vector + { vecPlaintext = "\x01\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\x57\x87\x82\xff\xf6\x01\x3b\x81\x5b\x28\x7c\x22\x49\x3a\x36\x4c" + , vecCiphertext = "\xb5\xd8\x39\x33\x0a\xc7\xb7\x86" + } + , Vector + { vecPlaintext = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\xa4\x97\x8d\xb3\x57\x39\x1a\x0b\xc4\xfd\xec\x8b\x0d\x10\x66\x39" + , vecCiphertext = "\x73\x23\xea\x61\xd0\x59\x32\x26\x00\x47\xd9\x42" + } + , Vector + { vecPlaintext = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\x30\x3a\xaf\x90\xf6\xfe\x21\x19\x9c\x60\x68\x57\x74\x37\xa0\xc4" + , vecCiphertext = "\x74\x3f\x7c\x80\x77\xab\x25\xf8\x62\x4e\x2e\x94\x85\x79\xcf\x77" + } + , Vector + { vecPlaintext = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\x1a\x8e\x45\xdc\xd4\x57\x8c\x66\x7c\xd8\x68\x47\xbf\x61\x55\xff" + , vecCiphertext = "\x84\xe0\x7e\x62\xba\x83\xa6\x58\x54\x17\x24\x5d\x7e\xc4\x13\xa9\xfe\x42\x7d\x63\x15\xc0\x9b\x57\xce\x45\xf2\xe3\x93\x6a\x94\x45" + } + , Vector + { vecPlaintext = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\x5e\x6e\x31\x1d\xbf\x39\x5d\x35\xb0\xfe\x39\xc2\x71\x43\x88\xf8" + , vecCiphertext = "\x3f\xd2\x4c\xe1\xf5\xa6\x7b\x75\xbf\x23\x51\xf1\x81\xa4\x75\xc7\xb8\x00\xa5\xb4\xd3\xdc\xf7\x01\x06\xb1\xee\xa8\x2f\xa1\xd6\x4d\xf4\x2b\xf7\x22\x61\x22\xfa\x92\xe1\x7a\x40\xee\xaa\xc1\x20\x1b" + } + , Vector + { vecPlaintext = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\x8a\x26\x3d\xd3\x17\xaa\x88\xd5\x6b\xdf\x39\x36\xdb\xa7\x5b\xb8" + , vecCiphertext = "\x24\x33\x66\x8f\x10\x58\x19\x0f\x6d\x43\xe3\x60\xf4\xf3\x5c\xd8\xe4\x75\x12\x7c\xfc\xa7\x02\x8e\xa8\xab\x5c\x20\xf7\xab\x2a\xf0\x25\x16\xa2\xbd\xcb\xc0\x8d\x52\x1b\xe3\x7f\xf2\x8c\x15\x2b\xba\x36\x69\x7f\x25\xb4\xcd\x16\x9c\x65\x90\xd1\xdd\x39\x56\x6d\x3f" + } + , Vector + { vecPlaintext = "\x02\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "\x01" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\x3b\x0a\x1a\x25\x60\x96\x9c\xdf\x79\x0d\x99\x75\x9a\xbd\x15\x08" + , vecCiphertext = "\x1e\x6d\xab\xa3\x56\x69\xf4\x27" + } + , Vector + { vecPlaintext = "\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "\x01" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\x08\x29\x9c\x51\x02\x74\x5a\xaa\x3a\x0c\x46\x9f\xad\x9e\x07\x5a" + , vecCiphertext = "\x29\x6c\x78\x89\xfd\x99\xf4\x19\x17\xf4\x46\x20" + } + , Vector + { vecPlaintext = "\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "\x01" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\x8f\x89\x36\xec\x03\x9e\x4e\x4b\xb9\x7e\xbd\x8c\x44\x57\x44\x1f" + , vecCiphertext = "\xe2\xb0\xc5\xda\x79\xa9\x01\xc1\x74\x5f\x70\x05\x25\xcb\x33\x5b" + } + , Vector + { vecPlaintext = "\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "\x01" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\xe6\xaf\x6a\x7f\x87\x28\x7d\xa0\x59\xa7\x16\x84\xed\x34\x98\xe1" + , vecCiphertext = "\x62\x00\x48\xef\x3c\x1e\x73\xe5\x7e\x02\xbb\x85\x62\xc4\x16\xa3\x19\xe7\x3e\x4c\xaa\xc8\xe9\x6a\x1e\xcb\x29\x33\x14\x5a\x1d\x71" + } + , Vector + { vecPlaintext = "\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "\x01" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\x6a\x8c\xc3\x86\x5f\x76\x89\x7c\x2e\x4b\x24\x5c\xf3\x1c\x51\xf2" + , vecCiphertext = "\x50\xc8\x30\x3e\xa9\x39\x25\xd6\x40\x90\xd0\x7b\xd1\x09\xdf\xd9\x51\x5a\x5a\x33\x43\x10\x19\xc1\x7d\x93\x46\x59\x99\xa8\xb0\x05\x32\x01\xd7\x23\x12\x0a\x85\x62\xb8\x38\xcd\xff\x25\xbf\x9d\x1e" + } + , Vector + { vecPlaintext = "\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "\x01" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\xcd\xc4\x6a\xe4\x75\x56\x3d\xe0\x37\x00\x1e\xf8\x4a\xe2\x17\x44" + , vecCiphertext = "\x2f\x5c\x64\x05\x9d\xb5\x5e\xe0\xfb\x84\x7e\xd5\x13\x00\x37\x46\xac\xa4\xe6\x1c\x71\x1b\x5d\xe2\xe7\xa7\x7f\xfd\x02\xda\x42\xfe\xec\x60\x19\x10\xd3\x46\x7b\xb8\xb3\x6e\xbb\xae\xbc\xe5\xfb\xa3\x0d\x36\xc9\x5f\x48\xa3\xe7\x98\x0f\x0e\x7a\xc2\x99\x33\x2a\x80" + } + , Vector + { vecPlaintext = "\x02\x00\x00\x00" + , vecAAD = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\x07\xeb\x1f\x84\xfb\x28\xf8\xcb\x73\xde\x8e\x99\xe2\xf4\x8a\x14" + , vecCiphertext = "\xa8\xfe\x3e\x87" + } + , Vector + { vecPlaintext = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00" + , vecAAD = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\x24\xaf\xc9\x80\x5e\x97\x6f\x45\x1e\x6d\x87\xf6\xfe\x10\x65\x14" + , vecCiphertext = "\x6b\xb0\xfe\xcf\x5d\xed\x9b\x77\xf9\x02\xc7\xd5\xda\x23\x6a\x43\x91\xdd\x02\x97" + } + , Vector + { vecPlaintext = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00" + , vecAAD = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\xbf\xf9\xb2\xef\x00\xfb\x47\x92\x0c\xc7\x2a\x0c\x0f\x13\xb9\xfd" + , vecCiphertext = "\x44\xd0\xaa\xf6\xfb\x2f\x1f\x34\xad\xd5\xe8\x06\x4e\x83\xe1\x2a\x2a\xda" + } + , Vector + { vecPlaintext = "" + , vecAAD = "" + , vecKey = "\xe6\x60\x21\xd5\xeb\x8e\x4f\x40\x66\xd4\xad\xb9\xc3\x35\x60\xe4" + , vecNonce = "\xf4\x6e\x44\xbb\x3d\xa0\x01\x5c\x94\xf7\x08\x87" + , vecTag = "\xa4\x19\x4b\x79\x07\x1b\x01\xa8\x7d\x65\xf7\x06\xe3\x94\x95\x78" + , vecCiphertext = "" + } + , Vector + { vecPlaintext = "\x7a\x80\x6c" + , vecAAD = "\x46\xbb\x91\xc3\xc5" + , vecKey = "\x36\x86\x42\x00\xe0\xea\xf5\x28\x4d\x88\x4a\x0e\x77\xd3\x16\x46" + , vecNonce = "\xba\xe8\xe3\x7f\xc8\x34\x41\xb1\x60\x34\x56\x6b" + , vecTag = "\x71\x1b\xd8\x5b\xc1\xe4\xd3\xe0\xa4\x62\xe0\x74\xee\xa4\x28\xa8" + , vecCiphertext = "\xaf\x60\xeb" + } + , Vector + { vecPlaintext = "\xbd\xc6\x6f\x14\x65\x45" + , vecAAD = "\xfc\x88\x0c\x94\xa9\x51\x98\x87\x42\x96" + , vecKey = "\xae\xdb\x64\xa6\xc5\x90\xbc\x84\xd1\xa5\xe2\x69\xe4\xb4\x78\x01" + , vecNonce = "\xaf\xc0\x57\x7e\x34\x69\x9b\x9e\x67\x1f\xdd\x4f" + , vecTag = "\xd6\xa9\xc4\x55\x45\xcf\xc1\x1f\x03\xad\x74\x3d\xba\x20\xf9\x66" + , vecCiphertext = "\xbb\x93\xa3\xe3\x4d\x3c" + } + , Vector + { vecPlaintext = "\x11\x77\x44\x1f\x19\x54\x95\x86\x0f" + , vecAAD = "\x04\x67\x87\xf3\xea\x22\xc1\x27\xaa\xf1\x95\xd1\x89\x47\x28" + , vecKey = "\xd5\xcc\x1f\xd1\x61\x32\x0b\x69\x20\xce\x07\x78\x7f\x86\x74\x3b" + , vecNonce = "\x27\x5d\x1a\xb3\x2f\x6d\x1f\x04\x34\xd8\x84\x8c" + , vecTag = "\x1d\x02\xfd\x0c\xd1\x74\xc8\x4f\xc5\xda\xe2\xf6\x0f\x52\xfd\x2b" + , vecCiphertext = "\x4f\x37\x28\x1f\x7a\xd1\x29\x49\xd0" + } + , Vector + { vecPlaintext = "\x9f\x57\x2c\x61\x4b\x47\x45\x91\x44\x74\xe7\xc7" + , vecAAD = "\xc9\x88\x2e\x53\x86\xfd\x9f\x92\xec\x48\x9c\x8f\xde\x2b\xe2\xcf\x97\xe7\x4e\x93" + , vecKey = "\xb3\xfe\xd1\x47\x3c\x52\x8b\x84\x26\xa5\x82\x99\x59\x29\xa1\x49" + , vecNonce = "\x9e\x9a\xd8\x78\x0c\x8d\x63\xd0\xab\x41\x49\xc0" + , vecTag = "\xc1\xdc\x2f\x87\x1f\xb7\x56\x1d\xa1\x28\x6e\x65\x5e\x24\xb7\xb0" + , vecCiphertext = "\xf5\x46\x73\xc5\xdd\xf7\x10\xc7\x45\x64\x1c\x8b" + } + , Vector + { vecPlaintext = "\x0d\x8c\x84\x51\x17\x80\x82\x35\x5c\x9e\x94\x0f\xea\x2f\x58" + , vecAAD = "\x29\x50\xa7\x0d\x5a\x1d\xb2\x31\x6f\xd5\x68\x37\x8d\xa1\x07\xb5\x2b\x0d\xa5\x52\x10\xcc\x1c\x1b\x0a" + , vecKey = "\x2d\x4e\xd8\x7d\xa4\x41\x02\x95\x2e\xf9\x4b\x02\xb8\x05\x24\x9b" + , vecNonce = "\xac\x80\xe6\xf6\x14\x55\xbf\xac\x83\x08\xa2\xd4" + , vecTag = "\x83\xb3\x44\x9b\x9f\x39\x55\x2d\xe9\x9d\xc2\x14\xa1\x19\x0b\x0b" + , vecCiphertext = "\xc9\xff\x54\x5e\x07\xb8\x8a\x01\x5f\x05\xb2\x74\x54\x0a\xa1" + } + , Vector + { vecPlaintext = "\x6b\x3d\xb4\xda\x3d\x57\xaa\x94\x84\x2b\x98\x03\xa9\x6e\x07\xfb\x6d\xe7" + , vecAAD = "\x18\x60\xf7\x62\xeb\xfb\xd0\x82\x84\xe4\x21\x70\x2d\xe0\xde\x18\xba\xa9\xc9\x59\x62\x91\xb0\x84\x66\xf3\x7d\xe2\x1c\x7f" + , vecKey = "\xbd\xe3\xb2\xf2\x04\xd1\xe9\xf8\xb0\x6b\xc4\x7f\x97\x45\xb3\xd1" + , vecNonce = "\xae\x06\x55\x6f\xb6\xaa\x78\x90\xbe\xbc\x18\xfe" + , vecTag = "\x3e\x37\x70\x94\xf0\x47\x09\xf6\x4d\x7b\x98\x53\x10\xa4\xdb\x84" + , vecCiphertext = "\x62\x98\xb2\x96\xe2\x4e\x8c\xc3\x5d\xce\x0b\xed\x48\x4b\x7f\x30\xd5\x80" + } + , Vector + { vecPlaintext = "\xe4\x2a\x3c\x02\xc2\x5b\x64\x86\x9e\x14\x6d\x7b\x23\x39\x87\xbd\xdf\xc2\x40\x87\x1d" + , vecAAD = "\x75\x76\xf7\x02\x8e\xc6\xeb\x5e\xa7\xe2\x98\x34\x2a\x94\xd4\xb2\x02\xb3\x70\xef\x97\x68\xec\x65\x61\xc4\xfe\x6b\x7e\x72\x96\xfa\x85\x9c\x21" + , vecKey = "\xf9\x01\xcf\xe8\xa6\x96\x15\xa9\x3f\xdf\x7a\x98\xca\xd4\x81\x79" + , vecNonce = "\x62\x45\x70\x9f\xb1\x88\x53\xf6\x8d\x83\x36\x40" + , vecTag = "\x2d\x15\x50\x6c\x84\xa9\xed\xd6\x5e\x13\xe9\xd2\x4a\x2a\x6e\x70" + , vecCiphertext = "\x39\x1c\xc3\x28\xd4\x84\xa4\xf4\x64\x06\x18\x1b\xcd\x62\xef\xd9\xb3\xee\x19\x7d\x05" + } + ] + +vectors256 :: [Vector AES256] +vectors256 = + [ Vector + { vecPlaintext = "" + , vecAAD = "" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\x07\xf5\xf4\x16\x9b\xbf\x55\xa8\x40\x0c\xd4\x7e\xa6\xfd\x40\x0f" + , vecCiphertext = "" + } + , Vector + { vecPlaintext = "\x01\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\x84\x31\x22\x13\x0f\x73\x64\xb7\x61\xe0\xb9\x74\x27\xe3\xdf\x28" + , vecCiphertext = "\xc2\xef\x32\x8e\x5c\x71\xc8\x3b" + } + , Vector + { vecPlaintext = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\x8c\xa5\x0d\xa9\xae\x65\x59\xe4\x8f\xd1\x0f\x6e\x5c\x9c\xa1\x7e" + , vecCiphertext = "\x9a\xab\x2a\xeb\x3f\xaa\x0a\x34\xae\xa8\xe2\xb1" + } + , Vector + { vecPlaintext = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\xc9\xea\xc6\xfa\x70\x09\x42\x70\x2e\x90\x86\x23\x83\xc6\xc3\x66" + , vecCiphertext = "\x85\xa0\x1b\x63\x02\x5b\xa1\x9b\x7f\xd3\xdd\xfc\x03\x3b\x3e\x76" + } + , Vector + { vecPlaintext = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\xe8\x19\xe6\x3a\xbc\xd0\x20\xb0\x06\xa9\x76\x39\x76\x32\xeb\x5d" + , vecCiphertext = "\x4a\x6a\x9d\xb4\xc8\xc6\x54\x92\x01\xb9\xed\xb5\x30\x06\xcb\xa8\x21\xec\x9c\xf8\x50\x94\x8a\x7c\x86\xc6\x8a\xc7\x53\x9d\x02\x7f" + } + , Vector + { vecPlaintext = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\x79\x0b\xc9\x68\x80\xa9\x9b\xa8\x04\xbd\x12\xc0\xe6\xa2\x2c\xc4" + , vecCiphertext = "\xc0\x0d\x12\x18\x93\xa9\xfa\x60\x3f\x48\xcc\xc1\xca\x3c\x57\xce\x74\x99\x24\x5e\xa0\x04\x6d\xb1\x6c\x53\xc7\xc6\x6f\xe7\x17\xe3\x9c\xf6\xc7\x48\x83\x7b\x61\xf6\xee\x3a\xdc\xee\x17\x53\x4e\xd5" + } + , Vector + { vecPlaintext = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\x11\x28\x64\xc2\x69\xfc\x0d\x9d\x88\xc6\x1f\xa4\x7e\x39\xaa\x08" + , vecCiphertext = "\xc2\xd5\x16\x0a\x1f\x86\x83\x83\x49\x10\xac\xda\xfc\x41\xfb\xb1\x63\x2d\x4a\x35\x3e\x8b\x90\x5e\xc9\xa5\x49\x9a\xc3\x4f\x96\xc7\xe1\x04\x9e\xb0\x80\x88\x38\x91\xa4\xdb\x8c\xaa\xa1\xf9\x9d\xd0\x04\xd8\x04\x87\x54\x07\x35\x23\x4e\x37\x44\x51\x2c\x6f\x90\xce" + } + , Vector + { vecPlaintext = "\x02\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "\x01" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\x91\x21\x3f\x26\x7e\x3b\x45\x2f\x02\xd0\x1a\xe3\x3e\x4e\xc8\x54" + , vecCiphertext = "\x1d\xe2\x29\x67\x23\x7a\x81\x32" + } + , Vector + { vecPlaintext = "\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "\x01" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\xc1\xa4\xa1\x9a\xe8\x00\x94\x1c\xcd\xc5\x7c\xc8\x41\x3c\x27\x7f" + , vecCiphertext = "\x16\x3d\x6f\x9c\xc1\xb3\x46\xcd\x45\x3a\x2e\x4c" + } + , Vector + { vecPlaintext = "\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "\x01" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\xb2\x92\xd2\x8f\xf6\x11\x89\xe8\xe4\x9f\x38\x75\xef\x91\xaf\xf7" + , vecCiphertext = "\xc9\x15\x45\x82\x3c\xc2\x4f\x17\xdb\xb0\xe9\xe8\x07\xd5\xec\x17" + } + , Vector + { vecPlaintext = "\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "\x01" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\xae\xa1\xba\xd1\x27\x02\xe1\x96\x56\x04\x37\x4a\xab\x96\xdb\xbc" + , vecCiphertext = "\x07\xda\xd3\x64\xbf\xc2\xb9\xda\x89\x11\x6d\x7b\xef\x6d\xaa\xaf\x6f\x25\x55\x10\xaa\x65\x4f\x92\x0a\xc8\x1b\x94\xe8\xba\xd3\x65" + } + , Vector + { vecPlaintext = "\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "\x01" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\x03\x33\x27\x42\xb2\x28\xc6\x47\x17\x36\x16\xcf\xd4\x4c\x54\xeb" + , vecCiphertext = "\xc6\x7a\x1f\x0f\x56\x7a\x51\x98\xaa\x1f\xcc\x8e\x3f\x21\x31\x43\x36\xf7\xf5\x1c\xa8\xb1\xaf\x61\xfe\xac\x35\xa8\x64\x16\xfa\x47\xfb\xca\x3b\x5f\x74\x9c\xdf\x56\x45\x27\xf2\x31\x4f\x42\xfe\x25" + } + , Vector + { vecPlaintext = "\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "\x01" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\x5b\xde\x02\x85\x03\x7c\x5d\xe8\x1e\x5b\x57\x0a\x04\x9b\x62\xa0" + , vecCiphertext = "\x67\xfd\x45\xe1\x26\xbf\xb9\xa7\x99\x30\xc4\x3a\xad\x2d\x36\x96\x7d\x3f\x0e\x4d\x21\x7c\x1e\x55\x1f\x59\x72\x78\x70\xbe\xef\xc9\x8c\xb9\x33\xa8\xfc\xe9\xde\x88\x7b\x1e\x40\x79\x99\x88\xdb\x1f\xc3\xf9\x18\x80\xed\x40\x5b\x2d\xd2\x98\x31\x88\x58\x46\x7c\x89" + } + , Vector + { vecPlaintext = "\x02\x00\x00\x00" + , vecAAD = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\x18\x35\xe5\x17\x74\x1d\xfd\xdc\xcf\xa0\x7f\xa4\x66\x1b\x74\xcf" + , vecCiphertext = "\x22\xb3\xf4\xcd" + } + , Vector + { vecPlaintext = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00" + , vecAAD = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\xb8\x79\xad\x97\x6d\x82\x42\xac\xc1\x88\xab\x59\xca\xbf\xe3\x07" + , vecCiphertext = "\x43\xdd\x01\x63\xcd\xb4\x8f\x9f\xe3\x21\x2b\xf6\x1b\x20\x19\x76\x06\x7f\x34\x2b" + } + , Vector + { vecPlaintext = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00" + , vecAAD = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00" + , vecKey = "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\xcf\xcd\xf5\x04\x21\x12\xaa\x29\x68\x5c\x91\x2f\xc2\x05\x65\x43" + , vecCiphertext = "\x46\x24\x01\x72\x4b\x5c\xe6\x58\x8d\x5a\x54\xaa\xe5\x37\x55\x13\xa0\x75" + } + , Vector + { vecPlaintext = "" + , vecAAD = "" + , vecKey = "\xe6\x60\x21\xd5\xeb\x8e\x4f\x40\x66\xd4\xad\xb9\xc3\x35\x60\xe4\xf4\x6e\x44\xbb\x3d\xa0\x01\x5c\x94\xf7\x08\x87\x36\x86\x42\x00" + , vecNonce = "\xe0\xea\xf5\x28\x4d\x88\x4a\x0e\x77\xd3\x16\x46" + , vecTag = "\x16\x9f\xbb\x2f\xbf\x38\x9a\x99\x5f\x63\x90\xaf\x22\x22\x8a\x62" + , vecCiphertext = "" + } + , Vector + { vecPlaintext = "\x67\x1f\xdd" + , vecAAD = "\x4f\xbd\xc6\x6f\x14" + , vecKey = "\xba\xe8\xe3\x7f\xc8\x34\x41\xb1\x60\x34\x56\x6b\x7a\x80\x6c\x46\xbb\x91\xc3\xc5\xae\xdb\x64\xa6\xc5\x90\xbc\x84\xd1\xa5\xe2\x69" + , vecNonce = "\xe4\xb4\x78\x01\xaf\xc0\x57\x7e\x34\x69\x9b\x9e" + , vecTag = "\x93\xda\x9b\xb8\x13\x33\xae\xe0\xc7\x85\xb2\x40\xd3\x19\x71\x9d" + , vecCiphertext = "\x0e\xac\xcb" + } + , Vector + { vecPlaintext = "\x19\x54\x95\x86\x0f\x04" + , vecAAD = "\x67\x87\xf3\xea\x22\xc1\x27\xaa\xf1\x95" + , vecKey = "\x65\x45\xfc\x88\x0c\x94\xa9\x51\x98\x87\x42\x96\xd5\xcc\x1f\xd1\x61\x32\x0b\x69\x20\xce\x07\x78\x7f\x86\x74\x3b\x27\x5d\x1a\xb3" + , vecNonce = "\x2f\x6d\x1f\x04\x34\xd8\x84\x8c\x11\x77\x44\x1f" + , vecTag = "\x6b\x62\xb8\x4d\xc4\x0c\x84\x63\x6a\x5e\xc1\x20\x20\xec\x8c\x2c" + , vecCiphertext = "\xa2\x54\xda\xd4\xf3\xf9" + } + , Vector + { vecPlaintext = "\xc9\x88\x2e\x53\x86\xfd\x9f\x92\xec" + , vecAAD = "\x48\x9c\x8f\xde\x2b\xe2\xcf\x97\xe7\x4e\x93\x2d\x4e\xd8\x7d" + , vecKey = "\xd1\x89\x47\x28\xb3\xfe\xd1\x47\x3c\x52\x8b\x84\x26\xa5\x82\x99\x59\x29\xa1\x49\x9e\x9a\xd8\x78\x0c\x8d\x63\xd0\xab\x41\x49\xc0" + , vecNonce = "\x9f\x57\x2c\x61\x4b\x47\x45\x91\x44\x74\xe7\xc7" + , vecTag = "\xc0\xfd\x3d\xc6\x62\x8d\xfe\x55\xeb\xb0\xb9\xfb\x22\x95\xc8\xc2" + , vecCiphertext = "\x0d\xf9\xe3\x08\x67\x82\x44\xc4\x4b" + } + , Vector + { vecPlaintext = "\x1d\xb2\x31\x6f\xd5\x68\x37\x8d\xa1\x07\xb5\x2b" + , vecAAD = "\x0d\xa5\x52\x10\xcc\x1c\x1b\x0a\xbd\xe3\xb2\xf2\x04\xd1\xe9\xf8\xb0\x6b\xc4\x7f" + , vecKey = "\xa4\x41\x02\x95\x2e\xf9\x4b\x02\xb8\x05\x24\x9b\xac\x80\xe6\xf6\x14\x55\xbf\xac\x83\x08\xa2\xd4\x0d\x8c\x84\x51\x17\x80\x82\x35" + , vecNonce = "\x5c\x9e\x94\x0f\xea\x2f\x58\x29\x50\xa7\x0d\x5a" + , vecTag = "\x40\x40\x99\xc2\x58\x7f\x64\x97\x9f\x21\x82\x67\x06\xd4\x97\xd5" + , vecCiphertext = "\x8d\xbe\xb9\xf7\x25\x5b\xf5\x76\x9d\xd5\x66\x92" + } + , Vector + { vecPlaintext = "\x21\x70\x2d\xe0\xde\x18\xba\xa9\xc9\x59\x62\x91\xb0\x84\x66" + , vecAAD = "\xf3\x7d\xe2\x1c\x7f\xf9\x01\xcf\xe8\xa6\x96\x15\xa9\x3f\xdf\x7a\x98\xca\xd4\x81\x79\x62\x45\x70\x9f" + , vecKey = "\x97\x45\xb3\xd1\xae\x06\x55\x6f\xb6\xaa\x78\x90\xbe\xbc\x18\xfe\x6b\x3d\xb4\xda\x3d\x57\xaa\x94\x84\x2b\x98\x03\xa9\x6e\x07\xfb" + , vecNonce = "\x6d\xe7\x18\x60\xf7\x62\xeb\xfb\xd0\x82\x84\xe4" + , vecTag = "\xb3\x08\x0d\x28\xf6\xeb\xb5\xd3\x64\x8c\xe9\x7b\xd5\xba\x67\xfd" + , vecCiphertext = "\x79\x35\x76\xdf\xa5\xc0\xf8\x87\x29\xa7\xed\x3c\x2f\x1b\xff" + } + , Vector + { vecPlaintext = "\xb2\x02\xb3\x70\xef\x97\x68\xec\x65\x61\xc4\xfe\x6b\x7e\x72\x96\xfa\x85" + , vecAAD = "\x9c\x21\x59\x05\x8b\x1f\x0f\xe9\x14\x33\xa5\xbd\xc2\x0e\x21\x4e\xab\x7f\xec\xef\x44\x54\xa1\x0e\xf0\x65\x7d\xf2\x1a\xc7" + , vecKey = "\xb1\x88\x53\xf6\x8d\x83\x36\x40\xe4\x2a\x3c\x02\xc2\x5b\x64\x86\x9e\x14\x6d\x7b\x23\x39\x87\xbd\xdf\xc2\x40\x87\x1d\x75\x76\xf7" + , vecNonce = "\x02\x8e\xc6\xeb\x5e\xa7\xe2\x98\x34\x2a\x94\xd4" + , vecTag = "\x45\x4f\xc2\xa1\x54\xfe\xa9\x1f\x83\x63\xa3\x9f\xec\x7d\x0a\x49" + , vecCiphertext = "\x85\x7e\x16\xa6\x49\x15\xa7\x87\x63\x76\x87\xdb\x4a\x95\x19\x63\x5c\xdd" + } + , Vector + { vecPlaintext = "\xce\xd5\x32\xce\x41\x59\xb0\x35\x27\x7d\x4d\xfb\xb7\xdb\x62\x96\x8b\x13\xcd\x4e\xec" + , vecAAD = "\x73\x43\x20\xcc\xc9\xd9\xbb\xbb\x19\xcb\x81\xb2\xaf\x4e\xcb\xc3\xe7\x28\x34\x32\x1f\x7a\xa0\xf7\x0b\x72\x82\xb4\xf3\x3d\xf2\x3f\x16\x75\x41" + , vecKey = "\x3c\x53\x5d\xe1\x92\xea\xed\x38\x22\xa2\xfb\xbe\x2c\xa9\xdf\xc8\x82\x55\xe1\x4a\x66\x1b\x8a\xa8\x2c\xc5\x42\x36\x09\x3b\xbc\x23" + , vecNonce = "\x68\x80\x89\xe5\x55\x40\xdb\x18\x72\x50\x4e\x1c" + , vecTag = "\x9d\x6c\x70\x29\x67\x5b\x89\xea\xf4\xba\x1d\xed\x1a\x28\x65\x94" + , vecCiphertext = "\x62\x66\x60\xc2\x6e\xa6\x61\x2f\xb1\x7a\xd9\x1e\x8e\x76\x76\x39\xed\xd6\xc9\xfa\xee" + } + ] + +vectorsWrap256 :: [Vector AES256] +vectorsWrap256 = + [ Vector + { vecPlaintext = "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\xb9\x23\xdc\x79\x3e\xe6\x49\x7c\x76\xdc\xc0\x3a\x98\xe1\x08" + , vecAAD = "" + , vecKey = "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecCiphertext = "\xf3\xf8\x0f\x2c\xf0\xcb\x2d\xd9\xc5\x98\x4f\xcd\xa9\x08\x45\x6c\xc5\x37\x70\x3b\x5b\xa7\x03\x24\xa6\x79\x3a\x7b\xf2\x18\xd3\xea" + } + , Vector + { vecPlaintext = "\xeb\x36\x40\x27\x7c\x7f\xfd\x13\x03\xc7\xa5\x42\xd0\x2d\x3e\x4c\x00\x00\x00\x00\x00\x00\x00\x00" + , vecAAD = "" + , vecKey = "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecNonce = "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecTag = "\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + , vecCiphertext = "\x18\xce\x4f\x0b\x8c\xb4\xd0\xca\xc6\x5f\xea\x8f\x79\x25\x7b\x20\x88\x8e\x53\xe7\x22\x99\xe5\x6d" + } + ] + +makeEncryptionTest :: BlockCipher128 aes => Int -> Vector aes -> TestTree +makeEncryptionTest i vec@Vector{..} = + testCase (show i) $ + (t, vecCiphertext) @=? encrypt (vecCipher vec) n vecAAD vecPlaintext + where t = AuthTag (B.convert vecTag) + n = throwCryptoError (nonce vecNonce) + +makeDecryptionTest :: BlockCipher128 aes => Int -> Vector aes -> TestTree +makeDecryptionTest i vec@Vector{..} = + testCase (show i) $ + Just vecPlaintext @=? decrypt (vecCipher vec) n vecAAD vecCiphertext t + where t = AuthTag (B.convert vecTag) + n = throwCryptoError (nonce vecNonce) + +katTests :: TestName + -> (forall c . BlockCipher128 c => Int -> Vector c -> TestTree) + -> TestTree +katTests name makeTest = testGroup name + [ testGroup "AES128" $ zipWith makeTest [1..] vectors128 + , testGroup "AES256" $ zipWith makeTest [1..] vectors256 + , testGroup "CounterWrap" $ zipWith makeTest [1..] vectorsWrap256 + ] + +newtype Key c = Key ByteString + deriving (Show,Eq) + +instance Arbitrary (Key AES128) where + arbitrary = Key <$> arbitraryBS 16 + +instance Arbitrary (Key AES256) where + arbitrary = Key <$> arbitraryBS 32 + +instance Arbitrary Nonce where + arbitrary = throwCryptoError . nonce <$> arbitraryBS 12 + +encDecTest :: BlockCipher128 c + => Proxy c -> Key c -> Nonce + -> ArbitraryBS0_2901 -> ArbitraryBS0_2901 -> Property +encDecTest prx (Key key) iv (ArbitraryBS0_2901 aad) (ArbitraryBS0_2901 input) = + let c = throwCryptoError (cipherInit key) `asProxyTypeOf` prx + (tag, ciphertext) = encrypt c iv aad input + in decrypt c iv aad ciphertext tag === Just input + +tests :: TestTree +tests = testGroup "AES-GCM-SIV" + [ testGroup "KATs" + [ katTests "encrypt" makeEncryptionTest + , katTests "decrypt" makeDecryptionTest + ] + , testGroup "properties" + [ testProperty "AES128" $ encDecTest (Proxy :: Proxy AES128) + , testProperty "AES256" $ encDecTest (Proxy :: Proxy AES256) + ] + ] diff --git a/tests/Tests.hs b/tests/Tests.hs index 7f4f6ce..4e2a863 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -33,6 +33,7 @@ import qualified KAT_PubKey import qualified KAT_Scrypt -- symmetric cipher -------------------- import qualified KAT_AES +import qualified KAT_AESGCMSIV import qualified KAT_Blowfish import qualified KAT_CAST5 import qualified KAT_Camellia @@ -77,6 +78,7 @@ tests = testGroup "cryptonite" ] , testGroup "block-cipher" [ KAT_AES.tests + , KAT_AESGCMSIV.tests , KAT_Blowfish.tests , KAT_CAST5.tests , KAT_Camellia.tests From 3ae08ed509dbf1af80798447863c7b245be1e1b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 25 Aug 2019 16:38:08 +0200 Subject: [PATCH 102/176] Add API to generate a random nonce This AEAD scheme is compatible with choosing the nonce randomly. --- Crypto/Cipher/AESGCMSIV.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/Crypto/Cipher/AESGCMSIV.hs b/Crypto/Cipher/AESGCMSIV.hs index 81a8c76..d29211a 100644 --- a/Crypto/Cipher/AESGCMSIV.hs +++ b/Crypto/Cipher/AESGCMSIV.hs @@ -21,6 +21,7 @@ module Crypto.Cipher.AESGCMSIV ( Nonce , nonce + , generateNonce , encrypt , decrypt ) where @@ -42,6 +43,7 @@ import Crypto.Cipher.AES.Primitive import Crypto.Cipher.Types import Crypto.Error import Crypto.Internal.Compat (unsafeDoIO) +import Crypto.Random -- 12-byte nonces @@ -55,6 +57,10 @@ nonce iv | B.length iv == 12 = CryptoPassed (Nonce $ B.convert iv) | otherwise = CryptoFailed CryptoError_IvSizeInvalid +-- | Generate a random nonce for use with AES-GCM-SIV. +generateNonce :: MonadRandom m => m Nonce +generateNonce = Nonce <$> getRandomBytes 12 + -- POLYVAL (mutable context) From 096e2ec0bda913e1e50c019d14772df365dc59bc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 31 Aug 2019 09:10:46 +0200 Subject: [PATCH 103/176] Add XSalsa.derive and example This function adds one more HSalsa key derivation to an XSalsa context that has previously been initialized. It allows multi-level cascades like the 2-level done by NaCl crypto_box. --- Crypto/Cipher/XSalsa.hs | 27 +++++++++++++++++++++++ Crypto/Tutorial.hs | 46 +++++++++++++++++++++++++++++++++++++++ cbits/cryptonite_xsalsa.c | 24 +++++++++++++++----- cbits/cryptonite_xsalsa.h | 1 + 4 files changed, 93 insertions(+), 5 deletions(-) diff --git a/Crypto/Cipher/XSalsa.hs b/Crypto/Cipher/XSalsa.hs index db8b919..1510597 100644 --- a/Crypto/Cipher/XSalsa.hs +++ b/Crypto/Cipher/XSalsa.hs @@ -12,6 +12,7 @@ {-# LANGUAGE ForeignFunctionInterface #-} module Crypto.Cipher.XSalsa ( initialize + , derive , combine , generate , State @@ -44,5 +45,31 @@ initialize nbRounds key nonce where kLen = B.length key nonceLen = B.length nonce +-- | Use an already initialized context and new nonce material to derive another +-- XSalsa context. +-- +-- This allows a multi-level cascade where a first key @k1@ and nonce @n1@ is +-- used to get @HState(k1,n1)@, and this value is then used as key @k2@ to build +-- @XSalsa(k2,n2)@. Function 'initialize' is to be called with the first 192 +-- bits of @n1|n2@, and the call to @derive@ should add the remaining 128 bits. +-- +-- The output context always uses the same number of rounds as the input +-- context. +derive :: ByteArrayAccess nonce + => State -- ^ base XSalsa state + -> nonce -- ^ the remainder nonce (128 bits) + -> State -- ^ the new XSalsa state +derive (State stPtr') nonce + | nonceLen /= 16 = error "XSalsa: nonce length should be 128 bits" + | otherwise = unsafeDoIO $ do + stPtr <- B.copy stPtr' $ \stPtr -> + B.withByteArray nonce $ \noncePtr -> + ccryptonite_xsalsa_derive stPtr nonceLen noncePtr + return $ State stPtr + where nonceLen = B.length nonce + foreign import ccall "cryptonite_xsalsa_init" ccryptonite_xsalsa_init :: Ptr State -> Int -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> IO () + +foreign import ccall "cryptonite_xsalsa_derive" + ccryptonite_xsalsa_derive :: Ptr State -> Int -> Ptr Word8 -> IO () diff --git a/Crypto/Tutorial.hs b/Crypto/Tutorial.hs index bd1c9c5..0fd5611 100644 --- a/Crypto/Tutorial.hs +++ b/Crypto/Tutorial.hs @@ -8,6 +8,9 @@ module Crypto.Tutorial -- * Symmetric block ciphers -- $symmetric_block_ciphers + + -- * Combining primitives + -- $combining_primitives ) where -- $api_design @@ -147,3 +150,46 @@ module Crypto.Tutorial -- > putStrLn $ "Original Message: " ++ show msg -- > putStrLn $ "Message after encryption: " ++ show eMsg -- > putStrLn $ "Message after decryption: " ++ show dMsg + +-- $combining_primitives +-- +-- This example shows how to use Curve25519, XSalsa and Poly1305 primitives to +-- emulate NaCl's @crypto_box@ construct. +-- +-- > import qualified Data.ByteArray as BA +-- > import Data.ByteString (ByteString) +-- > import qualified Data.ByteString as B +-- > +-- > import qualified Crypto.Cipher.XSalsa as XSalsa +-- > import qualified Crypto.MAC.Poly1305 as Poly1305 +-- > import qualified Crypto.PubKey.Curve25519 as X25519 +-- > +-- > -- | Build a @crypto_box@ packet encrypting the specified content with a +-- > -- 192-bit nonce, receiver public key and sender private key. +-- > crypto_box content nonce pk sk = BA.convert tag `B.append` c +-- > where +-- > zero = B.replicate 16 0 +-- > shared = X25519.dh pk sk +-- > (iv0, iv1) = B.splitAt 8 nonce +-- > state0 = XSalsa.initialize 20 shared (zero `B.append` iv0) +-- > state1 = XSalsa.derive state0 iv1 +-- > (rs, state2) = XSalsa.generate state1 32 +-- > (c, _) = XSalsa.combine state2 content +-- > tag = Poly1305.auth (rs :: ByteString) c +-- > +-- > -- | Try to open a @crypto_box@ packet and recover the content using the +-- > -- 192-bit nonce, sender public key and receiver private key. +-- > crypto_box_open packet nonce pk sk +-- > | B.length packet < 16 = Nothing +-- > | BA.constEq tag' tag = Just content +-- > | otherwise = Nothing +-- > where +-- > (tag', c) = B.splitAt 16 packet +-- > zero = B.replicate 16 0 +-- > shared = X25519.dh pk sk +-- > (iv0, iv1) = B.splitAt 8 nonce +-- > state0 = XSalsa.initialize 20 shared (zero `B.append` iv0) +-- > state1 = XSalsa.derive state0 iv1 +-- > (rs, state2) = XSalsa.generate state1 32 +-- > (content, _) = XSalsa.combine state2 c +-- > tag = Poly1305.auth (rs :: ByteString) c diff --git a/cbits/cryptonite_xsalsa.c b/cbits/cryptonite_xsalsa.c index a65c03a..9aa169f 100644 --- a/cbits/cryptonite_xsalsa.c +++ b/cbits/cryptonite_xsalsa.c @@ -47,13 +47,27 @@ void cryptonite_xsalsa_init(cryptonite_salsa_context *ctx, uint8_t nb_rounds, (x6, x7, x8, x9) is the first 128 bits of a 192-bit nonce */ cryptonite_salsa_init_core(&ctx->st, keylen, key, 8, iv); - ctx->st.d[ 8] = load_le32(iv + 8); - ctx->st.d[ 9] = load_le32(iv + 12); + + /* Continue initialization in a separate function that may also + be called independently */ + cryptonite_xsalsa_derive(ctx, ivlen - 8, iv + 8); +} + +void cryptonite_xsalsa_derive(cryptonite_salsa_context *ctx, + uint32_t ivlen, const uint8_t *iv) +{ + /* Finish creating initial 512-bit input block: + (x6, x7, x8, x9) is the first 128 bits of a 192-bit nonce + + Except iv has been shifted by 64 bits so there are now only 128 bits ahead. + */ + ctx->st.d[ 8] += load_le32(iv + 0); + ctx->st.d[ 9] += load_le32(iv + 4); /* Compute (z0, z1, . . . , z15) = doubleround ^(r/2) (x0, x1, . . . , x15) */ block hSalsa; memset(&hSalsa, 0, sizeof(block)); - cryptonite_salsa_core_xor(nb_rounds, &hSalsa, &ctx->st); + cryptonite_salsa_core_xor(ctx->nb_rounds, &hSalsa, &ctx->st); /* Build a new 512-bit input block (x′0, x′1, . . . , x′15): (x′0, x′5, x′10, x′15) is the Salsa20 constant @@ -69,8 +83,8 @@ void cryptonite_xsalsa_init(cryptonite_salsa_context *ctx, uint8_t nb_rounds, ctx->st.d[12] = hSalsa.d[ 7] - ctx->st.d[ 7]; ctx->st.d[13] = hSalsa.d[ 8] - ctx->st.d[ 8]; ctx->st.d[14] = hSalsa.d[ 9] - ctx->st.d[ 9]; - ctx->st.d[ 6] = load_le32(iv + 16); - ctx->st.d[ 7] = load_le32(iv + 20); + ctx->st.d[ 6] = load_le32(iv + 8); + ctx->st.d[ 7] = load_le32(iv + 12); ctx->st.d[ 8] = 0; ctx->st.d[ 9] = 0; } diff --git a/cbits/cryptonite_xsalsa.h b/cbits/cryptonite_xsalsa.h index 73233ce..57ac9fc 100644 --- a/cbits/cryptonite_xsalsa.h +++ b/cbits/cryptonite_xsalsa.h @@ -33,5 +33,6 @@ #include "cryptonite_salsa.h" void cryptonite_xsalsa_init(cryptonite_salsa_context *ctx, uint8_t nb_rounds, uint32_t keylen, const uint8_t *key, uint32_t ivlen, const uint8_t *iv); +void cryptonite_xsalsa_derive(cryptonite_salsa_context *ctx, uint32_t ivlen, const uint8_t *iv); #endif From 2433893730d66d7de0c470e22cbdadf96f5643cb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 14 Sep 2019 08:35:43 +0200 Subject: [PATCH 104/176] Test XSalsa.derive Adds a test case taken from NaCl paper, but without the parts related to Curve25519 and Poly1305 because we want to test only XSalsa here. --- tests/XSalsa.hs | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/tests/XSalsa.hs b/tests/XSalsa.hs index e59a73c..0bc4d5c 100644 --- a/tests/XSalsa.hs +++ b/tests/XSalsa.hs @@ -98,11 +98,31 @@ vectors = , "\xB2\xB7\x95\xFE\x6C\x1D\x4C\x83\xC1\x32\x7E\x01\x5A\x67\xD4\x46\x5F\xD8\xE3\x28\x13\x57\x5C\xBA\xB2\x63\xE2\x0E\xF0\x58\x64\xD2\xDC\x17\xE0\xE4\xEB\x81\x43\x6A\xDF\xE9\xF6\x38\xDC\xC1\xC8\xD7\x8F\x6B\x03\x06\xBA\xF9\x38\xE5\xD2\xAB\x0B\x3E\x05\xE7\x35\xCC\x6F\xFF\x2D\x6E\x02\xE3\xD6\x04\x84\xBE\xA7\xC7\xA8\xE1\x3E\x23\x19\x7F\xEA\x7B\x04\xD4\x7D\x48\xF4\xA4\xE5\x94\x41\x74\x53\x94\x92\x80\x0D\x3E\xF5\x1E\x2E\xE5\xE4\xC8\xA0\xBD\xF0\x50\xC2\xDD\x3D\xD7\x4F\xCE\x5E\x7E\x5C\x37\x36\x4F\x75\x47\xA1\x14\x80\xA3\x06\x3B\x9A\x0A\x15\x7B\x15\xB1\x0A\x5A\x95\x4D\xE2\x73\x1C\xED\x05\x5A\xA2\xE2\x76\x7F\x08\x91\xD4\x32\x9C\x42\x6F\x38\x08\xEE\x86\x7B\xED\x0D\xC7\x5B\x59\x22\xB7\xCF\xB8\x95\x70\x0F\xDA\x01\x61\x05\xA4\xC7\xB7\xF0\xBB\x90\xF0\x29\xF6\xBB\xCB\x04\xAC\x36\xAC\x16") ] +-- Test vector from paper "Cryptography in NaCl" +vectorsCB :: [Vector] +vectorsCB = + [ ( 20 + , "\x4A\x5D\x9D\x5B\xA4\xCE\x2D\xE1\x72\x8E\x3B\xF4\x80\x35\x0F\x25\xE0\x7E\x21\xC9\x47\xD1\x9E\x33\x76\xF0\x9B\x3C\x1E\x16\x17\x42" + , "\x69\x69\x6E\xE9\x55\xB6\x2B\x73\xCD\x62\xBD\xA8\x75\xFC\x73\xD6\x82\x19\xE0\x03\x6B\x7A\x0B\x37" + , "\xBE\x07\x5F\xC5\x3C\x81\xF2\xD5\xCF\x14\x13\x16\xEB\xEB\x0C\x7B\x52\x28\xC5\x2A\x4C\x62\xCB\xD4\x4B\x66\x84\x9B\x64\x24\x4F\xFC\xE5\xEC\xBA\xAF\x33\xBD\x75\x1A\x1A\xC7\x28\xD4\x5E\x6C\x61\x29\x6C\xDC\x3C\x01\x23\x35\x61\xF4\x1D\xB6\x6C\xCE\x31\x4A\xDB\x31\x0E\x3B\xE8\x25\x0C\x46\xF0\x6D\xCE\xEA\x3A\x7F\xA1\x34\x80\x57\xE2\xF6\x55\x6A\xD6\xB1\x31\x8A\x02\x4A\x83\x8F\x21\xAF\x1F\xDE\x04\x89\x77\xEB\x48\xF5\x9F\xFD\x49\x24\xCA\x1C\x60\x90\x2E\x52\xF0\xA0\x89\xBC\x76\x89\x70\x40\xE0\x82\xF9\x37\x76\x38\x48\x64\x5E\x07\x05" + , "\x8E\x99\x3B\x9F\x48\x68\x12\x73\xC2\x96\x50\xBA\x32\xFC\x76\xCE\x48\x33\x2E\xA7\x16\x4D\x96\xA4\x47\x6F\xB8\xC5\x31\xA1\x18\x6A\xC0\xDF\xC1\x7C\x98\xDC\xE8\x7B\x4D\xA7\xF0\x11\xEC\x48\xC9\x72\x71\xD2\xC2\x0F\x9B\x92\x8F\xE2\x27\x0D\x6F\xB8\x63\xD5\x17\x38\xB4\x8E\xEE\xE3\x14\xA7\xCC\x8A\xB9\x32\x16\x45\x48\xE5\x26\xAE\x90\x22\x43\x68\x51\x7A\xCF\xEA\xBD\x6B\xB3\x73\x2B\xC0\xE9\xDA\x99\x83\x2B\x61\xCA\x01\xB6\xDE\x56\x24\x4A\x9E\x88\xD5\xF9\xB3\x79\x73\xF6\x22\xA4\x3D\x14\xA6\x59\x9B\x1F\x65\x4C\xB4\x5A\x74\xE3\x55\xA5") + ] + tests = testGroup "XSalsa" [ testGroup "KAT" $ map (\(i,f) -> testCase (show (i :: Int)) f) $ zip [1..] $ map (\(r, k, i, p, e) -> salsaRunSimple r k i p e) vectors + , testGroup "crypto_box encryption" $ + map (\(i,f) -> testCase (show (i :: Int)) f) $ zip [1..] $ map (\(r, k, i, p, e) -> cryptoBoxEnc r k i p e) vectorsCB ] where salsaRunSimple rounds key nonce plain expected = let salsa = XSalsa.initialize rounds key nonce in fst (XSalsa.combine salsa plain) @?= expected + + cryptoBoxEnc rounds shared nonce plain expected = + let zero = B.replicate 16 0 + (iv0, iv1) = B.splitAt 8 nonce + salsa0 = XSalsa.initialize rounds shared (zero `B.append` iv0) + salsa1 = XSalsa.derive salsa0 iv1 + (_, salsa2) = XSalsa.generate salsa1 32 :: (B.ByteString, XSalsa.State) + in fst (XSalsa.combine salsa2 plain) @?= expected From 68c93ccbb1c47f751636539e4ccaf560127bb839 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 5 Oct 2019 08:23:45 +0200 Subject: [PATCH 105/176] Add GHC 8.8.1 to CI and bump versions --- .haskell-ci | 7 ++++--- .travis.yml | 15 ++++++++------- stack.yaml | 4 ++-- 3 files changed, 14 insertions(+), 12 deletions(-) diff --git a/.haskell-ci b/.haskell-ci index 17cb6a3..b0993fe 100644 --- a/.haskell-ci +++ b/.haskell-ci @@ -2,7 +2,8 @@ compiler: ghc-8.0 lts-9.21 compiler: ghc-8.2 lts-11.22 compiler: ghc-8.4 lts-12.26 -compiler: ghc-8.6 lts-13.21 +compiler: ghc-8.6 lts-14.7 +compiler: ghc-8.8 nightly-2019-10-05 # options # option: alias x=y z=v @@ -12,9 +13,9 @@ option: basementmin extradep=basement-0.0.8 extradep=memory-0.14.18 # builds build: ghc-8.2 basementmin build: ghc-8.0 basementmin gaugedeps -build: ghc-8.0 basementmin gaugedeps os=osx build: ghc-8.4 -build: ghc-8.6 +build: ghc-8.6 os=linux,osx +build: ghc-8.8 # packages package: '.' diff --git a/.travis.yml b/.travis.yml index 4aa5de8..8e943fa 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,4 +1,4 @@ -# ~*~ auto-generated by haskell-ci with config : cb76551db808ad3472d36865246ef3849351a6c78535dd987bd37bc95bfd47c0 ~*~ +# ~*~ auto-generated by haskell-ci with config : 6451b289e8421706e753915b02cdb0906d18c9917aff02d07176a0862ec87cf3 ~*~ # Use new container infrastructure to enable caching sudo: false @@ -14,9 +14,10 @@ matrix: include: - { env: BUILD=stack RESOLVER=ghc-8.2, compiler: ghc-8.2, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } - { env: BUILD=stack RESOLVER=ghc-8.0, compiler: ghc-8.0, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } - - { env: BUILD=stack RESOLVER=ghc-8.0, compiler: ghc-8.0, language: generic, addons: { apt: { packages: [ libgmp-dev ] } }, os: osx } - { env: BUILD=stack RESOLVER=ghc-8.4, compiler: ghc-8.4, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } - { env: BUILD=stack RESOLVER=ghc-8.6, compiler: ghc-8.6, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } + - { env: BUILD=stack RESOLVER=ghc-8.6, compiler: ghc-8.6, language: generic, addons: { apt: { packages: [ libgmp-dev ] } }, os: osx } + - { env: BUILD=stack RESOLVER=ghc-8.8, compiler: ghc-8.8, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } - { env: BUILD=hlint, compiler: hlint, language: generic } - { env: BUILD=weeder, compiler: weeder, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } allow_failures: @@ -56,16 +57,16 @@ script: echo "{ resolver: lts-9.21, packages: [ '.' ], extra-deps: [ basement-0.0.8, memory-0.14.18, gauge-0.2.1 ], flags: {} }" > stack.yaml stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; - ghc-8.0) - echo "{ resolver: lts-9.21, packages: [ '.' ], extra-deps: [ basement-0.0.8, memory-0.14.18, gauge-0.2.1 ], flags: {} }" > stack.yaml - stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps - ;; ghc-8.4) echo "{ resolver: lts-12.26, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; ghc-8.6) - echo "{ resolver: lts-13.21, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml + echo "{ resolver: lts-14.7, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml + stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps + ;; + ghc-8.8) + echo "{ resolver: nightly-2019-10-05, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; esac diff --git a/stack.yaml b/stack.yaml index 85bc4e8..c48151a 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1,3 @@ -# ~*~ auto-generated by haskell-ci with config : cb76551db808ad3472d36865246ef3849351a6c78535dd987bd37bc95bfd47c0 ~*~ -{ resolver: lts-13.21, packages: [ '.' ], extra-deps: [], flags: {} } +# ~*~ auto-generated by haskell-ci with config : 6451b289e8421706e753915b02cdb0906d18c9917aff02d07176a0862ec87cf3 ~*~ +{ resolver: lts-14.7, packages: [ '.' ], extra-deps: [], flags: {} } From 2e926396796aca084d61c85f554bedee577970d0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 7 Oct 2017 15:16:53 +0200 Subject: [PATCH 106/176] Add P256.scalarMul --- Crypto/PubKey/ECC/P256.hs | 9 +++++++++ tests/KAT_PubKey/P256.hs | 4 ++++ 2 files changed, 13 insertions(+) diff --git a/Crypto/PubKey/ECC/P256.hs b/Crypto/PubKey/ECC/P256.hs index 3c350cd..7b8c7c1 100644 --- a/Crypto/PubKey/ECC/P256.hs +++ b/Crypto/PubKey/ECC/P256.hs @@ -34,6 +34,7 @@ module Crypto.PubKey.ECC.P256 , scalarIsZero , scalarAdd , scalarSub + , scalarMul , scalarInv , scalarCmp , scalarFromBinary @@ -237,6 +238,14 @@ scalarSub a b = withNewScalarFreeze $ \d -> withScalar a $ \pa -> withScalar b $ \pb -> ccryptonite_p256e_modsub ccryptonite_SECP256r1_n pa pb d +-- | Perform multiplication between two scalars +-- +-- > a * b +scalarMul :: Scalar -> Scalar -> Scalar +scalarMul a b = + withNewScalarFreeze $ \d -> withScalar a $ \pa -> withScalar b $ \pb -> + ccryptonite_p256_modmul ccryptonite_SECP256r1_n pa 0 pb d + -- | Give the inverse of the scalar -- -- > 1 / a diff --git a/tests/KAT_PubKey/P256.hs b/tests/KAT_PubKey/P256.hs index c570548..f038133 100644 --- a/tests/KAT_PubKey/P256.hs +++ b/tests/KAT_PubKey/P256.hs @@ -92,6 +92,10 @@ tests = testGroup "P256" let v = unP256 r `mod` curveN v' = P256.scalarSub (unP256Scalar r) P256.scalarZero in v `propertyEq` p256ScalarToInteger v' + , testProperty "mul" $ \r1 r2 -> + let r = (unP256 r1 * unP256 r2) `mod` curveN + r' = P256.scalarMul (unP256Scalar r1) (unP256Scalar r2) + in r `propertyEq` p256ScalarToInteger r' , testProperty "inv" $ \r' -> let inv = inverseCoprimes (unP256 r') curveN inv' = P256.scalarInv (unP256Scalar r') From e0b201b5e703f8821cdf1850b78cd9ff7f8595d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Mon, 16 Apr 2018 19:47:49 +0200 Subject: [PATCH 107/176] Test P256.pointMul --- tests/KAT_PubKey/P256.hs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/tests/KAT_PubKey/P256.hs b/tests/KAT_PubKey/P256.hs index f038133..cd1356d 100644 --- a/tests/KAT_PubKey/P256.hs +++ b/tests/KAT_PubKey/P256.hs @@ -54,6 +54,9 @@ unP256Scalar (P256Scalar r) = unP256 :: P256Scalar -> Integer unP256 (P256Scalar r) = r +modP256Scalar :: P256Scalar -> P256Scalar +modP256Scalar (P256Scalar r) = P256Scalar (r `mod` curveN) + p256ScalarToInteger :: P256.Scalar -> Integer p256ScalarToInteger s = os2ip (P256.scalarToBinary s :: Bytes) @@ -122,6 +125,7 @@ tests = testGroup "P256" , testProperty "lift-to-curve" $ propertyLiftToCurve , testProperty "point-add" $ propertyPointAdd , testProperty "point-negate" $ propertyPointNegate + , testProperty "point-mul" $ propertyPointMul ] ] where @@ -151,3 +155,14 @@ tests = testGroup "P256" pe = ECC.pointMul curve (unP256 r) curveGen pR = P256.pointNegate p in ECC.pointNegate curve pe `propertyEq` (pointP256ToECC pR) + + propertyPointMul s' r' = + let s = modP256Scalar s' + r = modP256Scalar r' + p = P256.toPoint (unP256Scalar r) + pe = ECC.pointMul curve (unP256 r) curveGen + pR = P256.toPoint (P256.scalarMul (unP256Scalar s) (unP256Scalar r)) + peR = ECC.pointMul curve (unP256 s) pe + in propertyHold [ eqTest "p256" pR (P256.pointMul (unP256Scalar s) p) + , eqTest "ecc" peR (pointP256ToECC pR) + ] From bdf1a7a133aada008b3627a871f4a4aba99bed10 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 22 Sep 2019 09:29:50 +0200 Subject: [PATCH 108/176] Require point equality in EllipticCurveArith This is an incompatible API change but is very useful to test properties and algorithms derived from the primitives. An ECC instance sufficiently advanced to have math primitives should implement equality too. --- Crypto/ECC.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index 8391b5a..0d4b186 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -8,6 +8,7 @@ -- Elliptic Curve Cryptography -- {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -98,7 +99,7 @@ class EllipticCurve curve => EllipticCurveDH curve where -- value or an exception. ecdh :: proxy curve -> Scalar curve -> Point curve -> CryptoFailable SharedSecret -class EllipticCurve curve => EllipticCurveArith curve where +class (EllipticCurve curve, Eq (Point curve)) => EllipticCurveArith curve where -- | Add points on a curve pointAdd :: proxy curve -> Point curve -> Point curve -> Point curve From db8d47a76c0b00180287c270d18ce3513004f908 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 22 Sep 2019 09:32:51 +0200 Subject: [PATCH 109/176] ECC arithmetic in prime-order subgroup A type-class extension packs together additional functions related to a chosen basepoint as well as scalar serialization and arithmetic modulo the subgroup order. --- Crypto/ECC.hs | 124 ++++++++++++++++++++++++++++++++++++++++++++++++++ tests/ECC.hs | 41 +++++++++++++++++ 2 files changed, 165 insertions(+) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index 0d4b186..b3ec8ea 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -22,6 +22,7 @@ module Crypto.ECC , EllipticCurve(..) , EllipticCurveDH(..) , EllipticCurveArith(..) + , EllipticCurveBasepointArith(..) , KeyPair(..) , SharedSecret(..) ) where @@ -35,7 +36,9 @@ import Crypto.Error import Crypto.Internal.Imports import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes) import qualified Crypto.Internal.ByteArray as B +import Crypto.Number.Basic (numBits) import Crypto.Number.Serialize (i2ospOf_, os2ip) +import qualified Crypto.Number.Serialize.LE as LE import qualified Crypto.PubKey.Curve25519 as X25519 import qualified Crypto.PubKey.Curve448 as X448 import Data.ByteArray (convert) @@ -112,6 +115,35 @@ class (EllipticCurve curve, Eq (Point curve)) => EllipticCurveArith curve where -- -- | Scalar Inverse -- scalarInverse :: Scalar curve -> Scalar curve +class (EllipticCurveArith curve, Eq (Scalar curve)) => EllipticCurveBasepointArith curve where + -- | Get the curve order size in bits + curveOrderBits :: proxy curve -> Int + + -- | Multiply a scalar with the curve base point + pointBaseSmul :: proxy curve -> Scalar curve -> Point curve + + -- | Multiply the point @p@ with @s2@ and add a lifted to curve value @s1@ + pointsSmulVarTime :: proxy curve -> Scalar curve -> Scalar curve -> Point curve -> Point curve + pointsSmulVarTime prx s1 s2 p = pointAdd prx (pointBaseSmul prx s1) (pointSmul prx s2 p) + + -- | Encode an elliptic curve scalar into big-endian form + encodeScalar :: ByteArray bs => proxy curve -> Scalar curve -> bs + + -- | Try to decode the big-endian form of an elliptic curve scalar + decodeScalar :: ByteArray bs => proxy curve -> bs -> CryptoFailable (Scalar curve) + + -- | Convert an elliptic curve scalar to an integer + scalarToInteger :: proxy curve -> Scalar curve -> Integer + + -- | Try to create an elliptic curve scalar from an integer + scalarFromInteger :: proxy curve -> Integer -> CryptoFailable (Scalar curve) + + -- | Add two scalars and reduce modulo the curve order + scalarAdd :: proxy curve -> Scalar curve -> Scalar curve -> Scalar curve + + -- | Multiply two scalars and reduce modulo the curve order + scalarMul :: proxy curve -> Scalar curve -> Scalar curve -> Scalar curve + -- | P256 Curve -- -- also known as P256 @@ -149,6 +181,17 @@ instance EllipticCurveDH Curve_P256R1 where ecdhRaw _ s p = SharedSecret $ P256.pointDh s p ecdh prx s p = checkNonZeroDH (ecdhRaw prx s p) +instance EllipticCurveBasepointArith Curve_P256R1 where + curveOrderBits _ = 256 + pointBaseSmul _ = P256.toPoint + pointsSmulVarTime _ = P256.pointsMulVarTime + encodeScalar _ = P256.scalarToBinary + decodeScalar _ = P256.scalarFromBinary + scalarToInteger _ = P256.scalarToInteger + scalarFromInteger _ = P256.scalarFromInteger + scalarAdd _ = P256.scalarAdd + scalarMul _ = P256.scalarMul + data Curve_P384R1 = Curve_P384R1 deriving (Show,Data) @@ -172,6 +215,17 @@ instance EllipticCurveDH Curve_P384R1 where where prx = Proxy :: Proxy Simple.SEC_p384r1 +instance EllipticCurveBasepointArith Curve_P384R1 where + curveOrderBits _ = 384 + pointBaseSmul _ = Simple.pointBaseMul + pointsSmulVarTime _ = ecPointsMulVarTime + encodeScalar _ = ecScalarToBinary + decodeScalar _ = ecScalarFromBinary + scalarToInteger _ = ecScalarToInteger + scalarFromInteger _ = ecScalarFromInteger + scalarAdd _ = ecScalarAdd + scalarMul _ = ecScalarMul + data Curve_P521R1 = Curve_P521R1 deriving (Show,Data) @@ -195,6 +249,17 @@ instance EllipticCurveDH Curve_P521R1 where where prx = Proxy :: Proxy Simple.SEC_p521r1 +instance EllipticCurveBasepointArith Curve_P521R1 where + curveOrderBits _ = 521 + pointBaseSmul _ = Simple.pointBaseMul + pointsSmulVarTime _ = ecPointsMulVarTime + encodeScalar _ = ecScalarToBinary + decodeScalar _ = ecScalarFromBinary + scalarToInteger _ = ecScalarToInteger + scalarFromInteger _ = ecScalarFromInteger + scalarAdd _ = ecScalarAdd + scalarMul _ = ecScalarMul + data Curve_X25519 = Curve_X25519 deriving (Show,Data) @@ -251,6 +316,22 @@ instance EllipticCurveArith Curve_Edwards25519 where pointNegate _ p = Edwards25519.pointNegate p pointSmul _ s p = Edwards25519.pointMul s p +instance EllipticCurveBasepointArith Curve_Edwards25519 where + curveOrderBits _ = 253 + pointBaseSmul _ = Edwards25519.toPoint + pointsSmulVarTime _ = Edwards25519.pointsMulVarTime + encodeScalar _ = B.reverse . Edwards25519.scalarEncode + decodeScalar _ bs + | B.length bs == 32 = Edwards25519.scalarDecodeLong (B.reverse bs) + | otherwise = CryptoFailed CryptoError_SecretKeySizeInvalid + scalarToInteger _ s = LE.os2ip (Edwards25519.scalarEncode s :: B.Bytes) + scalarFromInteger _ i = + case LE.i2ospOf 32 i of + Nothing -> CryptoFailed CryptoError_SecretKeySizeInvalid + Just bs -> Edwards25519.scalarDecodeLong (bs :: B.Bytes) + scalarAdd _ = Edwards25519.scalarAdd + scalarMul _ = Edwards25519.scalarMul + checkNonZeroDH :: SharedSecret -> CryptoFailable SharedSecret checkNonZeroDH s@(SharedSecret b) | B.constAllZero b = CryptoFailed CryptoError_ScalarMultiplicationInvalid @@ -282,3 +363,46 @@ decodeECPoint mxy = case B.uncons mxy of y = os2ip yb in Simple.pointFromIntegers (x,y) | otherwise -> CryptoFailed $ CryptoError_PointFormatInvalid + +ecPointsMulVarTime :: forall curve . Simple.Curve curve + => Simple.Scalar curve + -> Simple.Scalar curve -> Simple.Point curve + -> Simple.Point curve +ecPointsMulVarTime n1 = Simple.pointAddTwoMuls n1 g + where g = Simple.curveEccG $ Simple.curveParameters (Proxy :: Proxy curve) + +ecScalarFromBinary :: forall curve bs . (Simple.Curve curve, ByteArrayAccess bs) + => bs -> CryptoFailable (Simple.Scalar curve) +ecScalarFromBinary ba + | B.length ba /= size = CryptoFailed CryptoError_SecretKeySizeInvalid + | otherwise = CryptoPassed (Simple.Scalar $ os2ip ba) + where size = ecCurveOrderBytes (Proxy :: Proxy curve) + +ecScalarToBinary :: forall curve bs . (Simple.Curve curve, ByteArray bs) + => Simple.Scalar curve -> bs +ecScalarToBinary (Simple.Scalar s) = i2ospOf_ size s + where size = ecCurveOrderBytes (Proxy :: Proxy curve) + +ecScalarFromInteger :: forall curve . Simple.Curve curve + => Integer -> CryptoFailable (Simple.Scalar curve) +ecScalarFromInteger s + | numBits s > nb = CryptoFailed CryptoError_SecretKeySizeInvalid + | otherwise = CryptoPassed (Simple.Scalar s) + where nb = 8 * ecCurveOrderBytes (Proxy :: Proxy curve) + +ecScalarToInteger :: Simple.Scalar curve -> Integer +ecScalarToInteger (Simple.Scalar s) = s + +ecCurveOrderBytes :: Simple.Curve c => proxy c -> Int +ecCurveOrderBytes prx = (numBits n + 7) `div` 8 + where n = Simple.curveEccN $ Simple.curveParameters prx + +ecScalarAdd :: forall curve . Simple.Curve curve + => Simple.Scalar curve -> Simple.Scalar curve -> Simple.Scalar curve +ecScalarAdd (Simple.Scalar a) (Simple.Scalar b) = Simple.Scalar ((a + b) `mod` n) + where n = Simple.curveEccN $ Simple.curveParameters (Proxy :: Proxy curve) + +ecScalarMul :: forall curve . Simple.Curve curve + => Simple.Scalar curve -> Simple.Scalar curve -> Simple.Scalar curve +ecScalarMul (Simple.Scalar a) (Simple.Scalar b) = Simple.Scalar ((a * b) `mod` n) + where n = Simple.curveEccN $ Simple.curveParameters (Proxy :: Proxy curve) diff --git a/tests/ECC.hs b/tests/ECC.hs index c00dedc..319a276 100644 --- a/tests/ECC.hs +++ b/tests/ECC.hs @@ -24,6 +24,19 @@ instance Arbitrary Curve where , Curve ECC.Curve_X448 ] +data CurveArith = forall curve. (ECC.EllipticCurveBasepointArith curve, Show curve) => CurveArith curve + +instance Show CurveArith where + showsPrec d (CurveArith curve) = showsPrec d curve + +instance Arbitrary CurveArith where + arbitrary = elements + [ CurveArith ECC.Curve_P256R1 + , CurveArith ECC.Curve_P384R1 + , CurveArith ECC.Curve_P521R1 + , CurveArith ECC.Curve_Edwards25519 + ] + data VectorPoint = VectorPoint { vpCurve :: Curve , vpHex :: ByteString @@ -298,5 +311,33 @@ tests = testGroup "ECC" bobShared' = ECC.ecdhRaw prx (ECC.keypairGetPrivate bob) (ECC.keypairGetPublic alice) in aliceShared == bobShared && aliceShared == CryptoPassed aliceShared' && bobShared == CryptoPassed bobShared' + , testProperty "decodeScalar.encodeScalar==id" $ \testDRG (CurveArith curve) -> + let prx = Just curve -- using Maybe as Proxy + s1 = withTestDRG testDRG $ ECC.curveGenerateScalar prx + bs = ECC.encodeScalar prx s1 :: ByteString + s2 = ECC.decodeScalar prx bs + in CryptoPassed s1 == s2 + , testProperty "scalarFromInteger.scalarToInteger==id" $ \testDRG (CurveArith curve) -> + let prx = Just curve -- using Maybe as Proxy + s1 = withTestDRG testDRG $ ECC.curveGenerateScalar prx + bs = ECC.scalarToInteger prx s1 + s2 = ECC.scalarFromInteger prx bs + in CryptoPassed s1 == s2 + , localOption (QuickCheckTests 20) $ testProperty "(a + b).P = a.P + b.P" $ \testDRG (CurveArith curve) -> + let prx = Just curve -- using Maybe as Proxy + (s, a, b) = withTestDRG testDRG $ + (,,) <$> ECC.curveGenerateScalar prx + <*> ECC.curveGenerateScalar prx + <*> ECC.curveGenerateScalar prx + p = ECC.pointBaseSmul prx s + in ECC.pointSmul prx (ECC.scalarAdd prx a b) p == ECC.pointAdd prx (ECC.pointSmul prx a p) (ECC.pointSmul prx b p) + , localOption (QuickCheckTests 20) $ testProperty "(a * b).P = a.(b.P)" $ \testDRG (CurveArith curve) -> + let prx = Just curve -- using Maybe as Proxy + (s, a, b) = withTestDRG testDRG $ + (,,) <$> ECC.curveGenerateScalar prx + <*> ECC.curveGenerateScalar prx + <*> ECC.curveGenerateScalar prx + p = ECC.pointBaseSmul prx s + in ECC.pointSmul prx (ECC.scalarMul prx a b) p == ECC.pointSmul prx a (ECC.pointSmul prx b p) ] ] From 6f2a59e47066044f8b12a411140b9d526cc5f57d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 28 Sep 2019 17:45:16 +0200 Subject: [PATCH 110/176] Apply hlint suggestions --- Crypto/ECC.hs | 8 ++++---- Crypto/PubKey/ECC/P256.hs | 8 ++++---- tests/ECC.hs | 2 +- tests/KAT_PubKey/P256.hs | 10 +++++----- 4 files changed, 14 insertions(+), 14 deletions(-) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index b3ec8ea..855ea60 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -166,11 +166,11 @@ instance EllipticCurve Curve_P256R1 where uncompressed = B.singleton 4 xy = P256.pointToBinary p decodePoint _ mxy = case B.uncons mxy of - Nothing -> CryptoFailed $ CryptoError_PointSizeInvalid + Nothing -> CryptoFailed CryptoError_PointSizeInvalid Just (m,xy) -- uncompressed | m == 4 -> P256.pointFromBinary xy - | otherwise -> CryptoFailed $ CryptoError_PointFormatInvalid + | otherwise -> CryptoFailed CryptoError_PointFormatInvalid instance EllipticCurveArith Curve_P256R1 where pointAdd _ a b = P256.pointAdd a b @@ -353,7 +353,7 @@ encodeECPoint (Simple.Point x y) = B.concat [uncompressed,xb,yb] decodeECPoint :: (Simple.Curve curve, ByteArray bs) => bs -> CryptoFailable (Simple.Point curve) decodeECPoint mxy = case B.uncons mxy of - Nothing -> CryptoFailed $ CryptoError_PointSizeInvalid + Nothing -> CryptoFailed CryptoError_PointSizeInvalid Just (m,xy) -- uncompressed | m == 4 -> @@ -362,7 +362,7 @@ decodeECPoint mxy = case B.uncons mxy of x = os2ip xb y = os2ip yb in Simple.pointFromIntegers (x,y) - | otherwise -> CryptoFailed $ CryptoError_PointFormatInvalid + | otherwise -> CryptoFailed CryptoError_PointFormatInvalid ecPointsMulVarTime :: forall curve . Simple.Curve curve => Simple.Scalar curve diff --git a/Crypto/PubKey/ECC/P256.hs b/Crypto/PubKey/ECC/P256.hs index 7b8c7c1..6edd8dd 100644 --- a/Crypto/PubKey/ECC/P256.hs +++ b/Crypto/PubKey/ECC/P256.hs @@ -110,7 +110,7 @@ pointAdd a b = withNewPoint $ \dx dy -> -- | Negate a point pointNegate :: Point -> Point pointNegate a = withNewPoint $ \dx dy -> - withPoint a $ \ax ay -> do + withPoint a $ \ax ay -> ccryptonite_p256e_point_negate ax ay dx dy -- | Multiply a point by a scalar @@ -188,12 +188,12 @@ pointFromBinary ba = unsafePointFromBinary ba >>= validatePoint validatePoint :: Point -> CryptoFailable Point validatePoint p | pointIsValid p = CryptoPassed p - | otherwise = CryptoFailed $ CryptoError_PointCoordinatesInvalid + | otherwise = CryptoFailed CryptoError_PointCoordinatesInvalid -- | Convert from binary to a point, possibly invalid unsafePointFromBinary :: ByteArrayAccess ba => ba -> CryptoFailable Point unsafePointFromBinary ba - | B.length ba /= pointSize = CryptoFailed $ CryptoError_PublicKeySizeInvalid + | B.length ba /= pointSize = CryptoFailed CryptoError_PublicKeySizeInvalid | otherwise = CryptoPassed $ withNewPoint $ \px py -> B.withByteArray ba $ \src -> do ccryptonite_p256_from_bin src (castPtr px) @@ -266,7 +266,7 @@ scalarCmp a b = unsafeDoIO $ -- | convert a scalar from binary scalarFromBinary :: ByteArrayAccess ba => ba -> CryptoFailable Scalar scalarFromBinary ba - | B.length ba /= scalarSize = CryptoFailed $ CryptoError_SecretKeySizeInvalid + | B.length ba /= scalarSize = CryptoFailed CryptoError_SecretKeySizeInvalid | otherwise = CryptoPassed $ withNewScalarFreeze $ \p -> B.withByteArray ba $ \b -> ccryptonite_p256_from_bin b p diff --git a/tests/ECC.hs b/tests/ECC.hs index 319a276..5faaf81 100644 --- a/tests/ECC.hs +++ b/tests/ECC.hs @@ -293,7 +293,7 @@ tests = testGroup "ECC" [ testGroup "decodePoint" $ map doPointDecodeTest (zip [katZero..] vectorsPoint) , testGroup "ECDH weak points" $ map doWeakPointECDHTest (zip [katZero..] vectorsWeakPoint) , testGroup "property" - [ testProperty "decodePoint.encodePoint==id" $ \testDRG (Curve curve) -> do + [ testProperty "decodePoint.encodePoint==id" $ \testDRG (Curve curve) -> let prx = Just curve -- using Maybe as Proxy keyPair = withTestDRG testDRG $ ECC.curveGenerateKeyPair prx p1 = ECC.keypairGetPublic keyPair diff --git a/tests/KAT_PubKey/P256.hs b/tests/KAT_PubKey/P256.hs index cd1356d..7dd508e 100644 --- a/tests/KAT_PubKey/P256.hs +++ b/tests/KAT_PubKey/P256.hs @@ -122,10 +122,10 @@ tests = testGroup "P256" t = P256.pointFromIntegers (xT, yT) r = P256.pointFromIntegers (xR, yR) in r @=? P256.pointAdd s t - , testProperty "lift-to-curve" $ propertyLiftToCurve - , testProperty "point-add" $ propertyPointAdd - , testProperty "point-negate" $ propertyPointNegate - , testProperty "point-mul" $ propertyPointMul + , testProperty "lift-to-curve" propertyLiftToCurve + , testProperty "point-add" propertyPointAdd + , testProperty "point-negate" propertyPointNegate + , testProperty "point-mul" propertyPointMul ] ] where @@ -154,7 +154,7 @@ tests = testGroup "P256" let p = P256.toPoint (unP256Scalar r) pe = ECC.pointMul curve (unP256 r) curveGen pR = P256.pointNegate p - in ECC.pointNegate curve pe `propertyEq` (pointP256ToECC pR) + in ECC.pointNegate curve pe `propertyEq` pointP256ToECC pR propertyPointMul s' r' = let s = modP256Scalar s' From 19b7ab375a80a0690deb7b149dcb4a602ea6ecfb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 8 Oct 2017 09:21:45 +0200 Subject: [PATCH 111/176] Time-constant modular inverse --- Crypto/Number/ModArithmetic.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/Crypto/Number/ModArithmetic.hs b/Crypto/Number/ModArithmetic.hs index dcd8663..3d46aaa 100644 --- a/Crypto/Number/ModArithmetic.hs +++ b/Crypto/Number/ModArithmetic.hs @@ -16,6 +16,7 @@ module Crypto.Number.ModArithmetic , inverse , inverseCoprimes , jacobi + , inverseFermat ) where import Control.Exception (throw, Exception) @@ -120,3 +121,8 @@ jacobi a n n1 = n `mod` a1 in if a1 == 1 then Just s else fmap (*s) (jacobi n1 a1) + +-- | Modular inverse using Fermat's little theorem. This works only when +-- the modulus is prime but avoids side channels like in 'expSafe'. +inverseFermat :: Integer -> Integer -> Integer +inverseFermat g p = expSafe g (p - 2) p From 977e75f47814566ee2b3150ce0a7e00c39830d61 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 8 Oct 2017 15:28:14 +0200 Subject: [PATCH 112/176] Add P256 functions to implement ECDSA --- Crypto/PubKey/ECC/P256.hs | 24 +++++++++++++++++++++++- tests/KAT_PubKey/P256.hs | 6 ++++++ 2 files changed, 29 insertions(+), 1 deletion(-) diff --git a/Crypto/PubKey/ECC/P256.hs b/Crypto/PubKey/ECC/P256.hs index 6edd8dd..aa5b18e 100644 --- a/Crypto/PubKey/ECC/P256.hs +++ b/Crypto/PubKey/ECC/P256.hs @@ -8,7 +8,6 @@ -- P256 support -- {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE EmptyDataDecls #-} {-# OPTIONS_GHC -fno-warn-unused-binds #-} module Crypto.PubKey.ECC.P256 @@ -22,7 +21,9 @@ module Crypto.PubKey.ECC.P256 , pointDh , pointsMulVarTime , pointIsValid + , pointIsAtInfinity , toPoint + , pointX , pointToIntegers , pointFromIntegers , pointToBinary @@ -31,6 +32,7 @@ module Crypto.PubKey.ECC.P256 -- * Scalar arithmetic , scalarGenerate , scalarZero + , scalarN , scalarIsZero , scalarAdd , scalarSub @@ -77,6 +79,9 @@ data P256Scalar data P256Y data P256X +order :: Integer +order = 0xffffffff00000000ffffffffffffffffbce6faada7179e84f3b9cac2fc632551 + ------------------------------------------------------------------------ -- Point methods ------------------------------------------------------------------------ @@ -146,6 +151,19 @@ pointIsValid p = unsafeDoIO $ withPoint p $ \px py -> do r <- ccryptonite_p256_is_valid_point px py return (r /= 0) +-- | Check if a 'Point' is the point at infinity +pointIsAtInfinity :: Point -> Bool +pointIsAtInfinity (Point b) = constAllZero b + +-- | Return the x coordinate as a 'Scalar' if the point is not at infinity +pointX :: Point -> Maybe Scalar +pointX p + | pointIsAtInfinity p = Nothing + | otherwise = Just $ + withNewScalarFreeze $ \d -> + withPoint p $ \px _ -> + ccryptonite_p256_mod ccryptonite_SECP256r1_n (castPtr px) (castPtr d) + -- | Convert a point to (x,y) Integers pointToIntegers :: Point -> (Integer, Integer) pointToIntegers p = unsafeDoIO $ withPoint p $ \px py -> @@ -216,6 +234,10 @@ scalarGenerate = unwrap . scalarFromBinary . witness <$> getRandomBytes 32 scalarZero :: Scalar scalarZero = withNewScalarFreeze $ \d -> ccryptonite_p256_init d +-- | The scalar representing the curve order +scalarN :: Scalar +scalarN = throwCryptoError (scalarFromInteger order) + -- | Check if the scalar is 0 scalarIsZero :: Scalar -> Bool scalarIsZero s = unsafeDoIO $ withScalar s $ \d -> do diff --git a/tests/KAT_PubKey/P256.hs b/tests/KAT_PubKey/P256.hs index 7dd508e..f04603f 100644 --- a/tests/KAT_PubKey/P256.hs +++ b/tests/KAT_PubKey/P256.hs @@ -126,6 +126,12 @@ tests = testGroup "P256" , testProperty "point-add" propertyPointAdd , testProperty "point-negate" propertyPointNegate , testProperty "point-mul" propertyPointMul + , testProperty "infinity" $ + let gN = P256.toPoint P256.scalarN + g1 = P256.pointBase + in propertyHold [ eqTest "zero" True (P256.pointIsAtInfinity gN) + , eqTest "base" False (P256.pointIsAtInfinity g1) + ] ] ] where From 8f75165f8b3cfa98846030026b66a253fdcaa299 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 26 Nov 2017 10:06:04 +0100 Subject: [PATCH 113/176] Time-constant P256 scalar inversion --- Crypto/PubKey/ECC/P256.hs | 11 ++++ cbits/p256/p256.c | 111 ++++++++++++++++++++++++++++++++++++++ tests/KAT_PubKey/P256.hs | 16 +++++- 3 files changed, 137 insertions(+), 1 deletion(-) diff --git a/Crypto/PubKey/ECC/P256.hs b/Crypto/PubKey/ECC/P256.hs index aa5b18e..77a5ff0 100644 --- a/Crypto/PubKey/ECC/P256.hs +++ b/Crypto/PubKey/ECC/P256.hs @@ -38,6 +38,7 @@ module Crypto.PubKey.ECC.P256 , scalarSub , scalarMul , scalarInv + , scalarInvSafe , scalarCmp , scalarFromBinary , scalarToBinary @@ -278,6 +279,14 @@ scalarInv a = withNewScalarFreeze $ \b -> withScalar a $ \pa -> ccryptonite_p256_modinv_vartime ccryptonite_SECP256r1_n pa b +-- | Give the inverse of the scalar using safe exponentiation +-- +-- > 1 / a +scalarInvSafe :: Scalar -> Scalar +scalarInvSafe a = + withNewScalarFreeze $ \b -> withScalar a $ \pa -> + ccryptonite_p256e_scalar_invert pa b + -- | Compare 2 Scalar scalarCmp :: Scalar -> Scalar -> Ordering scalarCmp a b = unsafeDoIO $ @@ -381,6 +390,8 @@ foreign import ccall "cryptonite_p256_mod" ccryptonite_p256_mod :: Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> IO () foreign import ccall "cryptonite_p256_modmul" ccryptonite_p256_modmul :: Ptr P256Scalar -> Ptr P256Scalar -> P256Digit -> Ptr P256Scalar -> Ptr P256Scalar -> IO () +foreign import ccall "cryptonite_p256e_scalar_invert" + ccryptonite_p256e_scalar_invert :: Ptr P256Scalar -> Ptr P256Scalar -> IO () --foreign import ccall "cryptonite_p256_modinv" -- ccryptonite_p256_modinv :: Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> IO () foreign import ccall "cryptonite_p256_modinv_vartime" diff --git a/cbits/p256/p256.c b/cbits/p256/p256.c index bd94f6a..8dad6ef 100644 --- a/cbits/p256/p256.c +++ b/cbits/p256/p256.c @@ -408,3 +408,114 @@ void cryptonite_p256e_modsub(const cryptonite_p256_int* MOD, const cryptonite_p2 top = subM(MOD, top, P256_DIGITS(c), MSB_COMPLEMENT(top)); addM(MOD, 0, P256_DIGITS(c), top); } + +// n' such as n * n' = -1 mod (2^32) +#define MONTGOMERY_FACTOR 0xEE00BC4F + +#define NTH_DOUBLE_THEN_ADD(i, a, nth, b, out) \ + cryptonite_p256e_montmul(a, a, out); \ + for (i = 1; i < nth; i++) \ + cryptonite_p256e_montmul(out, out, out); \ + cryptonite_p256e_montmul(out, b, out); + +const cryptonite_p256_int cryptonite_SECP256r1_r2 = // r^2 mod n + {{0xBE79EEA2, 0x83244C95, 0x49BD6FA6, 0x4699799C, + 0x2B6BEC59, 0x2845B239, 0xF3D95620, 0x66E12D94}}; + +const cryptonite_p256_int cryptonite_SECP256r1_one = {{1}}; + +// Montgomery multiplication, i.e. c = ab/r mod n with r = 2^256. +// Implementation is adapted from 'sc_montmul' in libdecaf. +static void cryptonite_p256e_montmul(const cryptonite_p256_int* a, const cryptonite_p256_int* b, cryptonite_p256_int* c) { + int i, j, borrow; + cryptonite_p256_digit accum[P256_NDIGITS+1] = {0}; + cryptonite_p256_digit hi_carry = 0; + + for (i=0; i>= P256_BITSPERDIGIT; + } + accum[j] = chain; + + mand = accum[0] * MONTGOMERY_FACTOR; + chain = 0; + mier = P256_DIGITS(&cryptonite_SECP256r1_n); + for (j=0; j>= P256_BITSPERDIGIT; + } + chain += accum[j]; + chain += hi_carry; + accum[j-1] = chain; + hi_carry = chain >> P256_BITSPERDIGIT; + } + + memcpy(P256_DIGITS(c), accum, sizeof(*c)); + borrow = cryptonite_p256_sub(c, &cryptonite_SECP256r1_n, c); + addM(&cryptonite_SECP256r1_n, 0, P256_DIGITS(c), borrow + hi_carry); +} + +// b = 1/a mod n, using Fermat's little theorem. +void cryptonite_p256e_scalar_invert(const cryptonite_p256_int* a, cryptonite_p256_int* b) { + cryptonite_p256_int _1, _10, _11, _101, _111, _1010, _1111; + cryptonite_p256_int _10101, _101010, _101111, x6, x8, x16, x32; + int i; + + // Montgomerize + cryptonite_p256e_montmul(a, &cryptonite_SECP256r1_r2, &_1); + + // P-256 (secp256r1) Scalar Inversion + // + cryptonite_p256e_montmul(&_1 , &_1 , &_10); + cryptonite_p256e_montmul(&_10 , &_1 , &_11); + cryptonite_p256e_montmul(&_10 , &_11 , &_101); + cryptonite_p256e_montmul(&_10 , &_101 , &_111); + cryptonite_p256e_montmul(&_101 , &_101 , &_1010); + cryptonite_p256e_montmul(&_101 , &_1010 , &_1111); + NTH_DOUBLE_THEN_ADD(i, &_1010, 1 , &_1 , &_10101); + cryptonite_p256e_montmul(&_10101 , &_10101 , &_101010); + cryptonite_p256e_montmul(&_101 , &_101010, &_101111); + cryptonite_p256e_montmul(&_10101 , &_101010, &x6); + NTH_DOUBLE_THEN_ADD(i, &x6 , 2 , &_11 , &x8); + NTH_DOUBLE_THEN_ADD(i, &x8 , 8 , &x8 , &x16); + NTH_DOUBLE_THEN_ADD(i, &x16 , 16 , &x16 , &x32); + + NTH_DOUBLE_THEN_ADD(i, &x32 , 32+32, &x32 , b); + NTH_DOUBLE_THEN_ADD(i, b , 32, &x32 , b); + NTH_DOUBLE_THEN_ADD(i, b , 6, &_101111, b); + NTH_DOUBLE_THEN_ADD(i, b , 2 + 3, &_111 , b); + NTH_DOUBLE_THEN_ADD(i, b , 2 + 2, &_11 , b); + NTH_DOUBLE_THEN_ADD(i, b , 1 + 4, &_1111 , b); + NTH_DOUBLE_THEN_ADD(i, b , 5, &_10101 , b); + NTH_DOUBLE_THEN_ADD(i, b , 1 + 3, &_101 , b); + NTH_DOUBLE_THEN_ADD(i, b , 3, &_101 , b); + NTH_DOUBLE_THEN_ADD(i, b , 3, &_101 , b); + NTH_DOUBLE_THEN_ADD(i, b , 2 + 3, &_111 , b); + NTH_DOUBLE_THEN_ADD(i, b , 3 + 6, &_101111, b); + NTH_DOUBLE_THEN_ADD(i, b , 2 + 4, &_1111 , b); + NTH_DOUBLE_THEN_ADD(i, b , 1 + 1, &_1 , b); + NTH_DOUBLE_THEN_ADD(i, b , 4 + 1, &_1 , b); + NTH_DOUBLE_THEN_ADD(i, b , 2 + 4, &_1111 , b); + NTH_DOUBLE_THEN_ADD(i, b , 2 + 3, &_111 , b); + NTH_DOUBLE_THEN_ADD(i, b , 1 + 3, &_111 , b); + NTH_DOUBLE_THEN_ADD(i, b , 2 + 3, &_111 , b); + NTH_DOUBLE_THEN_ADD(i, b , 2 + 3, &_101 , b); + NTH_DOUBLE_THEN_ADD(i, b , 1 + 2, &_11 , b); + NTH_DOUBLE_THEN_ADD(i, b , 4 + 6, &_101111, b); + NTH_DOUBLE_THEN_ADD(i, b , 2, &_11 , b); + NTH_DOUBLE_THEN_ADD(i, b , 3 + 2, &_11 , b); + NTH_DOUBLE_THEN_ADD(i, b , 3 + 2, &_11 , b); + NTH_DOUBLE_THEN_ADD(i, b , 2 + 1, &_1 , b); + NTH_DOUBLE_THEN_ADD(i, b , 2 + 5, &_10101 , b); + NTH_DOUBLE_THEN_ADD(i, b , 2 + 4, &_1111 , b); + + // Demontgomerize + cryptonite_p256e_montmul(b, &cryptonite_SECP256r1_one, b); +} diff --git a/tests/KAT_PubKey/P256.hs b/tests/KAT_PubKey/P256.hs index f04603f..63831ce 100644 --- a/tests/KAT_PubKey/P256.hs +++ b/tests/KAT_PubKey/P256.hs @@ -102,7 +102,21 @@ tests = testGroup "P256" , testProperty "inv" $ \r' -> let inv = inverseCoprimes (unP256 r') curveN inv' = P256.scalarInv (unP256Scalar r') - in if unP256 r' == 0 then True else inv `propertyEq` p256ScalarToInteger inv' + in unP256 r' /= 0 ==> inv `propertyEq` p256ScalarToInteger inv' + , testProperty "inv-safe" $ \r' -> + let inv = P256.scalarInv (unP256Scalar r') + inv' = P256.scalarInvSafe (unP256Scalar r') + in unP256 r' /= 0 ==> inv `propertyEq` inv' + , testProperty "inv-safe-mul" $ \r' -> + let inv = P256.scalarInvSafe (unP256Scalar r') + res = P256.scalarMul (unP256Scalar r') inv + in unP256 r' /= 0 ==> 1 `propertyEq` p256ScalarToInteger res + , testProperty "inv-safe-zero" $ + let inv0 = P256.scalarInvSafe P256.scalarZero + invN = P256.scalarInvSafe P256.scalarN + in propertyHold [ eqTest "scalarZero" P256.scalarZero inv0 + , eqTest "scalarN" P256.scalarZero invN + ] ] , testGroup "point" [ testProperty "marshalling" $ \rx ry -> From 15327ecd4ffffa94dfe698e8544f787ec71c8136 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 5 May 2019 09:13:57 +0200 Subject: [PATCH 114/176] ECDSA with a type class --- Crypto/PubKey/ECDSA.hs | 231 +++++++++++++++++++++++++++++++++++++++++ QA.hs | 1 + benchs/Bench.hs | 40 +++++++ cryptonite.cabal | 2 + tests/ECDSA.hs | 61 +++++++++++ tests/Tests.hs | 2 + 6 files changed, 337 insertions(+) create mode 100644 Crypto/PubKey/ECDSA.hs create mode 100644 tests/ECDSA.hs diff --git a/Crypto/PubKey/ECDSA.hs b/Crypto/PubKey/ECDSA.hs new file mode 100644 index 0000000..c1416a0 --- /dev/null +++ b/Crypto/PubKey/ECDSA.hs @@ -0,0 +1,231 @@ +-- | +-- Module : Crypto.PubKey.ECDSA +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- Elliptic Curve Digital Signature Algorithm, with the parameterized +-- curve implementations provided by module "Crypto.ECC". +-- +-- Public/private key pairs can be generated using +-- 'curveGenerateKeyPair' or decoded from binary. +-- +-- /WARNING:/ Only curve P-256 has constant-time implementation. +-- Signature operations with P-384 and P-521 may leak the private key. +-- +-- Signature verification should be safe for all curves. +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +module Crypto.PubKey.ECDSA + ( EllipticCurveECDSA (..) + -- * Public keys + , PublicKey + , encodePublic + , decodePublic + , toPublic + -- * Private keys + , PrivateKey + , encodePrivate + , decodePrivate + -- * Signatures + , Signature(..) + , signatureFromIntegers + , signatureToIntegers + -- * Generation and verification + , signWith + , sign + , verify + ) where + +import Control.Monad + +import Crypto.ECC +import qualified Crypto.ECC.Simple.Types as Simple +import Crypto.Error +import Crypto.Hash +import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess) +import Crypto.Internal.Imports +import Crypto.Number.ModArithmetic (inverseFermat) +import Crypto.Number.Serialize +import qualified Crypto.PubKey.ECC.P256 as P256 +import Crypto.Random.Types + +import Data.Bits (shiftR) +import Data.Data + +-- | Represent a ECDSA signature namely R and S. +data Signature curve = Signature + { sign_r :: Scalar curve -- ^ ECDSA r + , sign_s :: Scalar curve -- ^ ECDSA s + } + +deriving instance Eq (Scalar curve) => Eq (Signature curve) +deriving instance Show (Scalar curve) => Show (Signature curve) + +instance NFData (Scalar curve) => NFData (Signature curve) where + rnf (Signature r s) = rnf r `seq` rnf s `seq` () + +-- | ECDSA Public Key. +type PublicKey curve = Point curve + +-- | ECDSA Private Key. +type PrivateKey curve = Scalar curve + +-- | Elliptic curves with ECDSA capabilities. +class EllipticCurveBasepointArith curve => EllipticCurveECDSA curve where + -- | Is a scalar in the accepted range for ECDSA + scalarIsValid :: proxy curve -> Scalar curve -> Bool + + -- | Test whether the scalar is zero + scalarIsZero :: proxy curve -> Scalar curve -> Bool + scalarIsZero prx s = s == throwCryptoError (scalarFromInteger prx 0) + + -- | Scalar inversion modulo the curve order + scalarInv :: proxy curve -> Scalar curve -> Maybe (Scalar curve) + + -- | Return the point X coordinate as a scalar + pointX :: proxy curve -> Point curve -> Maybe (Scalar curve) + +instance EllipticCurveECDSA Curve_P256R1 where + scalarIsValid _ s = not (P256.scalarIsZero s) + && P256.scalarCmp s P256.scalarN == LT + + scalarIsZero _ = P256.scalarIsZero + + scalarInv _ s = let inv = P256.scalarInvSafe s + in if P256.scalarIsZero inv then Nothing else Just inv + + pointX _ = P256.pointX + +instance EllipticCurveECDSA Curve_P384R1 where + scalarIsValid _ = ecScalarIsValid (Proxy :: Proxy Simple.SEC_p384r1) + + scalarIsZero _ = ecScalarIsZero + + scalarInv _ = ecScalarInv (Proxy :: Proxy Simple.SEC_p384r1) + + pointX _ = ecPointX (Proxy :: Proxy Simple.SEC_p384r1) + +instance EllipticCurveECDSA Curve_P521R1 where + scalarIsValid _ = ecScalarIsValid (Proxy :: Proxy Simple.SEC_p521r1) + + scalarIsZero _ = ecScalarIsZero + + scalarInv _ = ecScalarInv (Proxy :: Proxy Simple.SEC_p521r1) + + pointX _ = ecPointX (Proxy :: Proxy Simple.SEC_p521r1) + + +-- | Create a signature from integers (R, S). +signatureFromIntegers :: EllipticCurveECDSA curve + => proxy curve -> (Integer, Integer) -> CryptoFailable (Signature curve) +signatureFromIntegers prx (r, s) = + liftA2 Signature (scalarFromInteger prx r) (scalarFromInteger prx s) + +-- | Get integers (R, S) from a signature. +-- +-- The values can then be used to encode the signature to binary with +-- ASN.1. +signatureToIntegers :: EllipticCurveECDSA curve + => proxy curve -> Signature curve -> (Integer, Integer) +signatureToIntegers prx sig = + (scalarToInteger prx $ sign_r sig, scalarToInteger prx $ sign_s sig) + +-- | Encode a public key into binary form, i.e. the uncompressed encoding +-- referenced from section 2.2. +encodePublic :: (EllipticCurve curve, ByteArray bs) + => proxy curve -> PublicKey curve -> bs +encodePublic = encodePoint + +-- | Try to decode the binary form of a public key. +decodePublic :: (EllipticCurve curve, ByteArray bs) + => proxy curve -> bs -> CryptoFailable (PublicKey curve) +decodePublic = decodePoint + +-- | Encode a private key into binary form, i.e. the @privateKey@ field +-- described in . +encodePrivate :: (EllipticCurveECDSA curve, ByteArray bs) + => proxy curve -> PrivateKey curve -> bs +encodePrivate = encodeScalar + +-- | Try to decode the binary form of a private key. +decodePrivate :: (EllipticCurveECDSA curve, ByteArray bs) + => proxy curve -> bs -> CryptoFailable (PrivateKey curve) +decodePrivate = decodeScalar + +-- | Create a public key from a private key. +toPublic :: EllipticCurveECDSA curve + => proxy curve -> PrivateKey curve -> PublicKey curve +toPublic = pointBaseSmul + +-- | Sign message using the private key and an explicit k scalar. +signWith :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash) + => proxy curve -> Scalar curve -> PrivateKey curve -> hash -> msg -> Maybe (Signature curve) +signWith prx k d hashAlg msg = do + let z = tHash prx hashAlg msg + point = pointBaseSmul prx k + r <- pointX prx point + kInv <- scalarInv prx k + let s = scalarMul prx kInv (scalarAdd prx z (scalarMul prx r d)) + when (scalarIsZero prx r || scalarIsZero prx s) Nothing + return $ Signature r s + +-- | Sign a message using hash and private key. +sign :: (EllipticCurveECDSA curve, MonadRandom m, ByteArrayAccess msg, HashAlgorithm hash) + => proxy curve -> PrivateKey curve -> hash -> msg -> m (Signature curve) +sign prx pk hashAlg msg = do + k <- curveGenerateScalar prx + case signWith prx k pk hashAlg msg of + Nothing -> sign prx pk hashAlg msg + Just sig -> return sig + +-- | Verify a signature using hash and public key. +verify :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash) + => proxy curve -> hash -> PublicKey curve -> Signature curve -> msg -> Bool +verify prx hashAlg q (Signature r s) msg + | not (scalarIsValid prx r) = False + | not (scalarIsValid prx s) = False + | otherwise = maybe False (r ==) $ do + w <- scalarInv prx s + let z = tHash prx hashAlg msg + u1 = scalarMul prx z w + u2 = scalarMul prx r w + x = pointsSmulVarTime prx u1 u2 q + pointX prx x + -- Note: precondition q /= PointO is not tested because we assume + -- point decoding never decodes point at infinity. + +-- | Truncate and hash. +tHash :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash) + => proxy curve -> hash -> msg -> Scalar curve +tHash prx hashAlg m = + throwCryptoError $ scalarFromInteger prx (if d > 0 then shiftR e d else e) + where e = os2ip $ hashWith hashAlg m + d = hashDigestSize hashAlg * 8 - curveOrderBits prx + + +ecScalarIsValid :: Simple.Curve c => proxy c -> Simple.Scalar c -> Bool +ecScalarIsValid prx (Simple.Scalar s) = s > 0 && s < n + where n = Simple.curveEccN $ Simple.curveParameters prx + +ecScalarIsZero :: forall curve . Simple.Curve curve + => Simple.Scalar curve -> Bool +ecScalarIsZero (Simple.Scalar a) = a == 0 + +ecScalarInv :: Simple.Curve c + => proxy c -> Simple.Scalar c -> Maybe (Simple.Scalar c) +ecScalarInv prx (Simple.Scalar s) + | i == 0 = Nothing + | otherwise = Just $ Simple.Scalar i + where n = Simple.curveEccN $ Simple.curveParameters prx + i = inverseFermat s n + +ecPointX :: Simple.Curve c + => proxy c -> Simple.Point c -> Maybe (Simple.Scalar c) +ecPointX _ Simple.PointO = Nothing +ecPointX prx (Simple.Point x _) = Just (Simple.Scalar $ x `mod` n) + where n = Simple.curveEccN $ Simple.curveParameters prx diff --git a/QA.hs b/QA.hs index bf6b2e2..f3090bb 100644 --- a/QA.hs +++ b/QA.hs @@ -47,6 +47,7 @@ perModuleAllowedExtensions = , ("Crypto/Cipher/DES/Primitive.hs", [FlexibleInstances]) , ("Crypto/Cipher/Twofish/Primitive.hs", [MagicHash]) , ("Crypto/PubKey/Curve25519.hs", [MagicHash]) + , ("Crypto/PubKey/ECDSA.hs", [FlexibleContexts,StandaloneDeriving,UndecidableInstances]) , ("Crypto/Number/Compat.hs", [UnboxedTuples,MagicHash,CPP]) , ("Crypto/System/CPU.hs", [CPP]) ] diff --git a/benchs/Bench.hs b/benchs/Bench.hs index bc1d668..e111a0d 100644 --- a/benchs/Bench.hs +++ b/benchs/Bench.hs @@ -23,6 +23,7 @@ import Crypto.Number.Generate import qualified Crypto.PubKey.DH as DH import qualified Crypto.PubKey.ECC.Types as ECC import qualified Crypto.PubKey.ECC.Prim as ECC +import qualified Crypto.PubKey.ECDSA as ECDSA import Crypto.Random import Control.DeepSeq (NFData) @@ -286,6 +287,44 @@ benchECDH = map doECDHBench curves , ("X448", CurveDH Curve_X448) ] +data CurveHashECDSA = + forall curve hashAlg . (ECDSA.EllipticCurveECDSA curve, + NFData (Scalar curve), + NFData (Point curve), + HashAlgorithm hashAlg) => CurveHashECDSA curve hashAlg + +benchECDSA = map doECDSABench curveHashes + where + doECDSABench (name, CurveHashECDSA c hashAlg) = + let proxy = Just c -- using Maybe as Proxy + in bgroup name + [ env (signGenerate proxy) $ bench "sign" . nfIO . signRun proxy hashAlg + , env (verifyGenerate proxy hashAlg) $ bench "verify" . nf (verifyRun proxy hashAlg) + ] + + signGenerate proxy = do + m <- tenKB + s <- curveGenerateScalar proxy + return (s, m) + + signRun proxy hashAlg (priv, msg) = ECDSA.sign proxy priv hashAlg msg + + verifyGenerate proxy hashAlg = do + m <- tenKB + KeyPair p s <- curveGenerateKeyPair proxy + sig <- ECDSA.sign proxy s hashAlg m + return (p, sig, m) + + verifyRun proxy hashAlg (pub, sig, msg) = ECDSA.verify proxy hashAlg pub sig msg + + tenKB :: IO Bytes + tenKB = getRandomBytes 10240 + + curveHashes = [ ("secp256r1_sha256", CurveHashECDSA Curve_P256R1 SHA256) + , ("secp384r1_sha384", CurveHashECDSA Curve_P384R1 SHA384) + , ("secp521r1_sha512", CurveHashECDSA Curve_P521R1 SHA512) + ] + main = defaultMain [ bgroup "hash" benchHash , bgroup "block-cipher" benchBlockCipher @@ -298,5 +337,6 @@ main = defaultMain [ bgroup "FFDH" benchFFDH , bgroup "ECDH" benchECDH ] + , bgroup "ECDSA" benchECDSA , bgroup "F2m" benchF2m ] diff --git a/cryptonite.cabal b/cryptonite.cabal index f7372c9..637521a 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -159,6 +159,7 @@ Library Crypto.PubKey.ECC.ECDSA Crypto.PubKey.ECC.P256 Crypto.PubKey.ECC.Types + Crypto.PubKey.ECDSA Crypto.PubKey.ECIES Crypto.PubKey.Ed25519 Crypto.PubKey.Ed448 @@ -387,6 +388,7 @@ Test-Suite test-cryptonite BCryptPBKDF ECC ECC.Edwards25519 + ECDSA Hash Imports KAT_AES.KATCBC diff --git a/tests/ECDSA.hs b/tests/ECDSA.hs new file mode 100644 index 0000000..7d8f2a6 --- /dev/null +++ b/tests/ECDSA.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +module ECDSA (tests) where + +import qualified Crypto.ECC as ECDSA +import qualified Crypto.PubKey.ECC.ECDSA as ECC +import qualified Crypto.PubKey.ECC.Types as ECC +import qualified Crypto.PubKey.ECDSA as ECDSA +import Crypto.Hash.Algorithms +import Crypto.Error +import qualified Data.ByteString as B + +import Imports + +data Curve = forall curve. (ECDSA.EllipticCurveECDSA curve, Show (ECDSA.Scalar curve)) => Curve curve ECC.Curve ECC.CurveName + +instance Show Curve where + showsPrec d (Curve _ _ name) = showsPrec d name + +instance Arbitrary Curve where + arbitrary = elements + [ makeCurve ECDSA.Curve_P256R1 ECC.SEC_p256r1 + , makeCurve ECDSA.Curve_P384R1 ECC.SEC_p384r1 + , makeCurve ECDSA.Curve_P521R1 ECC.SEC_p521r1 + ] + where + makeCurve c name = Curve c (ECC.getCurveByName name) name + +arbitraryScalar curve = choose (1, n - 1) + where n = ECC.ecc_n (ECC.common_curve curve) + +sigECCToECDSA :: ECDSA.EllipticCurveECDSA curve + => proxy curve -> ECC.Signature -> ECDSA.Signature curve +sigECCToECDSA prx (ECC.Signature r s) = + ECDSA.Signature (throwCryptoError $ ECDSA.scalarFromInteger prx r) + (throwCryptoError $ ECDSA.scalarFromInteger prx s) + +tests = localOption (QuickCheckTests 5) $ testGroup "ECDSA" + [ testProperty "SHA1" $ propertyECDSA SHA1 + , testProperty "SHA224" $ propertyECDSA SHA224 + , testProperty "SHA256" $ propertyECDSA SHA256 + , testProperty "SHA384" $ propertyECDSA SHA384 + , testProperty "SHA512" $ propertyECDSA SHA512 + ] + where + propertyECDSA hashAlg (Curve c curve _) (ArbitraryBS0_2901 msg) = do + d <- arbitraryScalar curve + kECC <- arbitraryScalar curve + let privECC = ECC.PrivateKey curve d + prx = Just c -- using Maybe as Proxy + kECDSA = throwCryptoError $ ECDSA.scalarFromInteger prx kECC + privECDSA = throwCryptoError $ ECDSA.scalarFromInteger prx d + pubECDSA = ECDSA.toPublic prx privECDSA + Just sigECC = ECC.signWith kECC privECC hashAlg msg + Just sigECDSA = ECDSA.signWith prx kECDSA privECDSA hashAlg msg + sigECDSA' = sigECCToECDSA prx sigECC + msg' = msg `B.append` B.singleton 42 + return $ propertyHold [ eqTest "signature" sigECDSA sigECDSA' + , eqTest "verification" True (ECDSA.verify prx hashAlg pubECDSA sigECDSA' msg) + , eqTest "alteration" False (ECDSA.verify prx hashAlg pubECDSA sigECDSA msg') + ] diff --git a/tests/Tests.hs b/tests/Tests.hs index 4e2a863..f379fc8 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -11,6 +11,7 @@ import qualified BCrypt import qualified BCryptPBKDF import qualified ECC import qualified ECC.Edwards25519 +import qualified ECDSA import qualified Hash import qualified Poly1305 import qualified Salsa @@ -96,6 +97,7 @@ tests = testGroup "cryptonite" , KAT_AFIS.tests , ECC.tests , ECC.Edwards25519.tests + , ECDSA.tests ] main = defaultMain tests From b9a8a6b83dc8d375e4abd1dfaf745088aed0c367 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Wed, 8 May 2019 08:18:07 +0200 Subject: [PATCH 115/176] ECDSA with digest --- Crypto/PubKey/ECDSA.hs | 63 ++++++++++++++++++++++++++++-------------- 1 file changed, 42 insertions(+), 21 deletions(-) diff --git a/Crypto/PubKey/ECDSA.hs b/Crypto/PubKey/ECDSA.hs index c1416a0..941f909 100644 --- a/Crypto/PubKey/ECDSA.hs +++ b/Crypto/PubKey/ECDSA.hs @@ -37,8 +37,11 @@ module Crypto.PubKey.ECDSA , signatureToIntegers -- * Generation and verification , signWith + , signDigestWith , sign + , signDigest , verify + , verifyDigest ) where import Control.Monad @@ -162,11 +165,11 @@ toPublic :: EllipticCurveECDSA curve => proxy curve -> PrivateKey curve -> PublicKey curve toPublic = pointBaseSmul --- | Sign message using the private key and an explicit k scalar. -signWith :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash) - => proxy curve -> Scalar curve -> PrivateKey curve -> hash -> msg -> Maybe (Signature curve) -signWith prx k d hashAlg msg = do - let z = tHash prx hashAlg msg +-- | Sign digest using the private key and an explicit k scalar. +signDigestWith :: (EllipticCurveECDSA curve, HashAlgorithm hash) + => proxy curve -> Scalar curve -> PrivateKey curve -> Digest hash -> Maybe (Signature curve) +signDigestWith prx k d digest = do + let z = tHashDigest prx digest point = pointBaseSmul prx k r <- pointX prx point kInv <- scalarInv prx k @@ -174,24 +177,34 @@ signWith prx k d hashAlg msg = do when (scalarIsZero prx r || scalarIsZero prx s) Nothing return $ Signature r s +-- | Sign message using the private key and an explicit k scalar. +signWith :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash) + => proxy curve -> Scalar curve -> PrivateKey curve -> hash -> msg -> Maybe (Signature curve) +signWith prx k d hashAlg msg = signDigestWith prx k d (hashWith hashAlg msg) + +-- | Sign a digest using hash and private key. +signDigest :: (EllipticCurveECDSA curve, MonadRandom m, HashAlgorithm hash) + => proxy curve -> PrivateKey curve -> Digest hash -> m (Signature curve) +signDigest prx pk digest = do + k <- curveGenerateScalar prx + case signDigestWith prx k pk digest of + Nothing -> signDigest prx pk digest + Just sig -> return sig + -- | Sign a message using hash and private key. sign :: (EllipticCurveECDSA curve, MonadRandom m, ByteArrayAccess msg, HashAlgorithm hash) => proxy curve -> PrivateKey curve -> hash -> msg -> m (Signature curve) -sign prx pk hashAlg msg = do - k <- curveGenerateScalar prx - case signWith prx k pk hashAlg msg of - Nothing -> sign prx pk hashAlg msg - Just sig -> return sig +sign prx pk hashAlg msg = signDigest prx pk (hashWith hashAlg msg) --- | Verify a signature using hash and public key. -verify :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash) - => proxy curve -> hash -> PublicKey curve -> Signature curve -> msg -> Bool -verify prx hashAlg q (Signature r s) msg +-- | Verify a digest using hash and public key. +verifyDigest :: (EllipticCurveECDSA curve, HashAlgorithm hash) + => proxy curve -> PublicKey curve -> Signature curve -> Digest hash -> Bool +verifyDigest prx q (Signature r s) digest | not (scalarIsValid prx r) = False | not (scalarIsValid prx s) = False | otherwise = maybe False (r ==) $ do w <- scalarInv prx s - let z = tHash prx hashAlg msg + let z = tHashDigest prx digest u1 = scalarMul prx z w u2 = scalarMul prx r w x = pointsSmulVarTime prx u1 u2 q @@ -199,13 +212,21 @@ verify prx hashAlg q (Signature r s) msg -- Note: precondition q /= PointO is not tested because we assume -- point decoding never decodes point at infinity. --- | Truncate and hash. -tHash :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash) - => proxy curve -> hash -> msg -> Scalar curve -tHash prx hashAlg m = +-- | Verify a signature using hash and public key. +verify :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash) + => proxy curve -> hash -> PublicKey curve -> Signature curve -> msg -> Bool +verify prx hashAlg q sig msg = verifyDigest prx q sig (hashWith hashAlg msg) + +-- | Truncate a digest based on curve order size. +tHashDigest :: (EllipticCurveECDSA curve, HashAlgorithm hash) + => proxy curve -> Digest hash -> Scalar curve +tHashDigest prx digest = throwCryptoError $ scalarFromInteger prx (if d > 0 then shiftR e d else e) - where e = os2ip $ hashWith hashAlg m - d = hashDigestSize hashAlg * 8 - curveOrderBits prx + where e = os2ip digest + d = hashDigestSize (getHashAlg digest) * 8 - curveOrderBits prx + +getHashAlg :: Digest hash -> hash +getHashAlg _ = undefined ecScalarIsValid :: Simple.Curve c => proxy c -> Simple.Scalar c -> Bool From 99820c742dec2b0fb808a1114a9cb09eda73e667 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 12 May 2019 08:10:11 +0200 Subject: [PATCH 116/176] Truncate the digest without Integer conversion --- Crypto/PubKey/ECDSA.hs | 36 ++++++++++++++++++++++++++++-------- 1 file changed, 28 insertions(+), 8 deletions(-) diff --git a/Crypto/PubKey/ECDSA.hs b/Crypto/PubKey/ECDSA.hs index 941f909..3014216 100644 --- a/Crypto/PubKey/ECDSA.hs +++ b/Crypto/PubKey/ECDSA.hs @@ -15,6 +15,7 @@ -- Signature operations with P-384 and P-521 may leak the private key. -- -- Signature verification should be safe for all curves. +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} @@ -50,16 +51,20 @@ import Crypto.ECC import qualified Crypto.ECC.Simple.Types as Simple import Crypto.Error import Crypto.Hash +import Crypto.Hash.Types import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess) import Crypto.Internal.Imports import Crypto.Number.ModArithmetic (inverseFermat) -import Crypto.Number.Serialize import qualified Crypto.PubKey.ECC.P256 as P256 import Crypto.Random.Types -import Data.Bits (shiftR) +import Data.Bits +import qualified Data.ByteArray as B import Data.Data +import Foreign.Ptr (Ptr) +import Foreign.Storable (peekByteOff, pokeByteOff) + -- | Represent a ECDSA signature namely R and S. data Signature curve = Signature { sign_r :: Scalar curve -- ^ ECDSA r @@ -220,13 +225,28 @@ verify prx hashAlg q sig msg = verifyDigest prx q sig (hashWith hashAlg msg) -- | Truncate a digest based on curve order size. tHashDigest :: (EllipticCurveECDSA curve, HashAlgorithm hash) => proxy curve -> Digest hash -> Scalar curve -tHashDigest prx digest = - throwCryptoError $ scalarFromInteger prx (if d > 0 then shiftR e d else e) - where e = os2ip digest - d = hashDigestSize (getHashAlg digest) * 8 - curveOrderBits prx +tHashDigest prx (Digest digest) = throwCryptoError $ decodeScalar prx encoded + where m = curveOrderBits prx + d = m - B.length digest * 8 + (n, r) = m `divMod` 8 + n' = if r > 0 then succ n else n -getHashAlg :: Digest hash -> hash -getHashAlg _ = undefined + encoded + | d > 0 = B.zero (n' - B.length digest) `B.append` digest + | d == 0 = digest + | r == 0 = B.take n digest + | otherwise = shiftBytes digest + + shiftBytes bs = B.allocAndFreeze n' $ \dst -> + B.withByteArray bs $ \src -> go dst src 0 0 + + go :: Ptr Word8 -> Ptr Word8 -> Word8 -> Int -> IO () + go dst src !a i + | i >= n' = return () + | otherwise = do + b <- peekByteOff src i + pokeByteOff dst i (unsafeShiftR b (8 - r) .|. unsafeShiftL a r) + go dst src b (succ i) ecScalarIsValid :: Simple.Curve c => proxy c -> Simple.Scalar c -> Bool From 78684bc62b554949a5e38a4dc8a6ce782fc4b5e2 Mon Sep 17 00:00:00 2001 From: Brian Wignall Date: Sat, 30 Nov 2019 18:22:26 -0500 Subject: [PATCH 117/176] Fix typos --- Crypto/ConstructHash/MiyaguchiPreneel.hs | 2 +- Crypto/Data/Padding.hs | 2 +- Crypto/Number/ModArithmetic.hs | 2 +- Crypto/Number/Prime.hs | 2 +- Crypto/System/CPU.hs | 2 +- cbits/cryptonite_rdrand.c | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/Crypto/ConstructHash/MiyaguchiPreneel.hs b/Crypto/ConstructHash/MiyaguchiPreneel.hs index 636af08..9f6a19a 100644 --- a/Crypto/ConstructHash/MiyaguchiPreneel.hs +++ b/Crypto/ConstructHash/MiyaguchiPreneel.hs @@ -44,7 +44,7 @@ compute' g = MP . foldl' (step $ g) (B.replicate bsz 0) . chunks . pad (ZERO bsz where (hd, tl) = B.splitAt bsz msg --- | Compute Miyaguchi-Preneel one way compress using the infered block cipher. +-- | Compute Miyaguchi-Preneel one way compress using the inferred block cipher. -- Only safe when KEY-SIZE equals to BLOCK-SIZE. -- -- Simple usage /mp' msg :: MiyaguchiPreneel AES128/ diff --git a/Crypto/Data/Padding.hs b/Crypto/Data/Padding.hs index 66ed160..902b132 100644 --- a/Crypto/Data/Padding.hs +++ b/Crypto/Data/Padding.hs @@ -6,7 +6,7 @@ -- Portability : unknown -- -- Various cryptographic padding commonly used for block ciphers --- or assymetric systems. +-- or asymmetric systems. -- module Crypto.Data.Padding ( Format(..) diff --git a/Crypto/Number/ModArithmetic.hs b/Crypto/Number/ModArithmetic.hs index dcd8663..4da96ff 100644 --- a/Crypto/Number/ModArithmetic.hs +++ b/Crypto/Number/ModArithmetic.hs @@ -56,7 +56,7 @@ expSafe b e m -- hiding parameters. -- -- Use this function when all the parameters are public, --- otherwise 'expSafe' should be prefered. +-- otherwise 'expSafe' should be preferred. expFast :: Integer -- ^ base -> Integer -- ^ exponent -> Integer -- ^ modulo diff --git a/Crypto/Number/Prime.hs b/Crypto/Number/Prime.hs index e48477d..808f1e0 100644 --- a/Crypto/Number/Prime.hs +++ b/Crypto/Number/Prime.hs @@ -127,7 +127,7 @@ primalityTestMillerRabin tries !n = factorise :: Integer -> Integer -> (Integer, Integer) factorise !si !vi | vi `testBit` 0 = (si, vi) - | otherwise = factorise (si+1) (vi `shiftR` 1) -- probably faster to not shift v continously, but just once. + | otherwise = factorise (si+1) (vi `shiftR` 1) -- probably faster to not shift v continuously, but just once. expmod = expSafe -- when iteration reach zero, we have a probable prime diff --git a/Crypto/System/CPU.hs b/Crypto/System/CPU.hs index 47e9eb6..72335d2 100644 --- a/Crypto/System/CPU.hs +++ b/Crypto/System/CPU.hs @@ -31,7 +31,7 @@ import Crypto.Random.Entropy.RDRand import Crypto.Random.Entropy.Source #endif --- | CPU options impacting cryptography implementation and libary performance. +-- | CPU options impacting cryptography implementation and library performance. data ProcessorOption = AESNI -- ^ Support for AES instructions, with flag @support_aesni@ | PCLMUL -- ^ Support for CLMUL instructions, with flag @support_pclmuldq@ diff --git a/cbits/cryptonite_rdrand.c b/cbits/cryptonite_rdrand.c index 03f6278..74f9d63 100644 --- a/cbits/cryptonite_rdrand.c +++ b/cbits/cryptonite_rdrand.c @@ -91,7 +91,7 @@ static inline int cryptonite_rdrand_step(RDRAND_T *buffer) } #endif -/* Returns the number of bytes succesfully generated */ +/* Returns the number of bytes successfully generated */ int cryptonite_get_rand_bytes(uint8_t *buffer, size_t len) { RDRAND_T tmp; From 0a1aa3517c1c234c68103826b21c5c64bc6ae2cb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Tue, 3 Dec 2019 21:05:47 +0100 Subject: [PATCH 118/176] Fix warnings and whitespace --- Crypto/Number/ModArithmetic.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/Crypto/Number/ModArithmetic.hs b/Crypto/Number/ModArithmetic.hs index 35dc41f..9ac1440 100644 --- a/Crypto/Number/ModArithmetic.hs +++ b/Crypto/Number/ModArithmetic.hs @@ -1,5 +1,4 @@ {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DeriveDataTypeable #-} -- | -- Module : Crypto.Number.ModArithmetic -- License : BSD-style @@ -71,7 +70,7 @@ exponentiation b e m | b == 1 = b | e == 0 = 1 | e == 1 = b `mod` m - | even e = let p = (exponentiation b (e `div` 2) m) `mod` m + | even e = let p = exponentiation b (e `div` 2) m `mod` m in (p^(2::Integer)) `mod` m | otherwise = (b * exponentiation b (e-1) m) `mod` m @@ -98,17 +97,17 @@ inverseCoprimes g m = -- | Computes the Jacobi symbol (a/n). -- 0 ≤ a < n; n ≥ 3 and odd. --- +-- -- The Legendre and Jacobi symbols are indistinguishable exactly when the -- lower argument is an odd prime, in which case they have the same value. --- +-- -- See algorithm 2.149 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al. jacobi :: Integer -> Integer -> Maybe Integer jacobi a n | n < 3 || even n = Nothing | a == 0 || a == 1 = Just a - | n <= a = jacobi (a `mod` n) n - | a < 0 = + | n <= a = jacobi (a `mod` n) n + | a < 0 = let b = if n `mod` 4 == 1 then 1 else -1 in fmap (*b) (jacobi (-a) n) | otherwise = From 9e0dbb32313b38cb21ce39ac1092e88dd41c0880 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 7 Dec 2019 08:35:14 +0100 Subject: [PATCH 119/176] Modular square root --- Crypto/Number/ModArithmetic.hs | 92 +++++++++++++++++++++++++++++++++- tests/Number.hs | 12 +++++ 2 files changed, 103 insertions(+), 1 deletion(-) diff --git a/Crypto/Number/ModArithmetic.hs b/Crypto/Number/ModArithmetic.hs index 9ac1440..edb2679 100644 --- a/Crypto/Number/ModArithmetic.hs +++ b/Crypto/Number/ModArithmetic.hs @@ -14,8 +14,10 @@ module Crypto.Number.ModArithmetic -- * Inverse computing , inverse , inverseCoprimes - , jacobi , inverseFermat + -- * Squares + , jacobi + , squareRoot ) where import Control.Exception (throw, Exception) @@ -125,3 +127,91 @@ jacobi a n -- the modulus is prime but avoids side channels like in 'expSafe'. inverseFermat :: Integer -> Integer -> Integer inverseFermat g p = expSafe g (p - 2) p + +-- | Raised when the assumption about the modulus is invalid. +data ModulusAssertionError = ModulusAssertionError + deriving (Show) + +instance Exception ModulusAssertionError + +-- | Modular square root of @g@ modulo a prime @p@. +-- +-- If the modulus is found not to be prime, the function will raise a +-- 'ModulusAssertionError'. +-- +-- This implementation is variable time and should be used with public +-- parameters only. +squareRoot :: Integer -> Integer -> Maybe Integer +squareRoot p + | p < 2 = throw ModulusAssertionError + | otherwise = + case p `divMod` 8 of + (v, 3) -> method1 (2 * v + 1) + (v, 7) -> method1 (2 * v + 2) + (u, 5) -> method2 u + (_, 1) -> tonelliShanks p + (0, 2) -> \a -> Just (if even a then 0 else 1) + _ -> throw ModulusAssertionError + + where + x `eqMod` y = (x - y) `mod` p == 0 + + validate g y | (y * y) `eqMod` g = Just y + | otherwise = Nothing + + -- p == 4u + 3 and u' == u + 1 + method1 u' g = + let y = expFast g u' p + in validate g y + + -- p == 8u + 5 + method2 u g = + let gamma = expFast (2 * g) u p + g_gamma = g * gamma + i = (2 * g_gamma * gamma) `mod` p + y = (g_gamma * (i - 1)) `mod` p + in validate g y + +tonelliShanks :: Integer -> Integer -> Maybe Integer +tonelliShanks p a + | aa == 0 = Just 0 + | otherwise = + case expFast aa p2 p of + b | b == p1 -> Nothing + | b == 1 -> Just $ go (expFast aa ((s + 1) `div` 2) p) + (expFast aa s p) + (expFast n s p) + e + | otherwise -> throw ModulusAssertionError + where + aa = a `mod` p + p1 = p - 1 + p2 = p1 `div` 2 + n = findN 2 + + x `mul` y = (x * y) `mod` p + + pow2m 0 x = x + pow2m i x = pow2m (i - 1) (x `mul` x) + + (e, s) = asPowerOf2AndOdd p1 + + -- find a quadratic non-residue + findN i + | expFast i p2 p == p1 = i + | otherwise = findN (i + 1) + + -- find m such that b^(2^m) == 1 (mod p) + findM b i + | b == 1 = i + | otherwise = findM (b `mul` b) (i + 1) + + go !x b g !r + | b == 1 = x + | otherwise = + let r' = findM b 0 + z = pow2m (r - r' - 1) g + x' = x `mul` z + b' = b `mul` g' + g' = z `mul` z + in go x' b' g' r' diff --git a/tests/Number.hs b/tests/Number.hs index 0b8f654..7aa6acf 100644 --- a/tests/Number.hs +++ b/tests/Number.hs @@ -10,6 +10,7 @@ import Crypto.Number.Generate import qualified Crypto.Number.Serialize as BE import qualified Crypto.Number.Serialize.LE as LE import Crypto.Number.Prime +import Crypto.Number.ModArithmetic import Data.Bits serializationVectors :: [(Int, Integer, ByteString)] @@ -55,6 +56,17 @@ tests = testGroup "number" , testProperty "as-power-of-2-and-odd" $ \n -> let (e, a1) = asPowerOf2AndOdd n in n == (2^e)*a1 + , testProperty "squareRoot" $ \testDRG (Int0_2901 baseBits') -> do + let baseBits = baseBits' `mod` 500 + bits = 5 + baseBits -- generating lower than 5 bits causes an error .. + p = withTestDRG testDRG $ generatePrime bits + g <- choose (1, p - 1) + let square x = (x * x) `mod` p + r = square <$> squareRoot p g + case jacobi g p of + Just 1 -> return $ Just g `assertEq` r + Just (-1) -> return $ Nothing `assertEq` r + _ -> error "invalid jacobi result" , testProperty "marshalling-be" $ \qaInt -> getQAInteger qaInt == BE.os2ip (BE.i2osp (getQAInteger qaInt) :: Bytes) , testProperty "marshalling-le" $ \qaInt -> From 1f6ed5711c4a8697564e42a832522c925442aa6f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 4 Jan 2020 10:58:22 +0100 Subject: [PATCH 120/176] Warn about non-uniform distribution with QuickCheck --- Crypto/Random.hs | 4 ++++ tests/Utils.hs | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/Crypto/Random.hs b/Crypto/Random.hs index 37d4124..4cea74b 100644 --- a/Crypto/Random.hs +++ b/Crypto/Random.hs @@ -80,6 +80,10 @@ drgNewSeed (Seed seed) = initialize seed -- -- It can also be used in other contexts provided the input -- has been properly randomly generated. +-- +-- Note that the @Arbitrary@ instance provided by QuickCheck for 'Word64' does +-- not have a uniform distribution. It is often better to use instead +-- @arbitraryBoundedRandom@. drgNewTest :: (Word64, Word64, Word64, Word64, Word64) -> ChaChaDRG drgNewTest = initializeWords diff --git a/tests/Utils.hs b/tests/Utils.hs index 03ba521..bf16bb4 100644 --- a/tests/Utils.hs +++ b/tests/Utils.hs @@ -19,7 +19,7 @@ newtype TestDRG = TestDRG (Word64, Word64, Word64, Word64, Word64) deriving (Show,Eq) instance Arbitrary TestDRG where - arbitrary = TestDRG `fmap` arbitrary + arbitrary = TestDRG `fmap` arbitrary -- distribution not uniform withTestDRG (TestDRG l) f = fst $ withDRG (drgNewTest l) f From 7ac30608737ebc8a381e7471d4b3c8ff8bc5979c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 27 Dec 2019 19:34:47 +0100 Subject: [PATCH 121/176] Better P256.pointMul performance Use dedicated function to avoid multiplying the basepoint with 0. --- Crypto/PubKey/ECC/P256.hs | 24 +++++++++++------------- cbits/p256/p256_ec.c | 17 +++++++++++++++++ 2 files changed, 28 insertions(+), 13 deletions(-) diff --git a/Crypto/PubKey/ECC/P256.hs b/Crypto/PubKey/ECC/P256.hs index 77a5ff0..f9ec7d0 100644 --- a/Crypto/PubKey/ECC/P256.hs +++ b/Crypto/PubKey/ECC/P256.hs @@ -124,16 +124,16 @@ pointNegate a = withNewPoint $ \dx dy -> -- warning: variable time pointMul :: Scalar -> Point -> Point pointMul scalar p = withNewPoint $ \dx dy -> - withScalar scalar $ \n -> withPoint p $ \px py -> withScalarZero $ \nzero -> - ccryptonite_p256_points_mul_vartime nzero n px py dx dy + withScalar scalar $ \n -> withPoint p $ \px py -> + ccryptonite_p256e_point_mul n px py dx dy -- | Similar to 'pointMul', serializing the x coordinate as binary. -- When scalar is multiple of point order the result is all zero. pointDh :: ByteArray binary => Scalar -> Point -> binary pointDh scalar p = B.unsafeCreate scalarSize $ \dst -> withTempPoint $ \dx dy -> do - withScalar scalar $ \n -> withPoint p $ \px py -> withScalarZero $ \nzero -> - ccryptonite_p256_points_mul_vartime nzero n px py dx dy + withScalar scalar $ \n -> withPoint p $ \px py -> + ccryptonite_p256e_point_mul n px py dx dy ccryptonite_p256_to_bin (castPtr dx) dst -- | multiply the point @p with @n2 and add a lifted to curve value @n1 @@ -338,18 +338,9 @@ withNewScalarFreeze f = Scalar $ B.allocAndFreeze scalarSize f withTempPoint :: (Ptr P256X -> Ptr P256Y -> IO a) -> IO a withTempPoint f = allocTempScrubbed pointSize (\p -> let px = castPtr p in f px (pxToPy px)) -withTempScalar :: (Ptr P256Scalar -> IO a) -> IO a -withTempScalar f = allocTempScrubbed scalarSize (f . castPtr) - withScalar :: Scalar -> (Ptr P256Scalar -> IO a) -> IO a withScalar (Scalar d) f = B.withByteArray d f -withScalarZero :: (Ptr P256Scalar -> IO a) -> IO a -withScalarZero f = - withTempScalar $ \d -> do - ccryptonite_p256_init d - f d - allocTemp :: Int -> (Ptr Word8 -> IO a) -> IO a allocTemp n f = ignoreSnd <$> B.allocRet n f where @@ -412,6 +403,13 @@ foreign import ccall "cryptonite_p256e_point_negate" -> Ptr P256X -> Ptr P256Y -> IO () +-- compute (out_x,out_y) = n * (in_x,in_y) +foreign import ccall "cryptonite_p256e_point_mul" + ccryptonite_p256e_point_mul :: Ptr P256Scalar -- n + -> Ptr P256X -> Ptr P256Y -- in_{x,y} + -> Ptr P256X -> Ptr P256Y -- out_{x,y} + -> IO () + -- compute (out_x,out,y) = n1 * G + n2 * (in_x,in_y) foreign import ccall "cryptonite_p256_points_mul_vartime" ccryptonite_p256_points_mul_vartime :: Ptr P256Scalar -- n1 diff --git a/cbits/p256/p256_ec.c b/cbits/p256/p256_ec.c index 2d1650a..41c183a 100644 --- a/cbits/p256/p256_ec.c +++ b/cbits/p256/p256_ec.c @@ -1311,3 +1311,20 @@ void cryptonite_p256e_point_negate( memcpy(out_x, in_x, P256_NBYTES); cryptonite_p256_sub(&cryptonite_SECP256r1_p, in_y, out_y); } + +/* this function is not part of the original source + cryptonite_p256e_point_mul sets {out_x,out_y} = n*{in_x,in_y}, where + n is < the order of the group. + */ +void cryptonite_p256e_point_mul(const cryptonite_p256_int* n, + const cryptonite_p256_int* in_x, const cryptonite_p256_int* in_y, + cryptonite_p256_int* out_x, cryptonite_p256_int* out_y) { + felem x, y, z, px, py; + + to_montgomery(px, in_x); + to_montgomery(py, in_y); + scalar_mult(x, y, z, px, py, n); + point_to_affine(px, py, x, y, z); + from_montgomery(out_x, px); + from_montgomery(out_y, py); +} From b5d9b6cba5485c7449af06a60a80a68cc755fb09 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 12 Jan 2020 18:21:17 +0100 Subject: [PATCH 122/176] Add AppVeyor file --- .appveyor.yml | 29 +++++++++++++++++++++++++++++ .haskell-ci | 4 ++-- .travis.yml | 2 +- stack.yaml | 2 +- 4 files changed, 33 insertions(+), 4 deletions(-) create mode 100644 .appveyor.yml diff --git a/.appveyor.yml b/.appveyor.yml new file mode 100644 index 0000000..d9a861c --- /dev/null +++ b/.appveyor.yml @@ -0,0 +1,29 @@ +# ~*~ auto-generated by haskell-ci with config : 90eae0e303541787a1c5382ef6f8198d8e3790ba5dd37a50c4def1fcd3995311 ~*~ + +version: "{build}" +clone_folder: C:\project +build: off +cache: + - "C:\\SR -> .appveyor.yml" + +environment: + global: + STACK_ROOT: "C:\\SR" + matrix: + - { BUILD: "ghc-8.6", STACKCMD: "stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps", STACKCFG: "{ resolver: lts-14.7, packages: [ '.' ], extra-deps: [], flags: {} }", STACKURL: "https://www.stackage.org/stack/windows-x86_64" } + - { BUILD: "ghc-8.8", STACKCMD: "stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps", STACKCFG: "{ resolver: nightly-2019-10-05, packages: [ '.' ], extra-deps: [], flags: {} }", STACKURL: "https://www.stackage.org/stack/windows-x86_64" } + +matrix: + fast_finish: true + +install: + - set PATH=C:\Program Files\Git\mingw64\bin;%PATH% + - curl -ostack.zip -L %STACKURL% + - 7z x stack.zip stack.exe + - refreshenv +test_script: + - echo %STACKCFG% > stack.yaml + - stack setup > nul + - echo "" | %STACKCMD% + + diff --git a/.haskell-ci b/.haskell-ci index b0993fe..df2b845 100644 --- a/.haskell-ci +++ b/.haskell-ci @@ -14,8 +14,8 @@ option: basementmin extradep=basement-0.0.8 extradep=memory-0.14.18 build: ghc-8.2 basementmin build: ghc-8.0 basementmin gaugedeps build: ghc-8.4 -build: ghc-8.6 os=linux,osx -build: ghc-8.8 +build: ghc-8.6 os=linux,osx,windows +build: ghc-8.8 os=linux,windows # packages package: '.' diff --git a/.travis.yml b/.travis.yml index 8e943fa..26dd1cf 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,4 +1,4 @@ -# ~*~ auto-generated by haskell-ci with config : 6451b289e8421706e753915b02cdb0906d18c9917aff02d07176a0862ec87cf3 ~*~ +# ~*~ auto-generated by haskell-ci with config : 90eae0e303541787a1c5382ef6f8198d8e3790ba5dd37a50c4def1fcd3995311 ~*~ # Use new container infrastructure to enable caching sudo: false diff --git a/stack.yaml b/stack.yaml index c48151a..02adde4 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1,3 @@ -# ~*~ auto-generated by haskell-ci with config : 6451b289e8421706e753915b02cdb0906d18c9917aff02d07176a0862ec87cf3 ~*~ +# ~*~ auto-generated by haskell-ci with config : 90eae0e303541787a1c5382ef6f8198d8e3790ba5dd37a50c4def1fcd3995311 ~*~ { resolver: lts-14.7, packages: [ '.' ], extra-deps: [], flags: {} } From f291bd08ef24085540065cb2edaa9af8c04ca8ed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Thu, 9 Jan 2020 22:08:24 +0100 Subject: [PATCH 123/176] Move p256 felem code --- cbits/p256/p256_ec.c | 740 +--------------------------------------- cbits/p256/p256_gf.h | 779 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 780 insertions(+), 739 deletions(-) create mode 100644 cbits/p256/p256_gf.h diff --git a/cbits/p256/p256_ec.c b/cbits/p256/p256_ec.c index 41c183a..c2b9c74 100644 --- a/cbits/p256/p256_ec.c +++ b/cbits/p256/p256_ec.c @@ -32,573 +32,11 @@ // // See http://www.imperialviolet.org/2010/12/04/ecc.html ([1]) for background. -#include -#include - -#include -#include - -#include "p256/p256.h" - -typedef uint8_t u8; -typedef uint32_t u32; -typedef int32_t s32; -typedef uint64_t u64; - -/* Our field elements are represented as nine 32-bit limbs. - * - * The value of an felem (field element) is: - * x[0] + (x[1] * 2**29) + (x[2] * 2**57) + ... + (x[8] * 2**228) - * - * That is, each limb is alternately 29 or 28-bits wide in little-endian - * order. - * - * This means that an felem hits 2**257, rather than 2**256 as we would like. A - * 28, 29, ... pattern would cause us to hit 2**256, but that causes problems - * when multiplying as terms end up one bit short of a limb which would require - * much bit-shifting to correct. - * - * Finally, the values stored in an felem are in Montgomery form. So the value - * |y| is stored as (y*R) mod p, where p is the P-256 prime and R is 2**257. - */ -typedef u32 limb; -#define NLIMBS 9 -typedef limb felem[NLIMBS]; - -static const limb kBottom28Bits = 0xfffffff; -static const limb kBottom29Bits = 0x1fffffff; - -/* kOne is the number 1 as an felem. It's 2**257 mod p split up into 29 and - * 28-bit words. */ -static const felem kOne = { - 2, 0, 0, 0xffff800, - 0x1fffffff, 0xfffffff, 0x1fbfffff, 0x1ffffff, - 0 -}; -static const felem kZero = {0}; -static const felem kP = { - 0x1fffffff, 0xfffffff, 0x1fffffff, 0x3ff, - 0, 0, 0x200000, 0xf000000, - 0xfffffff -}; -static const felem k2P = { - 0x1ffffffe, 0xfffffff, 0x1fffffff, 0x7ff, - 0, 0, 0x400000, 0xe000000, - 0x1fffffff -}; -/* kPrecomputed contains precomputed values to aid the calculation of scalar - * multiples of the base point, G. It's actually two, equal length, tables - * concatenated. - * - * The first table contains (x,y) felem pairs for 16 multiples of the base - * point, G. - * - * Index | Index (binary) | Value - * 0 | 0000 | 0G (all zeros, omitted) - * 1 | 0001 | G - * 2 | 0010 | 2**64G - * 3 | 0011 | 2**64G + G - * 4 | 0100 | 2**128G - * 5 | 0101 | 2**128G + G - * 6 | 0110 | 2**128G + 2**64G - * 7 | 0111 | 2**128G + 2**64G + G - * 8 | 1000 | 2**192G - * 9 | 1001 | 2**192G + G - * 10 | 1010 | 2**192G + 2**64G - * 11 | 1011 | 2**192G + 2**64G + G - * 12 | 1100 | 2**192G + 2**128G - * 13 | 1101 | 2**192G + 2**128G + G - * 14 | 1110 | 2**192G + 2**128G + 2**64G - * 15 | 1111 | 2**192G + 2**128G + 2**64G + G - * - * The second table follows the same style, but the terms are 2**32G, - * 2**96G, 2**160G, 2**224G. - * - * This is ~2KB of data. */ -static const limb kPrecomputed[NLIMBS * 2 * 15 * 2] = { - 0x11522878, 0xe730d41, 0xdb60179, 0x4afe2ff, 0x12883add, 0xcaddd88, 0x119e7edc, 0xd4a6eab, 0x3120bee, - 0x1d2aac15, 0xf25357c, 0x19e45cdd, 0x5c721d0, 0x1992c5a5, 0xa237487, 0x154ba21, 0x14b10bb, 0xae3fe3, - 0xd41a576, 0x922fc51, 0x234994f, 0x60b60d3, 0x164586ae, 0xce95f18, 0x1fe49073, 0x3fa36cc, 0x5ebcd2c, - 0xb402f2f, 0x15c70bf, 0x1561925c, 0x5a26704, 0xda91e90, 0xcdc1c7f, 0x1ea12446, 0xe1ade1e, 0xec91f22, - 0x26f7778, 0x566847e, 0xa0bec9e, 0x234f453, 0x1a31f21a, 0xd85e75c, 0x56c7109, 0xa267a00, 0xb57c050, - 0x98fb57, 0xaa837cc, 0x60c0792, 0xcfa5e19, 0x61bab9e, 0x589e39b, 0xa324c5, 0x7d6dee7, 0x2976e4b, - 0x1fc4124a, 0xa8c244b, 0x1ce86762, 0xcd61c7e, 0x1831c8e0, 0x75774e1, 0x1d96a5a9, 0x843a649, 0xc3ab0fa, - 0x6e2e7d5, 0x7673a2a, 0x178b65e8, 0x4003e9b, 0x1a1f11c2, 0x7816ea, 0xf643e11, 0x58c43df, 0xf423fc2, - 0x19633ffa, 0x891f2b2, 0x123c231c, 0x46add8c, 0x54700dd, 0x59e2b17, 0x172db40f, 0x83e277d, 0xb0dd609, - 0xfd1da12, 0x35c6e52, 0x19ede20c, 0xd19e0c0, 0x97d0f40, 0xb015b19, 0x449e3f5, 0xe10c9e, 0x33ab581, - 0x56a67ab, 0x577734d, 0x1dddc062, 0xc57b10d, 0x149b39d, 0x26a9e7b, 0xc35df9f, 0x48764cd, 0x76dbcca, - 0xca4b366, 0xe9303ab, 0x1a7480e7, 0x57e9e81, 0x1e13eb50, 0xf466cf3, 0x6f16b20, 0x4ba3173, 0xc168c33, - 0x15cb5439, 0x6a38e11, 0x73658bd, 0xb29564f, 0x3f6dc5b, 0x53b97e, 0x1322c4c0, 0x65dd7ff, 0x3a1e4f6, - 0x14e614aa, 0x9246317, 0x1bc83aca, 0xad97eed, 0xd38ce4a, 0xf82b006, 0x341f077, 0xa6add89, 0x4894acd, - 0x9f162d5, 0xf8410ef, 0x1b266a56, 0xd7f223, 0x3e0cb92, 0xe39b672, 0x6a2901a, 0x69a8556, 0x7e7c0, - 0x9b7d8d3, 0x309a80, 0x1ad05f7f, 0xc2fb5dd, 0xcbfd41d, 0x9ceb638, 0x1051825c, 0xda0cf5b, 0x812e881, - 0x6f35669, 0x6a56f2c, 0x1df8d184, 0x345820, 0x1477d477, 0x1645db1, 0xbe80c51, 0xc22be3e, 0xe35e65a, - 0x1aeb7aa0, 0xc375315, 0xf67bc99, 0x7fdd7b9, 0x191fc1be, 0x61235d, 0x2c184e9, 0x1c5a839, 0x47a1e26, - 0xb7cb456, 0x93e225d, 0x14f3c6ed, 0xccc1ac9, 0x17fe37f3, 0x4988989, 0x1a90c502, 0x2f32042, 0xa17769b, - 0xafd8c7c, 0x8191c6e, 0x1dcdb237, 0x16200c0, 0x107b32a1, 0x66c08db, 0x10d06a02, 0x3fc93, 0x5620023, - 0x16722b27, 0x68b5c59, 0x270fcfc, 0xfad0ecc, 0xe5de1c2, 0xeab466b, 0x2fc513c, 0x407f75c, 0xbaab133, - 0x9705fe9, 0xb88b8e7, 0x734c993, 0x1e1ff8f, 0x19156970, 0xabd0f00, 0x10469ea7, 0x3293ac0, 0xcdc98aa, - 0x1d843fd, 0xe14bfe8, 0x15be825f, 0x8b5212, 0xeb3fb67, 0x81cbd29, 0xbc62f16, 0x2b6fcc7, 0xf5a4e29, - 0x13560b66, 0xc0b6ac2, 0x51ae690, 0xd41e271, 0xf3e9bd4, 0x1d70aab, 0x1029f72, 0x73e1c35, 0xee70fbc, - 0xad81baf, 0x9ecc49a, 0x86c741e, 0xfe6be30, 0x176752e7, 0x23d416, 0x1f83de85, 0x27de188, 0x66f70b8, - 0x181cd51f, 0x96b6e4c, 0x188f2335, 0xa5df759, 0x17a77eb6, 0xfeb0e73, 0x154ae914, 0x2f3ec51, 0x3826b59, - 0xb91f17d, 0x1c72949, 0x1362bf0a, 0xe23fddf, 0xa5614b0, 0xf7d8f, 0x79061, 0x823d9d2, 0x8213f39, - 0x1128ae0b, 0xd095d05, 0xb85c0c2, 0x1ecb2ef, 0x24ddc84, 0xe35e901, 0x18411a4a, 0xf5ddc3d, 0x3786689, - 0x52260e8, 0x5ae3564, 0x542b10d, 0x8d93a45, 0x19952aa4, 0x996cc41, 0x1051a729, 0x4be3499, 0x52b23aa, - 0x109f307e, 0x6f5b6bb, 0x1f84e1e7, 0x77a0cfa, 0x10c4df3f, 0x25a02ea, 0xb048035, 0xe31de66, 0xc6ecaa3, - 0x28ea335, 0x2886024, 0x1372f020, 0xf55d35, 0x15e4684c, 0xf2a9e17, 0x1a4a7529, 0xcb7beb1, 0xb2a78a1, - 0x1ab21f1f, 0x6361ccf, 0x6c9179d, 0xb135627, 0x1267b974, 0x4408bad, 0x1cbff658, 0xe3d6511, 0xc7d76f, - 0x1cc7a69, 0xe7ee31b, 0x54fab4f, 0x2b914f, 0x1ad27a30, 0xcd3579e, 0xc50124c, 0x50daa90, 0xb13f72, - 0xb06aa75, 0x70f5cc6, 0x1649e5aa, 0x84a5312, 0x329043c, 0x41c4011, 0x13d32411, 0xb04a838, 0xd760d2d, - 0x1713b532, 0xbaa0c03, 0x84022ab, 0x6bcf5c1, 0x2f45379, 0x18ae070, 0x18c9e11e, 0x20bca9a, 0x66f496b, - 0x3eef294, 0x67500d2, 0xd7f613c, 0x2dbbeb, 0xb741038, 0xe04133f, 0x1582968d, 0xbe985f7, 0x1acbc1a, - 0x1a6a939f, 0x33e50f6, 0xd665ed4, 0xb4b7bd6, 0x1e5a3799, 0x6b33847, 0x17fa56ff, 0x65ef930, 0x21dc4a, - 0x2b37659, 0x450fe17, 0xb357b65, 0xdf5efac, 0x15397bef, 0x9d35a7f, 0x112ac15f, 0x624e62e, 0xa90ae2f, - 0x107eecd2, 0x1f69bbe, 0x77d6bce, 0x5741394, 0x13c684fc, 0x950c910, 0x725522b, 0xdc78583, 0x40eeabb, - 0x1fde328a, 0xbd61d96, 0xd28c387, 0x9e77d89, 0x12550c40, 0x759cb7d, 0x367ef34, 0xae2a960, 0x91b8bdc, - 0x93462a9, 0xf469ef, 0xb2e9aef, 0xd2ca771, 0x54e1f42, 0x7aaa49, 0x6316abb, 0x2413c8e, 0x5425bf9, - 0x1bed3e3a, 0xf272274, 0x1f5e7326, 0x6416517, 0xea27072, 0x9cedea7, 0x6e7633, 0x7c91952, 0xd806dce, - 0x8e2a7e1, 0xe421e1a, 0x418c9e1, 0x1dbc890, 0x1b395c36, 0xa1dc175, 0x1dc4ef73, 0x8956f34, 0xe4b5cf2, - 0x1b0d3a18, 0x3194a36, 0x6c2641f, 0xe44124c, 0xa2f4eaa, 0xa8c25ba, 0xf927ed7, 0x627b614, 0x7371cca, - 0xba16694, 0x417bc03, 0x7c0a7e3, 0x9c35c19, 0x1168a205, 0x8b6b00d, 0x10e3edc9, 0x9c19bf2, 0x5882229, - 0x1b2b4162, 0xa5cef1a, 0x1543622b, 0x9bd433e, 0x364e04d, 0x7480792, 0x5c9b5b3, 0xe85ff25, 0x408ef57, - 0x1814cfa4, 0x121b41b, 0xd248a0f, 0x3b05222, 0x39bb16a, 0xc75966d, 0xa038113, 0xa4a1769, 0x11fbc6c, - 0x917e50e, 0xeec3da8, 0x169d6eac, 0x10c1699, 0xa416153, 0xf724912, 0x15cd60b7, 0x4acbad9, 0x5efc5fa, - 0xf150ed7, 0x122b51, 0x1104b40a, 0xcb7f442, 0xfbb28ff, 0x6ac53ca, 0x196142cc, 0x7bf0fa9, 0x957651, - 0x4e0f215, 0xed439f8, 0x3f46bd5, 0x5ace82f, 0x110916b6, 0x6db078, 0xffd7d57, 0xf2ecaac, 0xca86dec, - 0x15d6b2da, 0x965ecc9, 0x1c92b4c2, 0x1f3811, 0x1cb080f5, 0x2d8b804, 0x19d1c12d, 0xf20bd46, 0x1951fa7, - 0xa3656c3, 0x523a425, 0xfcd0692, 0xd44ddc8, 0x131f0f5b, 0xaf80e4a, 0xcd9fc74, 0x99bb618, 0x2db944c, - 0xa673090, 0x1c210e1, 0x178c8d23, 0x1474383, 0x10b8743d, 0x985a55b, 0x2e74779, 0x576138, 0x9587927, - 0x133130fa, 0xbe05516, 0x9f4d619, 0xbb62570, 0x99ec591, 0xd9468fe, 0x1d07782d, 0xfc72e0b, 0x701b298, - 0x1863863b, 0x85954b8, 0x121a0c36, 0x9e7fedf, 0xf64b429, 0x9b9d71e, 0x14e2f5d8, 0xf858d3a, 0x942eea8, - 0xda5b765, 0x6edafff, 0xa9d18cc, 0xc65e4ba, 0x1c747e86, 0xe4ea915, 0x1981d7a1, 0x8395659, 0x52ed4e2, - 0x87d43b7, 0x37ab11b, 0x19d292ce, 0xf8d4692, 0x18c3053f, 0x8863e13, 0x4c146c0, 0x6bdf55a, 0x4e4457d, - 0x16152289, 0xac78ec2, 0x1a59c5a2, 0x2028b97, 0x71c2d01, 0x295851f, 0x404747b, 0x878558d, 0x7d29aa4, - 0x13d8341f, 0x8daefd7, 0x139c972d, 0x6b7ea75, 0xd4a9dde, 0xff163d8, 0x81d55d7, 0xa5bef68, 0xb7b30d8, - 0xbe73d6f, 0xaa88141, 0xd976c81, 0x7e7a9cc, 0x18beb771, 0xd773cbd, 0x13f51951, 0x9d0c177, 0x1c49a78, -}; +#include "p256/p256_gf.h" /* Field element operations: */ -/* NON_ZERO_TO_ALL_ONES returns: - * 0xffffffff for 0 < x <= 2**31 - * 0 for x == 0 or x > 2**31. - * - * x must be a u32 or an equivalent type such as limb. */ -#define NON_ZERO_TO_ALL_ONES(x) ((((u32)(x) - 1) >> 31) - 1) - -/* felem_reduce_carry adds a multiple of p in order to cancel |carry|, - * which is a term at 2**257. - * - * On entry: carry < 2**3, inout[0,2,...] < 2**29, inout[1,3,...] < 2**28. - * On exit: inout[0,2,..] < 2**30, inout[1,3,...] < 2**29. */ -static void felem_reduce_carry(felem inout, limb carry) { - const u32 carry_mask = NON_ZERO_TO_ALL_ONES(carry); - - inout[0] += carry << 1; - inout[3] += 0x10000000 & carry_mask; - /* carry < 2**3 thus (carry << 11) < 2**14 and we added 2**28 in the - * previous line therefore this doesn't underflow. */ - inout[3] -= carry << 11; - inout[4] += (0x20000000 - 1) & carry_mask; - inout[5] += (0x10000000 - 1) & carry_mask; - inout[6] += (0x20000000 - 1) & carry_mask; - inout[6] -= carry << 22; - /* This may underflow if carry is non-zero but, if so, we'll fix it in the - * next line. */ - inout[7] -= 1 & carry_mask; - inout[7] += carry << 25; -} - -/* felem_sum sets out = in+in2. - * - * On entry, in[i]+in2[i] must not overflow a 32-bit word. - * On exit: out[0,2,...] < 2**30, out[1,3,...] < 2**29 */ -static void felem_sum(felem out, const felem in, const felem in2) { - limb carry = 0; - unsigned i; - - for (i = 0;; i++) { - out[i] = in[i] + in2[i]; - out[i] += carry; - carry = out[i] >> 29; - out[i] &= kBottom29Bits; - - i++; - if (i == NLIMBS) - break; - - out[i] = in[i] + in2[i]; - out[i] += carry; - carry = out[i] >> 28; - out[i] &= kBottom28Bits; - } - - felem_reduce_carry(out, carry); -} - -#define two31m3 (((limb)1) << 31) - (((limb)1) << 3) -#define two30m2 (((limb)1) << 30) - (((limb)1) << 2) -#define two30p13m2 (((limb)1) << 30) + (((limb)1) << 13) - (((limb)1) << 2) -#define two31m2 (((limb)1) << 31) - (((limb)1) << 2) -#define two31p24m2 (((limb)1) << 31) + (((limb)1) << 24) - (((limb)1) << 2) -#define two30m27m2 (((limb)1) << 30) - (((limb)1) << 27) - (((limb)1) << 2) - -/* zero31 is 0 mod p. */ -static const felem zero31 = { two31m3, two30m2, two31m2, two30p13m2, two31m2, two30m2, two31p24m2, two30m27m2, two31m2 }; - -/* felem_diff sets out = in-in2. - * - * On entry: in[0,2,...] < 2**30, in[1,3,...] < 2**29 and - * in2[0,2,...] < 2**30, in2[1,3,...] < 2**29. - * On exit: out[0,2,...] < 2**30, out[1,3,...] < 2**29. */ -static void felem_diff(felem out, const felem in, const felem in2) { - limb carry = 0; - unsigned i; - - for (i = 0;; i++) { - out[i] = in[i] - in2[i]; - out[i] += zero31[i]; - out[i] += carry; - carry = out[i] >> 29; - out[i] &= kBottom29Bits; - - i++; - if (i == NLIMBS) - break; - - out[i] = in[i] - in2[i]; - out[i] += zero31[i]; - out[i] += carry; - carry = out[i] >> 28; - out[i] &= kBottom28Bits; - } - - felem_reduce_carry(out, carry); -} - -/* felem_reduce_degree sets out = tmp/R mod p where tmp contains 64-bit words - * with the same 29,28,... bit positions as an felem. - * - * The values in felems are in Montgomery form: x*R mod p where R = 2**257. - * Since we just multiplied two Montgomery values together, the result is - * x*y*R*R mod p. We wish to divide by R in order for the result also to be - * in Montgomery form. - * - * On entry: tmp[i] < 2**64 - * On exit: out[0,2,...] < 2**30, out[1,3,...] < 2**29 */ -static void felem_reduce_degree(felem out, u64 tmp[17]) { - /* The following table may be helpful when reading this code: - * - * Limb number: 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10... - * Width (bits): 29| 28| 29| 28| 29| 28| 29| 28| 29| 28| 29 - * Start bit: 0 | 29| 57| 86|114|143|171|200|228|257|285 - * (odd phase): 0 | 28| 57| 85|114|142|171|199|228|256|285 */ - limb tmp2[18], carry, x, xMask; - unsigned i; - - /* tmp contains 64-bit words with the same 29,28,29-bit positions as an - * felem. So the top of an element of tmp might overlap with another - * element two positions down. The following loop eliminates this - * overlap. */ - tmp2[0] = (limb)(tmp[0] & kBottom29Bits); - - /* In the following we use "(limb) tmp[x]" and "(limb) (tmp[x]>>32)" to try - * and hint to the compiler that it can do a single-word shift by selecting - * the right register rather than doing a double-word shift and truncating - * afterwards. */ - tmp2[1] = ((limb) tmp[0]) >> 29; - tmp2[1] |= (((limb)(tmp[0] >> 32)) << 3) & kBottom28Bits; - tmp2[1] += ((limb) tmp[1]) & kBottom28Bits; - carry = tmp2[1] >> 28; - tmp2[1] &= kBottom28Bits; - - for (i = 2; i < 17; i++) { - tmp2[i] = ((limb)(tmp[i - 2] >> 32)) >> 25; - tmp2[i] += ((limb)(tmp[i - 1])) >> 28; - tmp2[i] += (((limb)(tmp[i - 1] >> 32)) << 4) & kBottom29Bits; - tmp2[i] += ((limb) tmp[i]) & kBottom29Bits; - tmp2[i] += carry; - carry = tmp2[i] >> 29; - tmp2[i] &= kBottom29Bits; - - i++; - if (i == 17) - break; - tmp2[i] = ((limb)(tmp[i - 2] >> 32)) >> 25; - tmp2[i] += ((limb)(tmp[i - 1])) >> 29; - tmp2[i] += (((limb)(tmp[i - 1] >> 32)) << 3) & kBottom28Bits; - tmp2[i] += ((limb) tmp[i]) & kBottom28Bits; - tmp2[i] += carry; - carry = tmp2[i] >> 28; - tmp2[i] &= kBottom28Bits; - } - - tmp2[17] = ((limb)(tmp[15] >> 32)) >> 25; - tmp2[17] += ((limb)(tmp[16])) >> 29; - tmp2[17] += (((limb)(tmp[16] >> 32)) << 3); - tmp2[17] += carry; - - /* Montgomery elimination of terms. - * - * Since R is 2**257, we can divide by R with a bitwise shift if we can - * ensure that the right-most 257 bits are all zero. We can make that true by - * adding multiplies of p without affecting the value. - * - * So we eliminate limbs from right to left. Since the bottom 29 bits of p - * are all ones, then by adding tmp2[0]*p to tmp2 we'll make tmp2[0] == 0. - * We can do that for 8 further limbs and then right shift to eliminate the - * extra factor of R. */ - for (i = 0;; i += 2) { - tmp2[i + 1] += tmp2[i] >> 29; - x = tmp2[i] & kBottom29Bits; - xMask = NON_ZERO_TO_ALL_ONES(x); - tmp2[i] = 0; - - /* The bounds calculations for this loop are tricky. Each iteration of - * the loop eliminates two words by adding values to words to their - * right. - * - * The following table contains the amounts added to each word (as an - * offset from the value of i at the top of the loop). The amounts are - * accounted for from the first and second half of the loop separately - * and are written as, for example, 28 to mean a value <2**28. - * - * Word: 3 4 5 6 7 8 9 10 - * Added in top half: 28 11 29 21 29 28 - * 28 29 - * 29 - * Added in bottom half: 29 10 28 21 28 28 - * 29 - * - * The value that is currently offset 7 will be offset 5 for the next - * iteration and then offset 3 for the iteration after that. Therefore - * the total value added will be the values added at 7, 5 and 3. - * - * The following table accumulates these values. The sums at the bottom - * are written as, for example, 29+28, to mean a value < 2**29+2**28. - * - * Word: 3 4 5 6 7 8 9 10 11 12 13 - * 28 11 10 29 21 29 28 28 28 28 28 - * 29 28 11 28 29 28 29 28 29 28 - * 29 28 21 21 29 21 29 21 - * 10 29 28 21 28 21 28 - * 28 29 28 29 28 29 28 - * 11 10 29 10 29 10 - * 29 28 11 28 11 - * 29 29 - * -------------------------------------------- - * 30+ 31+ 30+ 31+ 30+ - * 28+ 29+ 28+ 29+ 21+ - * 21+ 28+ 21+ 28+ 10 - * 10 21+ 10 21+ - * 11 11 - * - * So the greatest amount is added to tmp2[10] and tmp2[12]. If - * tmp2[10/12] has an initial value of <2**29, then the maximum value - * will be < 2**31 + 2**30 + 2**28 + 2**21 + 2**11, which is < 2**32, - * as required. */ - tmp2[i + 3] += (x << 10) & kBottom28Bits; - tmp2[i + 4] += (x >> 18); - - tmp2[i + 6] += (x << 21) & kBottom29Bits; - tmp2[i + 7] += x >> 8; - - /* At position 200, which is the starting bit position for word 7, we - * have a factor of 0xf000000 = 2**28 - 2**24. */ - tmp2[i + 7] += 0x10000000 & xMask; - /* Word 7 is 28 bits wide, so the 2**28 term exactly hits word 8. */ - tmp2[i + 8] += (x - 1) & xMask; - tmp2[i + 7] -= (x << 24) & kBottom28Bits; - tmp2[i + 8] -= x >> 4; - - tmp2[i + 8] += 0x20000000 & xMask; - tmp2[i + 8] -= x; - tmp2[i + 8] += (x << 28) & kBottom29Bits; - tmp2[i + 9] += ((x >> 1) - 1) & xMask; - - if (i+1 == NLIMBS) - break; - tmp2[i + 2] += tmp2[i + 1] >> 28; - x = tmp2[i + 1] & kBottom28Bits; - xMask = NON_ZERO_TO_ALL_ONES(x); - tmp2[i + 1] = 0; - - tmp2[i + 4] += (x << 11) & kBottom29Bits; - tmp2[i + 5] += (x >> 18); - - tmp2[i + 7] += (x << 21) & kBottom28Bits; - tmp2[i + 8] += x >> 7; - - /* At position 199, which is the starting bit of the 8th word when - * dealing with a context starting on an odd word, we have a factor of - * 0x1e000000 = 2**29 - 2**25. Since we have not updated i, the 8th - * word from i+1 is i+8. */ - tmp2[i + 8] += 0x20000000 & xMask; - tmp2[i + 9] += (x - 1) & xMask; - tmp2[i + 8] -= (x << 25) & kBottom29Bits; - tmp2[i + 9] -= x >> 4; - - tmp2[i + 9] += 0x10000000 & xMask; - tmp2[i + 9] -= x; - tmp2[i + 10] += (x - 1) & xMask; - } - - /* We merge the right shift with a carry chain. The words above 2**257 have - * widths of 28,29,... which we need to correct when copying them down. */ - carry = 0; - for (i = 0; i < 8; i++) { - /* The maximum value of tmp2[i + 9] occurs on the first iteration and - * is < 2**30+2**29+2**28. Adding 2**29 (from tmp2[i + 10]) is - * therefore safe. */ - out[i] = tmp2[i + 9]; - out[i] += carry; - out[i] += (tmp2[i + 10] << 28) & kBottom29Bits; - carry = out[i] >> 29; - out[i] &= kBottom29Bits; - - i++; - out[i] = tmp2[i + 9] >> 1; - out[i] += carry; - carry = out[i] >> 28; - out[i] &= kBottom28Bits; - } - - out[8] = tmp2[17]; - out[8] += carry; - carry = out[8] >> 29; - out[8] &= kBottom29Bits; - - felem_reduce_carry(out, carry); -} - -/* felem_square sets out=in*in. - * - * On entry: in[0,2,...] < 2**30, in[1,3,...] < 2**29. - * On exit: out[0,2,...] < 2**30, out[1,3,...] < 2**29. */ -static void felem_square(felem out, const felem in) { - u64 tmp[17]; - - tmp[0] = ((u64) in[0]) * in[0]; - tmp[1] = ((u64) in[0]) * (in[1] << 1); - tmp[2] = ((u64) in[0]) * (in[2] << 1) + - ((u64) in[1]) * (in[1] << 1); - tmp[3] = ((u64) in[0]) * (in[3] << 1) + - ((u64) in[1]) * (in[2] << 1); - tmp[4] = ((u64) in[0]) * (in[4] << 1) + - ((u64) in[1]) * (in[3] << 2) + ((u64) in[2]) * in[2]; - tmp[5] = ((u64) in[0]) * (in[5] << 1) + ((u64) in[1]) * - (in[4] << 1) + ((u64) in[2]) * (in[3] << 1); - tmp[6] = ((u64) in[0]) * (in[6] << 1) + ((u64) in[1]) * - (in[5] << 2) + ((u64) in[2]) * (in[4] << 1) + - ((u64) in[3]) * (in[3] << 1); - tmp[7] = ((u64) in[0]) * (in[7] << 1) + ((u64) in[1]) * - (in[6] << 1) + ((u64) in[2]) * (in[5] << 1) + - ((u64) in[3]) * (in[4] << 1); - /* tmp[8] has the greatest value of 2**61 + 2**60 + 2**61 + 2**60 + 2**60, - * which is < 2**64 as required. */ - tmp[8] = ((u64) in[0]) * (in[8] << 1) + ((u64) in[1]) * - (in[7] << 2) + ((u64) in[2]) * (in[6] << 1) + - ((u64) in[3]) * (in[5] << 2) + ((u64) in[4]) * in[4]; - tmp[9] = ((u64) in[1]) * (in[8] << 1) + ((u64) in[2]) * - (in[7] << 1) + ((u64) in[3]) * (in[6] << 1) + - ((u64) in[4]) * (in[5] << 1); - tmp[10] = ((u64) in[2]) * (in[8] << 1) + ((u64) in[3]) * - (in[7] << 2) + ((u64) in[4]) * (in[6] << 1) + - ((u64) in[5]) * (in[5] << 1); - tmp[11] = ((u64) in[3]) * (in[8] << 1) + ((u64) in[4]) * - (in[7] << 1) + ((u64) in[5]) * (in[6] << 1); - tmp[12] = ((u64) in[4]) * (in[8] << 1) + - ((u64) in[5]) * (in[7] << 2) + ((u64) in[6]) * in[6]; - tmp[13] = ((u64) in[5]) * (in[8] << 1) + - ((u64) in[6]) * (in[7] << 1); - tmp[14] = ((u64) in[6]) * (in[8] << 1) + - ((u64) in[7]) * (in[7] << 1); - tmp[15] = ((u64) in[7]) * (in[8] << 1); - tmp[16] = ((u64) in[8]) * in[8]; - - felem_reduce_degree(out, tmp); -} - -/* felem_mul sets out=in*in2. - * - * On entry: in[0,2,...] < 2**30, in[1,3,...] < 2**29 and - * in2[0,2,...] < 2**30, in2[1,3,...] < 2**29. - * On exit: out[0,2,...] < 2**30, out[1,3,...] < 2**29. */ -static void felem_mul(felem out, const felem in, const felem in2) { - u64 tmp[17]; - - tmp[0] = ((u64) in[0]) * in2[0]; - tmp[1] = ((u64) in[0]) * (in2[1] << 0) + - ((u64) in[1]) * (in2[0] << 0); - tmp[2] = ((u64) in[0]) * (in2[2] << 0) + ((u64) in[1]) * - (in2[1] << 1) + ((u64) in[2]) * (in2[0] << 0); - tmp[3] = ((u64) in[0]) * (in2[3] << 0) + ((u64) in[1]) * - (in2[2] << 0) + ((u64) in[2]) * (in2[1] << 0) + - ((u64) in[3]) * (in2[0] << 0); - tmp[4] = ((u64) in[0]) * (in2[4] << 0) + ((u64) in[1]) * - (in2[3] << 1) + ((u64) in[2]) * (in2[2] << 0) + - ((u64) in[3]) * (in2[1] << 1) + - ((u64) in[4]) * (in2[0] << 0); - tmp[5] = ((u64) in[0]) * (in2[5] << 0) + ((u64) in[1]) * - (in2[4] << 0) + ((u64) in[2]) * (in2[3] << 0) + - ((u64) in[3]) * (in2[2] << 0) + ((u64) in[4]) * - (in2[1] << 0) + ((u64) in[5]) * (in2[0] << 0); - tmp[6] = ((u64) in[0]) * (in2[6] << 0) + ((u64) in[1]) * - (in2[5] << 1) + ((u64) in[2]) * (in2[4] << 0) + - ((u64) in[3]) * (in2[3] << 1) + ((u64) in[4]) * - (in2[2] << 0) + ((u64) in[5]) * (in2[1] << 1) + - ((u64) in[6]) * (in2[0] << 0); - tmp[7] = ((u64) in[0]) * (in2[7] << 0) + ((u64) in[1]) * - (in2[6] << 0) + ((u64) in[2]) * (in2[5] << 0) + - ((u64) in[3]) * (in2[4] << 0) + ((u64) in[4]) * - (in2[3] << 0) + ((u64) in[5]) * (in2[2] << 0) + - ((u64) in[6]) * (in2[1] << 0) + - ((u64) in[7]) * (in2[0] << 0); - /* tmp[8] has the greatest value but doesn't overflow. See logic in - * felem_square. */ - tmp[8] = ((u64) in[0]) * (in2[8] << 0) + ((u64) in[1]) * - (in2[7] << 1) + ((u64) in[2]) * (in2[6] << 0) + - ((u64) in[3]) * (in2[5] << 1) + ((u64) in[4]) * - (in2[4] << 0) + ((u64) in[5]) * (in2[3] << 1) + - ((u64) in[6]) * (in2[2] << 0) + ((u64) in[7]) * - (in2[1] << 1) + ((u64) in[8]) * (in2[0] << 0); - tmp[9] = ((u64) in[1]) * (in2[8] << 0) + ((u64) in[2]) * - (in2[7] << 0) + ((u64) in[3]) * (in2[6] << 0) + - ((u64) in[4]) * (in2[5] << 0) + ((u64) in[5]) * - (in2[4] << 0) + ((u64) in[6]) * (in2[3] << 0) + - ((u64) in[7]) * (in2[2] << 0) + - ((u64) in[8]) * (in2[1] << 0); - tmp[10] = ((u64) in[2]) * (in2[8] << 0) + ((u64) in[3]) * - (in2[7] << 1) + ((u64) in[4]) * (in2[6] << 0) + - ((u64) in[5]) * (in2[5] << 1) + ((u64) in[6]) * - (in2[4] << 0) + ((u64) in[7]) * (in2[3] << 1) + - ((u64) in[8]) * (in2[2] << 0); - tmp[11] = ((u64) in[3]) * (in2[8] << 0) + ((u64) in[4]) * - (in2[7] << 0) + ((u64) in[5]) * (in2[6] << 0) + - ((u64) in[6]) * (in2[5] << 0) + ((u64) in[7]) * - (in2[4] << 0) + ((u64) in[8]) * (in2[3] << 0); - tmp[12] = ((u64) in[4]) * (in2[8] << 0) + ((u64) in[5]) * - (in2[7] << 1) + ((u64) in[6]) * (in2[6] << 0) + - ((u64) in[7]) * (in2[5] << 1) + - ((u64) in[8]) * (in2[4] << 0); - tmp[13] = ((u64) in[5]) * (in2[8] << 0) + ((u64) in[6]) * - (in2[7] << 0) + ((u64) in[7]) * (in2[6] << 0) + - ((u64) in[8]) * (in2[5] << 0); - tmp[14] = ((u64) in[6]) * (in2[8] << 0) + ((u64) in[7]) * - (in2[7] << 1) + ((u64) in[8]) * (in2[6] << 0); - tmp[15] = ((u64) in[7]) * (in2[8] << 0) + - ((u64) in[8]) * (in2[7] << 0); - tmp[16] = ((u64) in[8]) * (in2[8] << 0); - - felem_reduce_degree(out, tmp); -} - -static void felem_assign(felem out, const felem in) { - memcpy(out, in, sizeof(felem)); -} - /* felem_inv calculates |out| = |in|^{-1} * * Based on Fermat's Little Theorem: @@ -667,130 +105,6 @@ static void felem_inv(felem out, const felem in) { felem_mul(out, ftmp2, ftmp); /* 2^256 - 2^224 + 2^192 + 2^96 - 3 */ } -/* felem_scalar_3 sets out=3*out. - * - * On entry: out[0,2,...] < 2**30, out[1,3,...] < 2**29. - * On exit: out[0,2,...] < 2**30, out[1,3,...] < 2**29. */ -static void felem_scalar_3(felem out) { - limb carry = 0; - unsigned i; - - for (i = 0;; i++) { - out[i] *= 3; - out[i] += carry; - carry = out[i] >> 29; - out[i] &= kBottom29Bits; - - i++; - if (i == NLIMBS) - break; - - out[i] *= 3; - out[i] += carry; - carry = out[i] >> 28; - out[i] &= kBottom28Bits; - } - - felem_reduce_carry(out, carry); -} - -/* felem_scalar_4 sets out=4*out. - * - * On entry: out[0,2,...] < 2**30, out[1,3,...] < 2**29. - * On exit: out[0,2,...] < 2**30, out[1,3,...] < 2**29. */ -static void felem_scalar_4(felem out) { - limb carry = 0, next_carry; - unsigned i; - - for (i = 0;; i++) { - next_carry = out[i] >> 27; - out[i] <<= 2; - out[i] &= kBottom29Bits; - out[i] += carry; - carry = next_carry + (out[i] >> 29); - out[i] &= kBottom29Bits; - - i++; - if (i == NLIMBS) - break; - - next_carry = out[i] >> 26; - out[i] <<= 2; - out[i] &= kBottom28Bits; - out[i] += carry; - carry = next_carry + (out[i] >> 28); - out[i] &= kBottom28Bits; - } - - felem_reduce_carry(out, carry); -} - -/* felem_scalar_8 sets out=8*out. - * - * On entry: out[0,2,...] < 2**30, out[1,3,...] < 2**29. - * On exit: out[0,2,...] < 2**30, out[1,3,...] < 2**29. */ -static void felem_scalar_8(felem out) { - limb carry = 0, next_carry; - unsigned i; - - for (i = 0;; i++) { - next_carry = out[i] >> 26; - out[i] <<= 3; - out[i] &= kBottom29Bits; - out[i] += carry; - carry = next_carry + (out[i] >> 29); - out[i] &= kBottom29Bits; - - i++; - if (i == NLIMBS) - break; - - next_carry = out[i] >> 25; - out[i] <<= 3; - out[i] &= kBottom28Bits; - out[i] += carry; - carry = next_carry + (out[i] >> 28); - out[i] &= kBottom28Bits; - } - - felem_reduce_carry(out, carry); -} - -/* felem_is_zero_vartime returns 1 iff |in| == 0. It takes a variable amount of - * time depending on the value of |in|. */ -static char felem_is_zero_vartime(const felem in) { - limb carry; - int i; - limb tmp[NLIMBS]; - - felem_assign(tmp, in); - - /* First, reduce tmp to a minimal form. */ - do { - carry = 0; - for (i = 0;; i++) { - tmp[i] += carry; - carry = tmp[i] >> 29; - tmp[i] &= kBottom29Bits; - - i++; - if (i == NLIMBS) - break; - - tmp[i] += carry; - carry = tmp[i] >> 28; - tmp[i] &= kBottom28Bits; - } - - felem_reduce_carry(tmp, carry); - } while (carry); - - /* tmp < 2**257, so the only possible zero values are 0, p and 2p. */ - return memcmp(tmp, kZero, sizeof(tmp)) == 0 || - memcmp(tmp, kP, sizeof(tmp)) == 0 || - memcmp(tmp, k2P, sizeof(tmp)) == 0; -} - /* Group operations: * @@ -1168,58 +482,6 @@ static void scalar_mult(felem nx, felem ny, felem nz, const felem x, } } -#define kRDigits {2, 0, 0, 0xfffffffe, 0xffffffff, 0xffffffff, 0xfffffffd, 1} // 2^257 mod p256.p - -#define kRInvDigits {0x80000000, 1, 0xffffffff, 0, 0x80000001, 0xfffffffe, 1, 0x7fffffff} // 1 / 2^257 mod p256.p - -static const cryptonite_p256_int kR = { kRDigits }; -static const cryptonite_p256_int kRInv = { kRInvDigits }; - -/* to_montgomery sets out = R*in. */ -static void to_montgomery(felem out, const cryptonite_p256_int* in) { - cryptonite_p256_int in_shifted; - int i; - - cryptonite_p256_init(&in_shifted); - cryptonite_p256_modmul(&cryptonite_SECP256r1_p, in, 0, &kR, &in_shifted); - - for (i = 0; i < NLIMBS; i++) { - if ((i & 1) == 0) { - out[i] = P256_DIGIT(&in_shifted, 0) & kBottom29Bits; - cryptonite_p256_shr(&in_shifted, 29, &in_shifted); - } else { - out[i] = P256_DIGIT(&in_shifted, 0) & kBottom28Bits; - cryptonite_p256_shr(&in_shifted, 28, &in_shifted); - } - } - - cryptonite_p256_clear(&in_shifted); -} - -/* from_montgomery sets out=in/R. */ -static void from_montgomery(cryptonite_p256_int* out, const felem in) { - cryptonite_p256_int result, tmp; - int i, top; - - cryptonite_p256_init(&result); - cryptonite_p256_init(&tmp); - - cryptonite_p256_add_d(&tmp, in[NLIMBS - 1], &result); - for (i = NLIMBS - 2; i >= 0; i--) { - if ((i & 1) == 0) { - top = cryptonite_p256_shl(&result, 29, &tmp); - } else { - top = cryptonite_p256_shl(&result, 28, &tmp); - } - top |= cryptonite_p256_add_d(&tmp, in[i], &result); - } - - cryptonite_p256_modmul(&cryptonite_SECP256r1_p, &kRInv, top, &result, out); - - cryptonite_p256_clear(&result); - cryptonite_p256_clear(&tmp); -} - /* cryptonite_p256_base_point_mul sets {out_x,out_y} = nG, where n is < the * order of the group. */ void cryptonite_p256_base_point_mul(const cryptonite_p256_int* n, cryptonite_p256_int* out_x, cryptonite_p256_int* out_y) { diff --git a/cbits/p256/p256_gf.h b/cbits/p256/p256_gf.h new file mode 100644 index 0000000..7144c9d --- /dev/null +++ b/cbits/p256/p256_gf.h @@ -0,0 +1,779 @@ +/* + * Copyright 2013 The Android Open Source Project + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * * Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * * 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. + * * Neither the name of Google Inc. nor the names of its contributors may + * be used to endorse or promote products derived from this software + * without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY Google Inc. ``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 Google Inc. 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. + */ + +// This is an implementation of the P256 finite field. It's written to be +// be portable 32-bit, although it's still constant-time. +// +// WARNING: Implementing these functions in a constant-time manner is far from +// obvious. Be careful when touching this code. +// +// See http://www.imperialviolet.org/2010/12/04/ecc.html ([1]) for background. + +#include +#include + +#include +#include + +#include "p256/p256.h" + +typedef uint8_t u8; +typedef uint32_t u32; +typedef int32_t s32; +typedef uint64_t u64; + +/* Our field elements are represented as nine 32-bit limbs. + * + * The value of an felem (field element) is: + * x[0] + (x[1] * 2**29) + (x[2] * 2**57) + ... + (x[8] * 2**228) + * + * That is, each limb is alternately 29 or 28-bits wide in little-endian + * order. + * + * This means that an felem hits 2**257, rather than 2**256 as we would like. A + * 28, 29, ... pattern would cause us to hit 2**256, but that causes problems + * when multiplying as terms end up one bit short of a limb which would require + * much bit-shifting to correct. + * + * Finally, the values stored in an felem are in Montgomery form. So the value + * |y| is stored as (y*R) mod p, where p is the P-256 prime and R is 2**257. + */ +typedef u32 limb; +#define NLIMBS 9 +typedef limb felem[NLIMBS]; + +static const limb kBottom28Bits = 0xfffffff; +static const limb kBottom29Bits = 0x1fffffff; + +/* kOne is the number 1 as an felem. It's 2**257 mod p split up into 29 and + * 28-bit words. */ +static const felem kOne = { + 2, 0, 0, 0xffff800, + 0x1fffffff, 0xfffffff, 0x1fbfffff, 0x1ffffff, + 0 +}; +static const felem kZero = {0}; +static const felem kP = { + 0x1fffffff, 0xfffffff, 0x1fffffff, 0x3ff, + 0, 0, 0x200000, 0xf000000, + 0xfffffff +}; +static const felem k2P = { + 0x1ffffffe, 0xfffffff, 0x1fffffff, 0x7ff, + 0, 0, 0x400000, 0xe000000, + 0x1fffffff +}; +/* kPrecomputed contains precomputed values to aid the calculation of scalar + * multiples of the base point, G. It's actually two, equal length, tables + * concatenated. + * + * The first table contains (x,y) felem pairs for 16 multiples of the base + * point, G. + * + * Index | Index (binary) | Value + * 0 | 0000 | 0G (all zeros, omitted) + * 1 | 0001 | G + * 2 | 0010 | 2**64G + * 3 | 0011 | 2**64G + G + * 4 | 0100 | 2**128G + * 5 | 0101 | 2**128G + G + * 6 | 0110 | 2**128G + 2**64G + * 7 | 0111 | 2**128G + 2**64G + G + * 8 | 1000 | 2**192G + * 9 | 1001 | 2**192G + G + * 10 | 1010 | 2**192G + 2**64G + * 11 | 1011 | 2**192G + 2**64G + G + * 12 | 1100 | 2**192G + 2**128G + * 13 | 1101 | 2**192G + 2**128G + G + * 14 | 1110 | 2**192G + 2**128G + 2**64G + * 15 | 1111 | 2**192G + 2**128G + 2**64G + G + * + * The second table follows the same style, but the terms are 2**32G, + * 2**96G, 2**160G, 2**224G. + * + * This is ~2KB of data. */ +static const limb kPrecomputed[NLIMBS * 2 * 15 * 2] = { + 0x11522878, 0xe730d41, 0xdb60179, 0x4afe2ff, 0x12883add, 0xcaddd88, 0x119e7edc, 0xd4a6eab, 0x3120bee, + 0x1d2aac15, 0xf25357c, 0x19e45cdd, 0x5c721d0, 0x1992c5a5, 0xa237487, 0x154ba21, 0x14b10bb, 0xae3fe3, + 0xd41a576, 0x922fc51, 0x234994f, 0x60b60d3, 0x164586ae, 0xce95f18, 0x1fe49073, 0x3fa36cc, 0x5ebcd2c, + 0xb402f2f, 0x15c70bf, 0x1561925c, 0x5a26704, 0xda91e90, 0xcdc1c7f, 0x1ea12446, 0xe1ade1e, 0xec91f22, + 0x26f7778, 0x566847e, 0xa0bec9e, 0x234f453, 0x1a31f21a, 0xd85e75c, 0x56c7109, 0xa267a00, 0xb57c050, + 0x98fb57, 0xaa837cc, 0x60c0792, 0xcfa5e19, 0x61bab9e, 0x589e39b, 0xa324c5, 0x7d6dee7, 0x2976e4b, + 0x1fc4124a, 0xa8c244b, 0x1ce86762, 0xcd61c7e, 0x1831c8e0, 0x75774e1, 0x1d96a5a9, 0x843a649, 0xc3ab0fa, + 0x6e2e7d5, 0x7673a2a, 0x178b65e8, 0x4003e9b, 0x1a1f11c2, 0x7816ea, 0xf643e11, 0x58c43df, 0xf423fc2, + 0x19633ffa, 0x891f2b2, 0x123c231c, 0x46add8c, 0x54700dd, 0x59e2b17, 0x172db40f, 0x83e277d, 0xb0dd609, + 0xfd1da12, 0x35c6e52, 0x19ede20c, 0xd19e0c0, 0x97d0f40, 0xb015b19, 0x449e3f5, 0xe10c9e, 0x33ab581, + 0x56a67ab, 0x577734d, 0x1dddc062, 0xc57b10d, 0x149b39d, 0x26a9e7b, 0xc35df9f, 0x48764cd, 0x76dbcca, + 0xca4b366, 0xe9303ab, 0x1a7480e7, 0x57e9e81, 0x1e13eb50, 0xf466cf3, 0x6f16b20, 0x4ba3173, 0xc168c33, + 0x15cb5439, 0x6a38e11, 0x73658bd, 0xb29564f, 0x3f6dc5b, 0x53b97e, 0x1322c4c0, 0x65dd7ff, 0x3a1e4f6, + 0x14e614aa, 0x9246317, 0x1bc83aca, 0xad97eed, 0xd38ce4a, 0xf82b006, 0x341f077, 0xa6add89, 0x4894acd, + 0x9f162d5, 0xf8410ef, 0x1b266a56, 0xd7f223, 0x3e0cb92, 0xe39b672, 0x6a2901a, 0x69a8556, 0x7e7c0, + 0x9b7d8d3, 0x309a80, 0x1ad05f7f, 0xc2fb5dd, 0xcbfd41d, 0x9ceb638, 0x1051825c, 0xda0cf5b, 0x812e881, + 0x6f35669, 0x6a56f2c, 0x1df8d184, 0x345820, 0x1477d477, 0x1645db1, 0xbe80c51, 0xc22be3e, 0xe35e65a, + 0x1aeb7aa0, 0xc375315, 0xf67bc99, 0x7fdd7b9, 0x191fc1be, 0x61235d, 0x2c184e9, 0x1c5a839, 0x47a1e26, + 0xb7cb456, 0x93e225d, 0x14f3c6ed, 0xccc1ac9, 0x17fe37f3, 0x4988989, 0x1a90c502, 0x2f32042, 0xa17769b, + 0xafd8c7c, 0x8191c6e, 0x1dcdb237, 0x16200c0, 0x107b32a1, 0x66c08db, 0x10d06a02, 0x3fc93, 0x5620023, + 0x16722b27, 0x68b5c59, 0x270fcfc, 0xfad0ecc, 0xe5de1c2, 0xeab466b, 0x2fc513c, 0x407f75c, 0xbaab133, + 0x9705fe9, 0xb88b8e7, 0x734c993, 0x1e1ff8f, 0x19156970, 0xabd0f00, 0x10469ea7, 0x3293ac0, 0xcdc98aa, + 0x1d843fd, 0xe14bfe8, 0x15be825f, 0x8b5212, 0xeb3fb67, 0x81cbd29, 0xbc62f16, 0x2b6fcc7, 0xf5a4e29, + 0x13560b66, 0xc0b6ac2, 0x51ae690, 0xd41e271, 0xf3e9bd4, 0x1d70aab, 0x1029f72, 0x73e1c35, 0xee70fbc, + 0xad81baf, 0x9ecc49a, 0x86c741e, 0xfe6be30, 0x176752e7, 0x23d416, 0x1f83de85, 0x27de188, 0x66f70b8, + 0x181cd51f, 0x96b6e4c, 0x188f2335, 0xa5df759, 0x17a77eb6, 0xfeb0e73, 0x154ae914, 0x2f3ec51, 0x3826b59, + 0xb91f17d, 0x1c72949, 0x1362bf0a, 0xe23fddf, 0xa5614b0, 0xf7d8f, 0x79061, 0x823d9d2, 0x8213f39, + 0x1128ae0b, 0xd095d05, 0xb85c0c2, 0x1ecb2ef, 0x24ddc84, 0xe35e901, 0x18411a4a, 0xf5ddc3d, 0x3786689, + 0x52260e8, 0x5ae3564, 0x542b10d, 0x8d93a45, 0x19952aa4, 0x996cc41, 0x1051a729, 0x4be3499, 0x52b23aa, + 0x109f307e, 0x6f5b6bb, 0x1f84e1e7, 0x77a0cfa, 0x10c4df3f, 0x25a02ea, 0xb048035, 0xe31de66, 0xc6ecaa3, + 0x28ea335, 0x2886024, 0x1372f020, 0xf55d35, 0x15e4684c, 0xf2a9e17, 0x1a4a7529, 0xcb7beb1, 0xb2a78a1, + 0x1ab21f1f, 0x6361ccf, 0x6c9179d, 0xb135627, 0x1267b974, 0x4408bad, 0x1cbff658, 0xe3d6511, 0xc7d76f, + 0x1cc7a69, 0xe7ee31b, 0x54fab4f, 0x2b914f, 0x1ad27a30, 0xcd3579e, 0xc50124c, 0x50daa90, 0xb13f72, + 0xb06aa75, 0x70f5cc6, 0x1649e5aa, 0x84a5312, 0x329043c, 0x41c4011, 0x13d32411, 0xb04a838, 0xd760d2d, + 0x1713b532, 0xbaa0c03, 0x84022ab, 0x6bcf5c1, 0x2f45379, 0x18ae070, 0x18c9e11e, 0x20bca9a, 0x66f496b, + 0x3eef294, 0x67500d2, 0xd7f613c, 0x2dbbeb, 0xb741038, 0xe04133f, 0x1582968d, 0xbe985f7, 0x1acbc1a, + 0x1a6a939f, 0x33e50f6, 0xd665ed4, 0xb4b7bd6, 0x1e5a3799, 0x6b33847, 0x17fa56ff, 0x65ef930, 0x21dc4a, + 0x2b37659, 0x450fe17, 0xb357b65, 0xdf5efac, 0x15397bef, 0x9d35a7f, 0x112ac15f, 0x624e62e, 0xa90ae2f, + 0x107eecd2, 0x1f69bbe, 0x77d6bce, 0x5741394, 0x13c684fc, 0x950c910, 0x725522b, 0xdc78583, 0x40eeabb, + 0x1fde328a, 0xbd61d96, 0xd28c387, 0x9e77d89, 0x12550c40, 0x759cb7d, 0x367ef34, 0xae2a960, 0x91b8bdc, + 0x93462a9, 0xf469ef, 0xb2e9aef, 0xd2ca771, 0x54e1f42, 0x7aaa49, 0x6316abb, 0x2413c8e, 0x5425bf9, + 0x1bed3e3a, 0xf272274, 0x1f5e7326, 0x6416517, 0xea27072, 0x9cedea7, 0x6e7633, 0x7c91952, 0xd806dce, + 0x8e2a7e1, 0xe421e1a, 0x418c9e1, 0x1dbc890, 0x1b395c36, 0xa1dc175, 0x1dc4ef73, 0x8956f34, 0xe4b5cf2, + 0x1b0d3a18, 0x3194a36, 0x6c2641f, 0xe44124c, 0xa2f4eaa, 0xa8c25ba, 0xf927ed7, 0x627b614, 0x7371cca, + 0xba16694, 0x417bc03, 0x7c0a7e3, 0x9c35c19, 0x1168a205, 0x8b6b00d, 0x10e3edc9, 0x9c19bf2, 0x5882229, + 0x1b2b4162, 0xa5cef1a, 0x1543622b, 0x9bd433e, 0x364e04d, 0x7480792, 0x5c9b5b3, 0xe85ff25, 0x408ef57, + 0x1814cfa4, 0x121b41b, 0xd248a0f, 0x3b05222, 0x39bb16a, 0xc75966d, 0xa038113, 0xa4a1769, 0x11fbc6c, + 0x917e50e, 0xeec3da8, 0x169d6eac, 0x10c1699, 0xa416153, 0xf724912, 0x15cd60b7, 0x4acbad9, 0x5efc5fa, + 0xf150ed7, 0x122b51, 0x1104b40a, 0xcb7f442, 0xfbb28ff, 0x6ac53ca, 0x196142cc, 0x7bf0fa9, 0x957651, + 0x4e0f215, 0xed439f8, 0x3f46bd5, 0x5ace82f, 0x110916b6, 0x6db078, 0xffd7d57, 0xf2ecaac, 0xca86dec, + 0x15d6b2da, 0x965ecc9, 0x1c92b4c2, 0x1f3811, 0x1cb080f5, 0x2d8b804, 0x19d1c12d, 0xf20bd46, 0x1951fa7, + 0xa3656c3, 0x523a425, 0xfcd0692, 0xd44ddc8, 0x131f0f5b, 0xaf80e4a, 0xcd9fc74, 0x99bb618, 0x2db944c, + 0xa673090, 0x1c210e1, 0x178c8d23, 0x1474383, 0x10b8743d, 0x985a55b, 0x2e74779, 0x576138, 0x9587927, + 0x133130fa, 0xbe05516, 0x9f4d619, 0xbb62570, 0x99ec591, 0xd9468fe, 0x1d07782d, 0xfc72e0b, 0x701b298, + 0x1863863b, 0x85954b8, 0x121a0c36, 0x9e7fedf, 0xf64b429, 0x9b9d71e, 0x14e2f5d8, 0xf858d3a, 0x942eea8, + 0xda5b765, 0x6edafff, 0xa9d18cc, 0xc65e4ba, 0x1c747e86, 0xe4ea915, 0x1981d7a1, 0x8395659, 0x52ed4e2, + 0x87d43b7, 0x37ab11b, 0x19d292ce, 0xf8d4692, 0x18c3053f, 0x8863e13, 0x4c146c0, 0x6bdf55a, 0x4e4457d, + 0x16152289, 0xac78ec2, 0x1a59c5a2, 0x2028b97, 0x71c2d01, 0x295851f, 0x404747b, 0x878558d, 0x7d29aa4, + 0x13d8341f, 0x8daefd7, 0x139c972d, 0x6b7ea75, 0xd4a9dde, 0xff163d8, 0x81d55d7, 0xa5bef68, 0xb7b30d8, + 0xbe73d6f, 0xaa88141, 0xd976c81, 0x7e7a9cc, 0x18beb771, 0xd773cbd, 0x13f51951, 0x9d0c177, 0x1c49a78, +}; + + +/* Field element operations: */ + +/* NON_ZERO_TO_ALL_ONES returns: + * 0xffffffff for 0 < x <= 2**31 + * 0 for x == 0 or x > 2**31. + * + * x must be a u32 or an equivalent type such as limb. */ +#define NON_ZERO_TO_ALL_ONES(x) ((((u32)(x) - 1) >> 31) - 1) + +/* felem_reduce_carry adds a multiple of p in order to cancel |carry|, + * which is a term at 2**257. + * + * On entry: carry < 2**3, inout[0,2,...] < 2**29, inout[1,3,...] < 2**28. + * On exit: inout[0,2,..] < 2**30, inout[1,3,...] < 2**29. */ +static void felem_reduce_carry(felem inout, limb carry) { + const u32 carry_mask = NON_ZERO_TO_ALL_ONES(carry); + + inout[0] += carry << 1; + inout[3] += 0x10000000 & carry_mask; + /* carry < 2**3 thus (carry << 11) < 2**14 and we added 2**28 in the + * previous line therefore this doesn't underflow. */ + inout[3] -= carry << 11; + inout[4] += (0x20000000 - 1) & carry_mask; + inout[5] += (0x10000000 - 1) & carry_mask; + inout[6] += (0x20000000 - 1) & carry_mask; + inout[6] -= carry << 22; + /* This may underflow if carry is non-zero but, if so, we'll fix it in the + * next line. */ + inout[7] -= 1 & carry_mask; + inout[7] += carry << 25; +} + +/* felem_sum sets out = in+in2. + * + * On entry, in[i]+in2[i] must not overflow a 32-bit word. + * On exit: out[0,2,...] < 2**30, out[1,3,...] < 2**29 */ +static void felem_sum(felem out, const felem in, const felem in2) { + limb carry = 0; + unsigned i; + + for (i = 0;; i++) { + out[i] = in[i] + in2[i]; + out[i] += carry; + carry = out[i] >> 29; + out[i] &= kBottom29Bits; + + i++; + if (i == NLIMBS) + break; + + out[i] = in[i] + in2[i]; + out[i] += carry; + carry = out[i] >> 28; + out[i] &= kBottom28Bits; + } + + felem_reduce_carry(out, carry); +} + +#define two31m3 (((limb)1) << 31) - (((limb)1) << 3) +#define two30m2 (((limb)1) << 30) - (((limb)1) << 2) +#define two30p13m2 (((limb)1) << 30) + (((limb)1) << 13) - (((limb)1) << 2) +#define two31m2 (((limb)1) << 31) - (((limb)1) << 2) +#define two31p24m2 (((limb)1) << 31) + (((limb)1) << 24) - (((limb)1) << 2) +#define two30m27m2 (((limb)1) << 30) - (((limb)1) << 27) - (((limb)1) << 2) + +/* zero31 is 0 mod p. */ +static const felem zero31 = { two31m3, two30m2, two31m2, two30p13m2, two31m2, two30m2, two31p24m2, two30m27m2, two31m2 }; + +/* felem_diff sets out = in-in2. + * + * On entry: in[0,2,...] < 2**30, in[1,3,...] < 2**29 and + * in2[0,2,...] < 2**30, in2[1,3,...] < 2**29. + * On exit: out[0,2,...] < 2**30, out[1,3,...] < 2**29. */ +static void felem_diff(felem out, const felem in, const felem in2) { + limb carry = 0; + unsigned i; + + for (i = 0;; i++) { + out[i] = in[i] - in2[i]; + out[i] += zero31[i]; + out[i] += carry; + carry = out[i] >> 29; + out[i] &= kBottom29Bits; + + i++; + if (i == NLIMBS) + break; + + out[i] = in[i] - in2[i]; + out[i] += zero31[i]; + out[i] += carry; + carry = out[i] >> 28; + out[i] &= kBottom28Bits; + } + + felem_reduce_carry(out, carry); +} + +/* felem_reduce_degree sets out = tmp/R mod p where tmp contains 64-bit words + * with the same 29,28,... bit positions as an felem. + * + * The values in felems are in Montgomery form: x*R mod p where R = 2**257. + * Since we just multiplied two Montgomery values together, the result is + * x*y*R*R mod p. We wish to divide by R in order for the result also to be + * in Montgomery form. + * + * On entry: tmp[i] < 2**64 + * On exit: out[0,2,...] < 2**30, out[1,3,...] < 2**29 */ +static void felem_reduce_degree(felem out, u64 tmp[17]) { + /* The following table may be helpful when reading this code: + * + * Limb number: 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10... + * Width (bits): 29| 28| 29| 28| 29| 28| 29| 28| 29| 28| 29 + * Start bit: 0 | 29| 57| 86|114|143|171|200|228|257|285 + * (odd phase): 0 | 28| 57| 85|114|142|171|199|228|256|285 */ + limb tmp2[18], carry, x, xMask; + unsigned i; + + /* tmp contains 64-bit words with the same 29,28,29-bit positions as an + * felem. So the top of an element of tmp might overlap with another + * element two positions down. The following loop eliminates this + * overlap. */ + tmp2[0] = (limb)(tmp[0] & kBottom29Bits); + + /* In the following we use "(limb) tmp[x]" and "(limb) (tmp[x]>>32)" to try + * and hint to the compiler that it can do a single-word shift by selecting + * the right register rather than doing a double-word shift and truncating + * afterwards. */ + tmp2[1] = ((limb) tmp[0]) >> 29; + tmp2[1] |= (((limb)(tmp[0] >> 32)) << 3) & kBottom28Bits; + tmp2[1] += ((limb) tmp[1]) & kBottom28Bits; + carry = tmp2[1] >> 28; + tmp2[1] &= kBottom28Bits; + + for (i = 2; i < 17; i++) { + tmp2[i] = ((limb)(tmp[i - 2] >> 32)) >> 25; + tmp2[i] += ((limb)(tmp[i - 1])) >> 28; + tmp2[i] += (((limb)(tmp[i - 1] >> 32)) << 4) & kBottom29Bits; + tmp2[i] += ((limb) tmp[i]) & kBottom29Bits; + tmp2[i] += carry; + carry = tmp2[i] >> 29; + tmp2[i] &= kBottom29Bits; + + i++; + if (i == 17) + break; + tmp2[i] = ((limb)(tmp[i - 2] >> 32)) >> 25; + tmp2[i] += ((limb)(tmp[i - 1])) >> 29; + tmp2[i] += (((limb)(tmp[i - 1] >> 32)) << 3) & kBottom28Bits; + tmp2[i] += ((limb) tmp[i]) & kBottom28Bits; + tmp2[i] += carry; + carry = tmp2[i] >> 28; + tmp2[i] &= kBottom28Bits; + } + + tmp2[17] = ((limb)(tmp[15] >> 32)) >> 25; + tmp2[17] += ((limb)(tmp[16])) >> 29; + tmp2[17] += (((limb)(tmp[16] >> 32)) << 3); + tmp2[17] += carry; + + /* Montgomery elimination of terms. + * + * Since R is 2**257, we can divide by R with a bitwise shift if we can + * ensure that the right-most 257 bits are all zero. We can make that true by + * adding multiplies of p without affecting the value. + * + * So we eliminate limbs from right to left. Since the bottom 29 bits of p + * are all ones, then by adding tmp2[0]*p to tmp2 we'll make tmp2[0] == 0. + * We can do that for 8 further limbs and then right shift to eliminate the + * extra factor of R. */ + for (i = 0;; i += 2) { + tmp2[i + 1] += tmp2[i] >> 29; + x = tmp2[i] & kBottom29Bits; + xMask = NON_ZERO_TO_ALL_ONES(x); + tmp2[i] = 0; + + /* The bounds calculations for this loop are tricky. Each iteration of + * the loop eliminates two words by adding values to words to their + * right. + * + * The following table contains the amounts added to each word (as an + * offset from the value of i at the top of the loop). The amounts are + * accounted for from the first and second half of the loop separately + * and are written as, for example, 28 to mean a value <2**28. + * + * Word: 3 4 5 6 7 8 9 10 + * Added in top half: 28 11 29 21 29 28 + * 28 29 + * 29 + * Added in bottom half: 29 10 28 21 28 28 + * 29 + * + * The value that is currently offset 7 will be offset 5 for the next + * iteration and then offset 3 for the iteration after that. Therefore + * the total value added will be the values added at 7, 5 and 3. + * + * The following table accumulates these values. The sums at the bottom + * are written as, for example, 29+28, to mean a value < 2**29+2**28. + * + * Word: 3 4 5 6 7 8 9 10 11 12 13 + * 28 11 10 29 21 29 28 28 28 28 28 + * 29 28 11 28 29 28 29 28 29 28 + * 29 28 21 21 29 21 29 21 + * 10 29 28 21 28 21 28 + * 28 29 28 29 28 29 28 + * 11 10 29 10 29 10 + * 29 28 11 28 11 + * 29 29 + * -------------------------------------------- + * 30+ 31+ 30+ 31+ 30+ + * 28+ 29+ 28+ 29+ 21+ + * 21+ 28+ 21+ 28+ 10 + * 10 21+ 10 21+ + * 11 11 + * + * So the greatest amount is added to tmp2[10] and tmp2[12]. If + * tmp2[10/12] has an initial value of <2**29, then the maximum value + * will be < 2**31 + 2**30 + 2**28 + 2**21 + 2**11, which is < 2**32, + * as required. */ + tmp2[i + 3] += (x << 10) & kBottom28Bits; + tmp2[i + 4] += (x >> 18); + + tmp2[i + 6] += (x << 21) & kBottom29Bits; + tmp2[i + 7] += x >> 8; + + /* At position 200, which is the starting bit position for word 7, we + * have a factor of 0xf000000 = 2**28 - 2**24. */ + tmp2[i + 7] += 0x10000000 & xMask; + /* Word 7 is 28 bits wide, so the 2**28 term exactly hits word 8. */ + tmp2[i + 8] += (x - 1) & xMask; + tmp2[i + 7] -= (x << 24) & kBottom28Bits; + tmp2[i + 8] -= x >> 4; + + tmp2[i + 8] += 0x20000000 & xMask; + tmp2[i + 8] -= x; + tmp2[i + 8] += (x << 28) & kBottom29Bits; + tmp2[i + 9] += ((x >> 1) - 1) & xMask; + + if (i+1 == NLIMBS) + break; + tmp2[i + 2] += tmp2[i + 1] >> 28; + x = tmp2[i + 1] & kBottom28Bits; + xMask = NON_ZERO_TO_ALL_ONES(x); + tmp2[i + 1] = 0; + + tmp2[i + 4] += (x << 11) & kBottom29Bits; + tmp2[i + 5] += (x >> 18); + + tmp2[i + 7] += (x << 21) & kBottom28Bits; + tmp2[i + 8] += x >> 7; + + /* At position 199, which is the starting bit of the 8th word when + * dealing with a context starting on an odd word, we have a factor of + * 0x1e000000 = 2**29 - 2**25. Since we have not updated i, the 8th + * word from i+1 is i+8. */ + tmp2[i + 8] += 0x20000000 & xMask; + tmp2[i + 9] += (x - 1) & xMask; + tmp2[i + 8] -= (x << 25) & kBottom29Bits; + tmp2[i + 9] -= x >> 4; + + tmp2[i + 9] += 0x10000000 & xMask; + tmp2[i + 9] -= x; + tmp2[i + 10] += (x - 1) & xMask; + } + + /* We merge the right shift with a carry chain. The words above 2**257 have + * widths of 28,29,... which we need to correct when copying them down. */ + carry = 0; + for (i = 0; i < 8; i++) { + /* The maximum value of tmp2[i + 9] occurs on the first iteration and + * is < 2**30+2**29+2**28. Adding 2**29 (from tmp2[i + 10]) is + * therefore safe. */ + out[i] = tmp2[i + 9]; + out[i] += carry; + out[i] += (tmp2[i + 10] << 28) & kBottom29Bits; + carry = out[i] >> 29; + out[i] &= kBottom29Bits; + + i++; + out[i] = tmp2[i + 9] >> 1; + out[i] += carry; + carry = out[i] >> 28; + out[i] &= kBottom28Bits; + } + + out[8] = tmp2[17]; + out[8] += carry; + carry = out[8] >> 29; + out[8] &= kBottom29Bits; + + felem_reduce_carry(out, carry); +} + +/* felem_square sets out=in*in. + * + * On entry: in[0,2,...] < 2**30, in[1,3,...] < 2**29. + * On exit: out[0,2,...] < 2**30, out[1,3,...] < 2**29. */ +static void felem_square(felem out, const felem in) { + u64 tmp[17]; + + tmp[0] = ((u64) in[0]) * in[0]; + tmp[1] = ((u64) in[0]) * (in[1] << 1); + tmp[2] = ((u64) in[0]) * (in[2] << 1) + + ((u64) in[1]) * (in[1] << 1); + tmp[3] = ((u64) in[0]) * (in[3] << 1) + + ((u64) in[1]) * (in[2] << 1); + tmp[4] = ((u64) in[0]) * (in[4] << 1) + + ((u64) in[1]) * (in[3] << 2) + ((u64) in[2]) * in[2]; + tmp[5] = ((u64) in[0]) * (in[5] << 1) + ((u64) in[1]) * + (in[4] << 1) + ((u64) in[2]) * (in[3] << 1); + tmp[6] = ((u64) in[0]) * (in[6] << 1) + ((u64) in[1]) * + (in[5] << 2) + ((u64) in[2]) * (in[4] << 1) + + ((u64) in[3]) * (in[3] << 1); + tmp[7] = ((u64) in[0]) * (in[7] << 1) + ((u64) in[1]) * + (in[6] << 1) + ((u64) in[2]) * (in[5] << 1) + + ((u64) in[3]) * (in[4] << 1); + /* tmp[8] has the greatest value of 2**61 + 2**60 + 2**61 + 2**60 + 2**60, + * which is < 2**64 as required. */ + tmp[8] = ((u64) in[0]) * (in[8] << 1) + ((u64) in[1]) * + (in[7] << 2) + ((u64) in[2]) * (in[6] << 1) + + ((u64) in[3]) * (in[5] << 2) + ((u64) in[4]) * in[4]; + tmp[9] = ((u64) in[1]) * (in[8] << 1) + ((u64) in[2]) * + (in[7] << 1) + ((u64) in[3]) * (in[6] << 1) + + ((u64) in[4]) * (in[5] << 1); + tmp[10] = ((u64) in[2]) * (in[8] << 1) + ((u64) in[3]) * + (in[7] << 2) + ((u64) in[4]) * (in[6] << 1) + + ((u64) in[5]) * (in[5] << 1); + tmp[11] = ((u64) in[3]) * (in[8] << 1) + ((u64) in[4]) * + (in[7] << 1) + ((u64) in[5]) * (in[6] << 1); + tmp[12] = ((u64) in[4]) * (in[8] << 1) + + ((u64) in[5]) * (in[7] << 2) + ((u64) in[6]) * in[6]; + tmp[13] = ((u64) in[5]) * (in[8] << 1) + + ((u64) in[6]) * (in[7] << 1); + tmp[14] = ((u64) in[6]) * (in[8] << 1) + + ((u64) in[7]) * (in[7] << 1); + tmp[15] = ((u64) in[7]) * (in[8] << 1); + tmp[16] = ((u64) in[8]) * in[8]; + + felem_reduce_degree(out, tmp); +} + +/* felem_mul sets out=in*in2. + * + * On entry: in[0,2,...] < 2**30, in[1,3,...] < 2**29 and + * in2[0,2,...] < 2**30, in2[1,3,...] < 2**29. + * On exit: out[0,2,...] < 2**30, out[1,3,...] < 2**29. */ +static void felem_mul(felem out, const felem in, const felem in2) { + u64 tmp[17]; + + tmp[0] = ((u64) in[0]) * in2[0]; + tmp[1] = ((u64) in[0]) * (in2[1] << 0) + + ((u64) in[1]) * (in2[0] << 0); + tmp[2] = ((u64) in[0]) * (in2[2] << 0) + ((u64) in[1]) * + (in2[1] << 1) + ((u64) in[2]) * (in2[0] << 0); + tmp[3] = ((u64) in[0]) * (in2[3] << 0) + ((u64) in[1]) * + (in2[2] << 0) + ((u64) in[2]) * (in2[1] << 0) + + ((u64) in[3]) * (in2[0] << 0); + tmp[4] = ((u64) in[0]) * (in2[4] << 0) + ((u64) in[1]) * + (in2[3] << 1) + ((u64) in[2]) * (in2[2] << 0) + + ((u64) in[3]) * (in2[1] << 1) + + ((u64) in[4]) * (in2[0] << 0); + tmp[5] = ((u64) in[0]) * (in2[5] << 0) + ((u64) in[1]) * + (in2[4] << 0) + ((u64) in[2]) * (in2[3] << 0) + + ((u64) in[3]) * (in2[2] << 0) + ((u64) in[4]) * + (in2[1] << 0) + ((u64) in[5]) * (in2[0] << 0); + tmp[6] = ((u64) in[0]) * (in2[6] << 0) + ((u64) in[1]) * + (in2[5] << 1) + ((u64) in[2]) * (in2[4] << 0) + + ((u64) in[3]) * (in2[3] << 1) + ((u64) in[4]) * + (in2[2] << 0) + ((u64) in[5]) * (in2[1] << 1) + + ((u64) in[6]) * (in2[0] << 0); + tmp[7] = ((u64) in[0]) * (in2[7] << 0) + ((u64) in[1]) * + (in2[6] << 0) + ((u64) in[2]) * (in2[5] << 0) + + ((u64) in[3]) * (in2[4] << 0) + ((u64) in[4]) * + (in2[3] << 0) + ((u64) in[5]) * (in2[2] << 0) + + ((u64) in[6]) * (in2[1] << 0) + + ((u64) in[7]) * (in2[0] << 0); + /* tmp[8] has the greatest value but doesn't overflow. See logic in + * felem_square. */ + tmp[8] = ((u64) in[0]) * (in2[8] << 0) + ((u64) in[1]) * + (in2[7] << 1) + ((u64) in[2]) * (in2[6] << 0) + + ((u64) in[3]) * (in2[5] << 1) + ((u64) in[4]) * + (in2[4] << 0) + ((u64) in[5]) * (in2[3] << 1) + + ((u64) in[6]) * (in2[2] << 0) + ((u64) in[7]) * + (in2[1] << 1) + ((u64) in[8]) * (in2[0] << 0); + tmp[9] = ((u64) in[1]) * (in2[8] << 0) + ((u64) in[2]) * + (in2[7] << 0) + ((u64) in[3]) * (in2[6] << 0) + + ((u64) in[4]) * (in2[5] << 0) + ((u64) in[5]) * + (in2[4] << 0) + ((u64) in[6]) * (in2[3] << 0) + + ((u64) in[7]) * (in2[2] << 0) + + ((u64) in[8]) * (in2[1] << 0); + tmp[10] = ((u64) in[2]) * (in2[8] << 0) + ((u64) in[3]) * + (in2[7] << 1) + ((u64) in[4]) * (in2[6] << 0) + + ((u64) in[5]) * (in2[5] << 1) + ((u64) in[6]) * + (in2[4] << 0) + ((u64) in[7]) * (in2[3] << 1) + + ((u64) in[8]) * (in2[2] << 0); + tmp[11] = ((u64) in[3]) * (in2[8] << 0) + ((u64) in[4]) * + (in2[7] << 0) + ((u64) in[5]) * (in2[6] << 0) + + ((u64) in[6]) * (in2[5] << 0) + ((u64) in[7]) * + (in2[4] << 0) + ((u64) in[8]) * (in2[3] << 0); + tmp[12] = ((u64) in[4]) * (in2[8] << 0) + ((u64) in[5]) * + (in2[7] << 1) + ((u64) in[6]) * (in2[6] << 0) + + ((u64) in[7]) * (in2[5] << 1) + + ((u64) in[8]) * (in2[4] << 0); + tmp[13] = ((u64) in[5]) * (in2[8] << 0) + ((u64) in[6]) * + (in2[7] << 0) + ((u64) in[7]) * (in2[6] << 0) + + ((u64) in[8]) * (in2[5] << 0); + tmp[14] = ((u64) in[6]) * (in2[8] << 0) + ((u64) in[7]) * + (in2[7] << 1) + ((u64) in[8]) * (in2[6] << 0); + tmp[15] = ((u64) in[7]) * (in2[8] << 0) + + ((u64) in[8]) * (in2[7] << 0); + tmp[16] = ((u64) in[8]) * (in2[8] << 0); + + felem_reduce_degree(out, tmp); +} + +static void felem_assign(felem out, const felem in) { + memcpy(out, in, sizeof(felem)); +} + +/* felem_scalar_3 sets out=3*out. + * + * On entry: out[0,2,...] < 2**30, out[1,3,...] < 2**29. + * On exit: out[0,2,...] < 2**30, out[1,3,...] < 2**29. */ +static void felem_scalar_3(felem out) { + limb carry = 0; + unsigned i; + + for (i = 0;; i++) { + out[i] *= 3; + out[i] += carry; + carry = out[i] >> 29; + out[i] &= kBottom29Bits; + + i++; + if (i == NLIMBS) + break; + + out[i] *= 3; + out[i] += carry; + carry = out[i] >> 28; + out[i] &= kBottom28Bits; + } + + felem_reduce_carry(out, carry); +} + +/* felem_scalar_4 sets out=4*out. + * + * On entry: out[0,2,...] < 2**30, out[1,3,...] < 2**29. + * On exit: out[0,2,...] < 2**30, out[1,3,...] < 2**29. */ +static void felem_scalar_4(felem out) { + limb carry = 0, next_carry; + unsigned i; + + for (i = 0;; i++) { + next_carry = out[i] >> 27; + out[i] <<= 2; + out[i] &= kBottom29Bits; + out[i] += carry; + carry = next_carry + (out[i] >> 29); + out[i] &= kBottom29Bits; + + i++; + if (i == NLIMBS) + break; + + next_carry = out[i] >> 26; + out[i] <<= 2; + out[i] &= kBottom28Bits; + out[i] += carry; + carry = next_carry + (out[i] >> 28); + out[i] &= kBottom28Bits; + } + + felem_reduce_carry(out, carry); +} + +/* felem_scalar_8 sets out=8*out. + * + * On entry: out[0,2,...] < 2**30, out[1,3,...] < 2**29. + * On exit: out[0,2,...] < 2**30, out[1,3,...] < 2**29. */ +static void felem_scalar_8(felem out) { + limb carry = 0, next_carry; + unsigned i; + + for (i = 0;; i++) { + next_carry = out[i] >> 26; + out[i] <<= 3; + out[i] &= kBottom29Bits; + out[i] += carry; + carry = next_carry + (out[i] >> 29); + out[i] &= kBottom29Bits; + + i++; + if (i == NLIMBS) + break; + + next_carry = out[i] >> 25; + out[i] <<= 3; + out[i] &= kBottom28Bits; + out[i] += carry; + carry = next_carry + (out[i] >> 28); + out[i] &= kBottom28Bits; + } + + felem_reduce_carry(out, carry); +} + +/* felem_is_zero_vartime returns 1 iff |in| == 0. It takes a variable amount of + * time depending on the value of |in|. */ +static char felem_is_zero_vartime(const felem in) { + limb carry; + int i; + limb tmp[NLIMBS]; + + felem_assign(tmp, in); + + /* First, reduce tmp to a minimal form. */ + do { + carry = 0; + for (i = 0;; i++) { + tmp[i] += carry; + carry = tmp[i] >> 29; + tmp[i] &= kBottom29Bits; + + i++; + if (i == NLIMBS) + break; + + tmp[i] += carry; + carry = tmp[i] >> 28; + tmp[i] &= kBottom28Bits; + } + + felem_reduce_carry(tmp, carry); + } while (carry); + + /* tmp < 2**257, so the only possible zero values are 0, p and 2p. */ + return memcmp(tmp, kZero, sizeof(tmp)) == 0 || + memcmp(tmp, kP, sizeof(tmp)) == 0 || + memcmp(tmp, k2P, sizeof(tmp)) == 0; +} + + +/* Montgomery operations: */ + +#define kRDigits {2, 0, 0, 0xfffffffe, 0xffffffff, 0xffffffff, 0xfffffffd, 1} // 2^257 mod p256.p + +#define kRInvDigits {0x80000000, 1, 0xffffffff, 0, 0x80000001, 0xfffffffe, 1, 0x7fffffff} // 1 / 2^257 mod p256.p + +static const cryptonite_p256_int kR = { kRDigits }; +static const cryptonite_p256_int kRInv = { kRInvDigits }; + +/* to_montgomery sets out = R*in. */ +static void to_montgomery(felem out, const cryptonite_p256_int* in) { + cryptonite_p256_int in_shifted; + int i; + + cryptonite_p256_init(&in_shifted); + cryptonite_p256_modmul(&cryptonite_SECP256r1_p, in, 0, &kR, &in_shifted); + + for (i = 0; i < NLIMBS; i++) { + if ((i & 1) == 0) { + out[i] = P256_DIGIT(&in_shifted, 0) & kBottom29Bits; + cryptonite_p256_shr(&in_shifted, 29, &in_shifted); + } else { + out[i] = P256_DIGIT(&in_shifted, 0) & kBottom28Bits; + cryptonite_p256_shr(&in_shifted, 28, &in_shifted); + } + } + + cryptonite_p256_clear(&in_shifted); +} + +/* from_montgomery sets out=in/R. */ +static void from_montgomery(cryptonite_p256_int* out, const felem in) { + cryptonite_p256_int result, tmp; + int i, top; + + cryptonite_p256_init(&result); + cryptonite_p256_init(&tmp); + + cryptonite_p256_add_d(&tmp, in[NLIMBS - 1], &result); + for (i = NLIMBS - 2; i >= 0; i--) { + if ((i & 1) == 0) { + top = cryptonite_p256_shl(&result, 29, &tmp); + } else { + top = cryptonite_p256_shl(&result, 28, &tmp); + } + top |= cryptonite_p256_add_d(&tmp, in[i], &result); + } + + cryptonite_p256_modmul(&cryptonite_SECP256r1_p, &kRInv, top, &result, out); + + cryptonite_p256_clear(&result); + cryptonite_p256_clear(&tmp); +} From f9a6a35ce3c3d5fac9ba47df446708ef520a9943 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 11 Jan 2020 08:42:59 +0100 Subject: [PATCH 124/176] Prepare 64-bit implementation for p256 --- cbits/p256/p256.c | 53 ++++++++++++++++++++++++----------------------- cbits/p256/p256.h | 5 +++++ 2 files changed, 32 insertions(+), 26 deletions(-) diff --git a/cbits/p256/p256.c b/cbits/p256/p256.c index 8dad6ef..b5889a5 100644 --- a/cbits/p256/p256.c +++ b/cbits/p256/p256.c @@ -40,14 +40,16 @@ #include "p256/p256.h" const cryptonite_p256_int cryptonite_SECP256r1_n = // curve order - {{0xfc632551, 0xf3b9cac2, 0xa7179e84, 0xbce6faad, -1, -1, 0, -1}}; + {{P256_LITERAL(0xfc632551, 0xf3b9cac2), P256_LITERAL(0xa7179e84, 0xbce6faad), + P256_LITERAL(-1, -1), P256_LITERAL(0, -1)}}; const cryptonite_p256_int cryptonite_SECP256r1_p = // curve field size - {{-1, -1, -1, 0, 0, 0, 1, -1 }}; + {{P256_LITERAL(-1, -1), P256_LITERAL(-1, 0), + P256_LITERAL(0, 0), P256_LITERAL(1, -1) }}; const cryptonite_p256_int cryptonite_SECP256r1_b = // curve b - {{0x27d2604b, 0x3bce3c3e, 0xcc53b0f6, 0x651d06b0, - 0x769886bc, 0xb3ebbd55, 0xaa3a93e7, 0x5ac635d8}}; + {{P256_LITERAL(0x27d2604b, 0x3bce3c3e), P256_LITERAL(0xcc53b0f6, 0x651d06b0), + P256_LITERAL(0x769886bc, 0xb3ebbd55), P256_LITERAL(0xaa3a93e7, 0x5ac635d8)}}; void cryptonite_p256_init(cryptonite_p256_int* a) { memset(a, 0, sizeof(*a)); @@ -61,9 +63,10 @@ int cryptonite_p256_get_bit(const cryptonite_p256_int* scalar, int bit) { } int cryptonite_p256_is_zero(const cryptonite_p256_int* a) { - int i, result = 0; + cryptonite_p256_digit result = 0; + int i = 0; for (i = 0; i < P256_NDIGITS; ++i) result |= P256_DIGIT(a, i); - return !result; + return result == 0; } // top, c[] += a[] * b @@ -229,7 +232,7 @@ static void cryptonite_p256_shr1(const cryptonite_p256_int* a, int highbit, cryp P256_DIGIT(b, i) = accu; } P256_DIGIT(b, i) = (P256_DIGIT(a, i) >> 1) | - (highbit << (P256_BITSPERDIGIT - 1)); + (((cryptonite_p256_sdigit) highbit) << (P256_BITSPERDIGIT - 1)); } // Return -1, 0, 1 for a < b, a == b or a > b respectively. @@ -359,31 +362,32 @@ int cryptonite_p256_is_valid_point(const cryptonite_p256_int* x, const cryptonit } void cryptonite_p256_from_bin(const uint8_t src[P256_NBYTES], cryptonite_p256_int* dst) { - int i; + int i, n; const uint8_t* p = &src[0]; for (i = P256_NDIGITS - 1; i >= 0; --i) { - P256_DIGIT(dst, i) = - (p[0] << 24) | - (p[1] << 16) | - (p[2] << 8) | - p[3]; - p += 4; + cryptonite_p256_digit dig = 0; + n = P256_BITSPERDIGIT; + while (n > 0) { + n -= 8; + dig |= ((cryptonite_p256_digit) *(p++)) << n; + } + P256_DIGIT(dst, i) = dig; } } void cryptonite_p256_to_bin(const cryptonite_p256_int* src, uint8_t dst[P256_NBYTES]) { - int i; + int i, n; uint8_t* p = &dst[0]; for (i = P256_NDIGITS -1; i >= 0; --i) { const cryptonite_p256_digit dig = P256_DIGIT(src, i); - p[0] = dig >> 24; - p[1] = dig >> 16; - p[2] = dig >> 8; - p[3] = dig; - p += 4; + n = P256_BITSPERDIGIT; + while (n > 0) { + n -= 8; + *(p++) = dig >> n; + } } } @@ -409,9 +413,6 @@ void cryptonite_p256e_modsub(const cryptonite_p256_int* MOD, const cryptonite_p2 addM(MOD, 0, P256_DIGITS(c), top); } -// n' such as n * n' = -1 mod (2^32) -#define MONTGOMERY_FACTOR 0xEE00BC4F - #define NTH_DOUBLE_THEN_ADD(i, a, nth, b, out) \ cryptonite_p256e_montmul(a, a, out); \ for (i = 1; i < nth; i++) \ @@ -419,8 +420,8 @@ void cryptonite_p256e_modsub(const cryptonite_p256_int* MOD, const cryptonite_p2 cryptonite_p256e_montmul(out, b, out); const cryptonite_p256_int cryptonite_SECP256r1_r2 = // r^2 mod n - {{0xBE79EEA2, 0x83244C95, 0x49BD6FA6, 0x4699799C, - 0x2B6BEC59, 0x2845B239, 0xF3D95620, 0x66E12D94}}; + {{P256_LITERAL(0xBE79EEA2, 0x83244C95), P256_LITERAL(0x49BD6FA6, 0x4699799C), + P256_LITERAL(0x2B6BEC59, 0x2845B239), P256_LITERAL(0xF3D95620, 0x66E12D94)}}; const cryptonite_p256_int cryptonite_SECP256r1_one = {{1}}; @@ -443,7 +444,7 @@ static void cryptonite_p256e_montmul(const cryptonite_p256_int* a, const crypton } accum[j] = chain; - mand = accum[0] * MONTGOMERY_FACTOR; + mand = accum[0] * P256_MONTGOMERY_FACTOR; chain = 0; mier = P256_DIGITS(&cryptonite_SECP256r1_n); for (j=0; j Date: Sat, 11 Jan 2020 08:42:59 +0100 Subject: [PATCH 125/176] Add 64-bit implementation for p256 --- cbits/{ => include32}/p256/p256.h | 0 cbits/{ => include32}/p256/p256_gf.h | 2 +- cbits/include64/p256/p256.h | 167 +++++++ cbits/include64/p256/p256_gf.h | 707 +++++++++++++++++++++++++++ cbits/p256/p256.c | 6 +- cbits/p256/p256_ec.c | 6 +- cryptonite.cabal | 8 +- 7 files changed, 890 insertions(+), 6 deletions(-) rename cbits/{ => include32}/p256/p256.h (100%) rename cbits/{ => include32}/p256/p256_gf.h (99%) create mode 100644 cbits/include64/p256/p256.h create mode 100644 cbits/include64/p256/p256_gf.h diff --git a/cbits/p256/p256.h b/cbits/include32/p256/p256.h similarity index 100% rename from cbits/p256/p256.h rename to cbits/include32/p256/p256.h diff --git a/cbits/p256/p256_gf.h b/cbits/include32/p256/p256_gf.h similarity index 99% rename from cbits/p256/p256_gf.h rename to cbits/include32/p256/p256_gf.h index 7144c9d..ca8a716 100644 --- a/cbits/p256/p256_gf.h +++ b/cbits/include32/p256/p256_gf.h @@ -25,7 +25,7 @@ */ // This is an implementation of the P256 finite field. It's written to be -// be portable 32-bit, although it's still constant-time. +// portable and still constant-time. // // WARNING: Implementing these functions in a constant-time manner is far from // obvious. Be careful when touching this code. diff --git a/cbits/include64/p256/p256.h b/cbits/include64/p256/p256.h new file mode 100644 index 0000000..c043957 --- /dev/null +++ b/cbits/include64/p256/p256.h @@ -0,0 +1,167 @@ +/* + * Copyright 2013 The Android Open Source Project + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * * Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * * 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. + * * Neither the name of Google Inc. nor the names of its contributors may + * be used to endorse or promote products derived from this software + * without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY Google Inc. ``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 Google Inc. 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 SYSTEM_CORE_INCLUDE_MINCRYPT_LITE_P256_H_ +#define SYSTEM_CORE_INCLUDE_MINCRYPT_LITE_P256_H_ + +// Collection of routines manipulating 256 bit unsigned integers. +// Just enough to implement ecdsa-p256 and related algorithms. + +#include + +#ifdef __cplusplus +extern "C" { +#endif + +#define P256_BITSPERDIGIT 64 +#define P256_NDIGITS 4 +#define P256_NBYTES 32 + +// n' such as n * n' = -1 mod (2^64) +#define P256_MONTGOMERY_FACTOR 0xCCD1C8AAEE00BC4F + +#define P256_LITERAL(lo,hi) (((uint32_t) (lo)) + (((uint64_t) (hi)) << 32)) + +typedef int cryptonite_p256_err; +typedef uint64_t cryptonite_p256_digit; +typedef int64_t cryptonite_p256_sdigit; +typedef __uint128_t cryptonite_p256_ddigit; +typedef __int128_t cryptonite_p256_sddigit; + +// Defining cryptonite_p256_int as struct to leverage struct assigment. +typedef struct { + cryptonite_p256_digit a[P256_NDIGITS]; +} cryptonite_p256_int; + +extern const cryptonite_p256_int cryptonite_SECP256r1_n; // Curve order +extern const cryptonite_p256_int cryptonite_SECP256r1_p; // Curve prime +extern const cryptonite_p256_int cryptonite_SECP256r1_b; // Curve param + +// Initialize a cryptonite_p256_int to zero. +void cryptonite_p256_init(cryptonite_p256_int* a); + +// Clear a cryptonite_p256_int to zero. +void cryptonite_p256_clear(cryptonite_p256_int* a); + +// Return bit. Index 0 is least significant. +int cryptonite_p256_get_bit(const cryptonite_p256_int* a, int index); + +// b := a % MOD +void cryptonite_p256_mod( + const cryptonite_p256_int* MOD, + const cryptonite_p256_int* a, + cryptonite_p256_int* b); + +// c := a * (top_b | b) % MOD +void cryptonite_p256_modmul( + const cryptonite_p256_int* MOD, + const cryptonite_p256_int* a, + const cryptonite_p256_digit top_b, + const cryptonite_p256_int* b, + cryptonite_p256_int* c); + +// b := 1 / a % MOD +// MOD best be SECP256r1_n +void cryptonite_p256_modinv( + const cryptonite_p256_int* MOD, + const cryptonite_p256_int* a, + cryptonite_p256_int* b); + +// b := 1 / a % MOD +// MOD best be SECP256r1_n +// Faster than cryptonite_p256_modinv() +void cryptonite_p256_modinv_vartime( + const cryptonite_p256_int* MOD, + const cryptonite_p256_int* a, + cryptonite_p256_int* b); + +// b := a << (n % P256_BITSPERDIGIT) +// Returns the bits shifted out of most significant digit. +cryptonite_p256_digit cryptonite_p256_shl(const cryptonite_p256_int* a, int n, cryptonite_p256_int* b); + +// b := a >> (n % P256_BITSPERDIGIT) +void cryptonite_p256_shr(const cryptonite_p256_int* a, int n, cryptonite_p256_int* b); + +int cryptonite_p256_is_zero(const cryptonite_p256_int* a); +int cryptonite_p256_is_odd(const cryptonite_p256_int* a); +int cryptonite_p256_is_even(const cryptonite_p256_int* a); + +// Returns -1, 0 or 1. +int cryptonite_p256_cmp(const cryptonite_p256_int* a, const cryptonite_p256_int *b); + +// c: = a - b +// Returns -1 on borrow. +int cryptonite_p256_sub(const cryptonite_p256_int* a, const cryptonite_p256_int* b, cryptonite_p256_int* c); + +// c := a + b +// Returns 1 on carry. +int cryptonite_p256_add(const cryptonite_p256_int* a, const cryptonite_p256_int* b, cryptonite_p256_int* c); + +// c := a + (single digit)b +// Returns carry 1 on carry. +int cryptonite_p256_add_d(const cryptonite_p256_int* a, cryptonite_p256_digit b, cryptonite_p256_int* c); + +// ec routines. + +// {out_x,out_y} := nG +void cryptonite_p256_base_point_mul(const cryptonite_p256_int *n, + cryptonite_p256_int *out_x, + cryptonite_p256_int *out_y); + +// {out_x,out_y} := n{in_x,in_y} +void cryptonite_p256_point_mul(const cryptonite_p256_int *n, + const cryptonite_p256_int *in_x, + const cryptonite_p256_int *in_y, + cryptonite_p256_int *out_x, + cryptonite_p256_int *out_y); + +// {out_x,out_y} := n1G + n2{in_x,in_y} +void cryptonite_p256_points_mul_vartime( + const cryptonite_p256_int *n1, const cryptonite_p256_int *n2, + const cryptonite_p256_int *in_x, const cryptonite_p256_int *in_y, + cryptonite_p256_int *out_x, cryptonite_p256_int *out_y); + +// Return whether point {x,y} is on curve. +int cryptonite_p256_is_valid_point(const cryptonite_p256_int* x, const cryptonite_p256_int* y); + +// Outputs big-endian binary form. No leading zero skips. +void cryptonite_p256_to_bin(const cryptonite_p256_int* src, uint8_t dst[P256_NBYTES]); + +// Reads from big-endian binary form, +// thus pre-pad with leading zeros if short. +void cryptonite_p256_from_bin(const uint8_t src[P256_NBYTES], cryptonite_p256_int* dst); + +#define P256_DIGITS(x) ((x)->a) +#define P256_DIGIT(x,y) ((x)->a[y]) + +#define P256_ZERO {{0}} +#define P256_ONE {{1}} + +#ifdef __cplusplus +} +#endif + +#endif // SYSTEM_CORE_INCLUDE_MINCRYPT_LITE_P256_H_ diff --git a/cbits/include64/p256/p256_gf.h b/cbits/include64/p256/p256_gf.h new file mode 100644 index 0000000..9920ab3 --- /dev/null +++ b/cbits/include64/p256/p256_gf.h @@ -0,0 +1,707 @@ +/* + * Copyright 2013 The Android Open Source Project + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * * Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * * 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. + * * Neither the name of Google Inc. nor the names of its contributors may + * be used to endorse or promote products derived from this software + * without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY Google Inc. ``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 Google Inc. 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. + */ + +// This is an implementation of the P256 finite field. It's written to be +// portable and still constant-time. +// +// WARNING: Implementing these functions in a constant-time manner is far from +// obvious. Be careful when touching this code. +// +// See http://www.imperialviolet.org/2010/12/04/ecc.html ([1]) for background. + +#include +#include + +#include +#include + +#include "p256/p256.h" + +typedef uint8_t u8; +typedef uint32_t u32; +typedef uint64_t u64; +typedef int64_t s64; +typedef __uint128_t u128; + +/* Our field elements are represented as five 64-bit limbs. + * + * The value of an felem (field element) is: + * x[0] + (x[1] * 2**51) + (x[2] * 2**103) + ... + (x[4] * 2**206) + * + * That is, each limb is alternately 51 or 52-bits wide in little-endian + * order. + * + * This means that an felem hits 2**257, rather than 2**256 as we would like. + * + * Finally, the values stored in an felem are in Montgomery form. So the value + * |y| is stored as (y*R) mod p, where p is the P-256 prime and R is 2**257. + */ +typedef u64 limb; +#define NLIMBS 5 +typedef limb felem[NLIMBS]; + +static const limb kBottom51Bits = 0x7ffffffffffff; +static const limb kBottom52Bits = 0xfffffffffffff; + +/* kOne is the number 1 as an felem. It's 2**257 mod p split up into 51 and + * 52-bit words. */ +static const felem kOne = { + 2, 0xfc00000000000, 0x7ffffffffffff, 0xfff7fffffffff, 0x7ffff +}; +static const felem kZero = {0}; +static const felem kP = { + 0x7ffffffffffff, 0x1fffffffffff, 0, 0x4000000000, 0x3fffffffc0000 +}; +static const felem k2P = { + 0x7fffffffffffe, 0x3fffffffffff, 0, 0x8000000000, 0x7fffffff80000 +}; +/* kPrecomputed contains precomputed values to aid the calculation of scalar + * multiples of the base point, G. It's actually two, equal length, tables + * concatenated. + * + * The first table contains (x,y) felem pairs for 16 multiples of the base + * point, G. + * + * Index | Index (binary) | Value + * 0 | 0000 | 0G (all zeros, omitted) + * 1 | 0001 | G + * 2 | 0010 | 2**64G + * 3 | 0011 | 2**64G + G + * 4 | 0100 | 2**128G + * 5 | 0101 | 2**128G + G + * 6 | 0110 | 2**128G + 2**64G + * 7 | 0111 | 2**128G + 2**64G + G + * 8 | 1000 | 2**192G + * 9 | 1001 | 2**192G + G + * 10 | 1010 | 2**192G + 2**64G + * 11 | 1011 | 2**192G + 2**64G + G + * 12 | 1100 | 2**192G + 2**128G + * 13 | 1101 | 2**192G + 2**128G + G + * 14 | 1110 | 2**192G + 2**128G + 2**64G + * 15 | 1111 | 2**192G + 2**128G + 2**64G + G + * + * The second table follows the same style, but the terms are 2**32G, + * 2**96G, 2**160G, 2**224G. + * + * This is ~2KB of data. */ +static const limb kPrecomputed[NLIMBS * 2 * 15 * 2] = { + 0x661a831522878, 0xf17fb6d805e79, 0x5889441d6ea57, 0xae33cfdb995bb, 0xc482fbb529ba, + 0x4a6af9d2aac15, 0x90e867917377c, 0x487cc962d2ae3, 0xec2a97443446e, 0x2b8ff8c52c42, + 0x45f8a2d41a576, 0xb06988d2653e4, 0x718b22c357305, 0x33fc920e79d2b, 0x17af34b0fe8db, + 0x38e17eb402f2f, 0x3382558649705, 0x47f6d48f482d1, 0x7bd42488d9b83, 0x3b247c8b86b78, + 0x4d08fc26f7778, 0x7a29a82fb2795, 0x75cd18f90d11a, 0xad8e213b0bc, 0x2d5f0142899e8, + 0x506f98098fb57, 0x2f0c98301e4aa, 0x39b30dd5cf67d, 0x9c146498ab13c, 0xa5db92df5b7b, + 0x184897fc4124a, 0xe3f73a19d8aa, 0x4e1c18e47066b, 0x27b2d4b52eaee, 0x30eac3ea10e99, + 0x4e74546e2e7d5, 0x1f4dde2d97a1d, 0x6ead0f88e1200, 0x7dec87c220f02, 0x3d08ff096310f, + 0x23e5659633ffa, 0x6ec648f08c722, 0x3172a3806ea35, 0xf6e5b681eb3c5, 0x2c3758260f89d, + 0x38dca4fd1da12, 0xf06067b78830d, 0x3194be87a068c, 0x78893c7eb602b, 0xcead60438432, + 0x6ee69a56a67ab, 0xd886f77701895, 0x67b0a4d9cee2b, 0x3586bbf3e4d53, 0x1db6f32921d93, + 0x260756ca4b366, 0x4f40e9d2039fa, 0x4f3f09f5a82bf, 0xccde2d641e8cd, 0x305a30cd2e8c5, + 0x471c235cb5439, 0xab279cd962f5a, 0x17e1fb6e2dd94, 0xfe64589800a77, 0xe8793d99775f, + 0x48c62f4e614aa, 0xbf76ef20eb2a4, 0x669c672556c, 0x24683e0eff056, 0x12252b369ab76, + 0x821de9f162d5, 0xf911ec99a95be, 0x6721f065c906b, 0x58d452035c736, 0x1f9f01a6a15, + 0x6135009b7d8d3, 0xdaeeeb417dfc0, 0x63865fea0ee17, 0x6e0a304b939d6, 0x204ba2076833d, + 0x4ade586f35669, 0x2c1077e34611a, 0x5b1a3bea3b81a, 0xf97d018a22c8b, 0x38d7996b08af8, + 0x6ea62baeb7aa0, 0xebdcbd9ef2670, 0x35dc8fe0df3fe, 0xe458309d20c24, 0x11e87898716a0, + 0x7c44bab7cb456, 0xd64d3cf1bb64, 0x189bff1bf9e66, 0xb5218a049311, 0x285dda6cbcc81, + 0x3238dcafd8c7c, 0x607736c8de0, 0xdb83d99508b1, 0x4e1a0d404cd81, 0x1588008c00ff2, + 0x16b8b36722b27, 0x876609c3f3f1a, 0x66b72ef0e17d6, 0x705f8a279d568, 0x2eaac4cd01fdd, + 0x1171ce9705fe9, 0xffc79cd3264ee, 0x700c8ab4b80f0, 0x208d3d4f57a1, 0x337262a8ca4eb, + 0x297fd01d843fd, 0xa90956fa097f8, 0x529759fdb3845, 0x1d78c5e2d0397, 0x3d6938a4adbf3, + 0x16d5853560b66, 0xf138946b9a430, 0x2ab79f4dea6a0, 0xd42053ee43ae1, 0x3b9c3ef1cf870, + 0x598934ad81baf, 0x5f1821b1d07a7, 0x416bb3a973ff3, 0x23f07bd0a047a, 0x19bdc2e09f786, + 0x56dc9981cd51f, 0xfbace23c8cd65, 0x673bd3bf5b52e, 0x46a95d229fd61, 0xe09ad64bcfb1, + 0xe5292b91f17d, 0xfeefcd8afc287, 0x58f52b0a58711, 0x4800f20c201ef, 0x2084fce608f67, + 0x12ba0b128ae0b, 0x5977ae17030b4, 0x101126ee420f6, 0xf70823495c6bd, 0xde19a27d7770, + 0x5c6ac852260e8, 0x9d22950ac4356, 0x441cca955246c, 0x660a34e5332d9, 0x14ac8ea92f8d2, + 0x6b6d7709f307e, 0x67d7e13879db, 0x2ea8626f9fbbd, 0x99609006a4b40, 0x31bb2a8f8c779, + 0x10c04828ea335, 0xae9acdcbc080a, 0x617af2342607a, 0xc7494ea53e553, 0x2ca9e2872defa, + 0x6c399fab21f1f, 0xab139b245e758, 0x3ad933dcba589, 0x4797fecb08811, 0x31f5dbf8f594, + 0x7dc6361cc7a69, 0xc8a7953ead3f9, 0x79ed693d18015, 0x418a024999a6a, 0x2c4fdc9436aa, + 0x1eb98cb06aa75, 0x2989592796a9c, 0x11194821e425, 0xe27a648228388, 0x35d834b6c12a0, + 0x541807713b532, 0x7ae0a1008aaee, 0x7017a29bcb5e, 0x6b193c23c315c, 0x19bd25ac82f2a, + 0x6a01a43eef294, 0xddf5b5fd84f19, 0x33f5ba081c016, 0xdeb052d1bc082, 0x6b2f06afa617, + 0x7ca1eda6a939f, 0xbdeb35997b50c, 0x47f2d1bccda5, 0xc2ff4adfed667, 0x87712997be4, + 0x21fc2e2b37659, 0xf7d62cd5ed951, 0x27fa9cbdf7efa, 0xba25582bf3a6b, 0x2a42b8bd89398, + 0x6d377d07eecd2, 0x9ca1df5af387, 0x1109e3427e2ba, 0xce4aa4572a19, 0x103baaef71e16, + 0x2c3b2dfde328a, 0xbec4b4a30e1ef, 0x37d92a86204f3, 0x806cfde68eb39, 0x246e2f72b8aa5, + 0x68d3de93462a9, 0x53b8acba6bbc3, 0x2492a70fa1696, 0x38c62d5760f55, 0x15096fe4904f2, + 0x4e44e9bed3e3a, 0xb28bfd79cc9bc, 0x6a77513839320, 0x480dcec6739db, 0x3601b739f2465, + 0x43c348e2a7e1, 0xe448106327879, 0x175d9cae1b0ed, 0xd3b89dee743b8, 0x392d73ca255bc, + 0x32946db0d3a18, 0x9261b09907cc, 0x5ba517a755722, 0x51f24fdaf5184, 0x1cdc732989ed8, + 0x2f7806ba16694, 0xae0c9f029f8d0, 0xd8b45102ce1, 0xca1c7db9316d6, 0x162088a67066f, + 0x39de35b2b4162, 0xa19f550d88ae9, 0x7921b27026cde, 0x94b936b66e900, 0x1023bd5fa17fc, + 0x436837814cfa4, 0x29113492283c4, 0x66d1cdd8b51d8, 0xa540702278eb2, 0x47ef1b29285d, + 0x587b50917e50e, 0xb4cda75bab3b, 0x112520b0a9886, 0x66b9ac16fee49, 0x17bf17e92b2eb, + 0x2456a2f150ed7, 0xfa214412d0280, 0x3ca7dd947fe5b, 0xa72c28598d58a, 0x255d945efc3e, + 0x2873f04e0f215, 0x74178fd1af57b, 0x788848b5b2d6, 0xb1ffafaae0db6, 0x32a1b7b3cbb2a, + 0x4bd9935d6b2da, 0x9c08f24ad30a5, 0x4e58407a80f, 0x1b3a3825a5b17, 0x6547e9fc82f5, + 0x47484aa3656c3, 0x6ee43f341a494, 0x64a98f87adea2, 0x619b3f8e95f01, 0xb6e513266ed8, + 0x421c2a673090, 0xa1c1de32348c7, 0x55b85c3a1e8a3, 0xe05ce8ef330b4, 0x2561e49c15d84, + 0x40aa2d33130fa, 0x12b827d35866f, 0xfe4cf62c8ddb, 0x2fa0ef05bb28d, 0x1c06ca63f1cb8, + 0x32a971863863b, 0xff6fc86830da1, 0x71e7b25a14cf3, 0xea9c5ebb1373a, 0x250bbaa3e1634, + 0x5b5ffeda5b765, 0xf25d2a746331b, 0x115e3a3f43632, 0x67303af43c9d5, 0x14bb538a0e559, + 0x75623687d43b7, 0xa349674a4b38d, 0x613c61829ffc6, 0x689828d8110c7, 0x139115f5af7d5, + 0xf1d856152289, 0x45cbe967168ab, 0x51f38e1680901, 0x34808e8f652b0, 0x1f4a6a921e156, + 0x35dfaf3d8341f, 0xf53ace725cb63, 0x3d86a54eef35b, 0xa103aabaffe2c, 0x2decc36296fbd, + 0x510282be73d6f, 0xd4e6365db206a, 0x4bdc5f5bb8bf3, 0xde7ea32a3aee7, 0x71269e274305, +}; + + +/* Field element operations: */ + +/* NON_ZERO_TO_ALL_ONES returns: + * 0xffffffffffffffff for 0 < x <= 2**63 + * 0 for x == 0 or x > 2**63. + * + * x must be a u64 or an equivalent type such as limb. */ +#define NON_ZERO_TO_ALL_ONES(x) ((((u64)(x) - 1) >> 63) - 1) + +/* felem_reduce_carry adds a multiple of p in order to cancel |carry|, + * which is a term at 2**257. + * + * On entry: carry < 2**6, inout[0,2,...] < 2**51, inout[1,3,...] < 2**52. + * On exit: inout[0,2,..] < 2**52, inout[1,3,...] < 2**53. */ +static void felem_reduce_carry(felem inout, limb carry) { + const u64 carry_mask = NON_ZERO_TO_ALL_ONES(carry); + + inout[0] += carry << 1; + inout[1] += 0x10000000000000 & carry_mask; + /* carry < 2**6 thus (carry << 46) < 2**52 and we added 2**52 in the + * previous line therefore this doesn't underflow. */ + inout[1] -= carry << 46; + inout[2] += (0x8000000000000 - 1) & carry_mask; + inout[3] += (0x10000000000000 - 1) & carry_mask; + inout[3] -= carry << 39; + /* This may underflow if carry is non-zero but, if so, we'll fix it in the + * next line. */ + inout[4] -= 1 & carry_mask; + inout[4] += carry << 19; +} + +/* felem_sum sets out = in+in2. + * + * On entry, in[i]+in2[i] must not overflow a 64-bit word. + * On exit: out[0,2,...] < 2**52, out[1,3,...] < 2**53 */ +static void felem_sum(felem out, const felem in, const felem in2) { + limb carry = 0; + unsigned i; + + for (i = 0;; i++) { + out[i] = in[i] + in2[i]; + out[i] += carry; + carry = out[i] >> 51; + out[i] &= kBottom51Bits; + + i++; + if (i == NLIMBS) + break; + + out[i] = in[i] + in2[i]; + out[i] += carry; + carry = out[i] >> 52; + out[i] &= kBottom52Bits; + } + + felem_reduce_carry(out, carry); +} + +/* zero31 is 0 mod p. */ +static const felem zero31 = { 0xffffffffffffc0, 0x1f7ffffffffffe0, 0xf7ffffffffffe1, 0x1f00fffffffffe1, 0xfffffffeffffe1 }; + +/* felem_diff sets out = in-in2. + * + * On entry: in[0,2,...] < 2**52, in[1,3,...] < 2**53 and + * in2[0,2,...] < 2**52, in2[1,3,...] < 2**53. + * On exit: out[0,2,...] < 2**52, out[1,3,...] < 2**53. */ +static void felem_diff(felem out, const felem in, const felem in2) { + limb carry = 0; + unsigned i; + + for (i = 0;; i++) { + out[i] = in[i] - in2[i]; + out[i] += zero31[i]; + out[i] += carry; + carry = out[i] >> 51; + out[i] &= kBottom51Bits; + + i++; + if (i == NLIMBS) + break; + + out[i] = in[i] - in2[i]; + out[i] += zero31[i]; + out[i] += carry; + carry = out[i] >> 52; + out[i] &= kBottom52Bits; + } + + felem_reduce_carry(out, carry); +} + +/* felem_reduce_degree sets out = tmp/R mod p where tmp contains 64-bit words + * with the same 51,52,... bit positions as an felem. + * + * The values in felems are in Montgomery form: x*R mod p where R = 2**257. + * Since we just multiplied two Montgomery values together, the result is + * x*y*R*R mod p. We wish to divide by R in order for the result also to be + * in Montgomery form. + * + * On entry: tmp[i] < 2**128 + * On exit: out[0,2,...] < 2**52, out[1,3,...] < 2**53 */ +static void felem_reduce_degree(felem out, u128 tmp[9]) { + /* The following table may be helpful when reading this code: + * + * Limb number: 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 + * Width (bits): 51| 52| 51| 52| 51| 52| 51| 52| 51| 52| 51 + * Start bit: 0 | 51|103|154|206|257|309|360|412|463|515 + * (odd phase): 0 | 52|103|155|206|258|309|361|412|464|515 */ + limb tmp2[10], carry, x, xShiftedMask; + unsigned i; + + /* tmp contains 128-bit words with the same 51,52,51-bit positions as an + * felem. So the top of an element of tmp might overlap with another + * element two positions down. The following loop eliminates this + * overlap. */ + tmp2[0] = (limb)(tmp[0] & kBottom51Bits); + + /* In the following we use "(limb) tmp[x]" and "(limb) (tmp[x]>>64)" to try + * and hint to the compiler that it can do a single-word shift by selecting + * the right register rather than doing a double-word shift and truncating + * afterwards. */ + tmp2[1] = ((limb) tmp[0]) >> 51; + tmp2[1] |= (((limb)(tmp[0] >> 64)) << 13) & kBottom52Bits; + tmp2[1] += ((limb) tmp[1]) & kBottom52Bits; + carry = tmp2[1] >> 52; + tmp2[1] &= kBottom52Bits; + + for (i = 2; i < 9; i++) { + tmp2[i] = ((limb)(tmp[i - 2] >> 64)) >> 39; + tmp2[i] += ((limb)(tmp[i - 1])) >> 52; + tmp2[i] += (((limb)(tmp[i - 1] >> 64)) << 12) & kBottom51Bits; + tmp2[i] += ((limb) tmp[i]) & kBottom51Bits; + tmp2[i] += carry; + carry = tmp2[i] >> 51; + tmp2[i] &= kBottom51Bits; + + i++; + if (i == 9) + break; + tmp2[i] = ((limb)(tmp[i - 2] >> 64)) >> 39; + tmp2[i] += ((limb)(tmp[i - 1])) >> 51; + tmp2[i] += (((limb)(tmp[i - 1] >> 64)) << 13) & kBottom52Bits; + tmp2[i] += ((limb) tmp[i]) & kBottom52Bits; + tmp2[i] += carry; + carry = tmp2[i] >> 52; + tmp2[i] &= kBottom52Bits; + } + + tmp2[9] = ((limb)(tmp[7] >> 64)) >> 39; + tmp2[9] += ((limb)(tmp[8])) >> 51; + tmp2[9] += (((limb)(tmp[8] >> 64)) << 13); + tmp2[9] += carry; + + /* Montgomery elimination of terms. + * + * Since R is 2**257, we can divide by R with a bitwise shift if we can + * ensure that the right-most 257 bits are all zero. We can make that true by + * adding multiplies of p without affecting the value. + * + * So we eliminate limbs from right to left. Since the bottom 51 bits of p + * are all ones, then by adding tmp2[0]*p to tmp2 we'll make tmp2[0] == 0. + * We can do that for 8 further limbs and then right shift to eliminate the + * extra factor of R. */ + for (i = 0;; i += 2) { + tmp2[i + 1] += tmp2[i] >> 51; + x = tmp2[i] & kBottom51Bits; + xShiftedMask = NON_ZERO_TO_ALL_ONES(x >> 1); + tmp2[i] = 0; + + /* The bounds calculations for this loop are tricky. Each iteration of + * the loop eliminates two words by adding values to words to their + * right. + * + * The following table contains the amounts added to each word (as an + * offset from the value of i at the top of the loop). The amounts are + * accounted for from the first and second half of the loop separately + * and are written as, for example, 51 to mean a value <2**51. + * + * Word: 1 2 3 4 5 6 + * Added in top half: 52 44 52 37 50 + * 51 + * 51 + * Added in bottom half: 51 45 51 38 50 + * 52 + * 52 + * + * The value that is currently offset 5 will be offset 3 for the next + * iteration and then offset 1 for the iteration after that. Therefore + * the total value added will be the values added at 5, 3 and 1. + * + * The following table accumulates these values. The sums at the bottom + * are written as, for example, 53+45, to mean a value < 2**53+2**45. + * + * Word: 1 2 3 4 5 6 7 8 9 + * 52 44 52 37 50 50 50 50 50 + * 51 45 51 38 37 38 37 + * 52 51 52 51 52 51 + * 51 52 51 52 51 + * 44 52 51 52 + * 51 45 44 + * 52 + * ------------------------------------ + * 53+ 53+ 54+ 52+ 53+ 52+ + * 45 44+ 50+ 51+ 52+ 50+ + * 37 45+ 50+ 50+ 37 + * 38 44+ 38 + * 37 + * + * So the greatest amount is added to tmp2[5]. If tmp2[5] has an initial + * value of <2**52, then the maximum value will be < 2**54 + 2**52 + 2**50 + + * 2**45 + 2**38, which is < 2**64, as required. */ + tmp2[i + 1] += (x << 45) & kBottom52Bits; + tmp2[i + 2] += x >> 7; + + tmp2[i + 3] += (x << 38) & kBottom52Bits; + tmp2[i + 4] += x >> 14; + + /* On tmp2[i + 4], when x < 2**1, the subtraction with (x << 18) will not + * underflow because it is balanced with the (x << 50) term. On the next + * word tmp2[i + 5], terms with (x >> 1) and (x >> 33) are both zero and + * there is no underflow either. + * + * When x >= 2**1, we add 2**51 to tmp2[i + 4] to avoid an underflow. + * Removing 1 from tmp2[i + 5] is safe because (x >> 1) - (x >> 33) is + * strictly positive. + */ + tmp2[i + 4] += 0x8000000000000 & xShiftedMask; + tmp2[i + 5] -= 1 & xShiftedMask; + + tmp2[i + 4] -= (x << 18) & kBottom51Bits; + tmp2[i + 4] += (x << 50) & kBottom51Bits; + tmp2[i + 5] += (x >> 1) - (x >> 33); + + if (i+1 == NLIMBS) + break; + tmp2[i + 2] += tmp2[i + 1] >> 52; + x = tmp2[i + 1] & kBottom52Bits; + xShiftedMask = NON_ZERO_TO_ALL_ONES(x >> 2); + tmp2[i + 1] = 0; + + tmp2[i + 2] += (x << 44) & kBottom51Bits; + tmp2[i + 3] += x >> 7; + + tmp2[i + 4] += (x << 37) & kBottom51Bits; + tmp2[i + 5] += x >> 14; + + /* On tmp2[i + 5], when x < 2**2, the subtraction with (x << 18) will not + * underflow because it is balanced with the (x << 50) term. On the next + * word tmp2[i + 6], terms with (x >> 2) and (x >> 34) are both zero and + * there is no underflow either. + * + * When x >= 2**2, we add 2**52 to tmp2[i + 5] to avoid an underflow. + * Removing 1 from tmp2[i + 6] is safe because (x >> 2) - (x >> 34) is + * stricly positive. + */ + tmp2[i + 5] += 0x10000000000000 & xShiftedMask; + tmp2[i + 6] -= 1 & xShiftedMask; + + tmp2[i + 5] -= (x << 18) & kBottom52Bits; + tmp2[i + 5] += (x << 50) & kBottom52Bits; + tmp2[i + 6] += (x >> 2) - (x >> 34); + } + + /* We merge the right shift with a carry chain. The words above 2**257 have + * widths of 52,51,... which we need to correct when copying them down. */ + carry = 0; + for (i = 0; i < 4; i++) { + out[i] = tmp2[i + 5]; + out[i] += carry; + carry = out[i] >> 51; + out[i] &= kBottom51Bits; + + i++; + out[i] = tmp2[i + 5] << 1; + out[i] += carry; + carry = out[i] >> 52; + out[i] &= kBottom52Bits; + } + + out[4] = tmp2[9]; + out[4] += carry; + carry = out[4] >> 51; + out[4] &= kBottom51Bits; + + felem_reduce_carry(out, carry); +} + +/* felem_square sets out=in*in. + * + * On entry: in[0,2,...] < 2**52, in[1,3,...] < 2**53. + * On exit: out[0,2,...] < 2**52, out[1,3,...] < 2**53. */ +static void felem_square(felem out, const felem in) { + u128 tmp[9], x1x1, x3x3; + + x1x1 = ((u128) in[1]) * in[1]; + x3x3 = ((u128) in[3]) * in[3]; + + tmp[0] = ((u128) in[0]) * (in[0] << 0); + tmp[1] = ((u128) in[0]) * (in[1] << 1) + ((x1x1 & 1) << 51); + tmp[2] = ((u128) in[0]) * (in[2] << 1) + (x1x1 >> 1); + tmp[3] = ((u128) in[0]) * (in[3] << 1) + + ((u128) in[1]) * (in[2] << 1); + tmp[4] = ((u128) in[0]) * (in[4] << 1) + + ((u128) in[1]) * (in[3] << 0) + + ((u128) in[2]) * (in[2] << 0); + tmp[5] = ((u128) in[1]) * (in[4] << 1) + + ((u128) in[2]) * (in[3] << 1) + ((x3x3 & 1) << 51); + tmp[6] = ((u128) in[2]) * (in[4] << 1) + (x3x3 >> 1); + tmp[7] = ((u128) in[3]) * (in[4] << 1); + tmp[8] = ((u128) in[4]) * (in[4] << 0); + + felem_reduce_degree(out, tmp); +} + +/* felem_mul sets out=in*in2. + * + * On entry: in[0,2,...] < 2**52, in[1,3,...] < 2**53 and + * in2[0,2,...] < 2**52, in2[1,3,...] < 2**53. + * On exit: out[0,2,...] < 2**52, out[1,3,...] < 2**53. */ +static void felem_mul(felem out, const felem in, const felem in2) { + u128 tmp[9], x1y1, x1y3, x3y1, x3y3; + + x1y1 = ((u128) in[1]) * in2[1]; + x1y3 = ((u128) in[1]) * in2[3]; + x3y1 = ((u128) in[3]) * in2[1]; + x3y3 = ((u128) in[3]) * in2[3]; + + tmp[0] = ((u128) in[0]) * in2[0]; + tmp[1] = ((u128) in[0]) * in2[1] + + ((u128) in[1]) * in2[0] + ((x1y1 & 1) << 51); + tmp[2] = ((u128) in[0]) * in2[2] + (x1y1 >> 1) + + ((u128) in[2]) * in2[0]; + tmp[3] = ((u128) in[0]) * in2[3] + + ((u128) in[1]) * in2[2] + + ((u128) in[2]) * in2[1] + ((x1y3 & 1) << 51) + + ((u128) in[3]) * in2[0] + ((x3y1 & 1) << 51); + tmp[4] = ((u128) in[0]) * in2[4] + (x1y3 >> 1) + + ((u128) in[2]) * in2[2] + (x3y1 >> 1) + + ((u128) in[4]) * in2[0]; + tmp[5] = ((u128) in[1]) * in2[4] + + ((u128) in[2]) * in2[3] + + ((u128) in[3]) * in2[2] + + ((u128) in[4]) * in2[1] + ((x3y3 & 1) << 51); + tmp[6] = ((u128) in[2]) * in2[4] + (x3y3 >> 1) + + ((u128) in[4]) * in2[2]; + tmp[7] = ((u128) in[3]) * in2[4] + + ((u128) in[4]) * in2[3]; + tmp[8] = ((u128) in[4]) * in2[4]; + + felem_reduce_degree(out, tmp); +} + +static void felem_assign(felem out, const felem in) { + memcpy(out, in, sizeof(felem)); +} + +/* felem_scalar_3 sets out=3*out. + * + * On entry: out[0,2,...] < 2**52, out[1,3,...] < 2**53. + * On exit: out[0,2,...] < 2**52, out[1,3,...] < 2**53. */ +static void felem_scalar_3(felem out) { + limb carry = 0; + unsigned i; + + for (i = 0;; i++) { + out[i] *= 3; + out[i] += carry; + carry = out[i] >> 51; + out[i] &= kBottom51Bits; + + i++; + if (i == NLIMBS) + break; + + out[i] *= 3; + out[i] += carry; + carry = out[i] >> 52; + out[i] &= kBottom52Bits; + } + + felem_reduce_carry(out, carry); +} + +/* felem_scalar_4 sets out=4*out. + * + * On entry: out[0,2,...] < 2**52, out[1,3,...] < 2**53. + * On exit: out[0,2,...] < 2**52, out[1,3,...] < 2**53. */ +static void felem_scalar_4(felem out) { + limb carry = 0, next_carry; + unsigned i; + + for (i = 0;; i++) { + next_carry = out[i] >> 49; + out[i] <<= 2; + out[i] &= kBottom51Bits; + out[i] += carry; + carry = next_carry + (out[i] >> 51); + out[i] &= kBottom51Bits; + + i++; + if (i == NLIMBS) + break; + + next_carry = out[i] >> 50; + out[i] <<= 2; + out[i] &= kBottom52Bits; + out[i] += carry; + carry = next_carry + (out[i] >> 52); + out[i] &= kBottom52Bits; + } + + felem_reduce_carry(out, carry); +} + +/* felem_scalar_8 sets out=8*out. + * + * On entry: out[0,2,...] < 2**52, out[1,3,...] < 2**53. + * On exit: out[0,2,...] < 2**52, out[1,3,...] < 2**53. */ +static void felem_scalar_8(felem out) { + limb carry = 0, next_carry; + unsigned i; + + for (i = 0;; i++) { + next_carry = out[i] >> 48; + out[i] <<= 3; + out[i] &= kBottom51Bits; + out[i] += carry; + carry = next_carry + (out[i] >> 51); + out[i] &= kBottom51Bits; + + i++; + if (i == NLIMBS) + break; + + next_carry = out[i] >> 49; + out[i] <<= 3; + out[i] &= kBottom52Bits; + out[i] += carry; + carry = next_carry + (out[i] >> 52); + out[i] &= kBottom52Bits; + } + + felem_reduce_carry(out, carry); +} + +/* felem_is_zero_vartime returns 1 iff |in| == 0. It takes a variable amount of + * time depending on the value of |in|. */ +static char felem_is_zero_vartime(const felem in) { + limb carry; + int i; + limb tmp[NLIMBS]; + + felem_assign(tmp, in); + + /* First, reduce tmp to a minimal form. */ + do { + carry = 0; + for (i = 0;; i++) { + tmp[i] += carry; + carry = tmp[i] >> 51; + tmp[i] &= kBottom51Bits; + + i++; + if (i == NLIMBS) + break; + + tmp[i] += carry; + carry = tmp[i] >> 52; + tmp[i] &= kBottom52Bits; + } + + felem_reduce_carry(tmp, carry); + } while (carry); + + /* tmp < 2**257, so the only possible zero values are 0, p and 2p. */ + return memcmp(tmp, kZero, sizeof(tmp)) == 0 || + memcmp(tmp, kP, sizeof(tmp)) == 0 || + memcmp(tmp, k2P, sizeof(tmp)) == 0; +} + + +/* Montgomery operations: */ + +#define kRDigits {2, 0xfffffffe00000000, 0xffffffffffffffff, 0x1fffffffd} // 2^257 mod p256.p + +#define kRInvDigits {0x180000000, 0xffffffff, 0xfffffffe80000001, 0x7fffffff00000001} // 1 / 2^257 mod p256.p + +static const cryptonite_p256_int kR = { kRDigits }; +static const cryptonite_p256_int kRInv = { kRInvDigits }; + +/* to_montgomery sets out = R*in. */ +static void to_montgomery(felem out, const cryptonite_p256_int* in) { + cryptonite_p256_int in_shifted; + int i; + + cryptonite_p256_init(&in_shifted); + cryptonite_p256_modmul(&cryptonite_SECP256r1_p, in, 0, &kR, &in_shifted); + + for (i = 0; i < NLIMBS; i++) { + if ((i & 1) == 0) { + out[i] = P256_DIGIT(&in_shifted, 0) & kBottom51Bits; + cryptonite_p256_shr(&in_shifted, 51, &in_shifted); + } else { + out[i] = P256_DIGIT(&in_shifted, 0) & kBottom52Bits; + cryptonite_p256_shr(&in_shifted, 52, &in_shifted); + } + } + + cryptonite_p256_clear(&in_shifted); +} + +/* from_montgomery sets out=in/R. */ +static void from_montgomery(cryptonite_p256_int* out, const felem in) { + cryptonite_p256_int result, tmp; + int i, top; + + cryptonite_p256_init(&result); + cryptonite_p256_init(&tmp); + + cryptonite_p256_add_d(&tmp, in[NLIMBS - 1], &result); + for (i = NLIMBS - 2; i >= 0; i--) { + if ((i & 1) == 0) { + top = cryptonite_p256_shl(&result, 51, &tmp); + } else { + top = cryptonite_p256_shl(&result, 52, &tmp); + } + top += cryptonite_p256_add_d(&tmp, in[i], &result); + } + + cryptonite_p256_modmul(&cryptonite_SECP256r1_p, &kRInv, top, &result, out); + + cryptonite_p256_clear(&result); + cryptonite_p256_clear(&tmp); +} diff --git a/cbits/p256/p256.c b/cbits/p256/p256.c index b5889a5..038b0a3 100644 --- a/cbits/p256/p256.c +++ b/cbits/p256/p256.c @@ -25,7 +25,7 @@ */ // This is an implementation of the P256 elliptic curve group. It's written to -// be portable 32-bit, although it's still constant-time. +// be portable and still constant-time. // // WARNING: Implementing these functions in a constant-time manner is far from // obvious. Be careful when touching this code. @@ -170,6 +170,10 @@ void cryptonite_p256_modmul(const cryptonite_p256_int* MOD, // top can be any value at this point. // Guestimate reducer as top * MOD, since msw of MOD is -1. top_reducer = mulAdd(MOD, top, 0, reducer); +#if P256_BITSPERDIGIT > 32 + // Correction when msw of MOD has only high 32 bits set + top_reducer += mulAdd(MOD, top >> 32, 0, reducer); +#endif // Subtract reducer from top | tmp. top = subTop(top_reducer, reducer, top, tmp + i); diff --git a/cbits/p256/p256_ec.c b/cbits/p256/p256_ec.c index c2b9c74..40c6ed5 100644 --- a/cbits/p256/p256_ec.c +++ b/cbits/p256/p256_ec.c @@ -25,7 +25,7 @@ */ // This is an implementation of the P256 elliptic curve group. It's written to -// be portable 32-bit, although it's still constant-time. +// be portable and still constant-time. // // WARNING: Implementing these functions in a constant-time manner is far from // obvious. Be careful when touching this code. @@ -285,9 +285,9 @@ static void point_add_or_double_vartime( felem_diff(y_out, y_out, tmp); } -/* copy_conditional sets out=in if mask = 0xffffffff in constant time. +/* copy_conditional sets out=in if mask = -1 in constant time. * - * On entry: mask is either 0 or 0xffffffff. */ + * On entry: mask is either 0 or -1. */ static void copy_conditional(felem out, const felem in, limb mask) { int i; diff --git a/cryptonite.cabal b/cryptonite.cabal index 637521a..c7e5742 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -50,7 +50,8 @@ extra-source-files: cbits/*.h cbits/decaf/p448/*.h cbits/decaf/ed448goldilocks/decaf_tables.c cbits/decaf/ed448goldilocks/decaf.c - cbits/p256/*.h + cbits/include32/p256/*.h + cbits/include64/p256/*.h cbits/blake2/ref/*.h cbits/blake2/sse/*.h cbits/argon2/*.h @@ -284,6 +285,11 @@ Library , cbits/decaf/include , cbits/decaf/p448 + if arch(x86_64) || arch(aarch64) + include-dirs: cbits/include64 + else + include-dirs: cbits/include32 + if arch(x86_64) || arch(aarch64) C-sources: cbits/decaf/p448/arch_ref64/f_impl.c , cbits/decaf/p448/f_generic.c From 44a1651d261a6bd9d710dc7d489e52bb7f611836 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 29 Dec 2019 14:08:37 +0100 Subject: [PATCH 126/176] Remove NULL checks in inner loop --- cbits/p256/p256.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/cbits/p256/p256.c b/cbits/p256/p256.c index 038b0a3..4d79c0e 100644 --- a/cbits/p256/p256.c +++ b/cbits/p256/p256.c @@ -403,6 +403,7 @@ void cryptonite_p256_to_bin(const cryptonite_p256_int* src, uint8_t dst[P256_NBY // c = a + b mod MOD void cryptonite_p256e_modadd(const cryptonite_p256_int* MOD, const cryptonite_p256_int* a, const cryptonite_p256_int* b, cryptonite_p256_int* c) { + assert(c); /* avoid repeated checks inside inlined cryptonite_p256_add */ cryptonite_p256_digit top = cryptonite_p256_add(a, b, c); top = subM(MOD, top, P256_DIGITS(c), -1); top = subM(MOD, top, P256_DIGITS(c), MSB_COMPLEMENT(top)); @@ -411,6 +412,7 @@ void cryptonite_p256e_modadd(const cryptonite_p256_int* MOD, const cryptonite_p2 // c = a - b mod MOD void cryptonite_p256e_modsub(const cryptonite_p256_int* MOD, const cryptonite_p256_int* a, const cryptonite_p256_int* b, cryptonite_p256_int* c) { + assert(c); /* avoid repeated checks inside inlined cryptonite_p256_sub */ cryptonite_p256_digit top = cryptonite_p256_sub(a, b, c); top = addM(MOD, top, P256_DIGITS(c), ~MSB_COMPLEMENT(top)); top = subM(MOD, top, P256_DIGITS(c), MSB_COMPLEMENT(top)); From 2579d1e7aab9841c8926984bd4571c3a5249bf25 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Tue, 14 Jan 2020 21:11:51 +0100 Subject: [PATCH 127/176] Use smaller value in felem_diff --- cbits/include64/p256/p256_gf.h | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/cbits/include64/p256/p256_gf.h b/cbits/include64/p256/p256_gf.h index 9920ab3..28b869a 100644 --- a/cbits/include64/p256/p256_gf.h +++ b/cbits/include64/p256/p256_gf.h @@ -229,8 +229,14 @@ static void felem_sum(felem out, const felem in, const felem in2) { felem_reduce_carry(out, carry); } -/* zero31 is 0 mod p. */ -static const felem zero31 = { 0xffffffffffffc0, 0x1f7ffffffffffe0, 0xf7ffffffffffe1, 0x1f00fffffffffe1, 0xfffffffeffffe1 }; +#define two53m3 (((limb)1) << 53) - (((limb)1) << 3) +#define two54m52p48m2 (((limb)1) << 54) - (((limb)1) << 52) + (((limb)1) << 48) - (((limb)1) << 2) +#define two53m2p0 (((limb)1) << 53) - (((limb)1) << 2) + (((limb)1) << 0) +#define two54m52p41m2 (((limb)1) << 54) - (((limb)1) << 52) + (((limb)1) << 41) - (((limb)1) << 2) +#define two53m21m2p0 (((limb)1) << 53) - (((limb)1) << 21) - (((limb)1) << 2) + (((limb)1) << 0) + +/* zero53 is 0 mod p. */ +static const felem zero53 = { two53m3, two54m52p48m2, two53m2p0, two54m52p41m2, two53m21m2p0 }; /* felem_diff sets out = in-in2. * @@ -243,7 +249,7 @@ static void felem_diff(felem out, const felem in, const felem in2) { for (i = 0;; i++) { out[i] = in[i] - in2[i]; - out[i] += zero31[i]; + out[i] += zero53[i]; out[i] += carry; carry = out[i] >> 51; out[i] &= kBottom51Bits; @@ -253,7 +259,7 @@ static void felem_diff(felem out, const felem in, const felem in2) { break; out[i] = in[i] - in2[i]; - out[i] += zero31[i]; + out[i] += zero53[i]; out[i] += carry; carry = out[i] >> 52; out[i] &= kBottom52Bits; From d2df760e34e83a9f2217b87086366acccdee10a5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 8 Feb 2020 16:32:35 +0100 Subject: [PATCH 128/176] Use zipWith --- tests/ECC.hs | 8 ++++---- tests/KAT_AFIS.hs | 4 ++-- tests/KAT_Argon2.hs | 4 ++-- tests/KAT_Ed25519.hs | 12 +++++------ tests/KAT_Ed448.hs | 12 +++++------ tests/KAT_PBKDF2.hs | 16 +++++++-------- tests/KAT_PubKey.hs | 4 ++-- tests/KAT_PubKey/DSA.hs | 24 +++++++++++----------- tests/KAT_PubKey/ECC.hs | 4 ++-- tests/KAT_PubKey/ECDSA.hs | 24 +++++++++++----------- tests/KAT_PubKey/OAEP.hs | 14 ++++++------- tests/KAT_PubKey/PSS.hs | 24 +++++++++++----------- tests/KAT_PubKey/RSA.hs | 8 ++++---- tests/KAT_PubKey/Rabin.hs | 42 +++++++++++++++++++-------------------- tests/KAT_RC4.hs | 4 ++-- tests/KAT_Scrypt.hs | 4 ++-- tests/Number.hs | 8 ++++---- tests/Padding.hs | 4 ++-- tests/Salsa.hs | 2 +- tests/XSalsa.hs | 4 ++-- 20 files changed, 113 insertions(+), 113 deletions(-) diff --git a/tests/ECC.hs b/tests/ECC.hs index 5faaf81..32b4a15 100644 --- a/tests/ECC.hs +++ b/tests/ECC.hs @@ -275,13 +275,13 @@ vpEncodedPoint vector = let Right bs = convertFromBase Base16 (vpHex vector) in cryptoError :: CryptoFailable a -> Maybe CryptoError cryptoError = onCryptoFailure Just (const Nothing) -doPointDecodeTest (i, vector) = +doPointDecodeTest i vector = case vpCurve vector of Curve curve -> let prx = Just curve -- using Maybe as Proxy in testCase (show i) (vpError vector @=? cryptoError (ECC.decodePoint prx $ vpEncodedPoint vector)) -doWeakPointECDHTest (i, vector) = +doWeakPointECDHTest i vector = case vpCurve vector of Curve curve -> testCase (show i) $ do let prx = Just curve -- using Maybe as Proxy @@ -290,8 +290,8 @@ doWeakPointECDHTest (i, vector) = vpError vector @=? cryptoError (ECC.ecdh prx (ECC.keypairGetPrivate keyPair) public) tests = testGroup "ECC" - [ testGroup "decodePoint" $ map doPointDecodeTest (zip [katZero..] vectorsPoint) - , testGroup "ECDH weak points" $ map doWeakPointECDHTest (zip [katZero..] vectorsWeakPoint) + [ testGroup "decodePoint" $ zipWith doPointDecodeTest [katZero..] vectorsPoint + , testGroup "ECDH weak points" $ zipWith doWeakPointECDHTest [katZero..] vectorsWeakPoint , testGroup "property" [ testProperty "decodePoint.encodePoint==id" $ \testDRG (Curve curve) -> let prx = Just curve -- using Maybe as Proxy diff --git a/tests/KAT_AFIS.hs b/tests/KAT_AFIS.hs index f4cb9b5..b808423 100644 --- a/tests/KAT_AFIS.hs +++ b/tests/KAT_AFIS.hs @@ -23,8 +23,8 @@ mergeVec = ) ] -mergeKATs = map toProp $ zip mergeVec [(0 :: Int)..] - where toProp ((nbExpands, hashAlg, expected, dat), i) = +mergeKATs = zipWith toProp mergeVec [(0 :: Int)..] + where toProp (nbExpands, hashAlg, expected, dat) i = testCase ("merge " ++ show i) (expected @=? AFIS.merge hashAlg nbExpands dat) data AFISParams = AFISParams B.ByteString Int SHA1 ChaChaDRG diff --git a/tests/KAT_Argon2.hs b/tests/KAT_Argon2.hs index aa73555..a347fc5 100644 --- a/tests/KAT_Argon2.hs +++ b/tests/KAT_Argon2.hs @@ -28,9 +28,9 @@ vectors = ] kdfTests :: [TestTree] -kdfTests = map toKDFTest $ zip is vectors +kdfTests = zipWith toKDFTest is vectors where - toKDFTest (i, v) = + toKDFTest i v = testCase (show i) (CryptoPassed (kdfResult v) @=? Argon2.hash (kdfOptions v) (kdfPass v) (kdfSalt v) (B.length $ kdfResult v)) diff --git a/tests/KAT_Ed25519.hs b/tests/KAT_Ed25519.hs index 44dee95..80d08b5 100644 --- a/tests/KAT_Ed25519.hs +++ b/tests/KAT_Ed25519.hs @@ -47,18 +47,18 @@ vectors = ] -doPublicKeyTest (i, vec) = testCase (show i) (pub @=? Ed25519.toPublic sec) +doPublicKeyTest i vec = testCase (show i) (pub @=? Ed25519.toPublic sec) where !pub = throwCryptoError $ Ed25519.publicKey (vecPub vec) !sec = throwCryptoError $ Ed25519.secretKey (vecSec vec) -doSignatureTest (i, vec) = testCase (show i) (sig @=? Ed25519.sign sec pub (vecMsg vec)) +doSignatureTest i vec = testCase (show i) (sig @=? Ed25519.sign sec pub (vecMsg vec)) where !sig = throwCryptoError $ Ed25519.signature (vecSig vec) !pub = throwCryptoError $ Ed25519.publicKey (vecPub vec) !sec = throwCryptoError $ Ed25519.secretKey (vecSec vec) -doVerifyTest (i, vec) = testCase (show i) (True @=? Ed25519.verify pub (vecMsg vec) sig) +doVerifyTest i vec = testCase (show i) (True @=? Ed25519.verify pub (vecMsg vec) sig) where !sig = throwCryptoError $ Ed25519.signature (vecSig vec) !pub = throwCryptoError $ Ed25519.publicKey (vecPub vec) @@ -66,7 +66,7 @@ doVerifyTest (i, vec) = testCase (show i) (True @=? Ed25519.verify pub (vecMsg v tests = testGroup "Ed25519" [ testCase "gen secretkey" (Ed25519.generateSecretKey *> pure ()) - , testGroup "gen publickey" $ map doPublicKeyTest (zip [katZero..] vectors) - , testGroup "gen signature" $ map doSignatureTest (zip [katZero..] vectors) - , testGroup "verify sig" $ map doVerifyTest (zip [katZero..] vectors) + , testGroup "gen publickey" $ zipWith doPublicKeyTest [katZero..] vectors + , testGroup "gen signature" $ zipWith doSignatureTest [katZero..] vectors + , testGroup "verify sig" $ zipWith doVerifyTest [katZero..] vectors ] diff --git a/tests/KAT_Ed448.hs b/tests/KAT_Ed448.hs index 1c66cd6..5c4d5cc 100644 --- a/tests/KAT_Ed448.hs +++ b/tests/KAT_Ed448.hs @@ -65,18 +65,18 @@ vectors = ] -doPublicKeyTest (i, vec) = testCase (show i) (pub @=? Ed448.toPublic sec) +doPublicKeyTest i vec = testCase (show i) (pub @=? Ed448.toPublic sec) where !pub = throwCryptoError $ Ed448.publicKey (vecPub vec) !sec = throwCryptoError $ Ed448.secretKey (vecSec vec) -doSignatureTest (i, vec) = testCase (show i) (sig @=? Ed448.sign sec pub (vecMsg vec)) +doSignatureTest i vec = testCase (show i) (sig @=? Ed448.sign sec pub (vecMsg vec)) where !sig = throwCryptoError $ Ed448.signature (vecSig vec) !pub = throwCryptoError $ Ed448.publicKey (vecPub vec) !sec = throwCryptoError $ Ed448.secretKey (vecSec vec) -doVerifyTest (i, vec) = testCase (show i) (True @=? Ed448.verify pub (vecMsg vec) sig) +doVerifyTest i vec = testCase (show i) (True @=? Ed448.verify pub (vecMsg vec) sig) where !sig = throwCryptoError $ Ed448.signature (vecSig vec) !pub = throwCryptoError $ Ed448.publicKey (vecPub vec) @@ -84,7 +84,7 @@ doVerifyTest (i, vec) = testCase (show i) (True @=? Ed448.verify pub (vecMsg vec tests = testGroup "Ed448" [ testCase "gen secretkey" (Ed448.generateSecretKey *> pure ()) - , testGroup "gen publickey" $ map doPublicKeyTest (zip [katZero..] vectors) - , testGroup "gen signature" $ map doSignatureTest (zip [katZero..] vectors) - , testGroup "verify sig" $ map doVerifyTest (zip [katZero..] vectors) + , testGroup "gen publickey" $ zipWith doPublicKeyTest [katZero..] vectors + , testGroup "gen signature" $ zipWith doSignatureTest [katZero..] vectors + , testGroup "verify sig" $ zipWith doVerifyTest [katZero..] vectors ] diff --git a/tests/KAT_PBKDF2.hs b/tests/KAT_PBKDF2.hs index 39373cc..de877a6 100644 --- a/tests/KAT_PBKDF2.hs +++ b/tests/KAT_PBKDF2.hs @@ -67,21 +67,21 @@ tests = testGroup "PBKDF2" , testGroup "KATs-HMAC-SHA512" (katTests (PBKDF2.prfHMAC SHA512) vectors_hmac_sha512) , testGroup "KATs-HMAC-SHA512 (fast)" (katTestFastPBKDF2_SHA512 vectors_hmac_sha512) ] - where katTests prf vects = map (toKatTest prf) $ zip is vects + where katTests prf = zipWith (toKatTest prf) is - toKatTest prf (i, ((pass, salt, iter, dkLen), output)) = + toKatTest prf i ((pass, salt, iter, dkLen), output) = testCase (show i) (output @=? PBKDF2.generate prf (PBKDF2.Parameters iter dkLen) pass salt) - katTestFastPBKDF2_SHA1 = map toKatTestFastPBKDF2_SHA1 . zip is - toKatTestFastPBKDF2_SHA1 (i, ((pass, salt, iter, dkLen), output)) = + katTestFastPBKDF2_SHA1 = zipWith toKatTestFastPBKDF2_SHA1 is + toKatTestFastPBKDF2_SHA1 i ((pass, salt, iter, dkLen), output) = testCase (show i) (output @=? PBKDF2.fastPBKDF2_SHA1 (PBKDF2.Parameters iter dkLen) pass salt) - katTestFastPBKDF2_SHA256 = map toKatTestFastPBKDF2_SHA256 . zip is - toKatTestFastPBKDF2_SHA256 (i, ((pass, salt, iter, dkLen), output)) = + katTestFastPBKDF2_SHA256 = zipWith toKatTestFastPBKDF2_SHA256 is + toKatTestFastPBKDF2_SHA256 i ((pass, salt, iter, dkLen), output) = testCase (show i) (output @=? PBKDF2.fastPBKDF2_SHA256 (PBKDF2.Parameters iter dkLen) pass salt) - katTestFastPBKDF2_SHA512 = map toKatTestFastPBKDF2_SHA512 . zip is - toKatTestFastPBKDF2_SHA512 (i, ((pass, salt, iter, dkLen), output)) = + katTestFastPBKDF2_SHA512 = zipWith toKatTestFastPBKDF2_SHA512 is + toKatTestFastPBKDF2_SHA512 i ((pass, salt, iter, dkLen), output) = testCase (show i) (output @=? PBKDF2.fastPBKDF2_SHA512 (PBKDF2.Parameters iter dkLen) pass salt) diff --git a/tests/KAT_PubKey.hs b/tests/KAT_PubKey.hs index ba619e8..c3da494 100644 --- a/tests/KAT_PubKey.hs +++ b/tests/KAT_PubKey.hs @@ -25,7 +25,7 @@ data VectorMgf = VectorMgf { seed :: ByteString , dbMask :: ByteString } -doMGFTest (i, vmgf) = testCase (show i) (dbMask vmgf @=? actual) +doMGFTest i vmgf = testCase (show i) (dbMask vmgf @=? actual) where actual = mgf1 SHA1 (seed vmgf) (B.length $ dbMask vmgf) vectorsMGF = @@ -36,7 +36,7 @@ vectorsMGF = ] tests = testGroup "PubKey" - [ testGroup "MGF1" $ map doMGFTest (zip [katZero..] vectorsMGF) + [ testGroup "MGF1" $ zipWith doMGFTest [katZero..] vectorsMGF , rsaTests , pssTests , oaepTests diff --git a/tests/KAT_PubKey/DSA.hs b/tests/KAT_PubKey/DSA.hs index 9bb8ff7..7fd7eb9 100644 --- a/tests/KAT_PubKey/DSA.hs +++ b/tests/KAT_PubKey/DSA.hs @@ -331,32 +331,32 @@ vectorToPublic vector = DSA.PublicKey , DSA.public_params = pgq vector } -doSignatureTest hashAlg (i, vector) = testCase (show i) (expected @=? actual) +doSignatureTest hashAlg i vector = testCase (show i) (expected @=? actual) where expected = Just $ DSA.Signature (r vector) (s vector) actual = DSA.signWith (k vector) (vectorToPrivate vector) hashAlg (msg vector) -doVerifyTest hashAlg (i, vector) = testCase (show i) (True @=? actual) +doVerifyTest hashAlg i vector = testCase (show i) (True @=? actual) where actual = DSA.verify hashAlg (vectorToPublic vector) (DSA.Signature (r vector) (s vector)) (msg vector) dsaTests = testGroup "DSA" [ testGroup "SHA1" - [ testGroup "signature" $ map (doSignatureTest SHA1) (zip [katZero..] vectorsSHA1) - , testGroup "verify" $ map (doVerifyTest SHA1) (zip [katZero..] vectorsSHA1) + [ testGroup "signature" $ zipWith (doSignatureTest SHA1) [katZero..] vectorsSHA1 + , testGroup "verify" $ zipWith (doVerifyTest SHA1) [katZero..] vectorsSHA1 ] , testGroup "SHA224" - [ testGroup "signature" $ map (doSignatureTest SHA224) (zip [katZero..] vectorsSHA224) - , testGroup "verify" $ map (doVerifyTest SHA224) (zip [katZero..] vectorsSHA224) + [ testGroup "signature" $ zipWith (doSignatureTest SHA224) [katZero..] vectorsSHA224 + , testGroup "verify" $ zipWith (doVerifyTest SHA224) [katZero..] vectorsSHA224 ] , testGroup "SHA256" - [ testGroup "signature" $ map (doSignatureTest SHA256) (zip [katZero..] vectorsSHA256) - , testGroup "verify" $ map (doVerifyTest SHA256) (zip [katZero..] vectorsSHA256) + [ testGroup "signature" $ zipWith (doSignatureTest SHA256) [katZero..] vectorsSHA256 + , testGroup "verify" $ zipWith (doVerifyTest SHA256) [katZero..] vectorsSHA256 ] , testGroup "SHA384" - [ testGroup "signature" $ map (doSignatureTest SHA384) (zip [katZero..] vectorsSHA384) - , testGroup "verify" $ map (doVerifyTest SHA384) (zip [katZero..] vectorsSHA384) + [ testGroup "signature" $ zipWith (doSignatureTest SHA384) [katZero..] vectorsSHA384 + , testGroup "verify" $ zipWith (doVerifyTest SHA384) [katZero..] vectorsSHA384 ] , testGroup "SHA512" - [ testGroup "signature" $ map (doSignatureTest SHA512) (zip [katZero..] vectorsSHA512) - , testGroup "verify" $ map (doVerifyTest SHA512) (zip [katZero..] vectorsSHA512) + [ testGroup "signature" $ zipWith (doSignatureTest SHA512) [katZero..] vectorsSHA512 + , testGroup "verify" $ zipWith (doVerifyTest SHA512) [katZero..] vectorsSHA512 ] ] diff --git a/tests/KAT_PubKey/ECC.hs b/tests/KAT_PubKey/ECC.hs index 7a97428..2267851 100644 --- a/tests/KAT_PubKey/ECC.hs +++ b/tests/KAT_PubKey/ECC.hs @@ -136,7 +136,7 @@ vectorsPoint = } ] -doPointValidTest (i, vector) = testCase (show i) (valid vector @=? ECC.isPointValid (curve vector) (ECC.Point (x vector) (y vector))) +doPointValidTest i vector = testCase (show i) (valid vector @=? ECC.isPointValid (curve vector) (ECC.Point (x vector) (y vector))) arbitraryPoint :: ECC.Curve -> Gen ECC.Point arbitraryPoint aCurve = @@ -146,7 +146,7 @@ arbitraryPoint aCurve = pointGen = ECC.pointBaseMul aCurve <$> choose (1, n - 1) eccTests = testGroup "ECC" - [ testGroup "valid-point" $ map doPointValidTest (zip [katZero..] vectorsPoint) + [ testGroup "valid-point" $ zipWith doPointValidTest [katZero..] vectorsPoint , localOption (QuickCheckTests 20) $ testGroup "property" [ testProperty "point-add" $ \aCurve (QAInteger r1) (QAInteger r2) -> let curveN = ECC.ecc_n . ECC.common_curve $ aCurve diff --git a/tests/KAT_PubKey/ECDSA.hs b/tests/KAT_PubKey/ECDSA.hs index c4de4ba..d1bac13 100644 --- a/tests/KAT_PubKey/ECDSA.hs +++ b/tests/KAT_PubKey/ECDSA.hs @@ -490,32 +490,32 @@ vectorToPrivate vector = ECDSA.PrivateKey (curve vector) (d vector) vectorToPublic :: VectorECDSA -> ECDSA.PublicKey vectorToPublic vector = ECDSA.PublicKey (curve vector) (q vector) -doSignatureTest hashAlg (i, vector) = testCase (show i) (expected @=? actual) +doSignatureTest hashAlg i vector = testCase (show i) (expected @=? actual) where expected = Just $ ECDSA.Signature (r vector) (s vector) actual = ECDSA.signWith (k vector) (vectorToPrivate vector) hashAlg (msg vector) -doVerifyTest hashAlg (i, vector) = testCase (show i) (True @=? actual) +doVerifyTest hashAlg i vector = testCase (show i) (True @=? actual) where actual = ECDSA.verify hashAlg (vectorToPublic vector) (ECDSA.Signature (r vector) (s vector)) (msg vector) ecdsaTests = testGroup "ECDSA" [ testGroup "SHA1" - [ testGroup "signature" $ map (doSignatureTest SHA1) (zip [katZero..] vectorsSHA1) - , testGroup "verify" $ map (doVerifyTest SHA1) (zip [katZero..] vectorsSHA1) + [ testGroup "signature" $ zipWith (doSignatureTest SHA1) [katZero..] vectorsSHA1 + , testGroup "verify" $ zipWith (doVerifyTest SHA1) [katZero..] vectorsSHA1 ] , testGroup "SHA224" - [ testGroup "signature" $ map (doSignatureTest SHA224) (zip [katZero..] rfc6979_vectorsSHA224) - , testGroup "verify" $ map (doVerifyTest SHA224) (zip [katZero..] rfc6979_vectorsSHA224) + [ testGroup "signature" $ zipWith (doSignatureTest SHA224) [katZero..] rfc6979_vectorsSHA224 + , testGroup "verify" $ zipWith (doVerifyTest SHA224) [katZero..] rfc6979_vectorsSHA224 ] , testGroup "SHA256" - [ testGroup "signature" $ map (doSignatureTest SHA256) (zip [katZero..] rfc6979_vectorsSHA256) - , testGroup "verify" $ map (doVerifyTest SHA256) (zip [katZero..] rfc6979_vectorsSHA256) + [ testGroup "signature" $ zipWith (doSignatureTest SHA256) [katZero..] rfc6979_vectorsSHA256 + , testGroup "verify" $ zipWith (doVerifyTest SHA256) [katZero..] rfc6979_vectorsSHA256 ] , testGroup "SHA384" - [ testGroup "signature" $ map (doSignatureTest SHA384) (zip [katZero..] rfc6979_vectorsSHA384) - , testGroup "verify" $ map (doVerifyTest SHA384) (zip [katZero..] rfc6979_vectorsSHA384) + [ testGroup "signature" $ zipWith (doSignatureTest SHA384) [katZero..] rfc6979_vectorsSHA384 + , testGroup "verify" $ zipWith (doVerifyTest SHA384) [katZero..] rfc6979_vectorsSHA384 ] , testGroup "SHA512" - [ testGroup "signature" $ map (doSignatureTest SHA512) (zip [katZero..] rfc6979_vectorsSHA512) - , testGroup "verify" $ map (doVerifyTest SHA512) (zip [katZero..] rfc6979_vectorsSHA512) + [ testGroup "signature" $ zipWith (doSignatureTest SHA512) [katZero..] rfc6979_vectorsSHA512 + , testGroup "verify" $ zipWith (doVerifyTest SHA512) [katZero..] rfc6979_vectorsSHA512 ] ] diff --git a/tests/KAT_PubKey/OAEP.hs b/tests/KAT_PubKey/OAEP.hs index c0aff87..a37197e 100644 --- a/tests/KAT_PubKey/OAEP.hs +++ b/tests/KAT_PubKey/OAEP.hs @@ -81,17 +81,17 @@ vectorsKey1 = } ] -doEncryptionTest key (i, vec) = testCase (show i) (Right (cipherText vec) @=? actual) - where actual = OAEP.encryptWithSeed (seed vec) (OAEP.defaultOAEPParams SHA1) key (message vec) +doEncryptionTest key i vec = testCase (show i) (Right (cipherText vec) @=? actual) + where actual = OAEP.encryptWithSeed (seed vec) (OAEP.defaultOAEPParams SHA1) key (message vec) -doDecryptionTest key (i, vec) = testCase (show i) (Right (message vec) @=? actual) +doDecryptionTest key i vec = testCase (show i) (Right (message vec) @=? actual) where actual = OAEP.decrypt Nothing (OAEP.defaultOAEPParams SHA1) key (cipherText vec) oaepTests = testGroup "RSA-OAEP" [ testGroup "internal" - [ doEncryptionTest (private_pub rsaKeyInt) (0 :: Int, vectorInt) - , doDecryptionTest rsaKeyInt (0 :: Int, vectorInt) + [ doEncryptionTest (private_pub rsaKeyInt) (0 :: Int) vectorInt + , doDecryptionTest rsaKeyInt (0 :: Int) vectorInt ] - , testGroup "encryption key 1024 bits" $ map (doEncryptionTest $ private_pub rsaKey1) (zip [katZero..] vectorsKey1) - , testGroup "decryption key 1024 bits" $ map (doDecryptionTest rsaKey1) (zip [katZero..] vectorsKey1) + , testGroup "encryption key 1024 bits" $ zipWith (doEncryptionTest $ private_pub rsaKey1) [katZero..] vectorsKey1 + , testGroup "decryption key 1024 bits" $ zipWith (doDecryptionTest rsaKey1) [katZero..] vectorsKey1 ] diff --git a/tests/KAT_PubKey/PSS.hs b/tests/KAT_PubKey/PSS.hs index 551ac61..4ced84d 100644 --- a/tests/KAT_PubKey/PSS.hs +++ b/tests/KAT_PubKey/PSS.hs @@ -326,23 +326,23 @@ vectorsKey8 = } ] -doSignTest key (i, vector) = testCase (show i) (Right (signature vector) @=? actual) +doSignTest key i vector = testCase (show i) (Right (signature vector) @=? actual) where actual = PSS.signWithSalt (salt vector) Nothing PSS.defaultPSSParamsSHA1 key (message vector) -doVerifyTest key (i, vector) = testCase (show i) (True @=? actual) +doVerifyTest key i vector = testCase (show i) (True @=? actual) where actual = PSS.verify PSS.defaultPSSParamsSHA1 (private_pub key) (message vector) (signature vector) pssTests = testGroup "RSA-PSS" [ testGroup "signature internal" - [ doSignTest rsaKeyInt (katZero, vectorInt) ] + [ doSignTest rsaKeyInt katZero vectorInt ] , testGroup "verify internal" - [ doVerifyTest rsaKeyInt (katZero, vectorInt) ] - , testGroup "signature key 1024" $ map (doSignTest rsaKey1) (zip [katZero..] vectorsKey1) - , testGroup "verify key 1024" $ map (doVerifyTest rsaKey1) (zip [katZero..] vectorsKey1) - , testGroup "signature key 1025" $ map (doSignTest rsaKey2) (zip [katZero..] vectorsKey2) - , testGroup "verify key 1025" $ map (doVerifyTest rsaKey2) (zip [katZero..] vectorsKey2) - , testGroup "signature key 1026" $ map (doSignTest rsaKey3) (zip [katZero..] vectorsKey3) - , testGroup "verify key 1026" $ map (doVerifyTest rsaKey3) (zip [katZero..] vectorsKey3) - , testGroup "signature key 1031" $ map (doSignTest rsaKey8) (zip [katZero..] vectorsKey8) - , testGroup "verify key 1031" $ map (doVerifyTest rsaKey8) (zip [katZero..] vectorsKey8) + [ doVerifyTest rsaKeyInt katZero vectorInt ] + , testGroup "signature key 1024" $ zipWith (doSignTest rsaKey1) [katZero..] vectorsKey1 + , testGroup "verify key 1024" $ zipWith (doVerifyTest rsaKey1) [katZero..] vectorsKey1 + , testGroup "signature key 1025" $ zipWith (doSignTest rsaKey2) [katZero..] vectorsKey2 + , testGroup "verify key 1025" $ zipWith (doVerifyTest rsaKey2) [katZero..] vectorsKey2 + , testGroup "signature key 1026" $ zipWith (doSignTest rsaKey3) [katZero..] vectorsKey3 + , testGroup "verify key 1026" $ zipWith (doVerifyTest rsaKey3) [katZero..] vectorsKey3 + , testGroup "signature key 1031" $ zipWith (doSignTest rsaKey8) [katZero..] vectorsKey8 + , testGroup "verify key 1031" $ zipWith (doVerifyTest rsaKey8) [katZero..] vectorsKey8 ] diff --git a/tests/KAT_PubKey/RSA.hs b/tests/KAT_PubKey/RSA.hs index 068043c..87fd106 100644 --- a/tests/KAT_PubKey/RSA.hs +++ b/tests/KAT_PubKey/RSA.hs @@ -86,17 +86,17 @@ vectorToPublic vector = RSA.PublicKey vectorHasSignature :: VectorRSA -> Bool vectorHasSignature = isRight . sig -doSignatureTest (i, vector) = testCase (show i) (expected @=? actual) +doSignatureTest i vector = testCase (show i) (expected @=? actual) where expected = sig vector actual = RSA.sign Nothing (Just SHA1) (vectorToPrivate vector) (msg vector) -doVerifyTest (i, vector) = testCase (show i) (True @=? actual) +doVerifyTest i vector = testCase (show i) (True @=? actual) where actual = RSA.verify (Just SHA1) (vectorToPublic vector) (msg vector) bs Right bs = sig vector rsaTests = testGroup "RSA" [ testGroup "SHA1" - [ testGroup "signature" $ map doSignatureTest (zip [katZero..] vectorsSHA1) - , testGroup "verify" $ map doVerifyTest $ filter (vectorHasSignature . snd) (zip [katZero..] vectorsSHA1) + [ testGroup "signature" $ zipWith doSignatureTest [katZero..] vectorsSHA1 + , testGroup "verify" $ zipWith doVerifyTest [katZero..] $ filter vectorHasSignature vectorsSHA1 ] ] diff --git a/tests/KAT_PubKey/Rabin.hs b/tests/KAT_PubKey/Rabin.hs index 2f44260..89a92b3 100644 --- a/tests/KAT_PubKey/Rabin.hs +++ b/tests/KAT_PubKey/Rabin.hs @@ -95,51 +95,51 @@ rwSignatureVectors = } ] -doBasicRabinEncryptTest key (i, vector) = testCase (show i) (Right (cipherText vector) @=? actual) +doBasicRabinEncryptTest key i vector = testCase (show i) (Right (cipherText vector) @=? actual) where actual = BRabin.encryptWithSeed (seed vector) (OAEP.defaultOAEPParams SHA1) key (plainText vector) -doBasicRabinDecryptTest key (i, vector) = testCase (show i) (Just (plainText vector) @=? actual) +doBasicRabinDecryptTest key i vector = testCase (show i) (Just (plainText vector) @=? actual) where actual = BRabin.decrypt (OAEP.defaultOAEPParams SHA1) key (cipherText vector) -doBasicRabinSignTest key (i, vector) = testCase (show i) (Right (BRabin.Signature ((os2ip $ padding vector), (signature vector))) @=? actual) +doBasicRabinSignTest key i vector = testCase (show i) (Right (BRabin.Signature ((os2ip $ padding vector), (signature vector))) @=? actual) where actual = BRabin.signWith (padding vector) key SHA1 (message vector) -doBasicRabinVerifyTest key (i, vector) = testCase (show i) (True @=? actual) +doBasicRabinVerifyTest key i vector = testCase (show i) (True @=? actual) where actual = BRabin.verify key SHA1 (message vector) (BRabin.Signature ((os2ip $ padding vector), (signature vector))) -doModifiedRabinSignTest key (i, vector) = testCase (show i) (Right (signature vector) @=? actual) +doModifiedRabinSignTest key i vector = testCase (show i) (Right (signature vector) @=? actual) where actual = MRabin.sign key SHA1 (message vector) -doModifiedRabinVerifyTest key (i, vector) = testCase (show i) (True @=? actual) +doModifiedRabinVerifyTest key i vector = testCase (show i) (True @=? actual) where actual = MRabin.verify key SHA1 (message vector) (signature vector) -doRwEncryptTest key (i, vector) = testCase (show i) (Right (cipherText vector) @=? actual) - where actual = RW.encryptWithSeed (seed vector) (OAEP.defaultOAEPParams SHA1) key (plainText vector) +doRwEncryptTest key i vector = testCase (show i) (Right (cipherText vector) @=? actual) + where actual = RW.encryptWithSeed (seed vector) (OAEP.defaultOAEPParams SHA1) key (plainText vector) -doRwDecryptTest key (i, vector) = testCase (show i) (Just (plainText vector) @=? actual) +doRwDecryptTest key i vector = testCase (show i) (Just (plainText vector) @=? actual) where actual = RW.decrypt (OAEP.defaultOAEPParams SHA1) key (cipherText vector) -doRwSignTest key (i, vector) = testCase (show i) (Right (signature vector) @=? actual) +doRwSignTest key i vector = testCase (show i) (Right (signature vector) @=? actual) where actual = RW.sign key SHA1 (message vector) -doRwVerifyTest key (i, vector) = testCase (show i) (True @=? actual) +doRwVerifyTest key i vector = testCase (show i) (True @=? actual) where actual = RW.verify key SHA1 (message vector) (signature vector) rabinTests = testGroup "Rabin" [ testGroup "Basic" - [ testGroup "encrypt" $ map (doBasicRabinEncryptTest $ BRabin.private_pub basicRabinKey) (zip [katZero..] basicRabinEncryptionVectors) - , testGroup "decrypt" $ map (doBasicRabinDecryptTest $ basicRabinKey) (zip [katZero..] basicRabinEncryptionVectors) - , testGroup "sign" $ map (doBasicRabinSignTest $ basicRabinKey) (zip [katZero..] basicRabinSignatureVectors) - , testGroup "verify" $ map (doBasicRabinVerifyTest $ BRabin.private_pub basicRabinKey) (zip [katZero..] basicRabinSignatureVectors) + [ testGroup "encrypt" $ zipWith (doBasicRabinEncryptTest $ BRabin.private_pub basicRabinKey) [katZero..] basicRabinEncryptionVectors + , testGroup "decrypt" $ zipWith (doBasicRabinDecryptTest basicRabinKey) [katZero..] basicRabinEncryptionVectors + , testGroup "sign" $ zipWith (doBasicRabinSignTest basicRabinKey) [katZero..] basicRabinSignatureVectors + , testGroup "verify" $ zipWith (doBasicRabinVerifyTest $ BRabin.private_pub basicRabinKey) [katZero..] basicRabinSignatureVectors ] , testGroup "Modified" - [ testGroup "sign" $ map (doModifiedRabinSignTest $ modifiedRabinKey) (zip [katZero..] modifiedRabinSignatureVectors) - , testGroup "verify" $ map (doModifiedRabinVerifyTest $ MRabin.private_pub modifiedRabinKey) (zip [katZero..] modifiedRabinSignatureVectors) + [ testGroup "sign" $ zipWith (doModifiedRabinSignTest modifiedRabinKey) [katZero..] modifiedRabinSignatureVectors + , testGroup "verify" $ zipWith (doModifiedRabinVerifyTest $ MRabin.private_pub modifiedRabinKey) [katZero..] modifiedRabinSignatureVectors ] , testGroup "RW" - [ testGroup "encrypt" $ map (doRwEncryptTest $ RW.private_pub rwKey) (zip [katZero..] rwEncryptionVectors) - , testGroup "decrypt" $ map (doRwDecryptTest $ rwKey) (zip [katZero..] rwEncryptionVectors) - , testGroup "sign" $ map (doRwSignTest $ rwKey) (zip [katZero..] rwSignatureVectors) - , testGroup "verify" $ map (doRwVerifyTest $ RW.private_pub rwKey) (zip [katZero..] rwSignatureVectors) + [ testGroup "encrypt" $ zipWith (doRwEncryptTest $ RW.private_pub rwKey) [katZero..] rwEncryptionVectors + , testGroup "decrypt" $ zipWith (doRwDecryptTest rwKey) [katZero..] rwEncryptionVectors + , testGroup "sign" $ zipWith (doRwSignTest rwKey) [katZero..] rwSignatureVectors + , testGroup "verify" $ zipWith (doRwVerifyTest $ RW.private_pub rwKey) [katZero..] rwSignatureVectors ] ] diff --git a/tests/KAT_RC4.hs b/tests/KAT_RC4.hs index 0c113c3..b5d4db0 100644 --- a/tests/KAT_RC4.hs +++ b/tests/KAT_RC4.hs @@ -27,8 +27,8 @@ vectors = ] tests = testGroup "RC4" - $ map toKatTest $ zip is vectors - where toKatTest (i, (key, plainText, cipherText)) = + $ zipWith toKatTest is vectors + where toKatTest i (key, plainText, cipherText) = testCase (show i) (cipherText @=? snd (RC4.combine (RC4.initialize key) plainText)) is :: [Int] is = [1..] diff --git a/tests/KAT_Scrypt.hs b/tests/KAT_Scrypt.hs index eee5a76..4d5e5bd 100644 --- a/tests/KAT_Scrypt.hs +++ b/tests/KAT_Scrypt.hs @@ -28,6 +28,6 @@ vectors = ] tests = testGroup "Scrypt" - $ map toCase $ zip [(1::Int)..] vectors - where toCase (i, ((pass,salt,n,r,p,dklen), output)) = + $ zipWith toCase [(1::Int)..] vectors + where toCase i ((pass,salt,n,r,p,dklen), output) = testCase (show i) (output @=? Scrypt.generate (Scrypt.Parameters n r p dklen) pass salt) diff --git a/tests/Number.hs b/tests/Number.hs index 7aa6acf..85b5a3d 100644 --- a/tests/Number.hs +++ b/tests/Number.hs @@ -79,9 +79,9 @@ tests = testGroup "number" getQAInteger qaInt == BE.os2ip (B.reverse (LE.i2osp (getQAInteger qaInt) :: Bytes)) , testProperty "le-rev-be-40" $ \qaInt -> getQAInteger qaInt == BE.os2ip (B.reverse (LE.i2ospOf_ 40 (getQAInteger qaInt) :: Bytes)) - , testGroup "marshalling-kat-to-bytearray" $ map toSerializationKat $ zip [katZero..] serializationVectors - , testGroup "marshalling-kat-to-integer" $ map toSerializationKatInteger $ zip [katZero..] serializationVectors + , testGroup "marshalling-kat-to-bytearray" $ zipWith toSerializationKat [katZero..] serializationVectors + , testGroup "marshalling-kat-to-integer" $ zipWith toSerializationKatInteger [katZero..] serializationVectors ] where - toSerializationKat (i, (sz, n, ba)) = testCase (show i) (ba @=? BE.i2ospOf_ sz n) - toSerializationKatInteger (i, (_, n, ba)) = testCase (show i) (n @=? BE.os2ip ba) + toSerializationKat i (sz, n, ba) = testCase (show i) (ba @=? BE.i2ospOf_ sz n) + toSerializationKatInteger i (_, n, ba) = testCase (show i) (n @=? BE.os2ip ba) diff --git a/tests/Padding.hs b/tests/Padding.hs index cc4dcf6..53bb29c 100644 --- a/tests/Padding.hs +++ b/tests/Padding.hs @@ -33,6 +33,6 @@ testZeroPad n (inp, sz, padded, unpadded) = ] tests = testGroup "Padding" - [ testGroup "Cases" $ map (uncurry testPad) (zip [1..] cases) - , testGroup "ZeroCases" $ map (uncurry testZeroPad) (zip [1..] zeroCases) + [ testGroup "Cases" $ zipWith testPad [1..] cases + , testGroup "ZeroCases" $ zipWith testZeroPad [1..] zeroCases ] diff --git a/tests/Salsa.hs b/tests/Salsa.hs index 1ecda19..7fceb86 100644 --- a/tests/Salsa.hs +++ b/tests/Salsa.hs @@ -37,7 +37,7 @@ instance Arbitrary RandomVector where tests = testGroup "Salsa" [ testGroup "KAT" $ - map (\(i,f) -> testCase (show (i :: Int)) f) $ zip [1..] $ map (\(r, k,i,e) -> salsaRunSimple e r k i) vectors + zipWith (\i (r,k,n,e) -> testCase (show (i :: Int)) $ salsaRunSimple e r k n) [1..] vectors , testProperty "generate-combine" salsaGenerateCombine , testProperty "chunking-generate" salsaGenerateChunks , testProperty "chunking-combine" salsaCombineChunks diff --git a/tests/XSalsa.hs b/tests/XSalsa.hs index 0bc4d5c..87eec2a 100644 --- a/tests/XSalsa.hs +++ b/tests/XSalsa.hs @@ -110,9 +110,9 @@ vectorsCB = tests = testGroup "XSalsa" [ testGroup "KAT" $ - map (\(i,f) -> testCase (show (i :: Int)) f) $ zip [1..] $ map (\(r, k, i, p, e) -> salsaRunSimple r k i p e) vectors + zipWith (\i (r, k, n, p, e) -> testCase (show (i :: Int)) $ salsaRunSimple r k n p e) [1..] vectors , testGroup "crypto_box encryption" $ - map (\(i,f) -> testCase (show (i :: Int)) f) $ zip [1..] $ map (\(r, k, i, p, e) -> cryptoBoxEnc r k i p e) vectorsCB + zipWith (\i (r, k, n, p, e) -> testCase (show (i :: Int)) $ cryptoBoxEnc r k n p e) [1..] vectorsCB ] where salsaRunSimple rounds key nonce plain expected = From 86470d556344822197753d1d74582a0c2780a8f4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Mon, 10 Feb 2020 06:41:53 +0100 Subject: [PATCH 129/176] Use conventional declaration order --- cbits/aes/gf.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cbits/aes/gf.c b/cbits/aes/gf.c index b750e3c..9f4fcb4 100644 --- a/cbits/aes/gf.c +++ b/cbits/aes/gf.c @@ -74,7 +74,7 @@ static inline void cpu_gf_mulx(block128 *a, const block128 *b) a->q[0] = v0 >> 1 ^ ((0-(v1 & 1)) & 0xe100000000000000ULL); } -const static uint64_t r4_0[] = +static const uint64_t r4_0[] = { 0x0000000000000000ULL, 0x1c20000000000000ULL , 0x3840000000000000ULL, 0x2460000000000000ULL , 0x7080000000000000ULL, 0x6ca0000000000000ULL From 43a9967b1d55f625977d6ea5c6244700f30b08e9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 14 Feb 2020 06:53:15 +0100 Subject: [PATCH 130/176] Remove redundant superclass in MonadRandom Reported by @frasertweedale --- Crypto/Random/Types.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Crypto/Random/Types.hs b/Crypto/Random/Types.hs index 961be8a..c82489f 100644 --- a/Crypto/Random/Types.hs +++ b/Crypto/Random/Types.hs @@ -17,7 +17,7 @@ import Crypto.Random.Entropy import Crypto.Internal.ByteArray -- | A monad constraint that allows to generate random bytes -class (Functor m, Monad m) => MonadRandom m where +class Monad m => MonadRandom m where getRandomBytes :: ByteArray byteArray => Int -> m byteArray -- | A Deterministic Random Generator (DRG) class From 4b8a8229cfd88ac6be9636a0bc8695cdb3514e57 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 23 Feb 2020 08:40:55 +0100 Subject: [PATCH 131/176] Remove redundant where --- Crypto/MAC/CMAC.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Crypto/MAC/CMAC.hs b/Crypto/MAC/CMAC.hs index cfb8a49..a54b189 100644 --- a/Crypto/MAC/CMAC.hs +++ b/Crypto/MAC/CMAC.hs @@ -94,7 +94,7 @@ bxor = B.xor cipherIPT :: BlockCipher k => k -> [Word8] -cipherIPT = expandIPT . blockSize where +cipherIPT = expandIPT . blockSize -- Data type which represents the smallest irreducibule binary polynomial -- against specified degree. From 4b9584dbe46a8c39a9cb62e89a003aa9470f4104 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Mon, 24 Feb 2020 06:53:19 +0100 Subject: [PATCH 132/176] Use lts-15 in CI and bump versions --- .appveyor.yml | 6 +++--- .haskell-ci | 4 ++-- .travis.yml | 6 +++--- cryptonite.cabal | 2 +- stack.yaml | 4 ++-- 5 files changed, 11 insertions(+), 11 deletions(-) diff --git a/.appveyor.yml b/.appveyor.yml index d9a861c..5d4d90f 100644 --- a/.appveyor.yml +++ b/.appveyor.yml @@ -1,4 +1,4 @@ -# ~*~ auto-generated by haskell-ci with config : 90eae0e303541787a1c5382ef6f8198d8e3790ba5dd37a50c4def1fcd3995311 ~*~ +# ~*~ auto-generated by haskell-ci with config : df7ce7fce63ae2c16030178e7df265c57b9650106ac97ee31118dbf14ddbd2ba ~*~ version: "{build}" clone_folder: C:\project @@ -10,8 +10,8 @@ environment: global: STACK_ROOT: "C:\\SR" matrix: - - { BUILD: "ghc-8.6", STACKCMD: "stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps", STACKCFG: "{ resolver: lts-14.7, packages: [ '.' ], extra-deps: [], flags: {} }", STACKURL: "https://www.stackage.org/stack/windows-x86_64" } - - { BUILD: "ghc-8.8", STACKCMD: "stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps", STACKCFG: "{ resolver: nightly-2019-10-05, packages: [ '.' ], extra-deps: [], flags: {} }", STACKURL: "https://www.stackage.org/stack/windows-x86_64" } + - { BUILD: "ghc-8.6", STACKCMD: "stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps", STACKCFG: "{ resolver: lts-14.27, packages: [ '.' ], extra-deps: [], flags: {} }", STACKURL: "https://www.stackage.org/stack/windows-x86_64" } + - { BUILD: "ghc-8.8", STACKCMD: "stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps", STACKCFG: "{ resolver: lts-15.1, packages: [ '.' ], extra-deps: [], flags: {} }", STACKURL: "https://www.stackage.org/stack/windows-x86_64" } matrix: fast_finish: true diff --git a/.haskell-ci b/.haskell-ci index df2b845..b3ddbda 100644 --- a/.haskell-ci +++ b/.haskell-ci @@ -2,8 +2,8 @@ compiler: ghc-8.0 lts-9.21 compiler: ghc-8.2 lts-11.22 compiler: ghc-8.4 lts-12.26 -compiler: ghc-8.6 lts-14.7 -compiler: ghc-8.8 nightly-2019-10-05 +compiler: ghc-8.6 lts-14.27 +compiler: ghc-8.8 lts-15.1 # options # option: alias x=y z=v diff --git a/.travis.yml b/.travis.yml index 26dd1cf..1f24739 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,4 +1,4 @@ -# ~*~ auto-generated by haskell-ci with config : 90eae0e303541787a1c5382ef6f8198d8e3790ba5dd37a50c4def1fcd3995311 ~*~ +# ~*~ auto-generated by haskell-ci with config : df7ce7fce63ae2c16030178e7df265c57b9650106ac97ee31118dbf14ddbd2ba ~*~ # Use new container infrastructure to enable caching sudo: false @@ -62,11 +62,11 @@ script: stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; ghc-8.6) - echo "{ resolver: lts-14.7, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml + echo "{ resolver: lts-14.27, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; ghc-8.8) - echo "{ resolver: nightly-2019-10-05, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml + echo "{ resolver: lts-15.1, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; esac diff --git a/cryptonite.cabal b/cryptonite.cabal index c7e5742..31bd64f 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -36,7 +36,7 @@ Build-Type: Simple Homepage: https://github.com/haskell-crypto/cryptonite Bug-reports: https://github.com/haskell-crypto/cryptonite/issues Cabal-Version: 1.18 -tested-with: GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 +tested-with: GHC==8.8.2, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 extra-doc-files: README.md CHANGELOG.md extra-source-files: cbits/*.h cbits/aes/*.h diff --git a/stack.yaml b/stack.yaml index 02adde4..e18363e 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1,3 @@ -# ~*~ auto-generated by haskell-ci with config : 90eae0e303541787a1c5382ef6f8198d8e3790ba5dd37a50c4def1fcd3995311 ~*~ -{ resolver: lts-14.7, packages: [ '.' ], extra-deps: [], flags: {} } +# ~*~ auto-generated by haskell-ci with config : df7ce7fce63ae2c16030178e7df265c57b9650106ac97ee31118dbf14ddbd2ba ~*~ +{ resolver: lts-14.27, packages: [ '.' ], extra-deps: [], flags: {} } From 6075b698e12453123dd618b2d8acd97975ef6b2d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Tue, 7 Nov 2017 13:58:30 +0100 Subject: [PATCH 133/176] Generic EdDSA implementation --- Crypto/PubKey/EdDSA.hs | 231 +++++++++++++++++++++++++++++++++++++++++ cryptonite.cabal | 1 + 2 files changed, 232 insertions(+) create mode 100644 Crypto/PubKey/EdDSA.hs diff --git a/Crypto/PubKey/EdDSA.hs b/Crypto/PubKey/EdDSA.hs new file mode 100644 index 0000000..3ae7854 --- /dev/null +++ b/Crypto/PubKey/EdDSA.hs @@ -0,0 +1,231 @@ +-- | +-- Module : Crypto.PubKey.EdDSA +-- License : BSD-style +-- Maintainer : Olivier Chéron +-- Stability : experimental +-- Portability : unknown +-- +-- EdDSA signature generation and verification. +-- +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +module Crypto.PubKey.EdDSA + ( SecretKey + , PublicKey + , Signature + -- * Curves with EdDSA implementation + , EllipticCurveEdDSA(publicKeySize, secretKeySize, signatureSize) + -- * Smart constructors + , signature + , publicKey + , secretKey + -- * Methods + , toPublic + , sign + , verify + , generateSecretKey + ) where + +import Data.Bits +import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, ScrubbedBytes, View) +import qualified Data.ByteArray as B + +import Crypto.ECC +import qualified Crypto.ECC.Edwards25519 as Edwards25519 +import Crypto.Error +import Crypto.Hash +import Crypto.Random + +import Crypto.Internal.Imports + +import Foreign.Storable + + +-- API + +-- | An EdDSA Secret key +newtype SecretKey curve = SecretKey ScrubbedBytes + deriving (Show,Eq,ByteArrayAccess,NFData) + +-- | An EdDSA public key +newtype PublicKey curve = PublicKey Bytes + deriving (Show,Eq,ByteArrayAccess,NFData) + +-- | An EdDSA signature +newtype Signature curve = Signature Bytes + deriving (Show,Eq,ByteArrayAccess,NFData) + +-- | Elliptic curves with an implementation of EdDSA +class ( EllipticCurveBasepointArith curve + , HashAlgorithm (HashAlg curve) + ) => EllipticCurveEdDSA curve where + + -- | Size of public keys for this curve (in bytes) + publicKeySize :: proxy curve -> Int + + -- | Size of secret keys for this curve (in bytes) + secretKeySize :: proxy curve -> Int + + -- | Size of signatures for this curve (in bytes) + signatureSize :: proxy curve -> Int + + -- prepare hash context with specified parameters + type HashAlg curve :: * + hashInitWithDom :: proxy curve -> Context (HashAlg curve) + + -- conversion between scalar, point and public key + pointPublic :: proxy curve -> Point curve -> PublicKey curve + publicPoint :: proxy curve -> PublicKey curve -> CryptoFailable (Point curve) + encodeScalarLE :: ByteArray bs => proxy curve -> Scalar curve -> bs + decodeScalarLE :: ByteArrayAccess bs => proxy curve -> bs -> CryptoFailable (Scalar curve) + + -- how to use bits in a secret key + scheduleSecret :: proxy curve + -> SecretKey curve + -> (Scalar curve, View (Digest (HashAlg curve))) + + +-- Constructors + +-- | Try to build a public key from a bytearray +publicKey :: (EllipticCurveEdDSA curve, ByteArrayAccess ba) + => proxy curve -> ba -> CryptoFailable (PublicKey curve) +publicKey prx bs + | B.length bs == publicKeySize prx = + CryptoPassed (PublicKey $ B.convert bs) + | otherwise = + CryptoFailed CryptoError_PublicKeySizeInvalid + +-- | Try to build a secret key from a bytearray +secretKey :: (EllipticCurveEdDSA curve, ByteArrayAccess ba) + => proxy curve -> ba -> CryptoFailable (SecretKey curve) +secretKey prx bs + | B.length bs == secretKeySize prx = + CryptoPassed (SecretKey $ B.convert bs) + | otherwise = + CryptoFailed CryptoError_SecretKeyStructureInvalid + +-- | Try to build a signature from a bytearray +signature :: (EllipticCurveEdDSA curve, ByteArrayAccess ba) + => proxy curve -> ba -> CryptoFailable (Signature curve) +signature prx bs + | B.length bs == signatureSize prx = + CryptoPassed (Signature $ B.convert bs) + | otherwise = + CryptoFailed CryptoError_SecretKeyStructureInvalid + + +-- Conversions + +-- | Generate a secret key +generateSecretKey :: (EllipticCurveEdDSA curve, MonadRandom m) + => proxy curve -> m (SecretKey curve) +generateSecretKey prx = SecretKey <$> getRandomBytes (secretKeySize prx) + +-- | Create a public key from a secret key +toPublic :: EllipticCurveEdDSA curve + => proxy curve -> SecretKey curve -> PublicKey curve +toPublic prx priv = + let p = pointBaseSmul prx (secretScalar prx priv) + in pointPublic prx p + +secretScalar :: EllipticCurveEdDSA curve + => proxy curve -> SecretKey curve -> Scalar curve +secretScalar prx priv = fst (scheduleSecret prx priv) + + +-- EdDSA signature generation & verification + +-- | Sign a message using the key pair +sign :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) + => proxy curve -> SecretKey curve -> PublicKey curve -> msg -> Signature curve +sign prx priv pub msg = + let (s, prefix) = scheduleSecret prx priv + digR = hashFinalize $ hashUpdate (hashUpdate (hashInitWithDom prx) prefix) msg + r = decodeScalarNoErr prx digR + pR = pointBaseSmul prx r + sK = getK prx pub pR msg + sS = scalarAdd prx r (scalarMul prx sK s) + in encodeSignature prx (pR, sS) + +-- | Verify a message +verify :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) + => proxy curve -> PublicKey curve -> msg -> Signature curve -> Bool +verify prx pub msg sig = + case doVerify of + CryptoPassed verified -> verified + CryptoFailed _ -> False + where + doVerify = do + (pR, sS) <- decodeSignature prx sig + nPub <- pointNegate prx `fmap` publicPoint prx pub + let sK = getK prx pub pR msg + pR' = pointsSmulVarTime prx sS sK nPub + return (pR == pR') + +getK :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) + => proxy curve -> PublicKey curve -> Point curve -> msg -> Scalar curve +getK prx pub pR msg = + let bsR = encodePoint prx pR :: Bytes + digK = hashFinalize $ hashUpdate (hashUpdate (hashUpdate (hashInitWithDom prx) bsR) pub) msg + in decodeScalarNoErr prx digK + +encodeSignature :: EllipticCurveEdDSA curve + => proxy curve + -> (Point curve, Scalar curve) + -> Signature curve +encodeSignature prx (pR, sS) = + let bsS = encodeScalarLE prx sS :: Bytes + len0 = signatureSize prx - publicKeySize prx - B.length bsS + in Signature $ B.concat [ encodePoint prx pR, bsS, B.zero len0 ] + +decodeSignature :: EllipticCurveEdDSA curve + => proxy curve + -> Signature curve + -> CryptoFailable (Point curve, Scalar curve) +decodeSignature prx (Signature bs) = do + let (bsR, bsS) = B.splitAt (publicKeySize prx) bs + pR <- decodePoint prx bsR + sS <- decodeScalarLE prx bsS + return (pR, sS) + +-- implementations are supposed to decode any scalar up to the size of the digest +decodeScalarNoErr :: (EllipticCurveEdDSA curve, ByteArrayAccess bs) + => proxy curve -> bs -> Scalar curve +decodeScalarNoErr prx = unwrap "decodeScalarNoErr" . decodeScalarLE prx + +unwrap :: String -> CryptoFailable a -> a +unwrap name (CryptoFailed _) = error (name ++ ": assumption failed") +unwrap _ (CryptoPassed x) = x + + +-- Ed25519 implementation + +instance EllipticCurveEdDSA Curve_Edwards25519 where + publicKeySize _ = 32 + secretKeySize _ = 32 + signatureSize _ = 64 + + type HashAlg Curve_Edwards25519 = SHA512 + hashInitWithDom _ = hashInitWith SHA512 + + pointPublic _ = PublicKey . Edwards25519.pointEncode + publicPoint _ = Edwards25519.pointDecode + encodeScalarLE _ = Edwards25519.scalarEncode + decodeScalarLE _ = Edwards25519.scalarDecodeLong + + scheduleSecret prx priv = + (decodeScalarNoErr prx clamped, B.dropView hashed 32) + where + hashed = hashWith SHA512 priv + + clamped :: Bytes + clamped = B.copyAndFreeze (B.takeView hashed 32) $ \p -> do + b0 <- peekElemOff p 0 :: IO Word8 + b31 <- peekElemOff p 31 :: IO Word8 + pokeElemOff p 31 ((b31 .&. 0x7F) .|. 0x40) + pokeElemOff p 0 (b0 .&. 0xF8) diff --git a/cryptonite.cabal b/cryptonite.cabal index 31bd64f..119c8ab 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -164,6 +164,7 @@ Library Crypto.PubKey.ECIES Crypto.PubKey.Ed25519 Crypto.PubKey.Ed448 + Crypto.PubKey.EdDSA Crypto.PubKey.RSA Crypto.PubKey.RSA.PKCS15 Crypto.PubKey.RSA.Prim From 633879f8016d886875a20799e81d5a49693bef35 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Tue, 4 Feb 2020 21:23:29 +0100 Subject: [PATCH 134/176] Avoid repeated point encoding --- Crypto/PubKey/EdDSA.hs | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/Crypto/PubKey/EdDSA.hs b/Crypto/PubKey/EdDSA.hs index 3ae7854..7754bcc 100644 --- a/Crypto/PubKey/EdDSA.hs +++ b/Crypto/PubKey/EdDSA.hs @@ -148,9 +148,10 @@ sign prx priv pub msg = digR = hashFinalize $ hashUpdate (hashUpdate (hashInitWithDom prx) prefix) msg r = decodeScalarNoErr prx digR pR = pointBaseSmul prx r - sK = getK prx pub pR msg + bsR = encodePoint prx pR + sK = getK prx pub bsR msg sS = scalarAdd prx r (scalarMul prx sK s) - in encodeSignature prx (pR, sS) + in encodeSignature prx (bsR, pR, sS) -- | Verify a message verify :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) @@ -161,37 +162,36 @@ verify prx pub msg sig = CryptoFailed _ -> False where doVerify = do - (pR, sS) <- decodeSignature prx sig + (bsR, pR, sS) <- decodeSignature prx sig nPub <- pointNegate prx `fmap` publicPoint prx pub - let sK = getK prx pub pR msg + let sK = getK prx pub bsR msg pR' = pointsSmulVarTime prx sS sK nPub return (pR == pR') getK :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) - => proxy curve -> PublicKey curve -> Point curve -> msg -> Scalar curve -getK prx pub pR msg = - let bsR = encodePoint prx pR :: Bytes - digK = hashFinalize $ hashUpdate (hashUpdate (hashUpdate (hashInitWithDom prx) bsR) pub) msg + => proxy curve -> PublicKey curve -> Bytes -> msg -> Scalar curve +getK prx pub bsR msg = + let digK = hashFinalize $ hashUpdate (hashUpdate (hashUpdate (hashInitWithDom prx) bsR) pub) msg in decodeScalarNoErr prx digK encodeSignature :: EllipticCurveEdDSA curve => proxy curve - -> (Point curve, Scalar curve) + -> (Bytes, Point curve, Scalar curve) -> Signature curve -encodeSignature prx (pR, sS) = +encodeSignature prx (bsR, _, sS) = let bsS = encodeScalarLE prx sS :: Bytes - len0 = signatureSize prx - publicKeySize prx - B.length bsS - in Signature $ B.concat [ encodePoint prx pR, bsS, B.zero len0 ] + len0 = signatureSize prx - B.length bsR - B.length bsS + in Signature $ B.concat [ bsR, bsS, B.zero len0 ] decodeSignature :: EllipticCurveEdDSA curve => proxy curve -> Signature curve - -> CryptoFailable (Point curve, Scalar curve) + -> CryptoFailable (Bytes, Point curve, Scalar curve) decodeSignature prx (Signature bs) = do let (bsR, bsS) = B.splitAt (publicKeySize prx) bs pR <- decodePoint prx bsR sS <- decodeScalarLE prx bsS - return (pR, sS) + return (bsR, pR, sS) -- implementations are supposed to decode any scalar up to the size of the digest decodeScalarNoErr :: (EllipticCurveEdDSA curve, ByteArrayAccess bs) From 6f70986cb17dd2248a3eb73760834d7941baadc5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Tue, 4 Feb 2020 21:39:50 +0100 Subject: [PATCH 135/176] Avoid signature padding when not required --- Crypto/PubKey/EdDSA.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/Crypto/PubKey/EdDSA.hs b/Crypto/PubKey/EdDSA.hs index 7754bcc..fc69a06 100644 --- a/Crypto/PubKey/EdDSA.hs +++ b/Crypto/PubKey/EdDSA.hs @@ -178,10 +178,12 @@ encodeSignature :: EllipticCurveEdDSA curve => proxy curve -> (Bytes, Point curve, Scalar curve) -> Signature curve -encodeSignature prx (bsR, _, sS) = - let bsS = encodeScalarLE prx sS :: Bytes - len0 = signatureSize prx - B.length bsR - B.length bsS - in Signature $ B.concat [ bsR, bsS, B.zero len0 ] +encodeSignature prx (bsR, _, sS) = Signature $ + if len0 > 0 then B.concat [ bsR, bsS, pad0 ] else B.append bsR bsS + where + bsS = encodeScalarLE prx sS + len0 = signatureSize prx - B.length bsR - B.length bsS + pad0 = B.zero len0 decodeSignature :: EllipticCurveEdDSA curve => proxy curve From bd84c75f3ee5f5e7762023ff905720c53a921171 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Wed, 5 Feb 2020 21:15:58 +0100 Subject: [PATCH 136/176] Use unsafe FFI calls Changed Edwards primitives to unsafe when overhead of FFI call is approximately 5% or more of total execution time. --- Crypto/ECC/Edwards25519.hs | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/Crypto/ECC/Edwards25519.hs b/Crypto/ECC/Edwards25519.hs index 92a0516..589fc55 100644 --- a/Crypto/ECC/Edwards25519.hs +++ b/Crypto/ECC/Edwards25519.hs @@ -283,45 +283,45 @@ pointsMulVarTime (Scalar s1) (Scalar s2) (Point p) = withByteArray p $ \pp -> ed25519_base_double_scalarmul_vartime out ps1 pp ps2 -foreign import ccall "cryptonite_ed25519_scalar_eq" +foreign import ccall unsafe "cryptonite_ed25519_scalar_eq" ed25519_scalar_eq :: Ptr Scalar -> Ptr Scalar -> IO CInt -foreign import ccall "cryptonite_ed25519_scalar_encode" +foreign import ccall unsafe "cryptonite_ed25519_scalar_encode" ed25519_scalar_encode :: Ptr Word8 -> Ptr Scalar -> IO () -foreign import ccall "cryptonite_ed25519_scalar_decode_long" +foreign import ccall unsafe "cryptonite_ed25519_scalar_decode_long" ed25519_scalar_decode_long :: Ptr Scalar -> Ptr Word8 -> CSize -> IO () -foreign import ccall "cryptonite_ed25519_scalar_add" +foreign import ccall unsafe "cryptonite_ed25519_scalar_add" ed25519_scalar_add :: Ptr Scalar -- sum -> Ptr Scalar -- a -> Ptr Scalar -- b -> IO () -foreign import ccall "cryptonite_ed25519_scalar_mul" +foreign import ccall unsafe "cryptonite_ed25519_scalar_mul" ed25519_scalar_mul :: Ptr Scalar -- out -> Ptr Scalar -- a -> Ptr Scalar -- b -> IO () -foreign import ccall "cryptonite_ed25519_point_encode" +foreign import ccall unsafe "cryptonite_ed25519_point_encode" ed25519_point_encode :: Ptr Word8 -> Ptr Point -> IO () -foreign import ccall "cryptonite_ed25519_point_decode_vartime" +foreign import ccall unsafe "cryptonite_ed25519_point_decode_vartime" ed25519_point_decode_vartime :: Ptr Point -> Ptr Word8 -> IO CInt -foreign import ccall "cryptonite_ed25519_point_eq" +foreign import ccall unsafe "cryptonite_ed25519_point_eq" ed25519_point_eq :: Ptr Point -> Ptr Point -> IO CInt @@ -330,23 +330,23 @@ foreign import ccall "cryptonite_ed25519_point_has_prime_order" ed25519_point_has_prime_order :: Ptr Point -> IO CInt -foreign import ccall "cryptonite_ed25519_point_negate" +foreign import ccall unsafe "cryptonite_ed25519_point_negate" ed25519_point_negate :: Ptr Point -- minus_a -> Ptr Point -- a -> IO () -foreign import ccall "cryptonite_ed25519_point_add" +foreign import ccall unsafe "cryptonite_ed25519_point_add" ed25519_point_add :: Ptr Point -- sum -> Ptr Point -- a -> Ptr Point -- b -> IO () -foreign import ccall "cryptonite_ed25519_point_double" +foreign import ccall unsafe "cryptonite_ed25519_point_double" ed25519_point_double :: Ptr Point -- two_a -> Ptr Point -- a -> IO () -foreign import ccall "cryptonite_ed25519_point_mul_by_cofactor" +foreign import ccall unsafe "cryptonite_ed25519_point_mul_by_cofactor" ed25519_point_mul_by_cofactor :: Ptr Point -- eight_a -> Ptr Point -- a -> IO () From 6f932998adc13d40e2679934f71f411655a71bb5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 7 Feb 2020 06:58:44 +0100 Subject: [PATCH 137/176] Fast hashing for EdDSA --- Crypto/PubKey/EdDSA.hs | 52 +++++++++++++++++++++++++++++++++--------- 1 file changed, 41 insertions(+), 11 deletions(-) diff --git a/Crypto/PubKey/EdDSA.hs b/Crypto/PubKey/EdDSA.hs index fc69a06..95e187b 100644 --- a/Crypto/PubKey/EdDSA.hs +++ b/Crypto/PubKey/EdDSA.hs @@ -11,6 +11,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} module Crypto.PubKey.EdDSA @@ -31,15 +32,17 @@ module Crypto.PubKey.EdDSA ) where import Data.Bits -import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, ScrubbedBytes, View) +import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, ScrubbedBytes) import qualified Data.ByteArray as B import Crypto.ECC import qualified Crypto.ECC.Edwards25519 as Edwards25519 import Crypto.Error -import Crypto.Hash +import Crypto.Hash.Algorithms +import Crypto.Hash.IO import Crypto.Random +import Crypto.Internal.Compat import Crypto.Internal.Imports import Foreign.Storable @@ -73,9 +76,9 @@ class ( EllipticCurveBasepointArith curve -- | Size of signatures for this curve (in bytes) signatureSize :: proxy curve -> Int - -- prepare hash context with specified parameters + -- hash with a given prefix type HashAlg curve :: * - hashInitWithDom :: proxy curve -> Context (HashAlg curve) + hashWithDom :: ByteArrayAccess msg => proxy curve -> [Bytes] -> msg -> Bytes -- conversion between scalar, point and public key pointPublic :: proxy curve -> Point curve -> PublicKey curve @@ -86,7 +89,7 @@ class ( EllipticCurveBasepointArith curve -- how to use bits in a secret key scheduleSecret :: proxy curve -> SecretKey curve - -> (Scalar curve, View (Digest (HashAlg curve))) + -> (Scalar curve, Bytes) -- Constructors @@ -145,7 +148,7 @@ sign :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) => proxy curve -> SecretKey curve -> PublicKey curve -> msg -> Signature curve sign prx priv pub msg = let (s, prefix) = scheduleSecret prx priv - digR = hashFinalize $ hashUpdate (hashUpdate (hashInitWithDom prx) prefix) msg + digR = hashWithDom prx [prefix] msg r = decodeScalarNoErr prx digR pR = pointBaseSmul prx r bsR = encodePoint prx pR @@ -170,8 +173,8 @@ verify prx pub msg sig = getK :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) => proxy curve -> PublicKey curve -> Bytes -> msg -> Scalar curve -getK prx pub bsR msg = - let digK = hashFinalize $ hashUpdate (hashUpdate (hashUpdate (hashInitWithDom prx) bsR) pub) msg +getK prx (PublicKey pub) bsR msg = + let digK = hashWithDom prx [bsR, pub] msg in decodeScalarNoErr prx digK encodeSignature :: EllipticCurveEdDSA curve @@ -213,7 +216,7 @@ instance EllipticCurveEdDSA Curve_Edwards25519 where signatureSize _ = 64 type HashAlg Curve_Edwards25519 = SHA512 - hashInitWithDom _ = hashInitWith SHA512 + hashWithDom _ = digestDomMsg SHA512 pointPublic _ = PublicKey . Edwards25519.pointEncode publicPoint _ = Edwards25519.pointDecode @@ -221,9 +224,9 @@ instance EllipticCurveEdDSA Curve_Edwards25519 where decodeScalarLE _ = Edwards25519.scalarDecodeLong scheduleSecret prx priv = - (decodeScalarNoErr prx clamped, B.dropView hashed 32) + (decodeScalarNoErr prx clamped, B.drop 32 hashed) where - hashed = hashWith SHA512 priv + hashed = digest SHA512 ($ priv) clamped :: Bytes clamped = B.copyAndFreeze (B.takeView hashed 32) $ \p -> do @@ -231,3 +234,30 @@ instance EllipticCurveEdDSA Curve_Edwards25519 where b31 <- peekElemOff p 31 :: IO Word8 pokeElemOff p 31 ((b31 .&. 0x7F) .|. 0x40) pokeElemOff p 0 (b0 .&. 0xF8) + + +{- + Optimize hashing by limiting the number of roundtrips between Haskell and C. + Hash "update" functions do not use unsafe FFI call, so better concanetate + small fragments together and call the update function once. + + Using the IO hash interface avoids context buffer copies. + + Data type Digest is not used directly but converted to Bytes early. Any use of + withByteArray on the unpinned Digest backend would require copy through a + pinned trampoline. +-} + +digestDomMsg :: (HashAlgorithm alg, ByteArrayAccess msg) + => alg -> [Bytes] -> msg -> Bytes +digestDomMsg alg bss bs = digest alg $ \update -> + update (B.concat bss :: Bytes) >> update bs + +digest :: HashAlgorithm alg + => alg + -> ((forall bs . ByteArrayAccess bs => bs -> IO ()) -> IO ()) + -> Bytes +digest alg fn = B.convert $ unsafeDoIO $ do + mc <- hashMutableInitWith alg + fn (hashMutableUpdate mc) + hashMutableFinalize mc From 436b9abc1381990057992a4d90264fca939f9b80 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 12 Nov 2017 14:54:14 +0100 Subject: [PATCH 138/176] Benchmark EdDSA implementations --- benchs/Bench.hs | 40 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/benchs/Bench.hs b/benchs/Bench.hs index e111a0d..f2a4f2a 100644 --- a/benchs/Bench.hs +++ b/benchs/Bench.hs @@ -24,6 +24,8 @@ import qualified Crypto.PubKey.DH as DH import qualified Crypto.PubKey.ECC.Types as ECC import qualified Crypto.PubKey.ECC.Prim as ECC import qualified Crypto.PubKey.ECDSA as ECDSA +import qualified Crypto.PubKey.Ed25519 as Ed25519 +import qualified Crypto.PubKey.EdDSA as EdDSA import Crypto.Random import Control.DeepSeq (NFData) @@ -325,6 +327,43 @@ benchECDSA = map doECDSABench curveHashes , ("secp521r1_sha512", CurveHashECDSA Curve_P521R1 SHA512) ] +benchEdDSA = + [ bgroup "EdDSA-Ed25519" $ benchGeneric (Just Curve_Edwards25519) + , bgroup "Ed25519" benchEd25519 + ] + where + benchGeneric prx = + [ bench "sign" $ perBatchEnv (genEnv prx) (run_gen_sign prx) + , bench "verify" $ perBatchEnv (genEnv prx) (run_gen_verify prx) + ] + + benchEd25519 = + [ bench "sign" $ perBatchEnv ed25519Env run_ed25519_sign + , bench "verify" $ perBatchEnv ed25519Env run_ed25519_verify + ] + + msg = B.empty -- empty message = worst-case scenario showing API overhead + + genEnv prx _ = do + sec <- EdDSA.generateSecretKey prx + let pub = EdDSA.toPublic prx sec + sig = EdDSA.sign prx sec pub msg + return (sec, pub, sig) + + run_gen_sign prx (sec, pub, _) = return (EdDSA.sign prx sec pub msg) + + run_gen_verify prx (_, pub, sig) = return (EdDSA.verify prx pub msg sig) + + ed25519Env _ = do + sec <- Ed25519.generateSecretKey + let pub = Ed25519.toPublic sec + sig = Ed25519.sign sec pub msg + return (sec, pub, sig) + + run_ed25519_sign (sec, pub, _) = return (Ed25519.sign sec pub msg) + + run_ed25519_verify (_, pub, sig) = return (Ed25519.verify pub msg sig) + main = defaultMain [ bgroup "hash" benchHash , bgroup "block-cipher" benchBlockCipher @@ -338,5 +377,6 @@ main = defaultMain , bgroup "ECDH" benchECDH ] , bgroup "ECDSA" benchECDSA + , bgroup "EdDSA" benchEdDSA , bgroup "F2m" benchF2m ] From 1cb2cd2f12e1565d744fc1f4e28df7bf7b80c83b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 8 Feb 2020 11:17:10 +0100 Subject: [PATCH 139/176] Ability to select the hash algorithm --- Crypto/PubKey/EdDSA.hs | 138 +++++++++++++++++++++++++++-------------- benchs/Bench.hs | 18 +++--- 2 files changed, 102 insertions(+), 54 deletions(-) diff --git a/Crypto/PubKey/EdDSA.hs b/Crypto/PubKey/EdDSA.hs index 95e187b..eeffa7b 100644 --- a/Crypto/PubKey/EdDSA.hs +++ b/Crypto/PubKey/EdDSA.hs @@ -19,7 +19,10 @@ module Crypto.PubKey.EdDSA , PublicKey , Signature -- * Curves with EdDSA implementation - , EllipticCurveEdDSA(publicKeySize, secretKeySize, signatureSize) + , EllipticCurveEdDSA(CurveDigestSize) + , publicKeySize + , secretKeySize + , signatureSize -- * Smart constructors , signature , publicKey @@ -34,16 +37,19 @@ module Crypto.PubKey.EdDSA import Data.Bits import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, ScrubbedBytes) import qualified Data.ByteArray as B +import Data.Proxy import Crypto.ECC import qualified Crypto.ECC.Edwards25519 as Edwards25519 import Crypto.Error -import Crypto.Hash.Algorithms import Crypto.Hash.IO import Crypto.Random +import GHC.TypeLits (KnownNat, Nat) + import Crypto.Internal.Compat import Crypto.Internal.Imports +import Crypto.Internal.Nat (integralNatVal) import Foreign.Storable @@ -55,49 +61,63 @@ newtype SecretKey curve = SecretKey ScrubbedBytes deriving (Show,Eq,ByteArrayAccess,NFData) -- | An EdDSA public key -newtype PublicKey curve = PublicKey Bytes +newtype PublicKey curve hash = PublicKey Bytes deriving (Show,Eq,ByteArrayAccess,NFData) -- | An EdDSA signature -newtype Signature curve = Signature Bytes +newtype Signature curve hash = Signature Bytes deriving (Show,Eq,ByteArrayAccess,NFData) -- | Elliptic curves with an implementation of EdDSA class ( EllipticCurveBasepointArith curve - , HashAlgorithm (HashAlg curve) + , KnownNat (CurveDigestSize curve) ) => EllipticCurveEdDSA curve where - -- | Size of public keys for this curve (in bytes) - publicKeySize :: proxy curve -> Int + -- | Size of the digest for this curve (in bytes) + type CurveDigestSize curve :: Nat -- | Size of secret keys for this curve (in bytes) secretKeySize :: proxy curve -> Int - -- | Size of signatures for this curve (in bytes) - signatureSize :: proxy curve -> Int - -- hash with a given prefix - type HashAlg curve :: * - hashWithDom :: ByteArrayAccess msg => proxy curve -> [Bytes] -> msg -> Bytes + hashWithDom :: (HashAlgorithm hash, ByteArrayAccess msg) + => proxy curve -> hash -> [Bytes] -> msg -> Bytes -- conversion between scalar, point and public key - pointPublic :: proxy curve -> Point curve -> PublicKey curve - publicPoint :: proxy curve -> PublicKey curve -> CryptoFailable (Point curve) + pointPublic :: proxy curve -> Point curve -> PublicKey curve hash + publicPoint :: proxy curve -> PublicKey curve hash -> CryptoFailable (Point curve) encodeScalarLE :: ByteArray bs => proxy curve -> Scalar curve -> bs decodeScalarLE :: ByteArrayAccess bs => proxy curve -> bs -> CryptoFailable (Scalar curve) -- how to use bits in a secret key - scheduleSecret :: proxy curve + scheduleSecret :: ( HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + ) + => proxy curve + -> hash -> SecretKey curve -> (Scalar curve, Bytes) +-- | Size of public keys for this curve (in bytes) +publicKeySize :: EllipticCurveEdDSA curve => proxy curve -> Int +publicKeySize prx = signatureSize prx `div` 2 + +-- | Size of signatures for this curve (in bytes) +signatureSize :: forall proxy curve . EllipticCurveEdDSA curve + => proxy curve -> Int +signatureSize _ = integralNatVal (Proxy :: Proxy (CurveDigestSize curve)) + -- Constructors -- | Try to build a public key from a bytearray -publicKey :: (EllipticCurveEdDSA curve, ByteArrayAccess ba) - => proxy curve -> ba -> CryptoFailable (PublicKey curve) -publicKey prx bs +publicKey :: ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess ba + ) + => proxy curve -> hash -> ba -> CryptoFailable (PublicKey curve hash) +publicKey prx _ bs | B.length bs == publicKeySize prx = CryptoPassed (PublicKey $ B.convert bs) | otherwise = @@ -113,9 +133,13 @@ secretKey prx bs CryptoFailed CryptoError_SecretKeyStructureInvalid -- | Try to build a signature from a bytearray -signature :: (EllipticCurveEdDSA curve, ByteArrayAccess ba) - => proxy curve -> ba -> CryptoFailable (Signature curve) -signature prx bs +signature :: ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess ba + ) + => proxy curve -> hash -> ba -> CryptoFailable (Signature curve hash) +signature prx _ bs | B.length bs == signatureSize prx = CryptoPassed (Signature $ B.convert bs) | otherwise = @@ -130,25 +154,37 @@ generateSecretKey :: (EllipticCurveEdDSA curve, MonadRandom m) generateSecretKey prx = SecretKey <$> getRandomBytes (secretKeySize prx) -- | Create a public key from a secret key -toPublic :: EllipticCurveEdDSA curve - => proxy curve -> SecretKey curve -> PublicKey curve -toPublic prx priv = - let p = pointBaseSmul prx (secretScalar prx priv) +toPublic :: ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + ) + => proxy curve -> hash -> SecretKey curve -> PublicKey curve hash +toPublic prx alg priv = + let p = pointBaseSmul prx (secretScalar prx alg priv) in pointPublic prx p -secretScalar :: EllipticCurveEdDSA curve - => proxy curve -> SecretKey curve -> Scalar curve -secretScalar prx priv = fst (scheduleSecret prx priv) +secretScalar :: ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + ) + => proxy curve -> hash -> SecretKey curve -> Scalar curve +secretScalar prx alg priv = fst (scheduleSecret prx alg priv) -- EdDSA signature generation & verification -- | Sign a message using the key pair -sign :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) - => proxy curve -> SecretKey curve -> PublicKey curve -> msg -> Signature curve +sign :: forall proxy curve hash msg . + ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , ByteArrayAccess msg + , HashDigestSize hash ~ CurveDigestSize curve + ) + => proxy curve -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash sign prx priv pub msg = - let (s, prefix) = scheduleSecret prx priv - digR = hashWithDom prx [prefix] msg + let alg = undefined :: hash + (s, prefix) = scheduleSecret prx alg priv + digR = hashWithDom prx alg [prefix] msg r = decodeScalarNoErr prx digR pR = pointBaseSmul prx r bsR = encodePoint prx pR @@ -157,8 +193,12 @@ sign prx priv pub msg = in encodeSignature prx (bsR, pR, sS) -- | Verify a message -verify :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) - => proxy curve -> PublicKey curve -> msg -> Signature curve -> Bool +verify :: ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess msg + ) + => proxy curve -> PublicKey curve hash -> msg -> Signature curve hash -> Bool verify prx pub msg sig = case doVerify of CryptoPassed verified -> verified @@ -171,16 +211,22 @@ verify prx pub msg sig = pR' = pointsSmulVarTime prx sS sK nPub return (pR == pR') -getK :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) - => proxy curve -> PublicKey curve -> Bytes -> msg -> Scalar curve +getK :: forall proxy curve hash msg . + ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess msg + ) + => proxy curve -> PublicKey curve hash -> Bytes -> msg -> Scalar curve getK prx (PublicKey pub) bsR msg = - let digK = hashWithDom prx [bsR, pub] msg + let alg = undefined :: hash + digK = hashWithDom prx alg [bsR, pub] msg in decodeScalarNoErr prx digK encodeSignature :: EllipticCurveEdDSA curve => proxy curve -> (Bytes, Point curve, Scalar curve) - -> Signature curve + -> Signature curve hash encodeSignature prx (bsR, _, sS) = Signature $ if len0 > 0 then B.concat [ bsR, bsS, pad0 ] else B.append bsR bsS where @@ -188,9 +234,11 @@ encodeSignature prx (bsR, _, sS) = Signature $ len0 = signatureSize prx - B.length bsR - B.length bsS pad0 = B.zero len0 -decodeSignature :: EllipticCurveEdDSA curve +decodeSignature :: ( EllipticCurveEdDSA curve + , HashDigestSize hash ~ CurveDigestSize curve + ) => proxy curve - -> Signature curve + -> Signature curve hash -> CryptoFailable (Bytes, Point curve, Scalar curve) decodeSignature prx (Signature bs) = do let (bsR, bsS) = B.splitAt (publicKeySize prx) bs @@ -211,22 +259,20 @@ unwrap _ (CryptoPassed x) = x -- Ed25519 implementation instance EllipticCurveEdDSA Curve_Edwards25519 where - publicKeySize _ = 32 + type CurveDigestSize Curve_Edwards25519 = 64 secretKeySize _ = 32 - signatureSize _ = 64 - type HashAlg Curve_Edwards25519 = SHA512 - hashWithDom _ = digestDomMsg SHA512 + hashWithDom _ = digestDomMsg pointPublic _ = PublicKey . Edwards25519.pointEncode publicPoint _ = Edwards25519.pointDecode encodeScalarLE _ = Edwards25519.scalarEncode decodeScalarLE _ = Edwards25519.scalarDecodeLong - scheduleSecret prx priv = + scheduleSecret prx alg priv = (decodeScalarNoErr prx clamped, B.drop 32 hashed) where - hashed = digest SHA512 ($ priv) + hashed = digest alg ($ priv) clamped :: Bytes clamped = B.copyAndFreeze (B.takeView hashed 32) $ \p -> do diff --git a/benchs/Bench.hs b/benchs/Bench.hs index f2a4f2a..5f7dca0 100644 --- a/benchs/Bench.hs +++ b/benchs/Bench.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} module Main where import Gauge.Main @@ -328,25 +329,26 @@ benchECDSA = map doECDSABench curveHashes ] benchEdDSA = - [ bgroup "EdDSA-Ed25519" $ benchGeneric (Just Curve_Edwards25519) - , bgroup "Ed25519" benchEd25519 + [ bgroup "EdDSA-Ed25519" benchGenEd25519 + , bgroup "Ed25519" benchEd25519 ] where - benchGeneric prx = - [ bench "sign" $ perBatchEnv (genEnv prx) (run_gen_sign prx) - , bench "verify" $ perBatchEnv (genEnv prx) (run_gen_verify prx) + benchGen prx alg = + [ bench "sign" $ perBatchEnv (genEnv prx alg) (run_gen_sign prx) + , bench "verify" $ perBatchEnv (genEnv prx alg) (run_gen_verify prx) ] - benchEd25519 = + benchGenEd25519 = benchGen (Just Curve_Edwards25519) SHA512 + benchEd25519 = [ bench "sign" $ perBatchEnv ed25519Env run_ed25519_sign , bench "verify" $ perBatchEnv ed25519Env run_ed25519_verify ] msg = B.empty -- empty message = worst-case scenario showing API overhead - genEnv prx _ = do + genEnv prx alg _ = do sec <- EdDSA.generateSecretKey prx - let pub = EdDSA.toPublic prx sec + let pub = EdDSA.toPublic prx alg sec sig = EdDSA.sign prx sec pub msg return (sec, pub, sig) From 977c72cac94383a454535bb7df448551568bba33 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 8 Feb 2020 15:55:05 +0100 Subject: [PATCH 140/176] Test EdDSA with both SHA-2 and BLAKE2 --- cryptonite.cabal | 1 + tests/KAT_EdDSA.hs | 131 +++++++++++++++++++++++++++++++++++++++++++++ tests/Tests.hs | 2 + 3 files changed, 134 insertions(+) create mode 100644 tests/KAT_EdDSA.hs diff --git a/cryptonite.cabal b/cryptonite.cabal index 119c8ab..245d8c2 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -416,6 +416,7 @@ Test-Suite test-cryptonite KAT_DES KAT_Ed25519 KAT_Ed448 + KAT_EdDSA KAT_CMAC KAT_HKDF KAT_HMAC diff --git a/tests/KAT_EdDSA.hs b/tests/KAT_EdDSA.hs new file mode 100644 index 0000000..b21b5d5 --- /dev/null +++ b/tests/KAT_EdDSA.hs @@ -0,0 +1,131 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +module KAT_EdDSA ( tests ) where + +import Crypto.Error +import Crypto.ECC +import Crypto.Hash.Algorithms +import Crypto.Hash.IO +import qualified Crypto.PubKey.EdDSA as EdDSA +import Imports + +data Vec = forall curve hash . + ( EdDSA.EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ EdDSA.CurveDigestSize curve + ) => Vec + { vecPrx :: Maybe curve + , vecAlg :: hash + , vecSec :: ByteString + , vecPub :: ByteString + , vecMsg :: ByteString + , vecSig :: ByteString + } + +vectors = + [ Vec + { vecPrx = Just Curve_Edwards25519 + , vecAlg = SHA512 + , vecSec = "\x9d\x61\xb1\x9d\xef\xfd\x5a\x60\xba\x84\x4a\xf4\x92\xec\x2c\xc4\x44\x49\xc5\x69\x7b\x32\x69\x19\x70\x3b\xac\x03\x1c\xae\x7f\x60" + , vecPub = "\xd7\x5a\x98\x01\x82\xb1\x0a\xb7\xd5\x4b\xfe\xd3\xc9\x64\x07\x3a\x0e\xe1\x72\xf3\xda\xa6\x23\x25\xaf\x02\x1a\x68\xf7\x07\x51\x1a" + , vecMsg = "" + , vecSig = "\xe5\x56\x43\x00\xc3\x60\xac\x72\x90\x86\xe2\xcc\x80\x6e\x82\x8a\x84\x87\x7f\x1e\xb8\xe5\xd9\x74\xd8\x73\xe0\x65\x22\x49\x01\x55\x5f\xb8\x82\x15\x90\xa3\x3b\xac\xc6\x1e\x39\x70\x1c\xf9\xb4\x6b\xd2\x5b\xf5\xf0\x59\x5b\xbe\x24\x65\x51\x41\x43\x8e\x7a\x10\x0b" + } + , Vec + { vecPrx = Just Curve_Edwards25519 + , vecAlg = SHA512 + , vecSec = "\x4c\xcd\x08\x9b\x28\xff\x96\xda\x9d\xb6\xc3\x46\xec\x11\x4e\x0f\x5b\x8a\x31\x9f\x35\xab\xa6\x24\xda\x8c\xf6\xed\x4f\xb8\xa6\xfb" + , vecPub = "\x3d\x40\x17\xc3\xe8\x43\x89\x5a\x92\xb7\x0a\xa7\x4d\x1b\x7e\xbc\x9c\x98\x2c\xcf\x2e\xc4\x96\x8c\xc0\xcd\x55\xf1\x2a\xf4\x66\x0c" + , vecMsg = "\x72" + , vecSig = "\x92\xa0\x09\xa9\xf0\xd4\xca\xb8\x72\x0e\x82\x0b\x5f\x64\x25\x40\xa2\xb2\x7b\x54\x16\x50\x3f\x8f\xb3\x76\x22\x23\xeb\xdb\x69\xda\x08\x5a\xc1\xe4\x3e\x15\x99\x6e\x45\x8f\x36\x13\xd0\xf1\x1d\x8c\x38\x7b\x2e\xae\xb4\x30\x2a\xee\xb0\x0d\x29\x16\x12\xbb\x0c\x00" + } + , Vec + { vecPrx = Just Curve_Edwards25519 + , vecAlg = SHA512 + , vecSec = "\xc5\xaa\x8d\xf4\x3f\x9f\x83\x7b\xed\xb7\x44\x2f\x31\xdc\xb7\xb1\x66\xd3\x85\x35\x07\x6f\x09\x4b\x85\xce\x3a\x2e\x0b\x44\x58\xf7" + , vecPub = "\xfc\x51\xcd\x8e\x62\x18\xa1\xa3\x8d\xa4\x7e\xd0\x02\x30\xf0\x58\x08\x16\xed\x13\xba\x33\x03\xac\x5d\xeb\x91\x15\x48\x90\x80\x25" + , vecMsg = "\xaf\x82" + , vecSig = "\x62\x91\xd6\x57\xde\xec\x24\x02\x48\x27\xe6\x9c\x3a\xbe\x01\xa3\x0c\xe5\x48\xa2\x84\x74\x3a\x44\x5e\x36\x80\xd7\xdb\x5a\xc3\xac\x18\xff\x9b\x53\x8d\x16\xf2\x90\xae\x67\xf7\x60\x98\x4d\xc6\x59\x4a\x7c\x15\xe9\x71\x6e\xd2\x8d\xc0\x27\xbe\xce\xea\x1e\xc4\x0a" + } + , Vec + { vecPrx = Just Curve_Edwards25519 + , vecAlg = SHA512 + , vecSec = "\xf5\xe5\x76\x7c\xf1\x53\x31\x95\x17\x63\x0f\x22\x68\x76\xb8\x6c\x81\x60\xcc\x58\x3b\xc0\x13\x74\x4c\x6b\xf2\x55\xf5\xcc\x0e\xe5" + , vecPub = "\x27\x81\x17\xfc\x14\x4c\x72\x34\x0f\x67\xd0\xf2\x31\x6e\x83\x86\xce\xff\xbf\x2b\x24\x28\xc9\xc5\x1f\xef\x7c\x59\x7f\x1d\x42\x6e" + , vecMsg = "\x08\xb8\xb2\xb7\x33\x42\x42\x43\x76\x0f\xe4\x26\xa4\xb5\x49\x08\x63\x21\x10\xa6\x6c\x2f\x65\x91\xea\xbd\x33\x45\xe3\xe4\xeb\x98\xfa\x6e\x26\x4b\xf0\x9e\xfe\x12\xee\x50\xf8\xf5\x4e\x9f\x77\xb1\xe3\x55\xf6\xc5\x05\x44\xe2\x3f\xb1\x43\x3d\xdf\x73\xbe\x84\xd8\x79\xde\x7c\x00\x46\xdc\x49\x96\xd9\xe7\x73\xf4\xbc\x9e\xfe\x57\x38\x82\x9a\xdb\x26\xc8\x1b\x37\xc9\x3a\x1b\x27\x0b\x20\x32\x9d\x65\x86\x75\xfc\x6e\xa5\x34\xe0\x81\x0a\x44\x32\x82\x6b\xf5\x8c\x94\x1e\xfb\x65\xd5\x7a\x33\x8b\xbd\x2e\x26\x64\x0f\x89\xff\xbc\x1a\x85\x8e\xfc\xb8\x55\x0e\xe3\xa5\xe1\x99\x8b\xd1\x77\xe9\x3a\x73\x63\xc3\x44\xfe\x6b\x19\x9e\xe5\xd0\x2e\x82\xd5\x22\xc4\xfe\xba\x15\x45\x2f\x80\x28\x8a\x82\x1a\x57\x91\x16\xec\x6d\xad\x2b\x3b\x31\x0d\xa9\x03\x40\x1a\xa6\x21\x00\xab\x5d\x1a\x36\x55\x3e\x06\x20\x3b\x33\x89\x0c\xc9\xb8\x32\xf7\x9e\xf8\x05\x60\xcc\xb9\xa3\x9c\xe7\x67\x96\x7e\xd6\x28\xc6\xad\x57\x3c\xb1\x16\xdb\xef\xef\xd7\x54\x99\xda\x96\xbd\x68\xa8\xa9\x7b\x92\x8a\x8b\xbc\x10\x3b\x66\x21\xfc\xde\x2b\xec\xa1\x23\x1d\x20\x6b\xe6\xcd\x9e\xc7\xaf\xf6\xf6\xc9\x4f\xcd\x72\x04\xed\x34\x55\xc6\x8c\x83\xf4\xa4\x1d\xa4\xaf\x2b\x74\xef\x5c\x53\xf1\xd8\xac\x70\xbd\xcb\x7e\xd1\x85\xce\x81\xbd\x84\x35\x9d\x44\x25\x4d\x95\x62\x9e\x98\x55\xa9\x4a\x7c\x19\x58\xd1\xf8\xad\xa5\xd0\x53\x2e\xd8\xa5\xaa\x3f\xb2\xd1\x7b\xa7\x0e\xb6\x24\x8e\x59\x4e\x1a\x22\x97\xac\xbb\xb3\x9d\x50\x2f\x1a\x8c\x6e\xb6\xf1\xce\x22\xb3\xde\x1a\x1f\x40\xcc\x24\x55\x41\x19\xa8\x31\xa9\xaa\xd6\x07\x9c\xad\x88\x42\x5d\xe6\xbd\xe1\xa9\x18\x7e\xbb\x60\x92\xcf\x67\xbf\x2b\x13\xfd\x65\xf2\x70\x88\xd7\x8b\x7e\x88\x3c\x87\x59\xd2\xc4\xf5\xc6\x5a\xdb\x75\x53\x87\x8a\xd5\x75\xf9\xfa\xd8\x78\xe8\x0a\x0c\x9b\xa6\x3b\xcb\xcc\x27\x32\xe6\x94\x85\xbb\xc9\xc9\x0b\xfb\xd6\x24\x81\xd9\x08\x9b\xec\xcf\x80\xcf\xe2\xdf\x16\xa2\xcf\x65\xbd\x92\xdd\x59\x7b\x07\x07\xe0\x91\x7a\xf4\x8b\xbb\x75\xfe\xd4\x13\xd2\x38\xf5\x55\x5a\x7a\x56\x9d\x80\xc3\x41\x4a\x8d\x08\x59\xdc\x65\xa4\x61\x28\xba\xb2\x7a\xf8\x7a\x71\x31\x4f\x31\x8c\x78\x2b\x23\xeb\xfe\x80\x8b\x82\xb0\xce\x26\x40\x1d\x2e\x22\xf0\x4d\x83\xd1\x25\x5d\xc5\x1a\xdd\xd3\xb7\x5a\x2b\x1a\xe0\x78\x45\x04\xdf\x54\x3a\xf8\x96\x9b\xe3\xea\x70\x82\xff\x7f\xc9\x88\x8c\x14\x4d\xa2\xaf\x58\x42\x9e\xc9\x60\x31\xdb\xca\xd3\xda\xd9\xaf\x0d\xcb\xaa\xaf\x26\x8c\xb8\xfc\xff\xea\xd9\x4f\x3c\x7c\xa4\x95\xe0\x56\xa9\xb4\x7a\xcd\xb7\x51\xfb\x73\xe6\x66\xc6\xc6\x55\xad\xe8\x29\x72\x97\xd0\x7a\xd1\xba\x5e\x43\xf1\xbc\xa3\x23\x01\x65\x13\x39\xe2\x29\x04\xcc\x8c\x42\xf5\x8c\x30\xc0\x4a\xaf\xdb\x03\x8d\xda\x08\x47\xdd\x98\x8d\xcd\xa6\xf3\xbf\xd1\x5c\x4b\x4c\x45\x25\x00\x4a\xa0\x6e\xef\xf8\xca\x61\x78\x3a\xac\xec\x57\xfb\x3d\x1f\x92\xb0\xfe\x2f\xd1\xa8\x5f\x67\x24\x51\x7b\x65\xe6\x14\xad\x68\x08\xd6\xf6\xee\x34\xdf\xf7\x31\x0f\xdc\x82\xae\xbf\xd9\x04\xb0\x1e\x1d\xc5\x4b\x29\x27\x09\x4b\x2d\xb6\x8d\x6f\x90\x3b\x68\x40\x1a\xde\xbf\x5a\x7e\x08\xd7\x8f\xf4\xef\x5d\x63\x65\x3a\x65\x04\x0c\xf9\xbf\xd4\xac\xa7\x98\x4a\x74\xd3\x71\x45\x98\x67\x80\xfc\x0b\x16\xac\x45\x16\x49\xde\x61\x88\xa7\xdb\xdf\x19\x1f\x64\xb5\xfc\x5e\x2a\xb4\x7b\x57\xf7\xf7\x27\x6c\xd4\x19\xc1\x7a\x3c\xa8\xe1\xb9\x39\xae\x49\xe4\x88\xac\xba\x6b\x96\x56\x10\xb5\x48\x01\x09\xc8\xb1\x7b\x80\xe1\xb7\xb7\x50\xdf\xc7\x59\x8d\x5d\x50\x11\xfd\x2d\xcc\x56\x00\xa3\x2e\xf5\xb5\x2a\x1e\xcc\x82\x0e\x30\x8a\xa3\x42\x72\x1a\xac\x09\x43\xbf\x66\x86\xb6\x4b\x25\x79\x37\x65\x04\xcc\xc4\x93\xd9\x7e\x6a\xed\x3f\xb0\xf9\xcd\x71\xa4\x3d\xd4\x97\xf0\x1f\x17\xc0\xe2\xcb\x37\x97\xaa\x2a\x2f\x25\x66\x56\x16\x8e\x6c\x49\x6a\xfc\x5f\xb9\x32\x46\xf6\xb1\x11\x63\x98\xa3\x46\xf1\xa6\x41\xf3\xb0\x41\xe9\x89\xf7\x91\x4f\x90\xcc\x2c\x7f\xff\x35\x78\x76\xe5\x06\xb5\x0d\x33\x4b\xa7\x7c\x22\x5b\xc3\x07\xba\x53\x71\x52\xf3\xf1\x61\x0e\x4e\xaf\xe5\x95\xf6\xd9\xd9\x0d\x11\xfa\xa9\x33\xa1\x5e\xf1\x36\x95\x46\x86\x8a\x7f\x3a\x45\xa9\x67\x68\xd4\x0f\xd9\xd0\x34\x12\xc0\x91\xc6\x31\x5c\xf4\xfd\xe7\xcb\x68\x60\x69\x37\x38\x0d\xb2\xea\xaa\x70\x7b\x4c\x41\x85\xc3\x2e\xdd\xcd\xd3\x06\x70\x5e\x4d\xc1\xff\xc8\x72\xee\xee\x47\x5a\x64\xdf\xac\x86\xab\xa4\x1c\x06\x18\x98\x3f\x87\x41\xc5\xef\x68\xd3\xa1\x01\xe8\xa3\xb8\xca\xc6\x0c\x90\x5c\x15\xfc\x91\x08\x40\xb9\x4c\x00\xa0\xb9\xd0" + , vecSig = "\x0a\xab\x4c\x90\x05\x01\xb3\xe2\x4d\x7c\xdf\x46\x63\x32\x6a\x3a\x87\xdf\x5e\x48\x43\xb2\xcb\xdb\x67\xcb\xf6\xe4\x60\xfe\xc3\x50\xaa\x53\x71\xb1\x50\x8f\x9f\x45\x28\xec\xea\x23\xc4\x36\xd9\x4b\x5e\x8f\xcd\x4f\x68\x1e\x30\xa6\xac\x00\xa9\x70\x4a\x18\x8a\x03" + } + , Vec + { vecPrx = Just Curve_Edwards25519 + , vecAlg = SHA512 + , vecSec = "\x83\x3f\xe6\x24\x09\x23\x7b\x9d\x62\xec\x77\x58\x75\x20\x91\x1e\x9a\x75\x9c\xec\x1d\x19\x75\x5b\x7d\xa9\x01\xb9\x6d\xca\x3d\x42" + , vecPub = "\xec\x17\x2b\x93\xad\x5e\x56\x3b\xf4\x93\x2c\x70\xe1\x24\x50\x34\xc3\x54\x67\xef\x2e\xfd\x4d\x64\xeb\xf8\x19\x68\x34\x67\xe2\xbf" + , vecMsg = "\xdd\xaf\x35\xa1\x93\x61\x7a\xba\xcc\x41\x73\x49\xae\x20\x41\x31\x12\xe6\xfa\x4e\x89\xa9\x7e\xa2\x0a\x9e\xee\xe6\x4b\x55\xd3\x9a\x21\x92\x99\x2a\x27\x4f\xc1\xa8\x36\xba\x3c\x23\xa3\xfe\xeb\xbd\x45\x4d\x44\x23\x64\x3c\xe8\x0e\x2a\x9a\xc9\x4f\xa5\x4c\xa4\x9f" + , vecSig = "\xdc\x2a\x44\x59\xe7\x36\x96\x33\xa5\x2b\x1b\xf2\x77\x83\x9a\x00\x20\x10\x09\xa3\xef\xbf\x3e\xcb\x69\xbe\xa2\x18\x6c\x26\xb5\x89\x09\x35\x1f\xc9\xac\x90\xb3\xec\xfd\xfb\xc7\xc6\x64\x31\xe0\x30\x3d\xca\x17\x9c\x13\x8a\xc1\x7a\xd9\xbe\xf1\x17\x73\x31\xa7\x04" + } + , Vec + { vecPrx = Just Curve_Edwards25519 + , vecAlg = Blake2b_512 + , vecSec = "\x9d\x61\xb1\x9d\xef\xfd\x5a\x60\xba\x84\x4a\xf4\x92\xec\x2c\xc4\x44\x49\xc5\x69\x7b\x32\x69\x19\x70\x3b\xac\x03\x1c\xae\x7f\x60" + , vecPub = "\x78\xe6\x5b\xf3\x0f\x89\x3d\x32\xfc\x57\xef\x05\x1c\x34\x1b\xde\xde\x24\x25\x44\xfc\x2a\x21\x12\xf0\xfa\x2c\x7a\xfd\xeb\xc0\x2f" + , vecMsg = "" + , vecSig = "\x99\xa5\x23\xbd\x46\x16\xc8\x16\x11\x44\xd6\xa9\x9d\x3c\x32\x40\x0c\xb4\xa3\x26\xf4\xd7\x9e\x30\x73\x40\xf6\xaf\xa1\x17\x50\xa0\x08\x5d\x7d\x84\x62\x6b\xc9\xe4\xb1\x53\xfc\x0e\x39\x6d\x15\xce\x44\xc3\x9b\xae\x45\x33\x80\x4d\xb1\xfe\x5b\x52\xf2\xb1\xb8\x05" + } + , Vec + { vecPrx = Just Curve_Edwards25519 + , vecAlg = Blake2b_512 + , vecSec = "\x4c\xcd\x08\x9b\x28\xff\x96\xda\x9d\xb6\xc3\x46\xec\x11\x4e\x0f\x5b\x8a\x31\x9f\x35\xab\xa6\x24\xda\x8c\xf6\xed\x4f\xb8\xa6\xfb" + , vecPub = "\x5e\x71\x39\x2d\x91\xe6\xa5\x8f\xed\xeb\x08\x50\x36\x4f\x56\xcd\x15\x8a\x60\x44\x75\x57\xd7\x89\x03\x89\xc9\xb3\xd4\x57\x6d\x4d" + , vecMsg = "\x72" + , vecSig = "\x6d\xa7\x5e\x15\xb5\x70\x7f\x4d\xe5\xa1\x53\xc4\x8a\x5d\x83\x9f\xb8\x50\x74\xc3\x8a\xeb\x62\x85\x97\x7f\x03\xa1\x39\x77\x59\x7f\x97\x60\x69\xfd\xb9\x03\xf1\x83\x47\x4a\xaa\x5e\xd0\xcf\xe8\x78\xba\x8e\xf8\x68\xc5\xe4\x7c\xa3\xf9\x6c\xcf\xb3\xa8\x9b\x2a\x06" + } + , Vec + { vecPrx = Just Curve_Edwards25519 + , vecAlg = Blake2b_512 + , vecSec = "\xc5\xaa\x8d\xf4\x3f\x9f\x83\x7b\xed\xb7\x44\x2f\x31\xdc\xb7\xb1\x66\xd3\x85\x35\x07\x6f\x09\x4b\x85\xce\x3a\x2e\x0b\x44\x58\xf7" + , vecPub = "\x8d\x53\xca\x70\xf0\xea\xb2\x3b\x91\x78\x34\x57\x85\xfc\xdb\x69\xed\x67\x23\xf8\x14\x8f\x7e\x33\x9e\x88\x65\x37\x00\xb7\x18\xda" + , vecMsg = "\xaf\x82" + , vecSig = "\x7c\xc3\xc1\x38\x52\xbd\x12\xab\xf3\xce\x4c\xa8\xca\x28\x36\xcb\xf8\x6d\xa9\x6c\x46\x34\xc5\x0d\xf3\xfb\x80\xdc\x80\x9e\x29\xdb\x0e\x10\x9c\x36\x13\x53\x40\x7c\x12\x36\xa9\x04\xf6\x36\x86\x8a\xa3\x39\x77\xa9\x9d\x3f\x84\x45\x98\xdb\x15\x38\xb4\x29\x52\x03" + } + , Vec + { vecPrx = Just Curve_Edwards25519 + , vecAlg = Blake2b_512 + , vecSec = "\xf5\xe5\x76\x7c\xf1\x53\x31\x95\x17\x63\x0f\x22\x68\x76\xb8\x6c\x81\x60\xcc\x58\x3b\xc0\x13\x74\x4c\x6b\xf2\x55\xf5\xcc\x0e\xe5" + , vecPub = "\x9e\x3c\xa4\x9b\xb2\xd9\xe3\x6b\x8f\x0c\x94\x4a\x7b\x1c\x29\x26\x45\xda\x87\xce\x6f\xa6\xb4\x28\x86\xe5\xd7\xc8\x68\x33\xa7\x14" + , vecMsg = "\x08\xb8\xb2\xb7\x33\x42\x42\x43\x76\x0f\xe4\x26\xa4\xb5\x49\x08\x63\x21\x10\xa6\x6c\x2f\x65\x91\xea\xbd\x33\x45\xe3\xe4\xeb\x98\xfa\x6e\x26\x4b\xf0\x9e\xfe\x12\xee\x50\xf8\xf5\x4e\x9f\x77\xb1\xe3\x55\xf6\xc5\x05\x44\xe2\x3f\xb1\x43\x3d\xdf\x73\xbe\x84\xd8\x79\xde\x7c\x00\x46\xdc\x49\x96\xd9\xe7\x73\xf4\xbc\x9e\xfe\x57\x38\x82\x9a\xdb\x26\xc8\x1b\x37\xc9\x3a\x1b\x27\x0b\x20\x32\x9d\x65\x86\x75\xfc\x6e\xa5\x34\xe0\x81\x0a\x44\x32\x82\x6b\xf5\x8c\x94\x1e\xfb\x65\xd5\x7a\x33\x8b\xbd\x2e\x26\x64\x0f\x89\xff\xbc\x1a\x85\x8e\xfc\xb8\x55\x0e\xe3\xa5\xe1\x99\x8b\xd1\x77\xe9\x3a\x73\x63\xc3\x44\xfe\x6b\x19\x9e\xe5\xd0\x2e\x82\xd5\x22\xc4\xfe\xba\x15\x45\x2f\x80\x28\x8a\x82\x1a\x57\x91\x16\xec\x6d\xad\x2b\x3b\x31\x0d\xa9\x03\x40\x1a\xa6\x21\x00\xab\x5d\x1a\x36\x55\x3e\x06\x20\x3b\x33\x89\x0c\xc9\xb8\x32\xf7\x9e\xf8\x05\x60\xcc\xb9\xa3\x9c\xe7\x67\x96\x7e\xd6\x28\xc6\xad\x57\x3c\xb1\x16\xdb\xef\xef\xd7\x54\x99\xda\x96\xbd\x68\xa8\xa9\x7b\x92\x8a\x8b\xbc\x10\x3b\x66\x21\xfc\xde\x2b\xec\xa1\x23\x1d\x20\x6b\xe6\xcd\x9e\xc7\xaf\xf6\xf6\xc9\x4f\xcd\x72\x04\xed\x34\x55\xc6\x8c\x83\xf4\xa4\x1d\xa4\xaf\x2b\x74\xef\x5c\x53\xf1\xd8\xac\x70\xbd\xcb\x7e\xd1\x85\xce\x81\xbd\x84\x35\x9d\x44\x25\x4d\x95\x62\x9e\x98\x55\xa9\x4a\x7c\x19\x58\xd1\xf8\xad\xa5\xd0\x53\x2e\xd8\xa5\xaa\x3f\xb2\xd1\x7b\xa7\x0e\xb6\x24\x8e\x59\x4e\x1a\x22\x97\xac\xbb\xb3\x9d\x50\x2f\x1a\x8c\x6e\xb6\xf1\xce\x22\xb3\xde\x1a\x1f\x40\xcc\x24\x55\x41\x19\xa8\x31\xa9\xaa\xd6\x07\x9c\xad\x88\x42\x5d\xe6\xbd\xe1\xa9\x18\x7e\xbb\x60\x92\xcf\x67\xbf\x2b\x13\xfd\x65\xf2\x70\x88\xd7\x8b\x7e\x88\x3c\x87\x59\xd2\xc4\xf5\xc6\x5a\xdb\x75\x53\x87\x8a\xd5\x75\xf9\xfa\xd8\x78\xe8\x0a\x0c\x9b\xa6\x3b\xcb\xcc\x27\x32\xe6\x94\x85\xbb\xc9\xc9\x0b\xfb\xd6\x24\x81\xd9\x08\x9b\xec\xcf\x80\xcf\xe2\xdf\x16\xa2\xcf\x65\xbd\x92\xdd\x59\x7b\x07\x07\xe0\x91\x7a\xf4\x8b\xbb\x75\xfe\xd4\x13\xd2\x38\xf5\x55\x5a\x7a\x56\x9d\x80\xc3\x41\x4a\x8d\x08\x59\xdc\x65\xa4\x61\x28\xba\xb2\x7a\xf8\x7a\x71\x31\x4f\x31\x8c\x78\x2b\x23\xeb\xfe\x80\x8b\x82\xb0\xce\x26\x40\x1d\x2e\x22\xf0\x4d\x83\xd1\x25\x5d\xc5\x1a\xdd\xd3\xb7\x5a\x2b\x1a\xe0\x78\x45\x04\xdf\x54\x3a\xf8\x96\x9b\xe3\xea\x70\x82\xff\x7f\xc9\x88\x8c\x14\x4d\xa2\xaf\x58\x42\x9e\xc9\x60\x31\xdb\xca\xd3\xda\xd9\xaf\x0d\xcb\xaa\xaf\x26\x8c\xb8\xfc\xff\xea\xd9\x4f\x3c\x7c\xa4\x95\xe0\x56\xa9\xb4\x7a\xcd\xb7\x51\xfb\x73\xe6\x66\xc6\xc6\x55\xad\xe8\x29\x72\x97\xd0\x7a\xd1\xba\x5e\x43\xf1\xbc\xa3\x23\x01\x65\x13\x39\xe2\x29\x04\xcc\x8c\x42\xf5\x8c\x30\xc0\x4a\xaf\xdb\x03\x8d\xda\x08\x47\xdd\x98\x8d\xcd\xa6\xf3\xbf\xd1\x5c\x4b\x4c\x45\x25\x00\x4a\xa0\x6e\xef\xf8\xca\x61\x78\x3a\xac\xec\x57\xfb\x3d\x1f\x92\xb0\xfe\x2f\xd1\xa8\x5f\x67\x24\x51\x7b\x65\xe6\x14\xad\x68\x08\xd6\xf6\xee\x34\xdf\xf7\x31\x0f\xdc\x82\xae\xbf\xd9\x04\xb0\x1e\x1d\xc5\x4b\x29\x27\x09\x4b\x2d\xb6\x8d\x6f\x90\x3b\x68\x40\x1a\xde\xbf\x5a\x7e\x08\xd7\x8f\xf4\xef\x5d\x63\x65\x3a\x65\x04\x0c\xf9\xbf\xd4\xac\xa7\x98\x4a\x74\xd3\x71\x45\x98\x67\x80\xfc\x0b\x16\xac\x45\x16\x49\xde\x61\x88\xa7\xdb\xdf\x19\x1f\x64\xb5\xfc\x5e\x2a\xb4\x7b\x57\xf7\xf7\x27\x6c\xd4\x19\xc1\x7a\x3c\xa8\xe1\xb9\x39\xae\x49\xe4\x88\xac\xba\x6b\x96\x56\x10\xb5\x48\x01\x09\xc8\xb1\x7b\x80\xe1\xb7\xb7\x50\xdf\xc7\x59\x8d\x5d\x50\x11\xfd\x2d\xcc\x56\x00\xa3\x2e\xf5\xb5\x2a\x1e\xcc\x82\x0e\x30\x8a\xa3\x42\x72\x1a\xac\x09\x43\xbf\x66\x86\xb6\x4b\x25\x79\x37\x65\x04\xcc\xc4\x93\xd9\x7e\x6a\xed\x3f\xb0\xf9\xcd\x71\xa4\x3d\xd4\x97\xf0\x1f\x17\xc0\xe2\xcb\x37\x97\xaa\x2a\x2f\x25\x66\x56\x16\x8e\x6c\x49\x6a\xfc\x5f\xb9\x32\x46\xf6\xb1\x11\x63\x98\xa3\x46\xf1\xa6\x41\xf3\xb0\x41\xe9\x89\xf7\x91\x4f\x90\xcc\x2c\x7f\xff\x35\x78\x76\xe5\x06\xb5\x0d\x33\x4b\xa7\x7c\x22\x5b\xc3\x07\xba\x53\x71\x52\xf3\xf1\x61\x0e\x4e\xaf\xe5\x95\xf6\xd9\xd9\x0d\x11\xfa\xa9\x33\xa1\x5e\xf1\x36\x95\x46\x86\x8a\x7f\x3a\x45\xa9\x67\x68\xd4\x0f\xd9\xd0\x34\x12\xc0\x91\xc6\x31\x5c\xf4\xfd\xe7\xcb\x68\x60\x69\x37\x38\x0d\xb2\xea\xaa\x70\x7b\x4c\x41\x85\xc3\x2e\xdd\xcd\xd3\x06\x70\x5e\x4d\xc1\xff\xc8\x72\xee\xee\x47\x5a\x64\xdf\xac\x86\xab\xa4\x1c\x06\x18\x98\x3f\x87\x41\xc5\xef\x68\xd3\xa1\x01\xe8\xa3\xb8\xca\xc6\x0c\x90\x5c\x15\xfc\x91\x08\x40\xb9\x4c\x00\xa0\xb9\xd0" + , vecSig = "\xd0\x39\x65\xac\x31\x6a\x20\xf5\xa4\x7a\xb2\xd6\x18\x5e\xb3\xf0\xae\xea\x9c\x2e\xb8\xab\xe9\x22\xe9\x6d\x31\x7b\x3b\xd0\xef\x02\xe8\xd4\x7f\xd9\x23\x84\xe2\x86\x15\xeb\x33\x14\xad\xbc\x71\xc4\x67\x59\x96\x09\x9e\x48\x4c\xeb\x16\x28\x47\xc4\x0c\x32\x44\x0e" + } + ] + + +doPublicKeyTest :: Int -> Vec -> TestTree +doPublicKeyTest i Vec{..} = + testCase (show i) (pub @=? EdDSA.toPublic vecPrx vecAlg sec) + where + !pub = throwCryptoError $ EdDSA.publicKey vecPrx vecAlg vecPub + !sec = throwCryptoError $ EdDSA.secretKey vecPrx vecSec + +doSignatureTest :: Int -> Vec -> TestTree +doSignatureTest i Vec{..} = + testCase (show i) (sig @=? EdDSA.sign vecPrx sec pub vecMsg) + where + !sig = throwCryptoError $ EdDSA.signature vecPrx vecAlg vecSig + !pub = throwCryptoError $ EdDSA.publicKey vecPrx vecAlg vecPub + !sec = throwCryptoError $ EdDSA.secretKey vecPrx vecSec + +doVerifyTest :: Int -> Vec -> TestTree +doVerifyTest i Vec{..} = + testCase (show i) (True @=? EdDSA.verify vecPrx pub vecMsg sig) + where + !sig = throwCryptoError $ EdDSA.signature vecPrx vecAlg vecSig + !pub = throwCryptoError $ EdDSA.publicKey vecPrx vecAlg vecPub + + +tests = testGroup "EdDSA" + [ testGroup "gen publickey" $ zipWith doPublicKeyTest [katZero..] vectors + , testGroup "gen signature" $ zipWith doSignatureTest [katZero..] vectors + , testGroup "verify sig" $ zipWith doVerifyTest [katZero..] vectors + ] diff --git a/tests/Tests.hs b/tests/Tests.hs index f379fc8..b3b0b27 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -29,6 +29,7 @@ import qualified KAT_Curve25519 import qualified KAT_Curve448 import qualified KAT_Ed25519 import qualified KAT_Ed448 +import qualified KAT_EdDSA import qualified KAT_OTP import qualified KAT_PubKey import qualified KAT_Scrypt @@ -67,6 +68,7 @@ tests = testGroup "cryptonite" , KAT_Curve448.tests , KAT_Ed25519.tests , KAT_Ed448.tests + , KAT_EdDSA.tests , KAT_PubKey.tests , KAT_OTP.tests , testGroup "KDF" From ef880291e32cf1fd85416644d927d71975e60fa7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Wed, 8 Nov 2017 11:52:18 +0100 Subject: [PATCH 141/176] Add EdDSA 'ctx' and 'ph' variants --- Crypto/PubKey/EdDSA.hs | 130 +++++++++++++++++++++++++++++++++-------- 1 file changed, 106 insertions(+), 24 deletions(-) diff --git a/Crypto/PubKey/EdDSA.hs b/Crypto/PubKey/EdDSA.hs index eeffa7b..f0fd8ec 100644 --- a/Crypto/PubKey/EdDSA.hs +++ b/Crypto/PubKey/EdDSA.hs @@ -5,7 +5,16 @@ -- Stability : experimental -- Portability : unknown -- --- EdDSA signature generation and verification. +-- EdDSA signature generation and verification, implemented in Haskell and +-- parameterized with elliptic curve and hash algorithm. Only edwards25519 is +-- supported at the moment. +-- +-- The module provides \"context\" and \"prehash\" variants defined in +-- . +-- +-- This implementation is most useful when wanting to customize the hash +-- algorithm. See module "Crypto.PubKey.Ed25519" for faster Ed25519 with +-- SHA-512. -- {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} @@ -30,18 +39,24 @@ module Crypto.PubKey.EdDSA -- * Methods , toPublic , sign + , signCtx + , signPh , verify + , verifyCtx + , verifyPh , generateSecretKey ) where import Data.Bits import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, ScrubbedBytes) import qualified Data.ByteArray as B +import Data.ByteString (ByteString) import Data.Proxy import Crypto.ECC import qualified Crypto.ECC.Edwards25519 as Edwards25519 import Crypto.Error +import Crypto.Hash (Digest) import Crypto.Hash.IO import Crypto.Random @@ -79,9 +94,9 @@ class ( EllipticCurveBasepointArith curve -- | Size of secret keys for this curve (in bytes) secretKeySize :: proxy curve -> Int - -- hash with a given prefix - hashWithDom :: (HashAlgorithm hash, ByteArrayAccess msg) - => proxy curve -> hash -> [Bytes] -> msg -> Bytes + -- hash with specified parameters + hashWithDom :: (HashAlgorithm hash, ByteArrayAccess ctx, ByteArrayAccess msg) + => proxy curve -> hash -> Bool -> ctx -> [Bytes] -> msg -> Bytes -- conversion between scalar, point and public key pointPublic :: proxy curve -> Point curve -> PublicKey curve hash @@ -174,23 +189,13 @@ secretScalar prx alg priv = fst (scheduleSecret prx alg priv) -- EdDSA signature generation & verification -- | Sign a message using the key pair -sign :: forall proxy curve hash msg . - ( EllipticCurveEdDSA curve +sign :: ( EllipticCurveEdDSA curve , HashAlgorithm hash - , ByteArrayAccess msg , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess msg ) => proxy curve -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash -sign prx priv pub msg = - let alg = undefined :: hash - (s, prefix) = scheduleSecret prx alg priv - digR = hashWithDom prx alg [prefix] msg - r = decodeScalarNoErr prx digR - pR = pointBaseSmul prx r - bsR = encodePoint prx pR - sK = getK prx pub bsR msg - sS = scalarAdd prx r (scalarMul prx sK s) - in encodeSignature prx (bsR, pR, sS) +sign prx = signCtx prx emptyCtx -- | Verify a message verify :: ( EllipticCurveEdDSA curve @@ -199,7 +204,73 @@ verify :: ( EllipticCurveEdDSA curve , ByteArrayAccess msg ) => proxy curve -> PublicKey curve hash -> msg -> Signature curve hash -> Bool -verify prx pub msg sig = +verify prx = verifyCtx prx emptyCtx + +-- | Sign a message using the key pair under context @ctx@ +signCtx :: ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess ctx + , ByteArrayAccess msg + ) + => proxy curve -> ctx -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash +signCtx prx = signPhCtx prx False + +-- | Verify a message under context @ctx@ +verifyCtx :: ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess ctx + , ByteArrayAccess msg + ) + => proxy curve -> ctx -> PublicKey curve hash -> msg -> Signature curve hash -> Bool +verifyCtx prx = verifyPhCtx prx False + +-- | Sign a prehashed message using the key pair under context @ctx@ +signPh :: ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess ctx + ) + => proxy curve -> ctx -> SecretKey curve -> PublicKey curve hash -> Digest prehash -> Signature curve hash +signPh prx = signPhCtx prx True + +-- | Verify a prehashed message under context @ctx@ +verifyPh :: ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess ctx + ) + => proxy curve -> ctx -> PublicKey curve hash -> Digest prehash -> Signature curve hash -> Bool +verifyPh prx = verifyPhCtx prx True + +signPhCtx :: forall proxy curve hash ctx msg . + ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess ctx + , ByteArrayAccess msg + ) + => proxy curve -> Bool -> ctx -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash +signPhCtx prx ph ctx priv pub msg = + let alg = undefined :: hash + (s, prefix) = scheduleSecret prx alg priv + digR = hashWithDom prx alg ph ctx [prefix] msg + r = decodeScalarNoErr prx digR + pR = pointBaseSmul prx r + bsR = encodePoint prx pR + sK = getK prx ph ctx pub bsR msg + sS = scalarAdd prx r (scalarMul prx sK s) + in encodeSignature prx (bsR, pR, sS) + +verifyPhCtx :: ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess ctx + , ByteArrayAccess msg + ) + => proxy curve -> Bool -> ctx -> PublicKey curve hash -> msg -> Signature curve hash -> Bool +verifyPhCtx prx ph ctx pub msg sig = case doVerify of CryptoPassed verified -> verified CryptoFailed _ -> False @@ -207,20 +278,24 @@ verify prx pub msg sig = doVerify = do (bsR, pR, sS) <- decodeSignature prx sig nPub <- pointNegate prx `fmap` publicPoint prx pub - let sK = getK prx pub bsR msg + let sK = getK prx ph ctx pub bsR msg pR' = pointsSmulVarTime prx sS sK nPub return (pR == pR') -getK :: forall proxy curve hash msg . +emptyCtx :: Bytes +emptyCtx = B.empty + +getK :: forall proxy curve hash ctx msg . ( EllipticCurveEdDSA curve , HashAlgorithm hash , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess ctx , ByteArrayAccess msg ) - => proxy curve -> PublicKey curve hash -> Bytes -> msg -> Scalar curve -getK prx (PublicKey pub) bsR msg = + => proxy curve -> Bool -> ctx -> PublicKey curve hash -> Bytes -> msg -> Scalar curve +getK prx ph ctx (PublicKey pub) bsR msg = let alg = undefined :: hash - digK = hashWithDom prx alg [bsR, pub] msg + digK = hashWithDom prx alg ph ctx [bsR, pub] msg in decodeScalarNoErr prx digK encodeSignature :: EllipticCurveEdDSA curve @@ -262,7 +337,14 @@ instance EllipticCurveEdDSA Curve_Edwards25519 where type CurveDigestSize Curve_Edwards25519 = 64 secretKeySize _ = 32 - hashWithDom _ = digestDomMsg + hashWithDom _ alg ph ctx bss + | not ph && B.null ctx = digestDomMsg alg bss + | otherwise = digestDomMsg alg (bs:bss) + where bs = B.concat [ "SigEd25519 no Ed25519 collisions" :: ByteString + , B.singleton $ if ph then 1 else 0 + , B.singleton $ fromIntegral $ B.length ctx + , B.convert ctx + ] pointPublic _ = PublicKey . Edwards25519.pointEncode publicPoint _ = Edwards25519.pointDecode From b01f610aa2014f3350a8c1f3e274e261193a17aa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 9 Feb 2020 13:41:37 +0100 Subject: [PATCH 142/176] Add and use Builder module Avoids intermediate allocations and conversions when concatenating byte arrays of different types. --- Crypto/Internal/Builder.hs | 50 ++++++++++++++++++++++++++++++++++++++ Crypto/MAC/KMAC.hs | 38 +++++------------------------ Crypto/PubKey/EdDSA.hs | 35 +++++++++++++------------- cryptonite.cabal | 1 + 4 files changed, 74 insertions(+), 50 deletions(-) create mode 100644 Crypto/Internal/Builder.hs diff --git a/Crypto/Internal/Builder.hs b/Crypto/Internal/Builder.hs new file mode 100644 index 0000000..d33ebfd --- /dev/null +++ b/Crypto/Internal/Builder.hs @@ -0,0 +1,50 @@ +-- | +-- Module : Crypto.Internal.Builder +-- License : BSD-style +-- Maintainer : Olivier Chéron +-- Stability : stable +-- Portability : Good +-- +-- Delaying and merging ByteArray allocations. This is similar to module +-- "Data.ByteArray.Pack" except the total length is computed automatically based +-- on what is appended. +-- +{-# LANGUAGE BangPatterns #-} +module Crypto.Internal.Builder + ( Builder + , buildAndFreeze + , builderLength + , (<+>) + , byte + , bytes + , zero + ) where + +import Data.ByteArray (ByteArray, ByteArrayAccess) +import qualified Data.ByteArray as B +import Data.Memory.PtrMethods (memSet) +import Data.Word (Word8) + +import Foreign.Ptr (Ptr, plusPtr) +import Foreign.Storable (poke) + +data Builder = Builder !Int (Ptr Word8 -> IO ()) -- size and initializer + +(<+>) :: Builder -> Builder -> Builder +(Builder s1 f1) <+> (Builder s2 f2) = Builder (s1 + s2) f + where f p = f1 p >> f2 (p `plusPtr` s1) + +builderLength :: Builder -> Int +builderLength (Builder s _) = s + +buildAndFreeze :: ByteArray ba => Builder -> ba +buildAndFreeze (Builder s f) = B.allocAndFreeze s f + +byte :: Word8 -> Builder +byte !b = Builder 1 (`poke` b) + +bytes :: ByteArrayAccess ba => ba -> Builder +bytes bs = Builder (B.length bs) (B.copyByteArrayToPtr bs) + +zero :: Int -> Builder +zero s = Builder s (\p -> memSet p 0 s) diff --git a/Crypto/MAC/KMAC.hs b/Crypto/MAC/KMAC.hs index f07e9e9..def8b98 100644 --- a/Crypto/MAC/KMAC.hs +++ b/Crypto/MAC/KMAC.hs @@ -27,13 +27,11 @@ import qualified Crypto.Hash as H import Crypto.Hash.SHAKE (HashSHAKE(..)) import Crypto.Hash.Types (HashAlgorithm(..), Digest(..)) import qualified Crypto.Hash.Types as H -import Foreign.Ptr (Ptr, plusPtr) -import Foreign.Storable (poke) +import Crypto.Internal.Builder +import Foreign.Ptr (Ptr) import Data.Bits (shiftR) -import Data.ByteArray (ByteArray, ByteArrayAccess) +import Data.ByteArray (ByteArrayAccess) import qualified Data.ByteArray as B -import Data.Word (Word8) -import Data.Memory.PtrMethods (memSet) -- cSHAKE @@ -48,7 +46,7 @@ cshakeInit n s p = H.Context $ B.allocAndFreeze c $ \(ptr :: Ptr (H.Context a)) c = hashInternalContextSize (undefined :: a) w = hashBlockSize (undefined :: a) x = encodeString n <+> encodeString s - b = builderAllocAndFreeze (bytepad x w) :: B.Bytes + b = buildAndFreeze (bytepad x w) :: B.Bytes cshakeUpdate :: (HashSHAKE a, ByteArrayAccess ba) => H.Context a -> ba -> H.Context a @@ -99,7 +97,7 @@ initialize str key = Context $ cshakeInit n str p where n = B.pack [75,77,65,67] :: B.Bytes -- "KMAC" w = hashBlockSize (undefined :: a) - p = builderAllocAndFreeze (bytepad (encodeString key) w) :: B.ScrubbedBytes + p = buildAndFreeze (bytepad (encodeString key) w) :: B.ScrubbedBytes -- | Incrementally update a KMAC context. update :: (HashSHAKE a, ByteArrayAccess ba) => Context a -> ba -> Context a @@ -114,7 +112,7 @@ finalize :: forall a . HashSHAKE a => Context a -> KMAC a finalize (Context ctx) = KMAC $ cshakeFinalize ctx suffix where l = cshakeOutputLength (undefined :: a) - suffix = builderAllocAndFreeze (rightEncode l) :: B.Bytes + suffix = buildAndFreeze (rightEncode l) :: B.Bytes -- Utilities @@ -143,27 +141,3 @@ rightEncode x = digits <+> byte len i2osp :: Int -> Builder i2osp i | i >= 256 = i2osp (shiftR i 8) <+> byte (fromIntegral i) | otherwise = byte (fromIntegral i) - - --- Delaying and merging ByteArray allocations - -data Builder = Builder !Int (Ptr Word8 -> IO ()) -- size and initializer - -(<+>) :: Builder -> Builder -> Builder -(Builder s1 f1) <+> (Builder s2 f2) = Builder (s1 + s2) f - where f p = f1 p >> f2 (p `plusPtr` s1) - -builderLength :: Builder -> Int -builderLength (Builder s _) = s - -builderAllocAndFreeze :: ByteArray ba => Builder -> ba -builderAllocAndFreeze (Builder s f) = B.allocAndFreeze s f - -byte :: Word8 -> Builder -byte !b = Builder 1 (`poke` b) - -bytes :: ByteArrayAccess ba => ba -> Builder -bytes bs = Builder (B.length bs) (B.copyByteArrayToPtr bs) - -zero :: Int -> Builder -zero s = Builder s (\p -> memSet p 0 s) diff --git a/Crypto/PubKey/EdDSA.hs b/Crypto/PubKey/EdDSA.hs index f0fd8ec..67b733c 100644 --- a/Crypto/PubKey/EdDSA.hs +++ b/Crypto/PubKey/EdDSA.hs @@ -48,7 +48,7 @@ module Crypto.PubKey.EdDSA ) where import Data.Bits -import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, ScrubbedBytes) +import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, ScrubbedBytes, View) import qualified Data.ByteArray as B import Data.ByteString (ByteString) import Data.Proxy @@ -62,6 +62,7 @@ import Crypto.Random import GHC.TypeLits (KnownNat, Nat) +import Crypto.Internal.Builder import Crypto.Internal.Compat import Crypto.Internal.Imports import Crypto.Internal.Nat (integralNatVal) @@ -96,7 +97,7 @@ class ( EllipticCurveBasepointArith curve -- hash with specified parameters hashWithDom :: (HashAlgorithm hash, ByteArrayAccess ctx, ByteArrayAccess msg) - => proxy curve -> hash -> Bool -> ctx -> [Bytes] -> msg -> Bytes + => proxy curve -> hash -> Bool -> ctx -> Builder -> msg -> Bytes -- conversion between scalar, point and public key pointPublic :: proxy curve -> Point curve -> PublicKey curve hash @@ -111,7 +112,7 @@ class ( EllipticCurveBasepointArith curve => proxy curve -> hash -> SecretKey curve - -> (Scalar curve, Bytes) + -> (Scalar curve, View Bytes) -- | Size of public keys for this curve (in bytes) publicKeySize :: EllipticCurveEdDSA curve => proxy curve -> Int @@ -255,7 +256,7 @@ signPhCtx :: forall proxy curve hash ctx msg . signPhCtx prx ph ctx priv pub msg = let alg = undefined :: hash (s, prefix) = scheduleSecret prx alg priv - digR = hashWithDom prx alg ph ctx [prefix] msg + digR = hashWithDom prx alg ph ctx (bytes prefix) msg r = decodeScalarNoErr prx digR pR = pointBaseSmul prx r bsR = encodePoint prx pR @@ -295,19 +296,18 @@ getK :: forall proxy curve hash ctx msg . => proxy curve -> Bool -> ctx -> PublicKey curve hash -> Bytes -> msg -> Scalar curve getK prx ph ctx (PublicKey pub) bsR msg = let alg = undefined :: hash - digK = hashWithDom prx alg ph ctx [bsR, pub] msg + digK = hashWithDom prx alg ph ctx (bytes bsR <+> bytes pub) msg in decodeScalarNoErr prx digK encodeSignature :: EllipticCurveEdDSA curve => proxy curve -> (Bytes, Point curve, Scalar curve) -> Signature curve hash -encodeSignature prx (bsR, _, sS) = Signature $ - if len0 > 0 then B.concat [ bsR, bsS, pad0 ] else B.append bsR bsS +encodeSignature prx (bsR, _, sS) = Signature $ buildAndFreeze $ + bytes bsR <+> bytes bsS <+> zero len0 where - bsS = encodeScalarLE prx sS + bsS = encodeScalarLE prx sS :: Bytes len0 = signatureSize prx - B.length bsR - B.length bsS - pad0 = B.zero len0 decodeSignature :: ( EllipticCurveEdDSA curve , HashDigestSize hash ~ CurveDigestSize curve @@ -339,12 +339,11 @@ instance EllipticCurveEdDSA Curve_Edwards25519 where hashWithDom _ alg ph ctx bss | not ph && B.null ctx = digestDomMsg alg bss - | otherwise = digestDomMsg alg (bs:bss) - where bs = B.concat [ "SigEd25519 no Ed25519 collisions" :: ByteString - , B.singleton $ if ph then 1 else 0 - , B.singleton $ fromIntegral $ B.length ctx - , B.convert ctx - ] + | otherwise = digestDomMsg alg (dom <+> bss) + where dom = bytes ("SigEd25519 no Ed25519 collisions" :: ByteString) <+> + byte (if ph then 1 else 0) <+> + byte (fromIntegral $ B.length ctx) <+> + bytes ctx pointPublic _ = PublicKey . Edwards25519.pointEncode publicPoint _ = Edwards25519.pointDecode @@ -352,7 +351,7 @@ instance EllipticCurveEdDSA Curve_Edwards25519 where decodeScalarLE _ = Edwards25519.scalarDecodeLong scheduleSecret prx alg priv = - (decodeScalarNoErr prx clamped, B.drop 32 hashed) + (decodeScalarNoErr prx clamped, B.dropView hashed 32) where hashed = digest alg ($ priv) @@ -377,9 +376,9 @@ instance EllipticCurveEdDSA Curve_Edwards25519 where -} digestDomMsg :: (HashAlgorithm alg, ByteArrayAccess msg) - => alg -> [Bytes] -> msg -> Bytes + => alg -> Builder -> msg -> Bytes digestDomMsg alg bss bs = digest alg $ \update -> - update (B.concat bss :: Bytes) >> update bs + update (buildAndFreeze bss :: Bytes) >> update bs digest :: HashAlgorithm alg => alg diff --git a/cryptonite.cabal b/cryptonite.cabal index 245d8c2..619c0f3 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -230,6 +230,7 @@ Library Crypto.PubKey.ElGamal Crypto.ECC.Simple.Types Crypto.ECC.Simple.Prim + Crypto.Internal.Builder Crypto.Internal.ByteArray Crypto.Internal.Compat Crypto.Internal.CompatPrim From 2e0a60f7f737eab2ab8113bdb011bf37aac2deab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 23 Feb 2020 09:02:10 +0100 Subject: [PATCH 143/176] Use Semigroup API --- Crypto/Internal/Builder.hs | 10 +++++----- Crypto/Internal/Imports.hs | 4 ++++ Crypto/MAC/KMAC.hs | 15 ++++++++------- Crypto/PubKey/EdDSA.hs | 12 ++++++------ 4 files changed, 23 insertions(+), 18 deletions(-) diff --git a/Crypto/Internal/Builder.hs b/Crypto/Internal/Builder.hs index d33ebfd..fd5b920 100644 --- a/Crypto/Internal/Builder.hs +++ b/Crypto/Internal/Builder.hs @@ -14,7 +14,6 @@ module Crypto.Internal.Builder ( Builder , buildAndFreeze , builderLength - , (<+>) , byte , bytes , zero @@ -23,16 +22,17 @@ module Crypto.Internal.Builder import Data.ByteArray (ByteArray, ByteArrayAccess) import qualified Data.ByteArray as B import Data.Memory.PtrMethods (memSet) -import Data.Word (Word8) import Foreign.Ptr (Ptr, plusPtr) import Foreign.Storable (poke) +import Crypto.Internal.Imports + data Builder = Builder !Int (Ptr Word8 -> IO ()) -- size and initializer -(<+>) :: Builder -> Builder -> Builder -(Builder s1 f1) <+> (Builder s2 f2) = Builder (s1 + s2) f - where f p = f1 p >> f2 (p `plusPtr` s1) +instance Semigroup Builder where + (Builder s1 f1) <> (Builder s2 f2) = Builder (s1 + s2) f + where f p = f1 p >> f2 (p `plusPtr` s1) builderLength :: Builder -> Int builderLength (Builder s _) = s diff --git a/Crypto/Internal/Imports.hs b/Crypto/Internal/Imports.hs index 4ed44e1..6d551e9 100644 --- a/Crypto/Internal/Imports.hs +++ b/Crypto/Internal/Imports.hs @@ -5,11 +5,15 @@ -- Stability : experimental -- Portability : unknown -- +{-# LANGUAGE CPP #-} module Crypto.Internal.Imports ( module X ) where import Data.Word as X +#if !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup as X (Semigroup(..)) +#endif import Control.Applicative as X import Control.Monad as X (forM, forM_, void) import Control.Arrow as X (first, second) diff --git a/Crypto/MAC/KMAC.hs b/Crypto/MAC/KMAC.hs index def8b98..b7ad88e 100644 --- a/Crypto/MAC/KMAC.hs +++ b/Crypto/MAC/KMAC.hs @@ -28,6 +28,7 @@ import Crypto.Hash.SHAKE (HashSHAKE(..)) import Crypto.Hash.Types (HashAlgorithm(..), Digest(..)) import qualified Crypto.Hash.Types as H import Crypto.Internal.Builder +import Crypto.Internal.Imports import Foreign.Ptr (Ptr) import Data.Bits (shiftR) import Data.ByteArray (ByteArrayAccess) @@ -45,7 +46,7 @@ cshakeInit n s p = H.Context $ B.allocAndFreeze c $ \(ptr :: Ptr (H.Context a)) where c = hashInternalContextSize (undefined :: a) w = hashBlockSize (undefined :: a) - x = encodeString n <+> encodeString s + x = encodeString n <> encodeString s b = buildAndFreeze (bytepad x w) :: B.Bytes cshakeUpdate :: (HashSHAKE a, ByteArrayAccess ba) @@ -75,7 +76,7 @@ cshakeFinalize !c s = -- The Eq instance is constant time. No Show instance is provided, to avoid -- printing by mistake. newtype KMAC a = KMAC { kmacGetDigest :: Digest a } - deriving ByteArrayAccess + deriving (ByteArrayAccess,NFData) instance Eq (KMAC a) where (KMAC b1) == (KMAC b2) = B.constEq b1 b2 @@ -118,26 +119,26 @@ finalize (Context ctx) = KMAC $ cshakeFinalize ctx suffix -- Utilities bytepad :: Builder -> Int -> Builder -bytepad x w = prefix <+> x <+> zero padLen +bytepad x w = prefix <> x <> zero padLen where prefix = leftEncode w padLen = (w - builderLength prefix - builderLength x) `mod` w encodeString :: ByteArrayAccess bin => bin -> Builder -encodeString s = leftEncode (8 * B.length s) <+> bytes s +encodeString s = leftEncode (8 * B.length s) <> bytes s leftEncode :: Int -> Builder -leftEncode x = byte len <+> digits +leftEncode x = byte len <> digits where digits = i2osp x len = fromIntegral (builderLength digits) rightEncode :: Int -> Builder -rightEncode x = digits <+> byte len +rightEncode x = digits <> byte len where digits = i2osp x len = fromIntegral (builderLength digits) i2osp :: Int -> Builder -i2osp i | i >= 256 = i2osp (shiftR i 8) <+> byte (fromIntegral i) +i2osp i | i >= 256 = i2osp (shiftR i 8) <> byte (fromIntegral i) | otherwise = byte (fromIntegral i) diff --git a/Crypto/PubKey/EdDSA.hs b/Crypto/PubKey/EdDSA.hs index 67b733c..95fa7fd 100644 --- a/Crypto/PubKey/EdDSA.hs +++ b/Crypto/PubKey/EdDSA.hs @@ -296,7 +296,7 @@ getK :: forall proxy curve hash ctx msg . => proxy curve -> Bool -> ctx -> PublicKey curve hash -> Bytes -> msg -> Scalar curve getK prx ph ctx (PublicKey pub) bsR msg = let alg = undefined :: hash - digK = hashWithDom prx alg ph ctx (bytes bsR <+> bytes pub) msg + digK = hashWithDom prx alg ph ctx (bytes bsR <> bytes pub) msg in decodeScalarNoErr prx digK encodeSignature :: EllipticCurveEdDSA curve @@ -304,7 +304,7 @@ encodeSignature :: EllipticCurveEdDSA curve -> (Bytes, Point curve, Scalar curve) -> Signature curve hash encodeSignature prx (bsR, _, sS) = Signature $ buildAndFreeze $ - bytes bsR <+> bytes bsS <+> zero len0 + bytes bsR <> bytes bsS <> zero len0 where bsS = encodeScalarLE prx sS :: Bytes len0 = signatureSize prx - B.length bsR - B.length bsS @@ -339,10 +339,10 @@ instance EllipticCurveEdDSA Curve_Edwards25519 where hashWithDom _ alg ph ctx bss | not ph && B.null ctx = digestDomMsg alg bss - | otherwise = digestDomMsg alg (dom <+> bss) - where dom = bytes ("SigEd25519 no Ed25519 collisions" :: ByteString) <+> - byte (if ph then 1 else 0) <+> - byte (fromIntegral $ B.length ctx) <+> + | otherwise = digestDomMsg alg (dom <> bss) + where dom = bytes ("SigEd25519 no Ed25519 collisions" :: ByteString) <> + byte (if ph then 1 else 0) <> + byte (fromIntegral $ B.length ctx) <> bytes ctx pointPublic _ = PublicKey . Edwards25519.pointEncode From 981b97a132a4110aeb5a15f986b1bdf3631c274b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 23 Feb 2020 09:06:00 +0100 Subject: [PATCH 144/176] Protect against negative argument --- Crypto/Internal/Builder.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/Crypto/Internal/Builder.hs b/Crypto/Internal/Builder.hs index fd5b920..bc072e3 100644 --- a/Crypto/Internal/Builder.hs +++ b/Crypto/Internal/Builder.hs @@ -26,7 +26,7 @@ import Data.Memory.PtrMethods (memSet) import Foreign.Ptr (Ptr, plusPtr) import Foreign.Storable (poke) -import Crypto.Internal.Imports +import Crypto.Internal.Imports hiding (empty) data Builder = Builder !Int (Ptr Word8 -> IO ()) -- size and initializer @@ -47,4 +47,7 @@ bytes :: ByteArrayAccess ba => ba -> Builder bytes bs = Builder (B.length bs) (B.copyByteArrayToPtr bs) zero :: Int -> Builder -zero s = Builder s (\p -> memSet p 0 s) +zero s = if s > 0 then Builder s (\p -> memSet p 0 s) else empty + +empty :: Builder +empty = Builder 0 (const $ return ()) From e56308f9d0a98eec38e1bffcaf353c2fb338bca4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 8 Mar 2020 18:33:37 +0100 Subject: [PATCH 145/176] Fix ignored allow_failures and weeder build in Travis CI Used haskell-ci commit cbf9d90 from PR vincenthz/haskell-ci#5 to regenerate the files. --- .appveyor.yml | 2 +- .haskell-ci | 2 +- .travis.yml | 44 ++++++++++++++++++++++---------------------- stack.yaml | 2 +- 4 files changed, 25 insertions(+), 25 deletions(-) diff --git a/.appveyor.yml b/.appveyor.yml index 5d4d90f..171240e 100644 --- a/.appveyor.yml +++ b/.appveyor.yml @@ -1,4 +1,4 @@ -# ~*~ auto-generated by haskell-ci with config : df7ce7fce63ae2c16030178e7df265c57b9650106ac97ee31118dbf14ddbd2ba ~*~ +# ~*~ auto-generated by haskell-ci with config : 4fdddfa41dd039e198b8d125a70471f7dd140fa01001d99126af56fb31429ece ~*~ version: "{build}" clone_folder: C:\project diff --git a/.haskell-ci b/.haskell-ci index b3ddbda..9abc447 100644 --- a/.haskell-ci +++ b/.haskell-ci @@ -11,8 +11,8 @@ option: gaugedeps extradep=gauge-0.2.1 option: basementmin extradep=basement-0.0.8 extradep=memory-0.14.18 # builds -build: ghc-8.2 basementmin build: ghc-8.0 basementmin gaugedeps +build: ghc-8.2 basementmin build: ghc-8.4 build: ghc-8.6 os=linux,osx,windows build: ghc-8.8 os=linux,windows diff --git a/.travis.yml b/.travis.yml index 1f24739..af9c053 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,7 +1,4 @@ -# ~*~ auto-generated by haskell-ci with config : df7ce7fce63ae2c16030178e7df265c57b9650106ac97ee31118dbf14ddbd2ba ~*~ - -# Use new container infrastructure to enable caching -sudo: false +# ~*~ auto-generated by haskell-ci with config : 4fdddfa41dd039e198b8d125a70471f7dd140fa01001d99126af56fb31429ece ~*~ # Caching so the next build will be fast too. cache: @@ -10,29 +7,32 @@ cache: - $HOME/.stack - $HOME/.local -matrix: +language: generic +os: linux + +jobs: include: - - { env: BUILD=stack RESOLVER=ghc-8.2, compiler: ghc-8.2, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } - - { env: BUILD=stack RESOLVER=ghc-8.0, compiler: ghc-8.0, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } - - { env: BUILD=stack RESOLVER=ghc-8.4, compiler: ghc-8.4, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } - - { env: BUILD=stack RESOLVER=ghc-8.6, compiler: ghc-8.6, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } - - { env: BUILD=stack RESOLVER=ghc-8.6, compiler: ghc-8.6, language: generic, addons: { apt: { packages: [ libgmp-dev ] } }, os: osx } - - { env: BUILD=stack RESOLVER=ghc-8.8, compiler: ghc-8.8, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } - - { env: BUILD=hlint, compiler: hlint, language: generic } - - { env: BUILD=weeder, compiler: weeder, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } + - { env: BUILD=stack RESOLVER=ghc-8.0, addons: { apt: { packages: [ libgmp-dev ] } } } + - { env: BUILD=stack RESOLVER=ghc-8.2, addons: { apt: { packages: [ libgmp-dev ] } } } + - { env: BUILD=stack RESOLVER=ghc-8.4, addons: { apt: { packages: [ libgmp-dev ] } } } + - { env: BUILD=stack RESOLVER=ghc-8.6, addons: { apt: { packages: [ libgmp-dev ] } } } + - { env: BUILD=stack RESOLVER=ghc-8.6, addons: { apt: { packages: [ libgmp-dev ] } }, os: osx } + - { env: BUILD=stack RESOLVER=ghc-8.8, addons: { apt: { packages: [ libgmp-dev ] } } } + - { env: BUILD=hlint } + - { env: BUILD=weeder, addons: { apt: { packages: [ libgmp-dev ] } } } allow_failures: - - { env: BUILD=hlint, compiler: hlint, language: generic } - - { env: BUILD=weeder, compiler: weeder, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } + - { env: BUILD=hlint } + - { env: BUILD=weeder, addons: { apt: { packages: [ libgmp-dev ] } } } install: - - export PATH=$HOME/.local/bin::$HOME/.cabal/bin:$PATH + - export PATH=$HOME/.local/bin:$HOME/.cabal/bin:$PATH - mkdir -p ~/.local/bin - | case "$BUILD" in stack|weeder) if [ `uname` = "Darwin" ] then - travis_retry curl --insecure -L https://www.stackage.org/stack/osx-x86_64 | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin + travis_retry curl -L https://www.stackage.org/stack/osx-x86_64 | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin else travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' fi @@ -49,14 +49,14 @@ script: stack) # create the build stack.yaml case "$RESOLVER" in - ghc-8.2) - echo "{ resolver: lts-11.22, packages: [ '.' ], extra-deps: [ basement-0.0.8, memory-0.14.18 ], flags: {} }" > stack.yaml - stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps - ;; ghc-8.0) echo "{ resolver: lts-9.21, packages: [ '.' ], extra-deps: [ basement-0.0.8, memory-0.14.18, gauge-0.2.1 ], flags: {} }" > stack.yaml stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; + ghc-8.2) + echo "{ resolver: lts-11.22, packages: [ '.' ], extra-deps: [ basement-0.0.8, memory-0.14.18 ], flags: {} }" > stack.yaml + stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps + ;; ghc-8.4) echo "{ resolver: lts-12.26, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps @@ -75,7 +75,7 @@ script: curl -sL https://raw.github.com/ndmitchell/hlint/master/misc/travis.sh | sh -s . --cpp-define=__GLASGOW_HASKELL__=800 --cpp-define=x86_64_HOST_ARCH=1 --cpp-define=mingw32_HOST_OS=1 ;; weeder) - stack --no-terminal build --install-ghc + stack --no-terminal build --install-ghc --ghc-options="-ddump-to-file -ddump-hi" --test --no-run-tests --bench --no-run-benchmarks curl -sL https://raw.github.com/ndmitchell/weeder/master/misc/travis.sh | sh -s . ;; esac diff --git a/stack.yaml b/stack.yaml index e18363e..0353574 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1,3 @@ -# ~*~ auto-generated by haskell-ci with config : df7ce7fce63ae2c16030178e7df265c57b9650106ac97ee31118dbf14ddbd2ba ~*~ +# ~*~ auto-generated by haskell-ci with config : 4fdddfa41dd039e198b8d125a70471f7dd140fa01001d99126af56fb31429ece ~*~ { resolver: lts-14.27, packages: [ '.' ], extra-deps: [], flags: {} } From b9e1e75a101578fd0774cbfd9fe7aa0b9a56dccb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Wed, 11 Mar 2020 19:15:32 +0100 Subject: [PATCH 146/176] Fix support_sse on i386 architecture On i386 compilation failed with support_sse enabled and support_aesni disabled. This enables the minimum required instruction set, guarded with an architecture condition. --- cryptonite.cabal | 2 ++ 1 file changed, 2 insertions(+) diff --git a/cryptonite.cabal b/cryptonite.cabal index 31bd64f..68cb78f 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -363,6 +363,8 @@ Library if arch(x86_64) || flag(support_sse) CPP-options: -DSUPPORT_SSE + if arch(i386) + CC-options: -msse2 C-sources: cbits/argon2/argon2.c include-dirs: cbits/argon2 From d8a39637f5ee224300c474c3b7986bfe4e88e9bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 14 Mar 2020 07:39:06 +0100 Subject: [PATCH 147/176] Ignore hint "Use camelCase" globally --- .hlint.yaml | 1 + 1 file changed, 1 insertion(+) create mode 100644 .hlint.yaml diff --git a/.hlint.yaml b/.hlint.yaml new file mode 100644 index 0000000..343a26c --- /dev/null +++ b/.hlint.yaml @@ -0,0 +1 @@ +- ignore: { name: Use camelCase } From a1072948ca93ce91ab785221819734446c64bf99 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 14 Mar 2020 08:07:35 +0100 Subject: [PATCH 148/176] Avoid error "Unknown mingw32 arch" with hlint --- .hlint.yaml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.hlint.yaml b/.hlint.yaml index 343a26c..ca4dcdf 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -1 +1,3 @@ +- arguments: [ --cpp-define=ARCH_X86_64 + ] - ignore: { name: Use camelCase } From dae01d056d433ab9b0aa6dd95bd73655345c4b8d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 6 Mar 2020 06:43:32 +0100 Subject: [PATCH 149/176] AES-NI with per-file target compiler options --- cbits/aes/x86ni.c | 7 +++++++ cryptonite.cabal | 2 +- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/cbits/aes/x86ni.c b/cbits/aes/x86ni.c index 590a897..f51b32d 100644 --- a/cbits/aes/x86ni.c +++ b/cbits/aes/x86ni.c @@ -30,6 +30,10 @@ #ifdef WITH_AESNI +#pragma GCC push_options +#pragma GCC target("ssse3", "aes") +#pragma clang attribute push (__attribute__((target("ssse3,aes"))), apply_to=function) + #include #include #include @@ -400,4 +404,7 @@ static inline __m128i ghash_add(__m128i tag, const table_4bit htable, __m128i m) #endif +#pragma clang attribute pop +#pragma GCC pop_options + #endif diff --git a/cryptonite.cabal b/cryptonite.cabal index 68cb78f..d0c51db 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -336,7 +336,7 @@ Library c-sources: cbits/cryptonite_rdrand.c if flag(support_aesni) && (os(linux) || os(freebsd) || os(osx)) && (arch(i386) || arch(x86_64)) - CC-options: -mssse3 -maes -DWITH_AESNI + CC-options: -DWITH_AESNI if flag(support_pclmuldq) CC-options: -msse4.1 -mpclmul -DWITH_PCLMUL C-sources: cbits/aes/x86ni.c From f5706959a473a684f2eeab3648e6476e6bc03f0f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Thu, 12 Mar 2020 07:04:55 +0100 Subject: [PATCH 150/176] AES-NI and PCLMUL with per-function target compiler options --- cbits/aes/x86ni.c | 15 ++++++++------- cbits/aes/x86ni.h | 4 ++++ cbits/aes/x86ni_impl.c | 10 ++++++++++ cryptonite.cabal | 2 +- 4 files changed, 23 insertions(+), 8 deletions(-) diff --git a/cbits/aes/x86ni.c b/cbits/aes/x86ni.c index f51b32d..75aae55 100644 --- a/cbits/aes/x86ni.c +++ b/cbits/aes/x86ni.c @@ -30,10 +30,6 @@ #ifdef WITH_AESNI -#pragma GCC push_options -#pragma GCC target("ssse3", "aes") -#pragma clang attribute push (__attribute__((target("ssse3,aes"))), apply_to=function) - #include #include #include @@ -50,6 +46,7 @@ /* old GCC version doesn't cope with the shuffle parameters, that can take 2 values (0xff and 0xaa) * in our case, passed as argument despite being a immediate 8 bits constant anyway. * un-factorise aes_128_key_expansion into 2 version that have the shuffle parameter explicitly set */ +TARGET_AESNI static __m128i aes_128_key_expansion_ff(__m128i key, __m128i keygened) { keygened = _mm_shuffle_epi32(keygened, 0xff); @@ -59,6 +56,7 @@ static __m128i aes_128_key_expansion_ff(__m128i key, __m128i keygened) return _mm_xor_si128(key, keygened); } +TARGET_AESNI static __m128i aes_128_key_expansion_aa(__m128i key, __m128i keygened) { keygened = _mm_shuffle_epi32(keygened, 0xaa); @@ -68,6 +66,7 @@ static __m128i aes_128_key_expansion_aa(__m128i key, __m128i keygened) return _mm_xor_si128(key, keygened); } +TARGET_AESNI void cryptonite_aesni_init(aes_key *key, uint8_t *ikey, uint8_t size) { __m128i k[28]; @@ -149,6 +148,7 @@ void cryptonite_aesni_init(aes_key *key, uint8_t *ikey, uint8_t size) /* TO OPTIMISE: use pcmulqdq... or some faster code. * this is the lamest way of doing it, but i'm out of time. * this is basically a copy of gf_mulx in gf.c */ +TARGET_AESNI static __m128i gfmulx(__m128i v) { uint64_t v_[2] ALIGNMENT(16); @@ -162,6 +162,7 @@ static __m128i gfmulx(__m128i v) return v; } +TARGET_AESNI static __m128i gfmul_generic(__m128i tag, const table_4bit htable) { aes_block _t; @@ -181,6 +182,7 @@ __m128i (*gfmul_branch_ptr)(__m128i a, const table_4bit t) = gfmul_generic; * Adapted from figure 5, with additional byte swapping so that interface * is simimar to cryptonite_aes_generic_gf_mul. */ +TARGET_AESNI_PCLMUL static __m128i gfmul_pclmuldq(__m128i a, const table_4bit htable) { __m128i b, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7, tmp8, tmp9; @@ -244,6 +246,7 @@ void cryptonite_aesni_hinit_pclmul(table_4bit htable, const block128 *h) htable->q[1] = bitfn_swap64(h->q[0]); } +TARGET_AESNI_PCLMUL void cryptonite_aesni_gf_mul_pclmul(block128 *a, const table_4bit htable) { __m128i _a, _b; @@ -261,6 +264,7 @@ void cryptonite_aesni_init_pclmul(void) #define gfmul(a,t) (gfmul_generic(a,t)) #endif +TARGET_AESNI static inline __m128i ghash_add(__m128i tag, const table_4bit htable, __m128i m) { tag = _mm_xor_si128(tag, m); @@ -404,7 +408,4 @@ static inline __m128i ghash_add(__m128i tag, const table_4bit htable, __m128i m) #endif -#pragma clang attribute pop -#pragma GCC pop_options - #endif diff --git a/cbits/aes/x86ni.h b/cbits/aes/x86ni.h index 6ffe74c..c0ffd44 100644 --- a/cbits/aes/x86ni.h +++ b/cbits/aes/x86ni.h @@ -40,7 +40,11 @@ #include #include +#define TARGET_AESNI __attribute__((target("ssse3,aes"))) +#define TARGET_AESNI_PCLMUL __attribute__((target("sse4.1,aes,pclmul"))) + #ifdef IMPL_DEBUG +TARGET_AESNI static void block128_sse_print(__m128i m) { block128 b; diff --git a/cbits/aes/x86ni_impl.c b/cbits/aes/x86ni_impl.c index ba8d762..39b8f31 100644 --- a/cbits/aes/x86ni_impl.c +++ b/cbits/aes/x86ni_impl.c @@ -28,6 +28,7 @@ * SUCH DAMAGE. */ +TARGET_AESNI void SIZED(cryptonite_aesni_encrypt_block)(aes_block *out, aes_key *key, aes_block *in) { __m128i *k = (__m128i *) key->data; @@ -37,6 +38,7 @@ void SIZED(cryptonite_aesni_encrypt_block)(aes_block *out, aes_key *key, aes_blo _mm_storeu_si128((__m128i *) out, m); } +TARGET_AESNI void SIZED(cryptonite_aesni_decrypt_block)(aes_block *out, aes_key *key, aes_block *in) { __m128i *k = (__m128i *) key->data; @@ -46,6 +48,7 @@ void SIZED(cryptonite_aesni_decrypt_block)(aes_block *out, aes_key *key, aes_blo _mm_storeu_si128((__m128i *) out, m); } +TARGET_AESNI void SIZED(cryptonite_aesni_encrypt_ecb)(aes_block *out, aes_key *key, aes_block *in, uint32_t blocks) { __m128i *k = (__m128i *) key->data; @@ -58,6 +61,7 @@ void SIZED(cryptonite_aesni_encrypt_ecb)(aes_block *out, aes_key *key, aes_block } } +TARGET_AESNI void SIZED(cryptonite_aesni_decrypt_ecb)(aes_block *out, aes_key *key, aes_block *in, uint32_t blocks) { __m128i *k = (__m128i *) key->data; @@ -71,6 +75,7 @@ void SIZED(cryptonite_aesni_decrypt_ecb)(aes_block *out, aes_key *key, aes_block } } +TARGET_AESNI void SIZED(cryptonite_aesni_encrypt_cbc)(aes_block *out, aes_key *key, aes_block *_iv, aes_block *in, uint32_t blocks) { __m128i *k = (__m128i *) key->data; @@ -87,6 +92,7 @@ void SIZED(cryptonite_aesni_encrypt_cbc)(aes_block *out, aes_key *key, aes_block } } +TARGET_AESNI void SIZED(cryptonite_aesni_decrypt_cbc)(aes_block *out, aes_key *key, aes_block *_iv, aes_block *in, uint32_t blocks) { __m128i *k = (__m128i *) key->data; @@ -106,6 +112,7 @@ void SIZED(cryptonite_aesni_decrypt_cbc)(aes_block *out, aes_key *key, aes_block } } +TARGET_AESNI void SIZED(cryptonite_aesni_encrypt_ctr)(uint8_t *output, aes_key *key, aes_block *_iv, uint8_t *input, uint32_t len) { __m128i *k = (__m128i *) key->data; @@ -151,6 +158,7 @@ void SIZED(cryptonite_aesni_encrypt_ctr)(uint8_t *output, aes_key *key, aes_bloc return ; } +TARGET_AESNI void SIZED(cryptonite_aesni_encrypt_c32_)(uint8_t *output, aes_key *key, aes_block *_iv, uint8_t *input, uint32_t len) { __m128i *k = (__m128i *) key->data; @@ -192,6 +200,7 @@ void SIZED(cryptonite_aesni_encrypt_c32_)(uint8_t *output, aes_key *key, aes_blo return ; } +TARGET_AESNI void SIZED(cryptonite_aesni_encrypt_xts)(aes_block *out, aes_key *key1, aes_key *key2, aes_block *_tweak, uint32_t spoint, aes_block *in, uint32_t blocks) { @@ -222,6 +231,7 @@ void SIZED(cryptonite_aesni_encrypt_xts)(aes_block *out, aes_key *key1, aes_key } while (0); } +TARGET_AESNI void SIZED(cryptonite_aesni_gcm_encrypt)(uint8_t *output, aes_gcm *gcm, aes_key *key, uint8_t *input, uint32_t length) { __m128i *k = (__m128i *) key->data; diff --git a/cryptonite.cabal b/cryptonite.cabal index d0c51db..d983581 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -338,7 +338,7 @@ Library if flag(support_aesni) && (os(linux) || os(freebsd) || os(osx)) && (arch(i386) || arch(x86_64)) CC-options: -DWITH_AESNI if flag(support_pclmuldq) - CC-options: -msse4.1 -mpclmul -DWITH_PCLMUL + CC-options: -DWITH_PCLMUL C-sources: cbits/aes/x86ni.c , cbits/aes/generic.c , cbits/aes/gf.c From 0cf0d076abc995c410cbd66ea81da2740b1a6700 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 14 Mar 2020 07:50:30 +0100 Subject: [PATCH 151/176] Add flag use_target_attributes --- cbits/aes/x86ni.h | 5 +++++ cryptonite.cabal | 11 +++++++++++ 2 files changed, 16 insertions(+) diff --git a/cbits/aes/x86ni.h b/cbits/aes/x86ni.h index c0ffd44..cd26ce4 100644 --- a/cbits/aes/x86ni.h +++ b/cbits/aes/x86ni.h @@ -40,8 +40,13 @@ #include #include +#ifdef WITH_TARGET_ATTRIBUTES #define TARGET_AESNI __attribute__((target("ssse3,aes"))) #define TARGET_AESNI_PCLMUL __attribute__((target("sse4.1,aes,pclmul"))) +#else +#define TARGET_AESNI +#define TARGET_AESNI_PCLMUL +#endif #ifdef IMPL_DEBUG TARGET_AESNI diff --git a/cryptonite.cabal b/cryptonite.cabal index d983581..2d386b0 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -103,6 +103,11 @@ Flag check_alignment Default: False Manual: True +Flag use_target_attributes + Description: use GCC / clang function attributes instead of global target options. + Default: False + Manual: True + Library Exposed-modules: Crypto.Cipher.AES Crypto.Cipher.AESGCMSIV @@ -337,8 +342,12 @@ Library if flag(support_aesni) && (os(linux) || os(freebsd) || os(osx)) && (arch(i386) || arch(x86_64)) CC-options: -DWITH_AESNI + if !flag(use_target_attributes) + CC-options: -mssse3 -maes if flag(support_pclmuldq) CC-options: -DWITH_PCLMUL + if !flag(use_target_attributes) + CC-options: -msse4.1 -mpclmul C-sources: cbits/aes/x86ni.c , cbits/aes/generic.c , cbits/aes/gf.c @@ -385,6 +394,8 @@ Library Build-depends: deepseq if flag(check_alignment) cc-options: -DWITH_ASSERT_ALIGNMENT + if flag(use_target_attributes) + cc-options: -DWITH_TARGET_ATTRIBUTES Test-Suite test-cryptonite type: exitcode-stdio-1.0 From f84f7e300934ea1d6cf150c50ed9305a8706e55a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 15 Mar 2020 15:39:56 +0100 Subject: [PATCH 152/176] Enable flag by default --- cryptonite.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cryptonite.cabal b/cryptonite.cabal index 2d386b0..652e595 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -105,7 +105,7 @@ Flag check_alignment Flag use_target_attributes Description: use GCC / clang function attributes instead of global target options. - Default: False + Default: True Manual: True Library From 775855994cb5d0b5fcaa1dd04500f98f054c1ee9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 15 Mar 2020 15:44:35 +0100 Subject: [PATCH 153/176] Use notElem --- Crypto/Cipher/ChaCha.hs | 6 +++--- Crypto/Cipher/Salsa.hs | 6 +++--- Crypto/Cipher/XSalsa.hs | 2 +- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/Crypto/Cipher/ChaCha.hs b/Crypto/Cipher/ChaCha.hs index 4dd70ad..8d9c638 100644 --- a/Crypto/Cipher/ChaCha.hs +++ b/Crypto/Cipher/ChaCha.hs @@ -41,9 +41,9 @@ initialize :: (ByteArrayAccess key, ByteArrayAccess nonce) -> nonce -- ^ the nonce (64 or 96 bits) -> State -- ^ the initial ChaCha state initialize nbRounds key nonce - | not (kLen `elem` [16,32]) = error "ChaCha: key length should be 128 or 256 bits" - | not (nonceLen `elem` [8,12]) = error "ChaCha: nonce length should be 64 or 96 bits" - | not (nbRounds `elem` [8,12,20]) = error "ChaCha: rounds should be 8, 12 or 20" + | kLen `notElem` [16,32] = error "ChaCha: key length should be 128 or 256 bits" + | nonceLen `notElem` [8,12] = error "ChaCha: nonce length should be 64 or 96 bits" + | nbRounds `notElem` [8,12,20] = error "ChaCha: rounds should be 8, 12 or 20" | otherwise = unsafeDoIO $ do stPtr <- B.alloc 132 $ \stPtr -> B.withByteArray nonce $ \noncePtr -> diff --git a/Crypto/Cipher/Salsa.hs b/Crypto/Cipher/Salsa.hs index 7d05e6c..34cd7b7 100644 --- a/Crypto/Cipher/Salsa.hs +++ b/Crypto/Cipher/Salsa.hs @@ -33,9 +33,9 @@ initialize :: (ByteArrayAccess key, ByteArrayAccess nonce) -> nonce -- ^ the nonce (64 or 96 bits) -> State -- ^ the initial Salsa state initialize nbRounds key nonce - | not (kLen `elem` [16,32]) = error "Salsa: key length should be 128 or 256 bits" - | not (nonceLen `elem` [8,12]) = error "Salsa: nonce length should be 64 or 96 bits" - | not (nbRounds `elem` [8,12,20]) = error "Salsa: rounds should be 8, 12 or 20" + | kLen `notElem` [16,32] = error "Salsa: key length should be 128 or 256 bits" + | nonceLen `notElem` [8,12] = error "Salsa: nonce length should be 64 or 96 bits" + | nbRounds `notElem` [8,12,20] = error "Salsa: rounds should be 8, 12 or 20" | otherwise = unsafeDoIO $ do stPtr <- B.alloc 132 $ \stPtr -> B.withByteArray nonce $ \noncePtr -> diff --git a/Crypto/Cipher/XSalsa.hs b/Crypto/Cipher/XSalsa.hs index 1510597..0353aa2 100644 --- a/Crypto/Cipher/XSalsa.hs +++ b/Crypto/Cipher/XSalsa.hs @@ -35,7 +35,7 @@ initialize :: (ByteArrayAccess key, ByteArrayAccess nonce) initialize nbRounds key nonce | kLen /= 32 = error "XSalsa: key length should be 256 bits" | nonceLen /= 24 = error "XSalsa: nonce length should be 192 bits" - | not (nbRounds `elem` [8,12,20]) = error "XSalsa: rounds should be 8, 12 or 20" + | nbRounds `notElem` [8,12,20] = error "XSalsa: rounds should be 8, 12 or 20" | otherwise = unsafeDoIO $ do stPtr <- B.alloc 132 $ \stPtr -> B.withByteArray nonce $ \noncePtr -> From 17336857c5fec89429c4d81853e2d2e463195d88 Mon Sep 17 00:00:00 2001 From: Will Song Date: Mon, 1 Jun 2020 20:56:42 -0500 Subject: [PATCH 154/176] implement square roots in f2m --- Crypto/Number/F2m.hs | 52 +++++++++++++++++++++++++++++++++++++++++--- tests/Number/F2m.hs | 8 +++++++ 2 files changed, 57 insertions(+), 3 deletions(-) diff --git a/Crypto/Number/F2m.hs b/Crypto/Number/F2m.hs index 93b1f48..ad0941f 100644 --- a/Crypto/Number/F2m.hs +++ b/Crypto/Number/F2m.hs @@ -16,7 +16,10 @@ module Crypto.Number.F2m , mulF2m , squareF2m' , squareF2m + , powF2m + , powF2m' , modF2m + , sqrtF2m , invF2m , divF2m ) where @@ -66,8 +69,8 @@ mulF2m :: BinaryPolynomial -- ^ Modulus mulF2m fx n1 n2 | fx < 0 || n1 < 0 - || n2 < 0 = error "mulF2m: negative number represent no binary binary polynomial" - | fx == 0 = error "modF2m: cannot multiply modulo zero polynomial" + || n2 < 0 = error "mulF2m: negative number represent no binary polynomial" + | fx == 0 = error "mulF2m: cannot multiply modulo zero polynomial" | otherwise = modF2m fx $ go (if n2 `mod` 2 == 1 then n1 else 0) (log2 n2) where go n s | s == 0 = n @@ -96,10 +99,53 @@ squareF2m fx = modF2m fx . squareF2m' squareF2m' :: Integer -> Integer squareF2m' n - | n < 0 = error "mulF2m: negative number represent no binary binary polynomial" + | n < 0 = error "mulF2m: negative number represent no binary polynomial" | otherwise = foldl' (\acc s -> if testBit n s then setBit acc (2 * s) else acc) 0 [0 .. log2 n] {-# INLINE squareF2m' #-} +-- | Exponentiation in F₂m by computing @a^b mod fx@. +-- +-- This implements an exponentiation by squaring based solution. It inherits the +-- same restrictions as 'squareF2m'. Negative exponents are disallowed. See +-- 'powF2m'' for one that handles this case +powF2m :: BinaryPolynomial -- ^Modulus + -> Integer -- ^a + -> Integer -- ^b + -> Integer +powF2m fx a b + | b == 0 = 1 + | b > 0 = squareF2m fx x * if even b then 1 else a + | b < 0 = error "powF2m: negative exponents disallowed" + | otherwise = error "powF2m: impossible" + where x = powF2m fx a (b `div` 2) + +-- | Exponentiation in F₂m by computing @a^b mod fx@. +-- +-- This implements an exponentiation by squaring based solution. It inherits the +-- same restrictions as 'squareF2m'. 'Nothing' is returned when a negative +-- exponent is given and @a@ is not invertible. +powF2m' :: BinaryPolynomial -- ^Modulus + -> Integer -- ^a + -> Integer -- ^b + -> Maybe Integer +powF2m' fx a b + | b == 0 = Just 1 + | b > 0 = Just $ powF2m fx a b + | b < 0 = case invF2m fx a of + Just inv -> Just $ powF2m fx inv (-b) + Nothing -> Nothing + | otherwise = error "impossible" + +-- | Square rooot in F₂m. +-- +-- We exploit the fact that @a^(2^m) = a@, or in particular, @a^(2^m - 1) = 1@ +-- from a classical result by Lagrange. Thus the square root is simply @a^(2^(m +-- - 1))@. +sqrtF2m :: BinaryPolynomial -- ^Modulus + -> Integer -- ^a + -> Integer +sqrtF2m fx a = powF2m fx a (2 ^ (log2 fx - 1)) + -- | Extended GCD algorithm for polynomials. For @a@ and @b@ returns @(g, u, v)@ such that @a * u + b * v == g@. -- -- Reference: https://en.wikipedia.org/wiki/Polynomial_greatest_common_divisor#B.C3.A9zout.27s_identity_and_extended_GCD_algorithm diff --git a/tests/Number/F2m.hs b/tests/Number/F2m.hs index afa6e50..4434a9b 100644 --- a/tests/Number/F2m.hs +++ b/tests/Number/F2m.hs @@ -52,6 +52,14 @@ mulTests = testGroup "mulF2m" squareTests = testGroup "squareF2m" [ testProperty "sqr(a) == a * a" $ \(Positive m) (NonNegative a) -> mulF2m m a a == squareF2m m a + -- disabled because we require @m@ to be a suitable modulus and there is no + -- way to guarantee this + -- , testProperty "sqrt(a) * sqrt(a) = a" + -- $ \(Positive m) (NonNegative aa) -> let a = sqrtF2m m aa in mulF2m m a a == modF2m m aa + , testProperty "sqrt(a) * sqrt(a) = a in GF(2^16)" + $ let m = 65581 :: Integer -- x^16 + x^5 + x^3 + x^2 + 1 + nums = [0 .. 65535 :: Integer] + in nums == [let y = sqrtF2m m x in squareF2m m y | x <- nums] ] invTests = testGroup "invF2m" From f64efafbad17a92aa8b7c009e70a9073ac3c940b Mon Sep 17 00:00:00 2001 From: Will Song Date: Mon, 8 Jun 2020 10:16:42 -0500 Subject: [PATCH 155/176] update sqrtF2m --- Crypto/Number/F2m.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/Crypto/Number/F2m.hs b/Crypto/Number/F2m.hs index ad0941f..53b1c69 100644 --- a/Crypto/Number/F2m.hs +++ b/Crypto/Number/F2m.hs @@ -144,7 +144,9 @@ powF2m' fx a b sqrtF2m :: BinaryPolynomial -- ^Modulus -> Integer -- ^a -> Integer -sqrtF2m fx a = powF2m fx a (2 ^ (log2 fx - 1)) +sqrtF2m fx a = go (log2 fx - 1) a + where go 0 x = x + go n x = go (n - 1) (squareF2m fx x) -- | Extended GCD algorithm for polynomials. For @a@ and @b@ returns @(g, u, v)@ such that @a * u + b * v == g@. -- From 5f657fda2e18988b2b7ed91c7cc3373f98922b2f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 12 Jun 2020 18:54:37 +0200 Subject: [PATCH 156/176] Remove powF2m' We keep only the function providing the base service, negative exponents can be still computed with invF2m. --- Crypto/Number/F2m.hs | 21 +-------------------- 1 file changed, 1 insertion(+), 20 deletions(-) diff --git a/Crypto/Number/F2m.hs b/Crypto/Number/F2m.hs index 53b1c69..4dd0db2 100644 --- a/Crypto/Number/F2m.hs +++ b/Crypto/Number/F2m.hs @@ -17,7 +17,6 @@ module Crypto.Number.F2m , squareF2m' , squareF2m , powF2m - , powF2m' , modF2m , sqrtF2m , invF2m @@ -106,8 +105,7 @@ squareF2m' n -- | Exponentiation in F₂m by computing @a^b mod fx@. -- -- This implements an exponentiation by squaring based solution. It inherits the --- same restrictions as 'squareF2m'. Negative exponents are disallowed. See --- 'powF2m'' for one that handles this case +-- same restrictions as 'squareF2m'. Negative exponents are disallowed. powF2m :: BinaryPolynomial -- ^Modulus -> Integer -- ^a -> Integer -- ^b @@ -119,23 +117,6 @@ powF2m fx a b | otherwise = error "powF2m: impossible" where x = powF2m fx a (b `div` 2) --- | Exponentiation in F₂m by computing @a^b mod fx@. --- --- This implements an exponentiation by squaring based solution. It inherits the --- same restrictions as 'squareF2m'. 'Nothing' is returned when a negative --- exponent is given and @a@ is not invertible. -powF2m' :: BinaryPolynomial -- ^Modulus - -> Integer -- ^a - -> Integer -- ^b - -> Maybe Integer -powF2m' fx a b - | b == 0 = Just 1 - | b > 0 = Just $ powF2m fx a b - | b < 0 = case invF2m fx a of - Just inv -> Just $ powF2m fx inv (-b) - Nothing -> Nothing - | otherwise = error "impossible" - -- | Square rooot in F₂m. -- -- We exploit the fact that @a^(2^m) = a@, or in particular, @a^(2^m - 1) = 1@ From dfc9fb9fb254e4cdf517585c406bf4b01704ccaa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 12 Jun 2020 19:01:52 +0200 Subject: [PATCH 157/176] Fix powF2m when exponent is not a power of 2 Integer multiplication cannot be used because it includes carry propagation. This needs to use carry-less mulF2m instead. --- Crypto/Number/F2m.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Crypto/Number/F2m.hs b/Crypto/Number/F2m.hs index 4dd0db2..6ca2604 100644 --- a/Crypto/Number/F2m.hs +++ b/Crypto/Number/F2m.hs @@ -111,10 +111,10 @@ powF2m :: BinaryPolynomial -- ^Modulus -> Integer -- ^b -> Integer powF2m fx a b - | b == 0 = 1 - | b > 0 = squareF2m fx x * if even b then 1 else a - | b < 0 = error "powF2m: negative exponents disallowed" - | otherwise = error "powF2m: impossible" + | b < 0 = error "powF2m: negative exponents disallowed" + | b == 0 = if fx > 1 then 1 else 0 + | even b = squareF2m fx x + | otherwise = mulF2m fx a (squareF2m' x) where x = powF2m fx a (b `div` 2) -- | Square rooot in F₂m. From edbd9e09fb379023bfbbdd3703570d85e7c14ffa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 12 Jun 2020 19:06:58 +0200 Subject: [PATCH 158/176] Test properties of powF2m --- tests/Number/F2m.hs | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/tests/Number/F2m.hs b/tests/Number/F2m.hs index 4434a9b..80c86be 100644 --- a/tests/Number/F2m.hs +++ b/tests/Number/F2m.hs @@ -62,6 +62,24 @@ squareTests = testGroup "squareF2m" in nums == [let y = sqrtF2m m x in squareF2m m y | x <- nums] ] +powTests = testGroup "powF2m" + [ testProperty "2 is square" + $ \(Positive m) (NonNegative a) -> powF2m m a 2 == squareF2m m a + , testProperty "1 is identity" + $ \(Positive m) (NonNegative a) -> powF2m m a 1 == modF2m m a + , testProperty "0 is annihilator" + $ \(Positive m) (NonNegative a) -> powF2m m a 0 == modF2m m 1 + , testProperty "(a * b) ^ c == (a ^ c) * (b ^ c)" + $ \(Positive m) (NonNegative a) (NonNegative b) (NonNegative c) + -> powF2m m (mulF2m m a b) c == mulF2m m (powF2m m a c) (powF2m m b c) + , testProperty "a ^ (b + c) == (a ^ b) * (a ^ c)" + $ \(Positive m) (NonNegative a) (NonNegative b) (NonNegative c) + -> powF2m m a (b + c) == mulF2m m (powF2m m a b) (powF2m m a c) + , testProperty "a ^ (b * c) == (a ^ b) ^ c" + $ \(Positive m) (NonNegative a) (NonNegative b) (NonNegative c) + -> powF2m m a (b * c) == powF2m m (powF2m m a b) c + ] + invTests = testGroup "invF2m" [ testProperty "1 / a * a == 1" $ \(Positive m) (NonNegative a) @@ -86,6 +104,7 @@ tests = testGroup "number.F2m" , modTests , mulTests , squareTests + , powTests , invTests , divTests ] From c123752de438fe00a7342e91e522c67bb274f642 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 13 Jun 2020 09:24:47 +0200 Subject: [PATCH 159/176] Use isNothing --- tests/Number/F2m.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/Number/F2m.hs b/tests/Number/F2m.hs index 80c86be..19acd61 100644 --- a/tests/Number/F2m.hs +++ b/tests/Number/F2m.hs @@ -2,6 +2,7 @@ module Number.F2m (tests) where import Imports hiding ((.&.)) import Data.Bits +import Data.Maybe import Crypto.Number.Basic (log2) import Crypto.Number.F2m @@ -96,7 +97,7 @@ divTests = testGroup "divF2m" -> divF2m m a b == (mulF2m m a <$> invF2m m b) , testProperty "a * b / b == a" $ \(Positive m) (NonNegative a) (NonNegative b) - -> invF2m m b == Nothing || divF2m m (mulF2m m a b) b == Just (modF2m m a) + -> isNothing (invF2m m b) || divF2m m (mulF2m m a b) b == Just (modF2m m a) ] tests = testGroup "number.F2m" From 0254f16e83f7cb2f5d4f7a679016aeffa4c3ebc0 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Sun, 21 Jun 2020 12:07:25 +0800 Subject: [PATCH 160/176] release 0.27 --- CHANGELOG.md | 10 ++++++++++ cryptonite.cabal | 2 +- 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index cd23f2a..198c7b5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,13 @@ +## 0.27 + +* Optimise AES GCM and CCM +* Optimise P256R1 implementation +* Various AES-NI building improvements +* Add better ECDSA support +* Add XSalsa derive +* Implement square roots for ECC binary curve +* Various tests and benchmarks + ## 0.26 * Add Rabin cryptosystem (and variants) diff --git a/cryptonite.cabal b/cryptonite.cabal index 652e595..b4bf6e5 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -1,5 +1,5 @@ Name: cryptonite -version: 0.26 +version: 0.27 Synopsis: Cryptography Primitives sink Description: A repository of cryptographic primitives. From ba3ab1f0cda4616063e55f21c0b94db6e71be09b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 26 Jun 2020 07:16:18 +0200 Subject: [PATCH 161/176] Add HashAlgorithmPrefix API --- Crypto/Hash.hs | 29 +++++++++++++++++++++++++++++ Crypto/Hash/Algorithms.hs | 3 ++- Crypto/Hash/Types.hs | 12 ++++++++++++ 3 files changed, 43 insertions(+), 1 deletion(-) diff --git a/Crypto/Hash.hs b/Crypto/Hash.hs index 37e6f9f..50abed6 100644 --- a/Crypto/Hash.hs +++ b/Crypto/Hash.hs @@ -28,14 +28,17 @@ module Crypto.Hash -- * Hash methods parametrized by algorithm , hashInitWith , hashWith + , hashPrefixWith -- * Hash methods , hashInit , hashUpdates , hashUpdate , hashFinalize + , hashFinalizePrefix , hashBlockSize , hashDigestSize , hash + , hashPrefix , hashlazy -- * Hash algorithms , module Crypto.Hash.Algorithms @@ -57,6 +60,10 @@ import Data.Word (Word8) hash :: (ByteArrayAccess ba, HashAlgorithm a) => ba -> Digest a hash bs = hashFinalize $ hashUpdate hashInit bs +-- | Hash the first N bytes of a bytestring, with code path independent from N. +hashPrefix :: (ByteArrayAccess ba, HashAlgorithmPrefix a) => ba -> Int -> Digest a +hashPrefix = hashFinalizePrefix hashInit + -- | Hash a lazy bytestring into a digest. hashlazy :: HashAlgorithm a => L.ByteString -> Digest a hashlazy lbs = hashFinalize $ hashUpdates hashInit (L.toChunks lbs) @@ -94,6 +101,24 @@ hashFinalize !c = ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (Context a)) -> hashInternalFinalize ctx dig return () +-- | Update the context with the first N bytes of a bytestring and return the +-- digest. The code path is independent from N but much slower than a normal +-- 'hashUpdate'. The function can be called for the last bytes of a message, in +-- order to exclude a variable padding, without leaking the padding length. The +-- begining of the message, never impacted by the padding, should preferably go +-- through 'hashUpdate' for better performance. +hashFinalizePrefix :: forall a ba . (HashAlgorithmPrefix a, ByteArrayAccess ba) + => Context a + -> ba + -> Int + -> Digest a +hashFinalizePrefix !c b len = + Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \(dig :: Ptr (Digest a)) -> do + ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (Context a)) -> + B.withByteArray b $ \d -> + hashInternalFinalizePrefix ctx d (fromIntegral $ B.length b) (fromIntegral len) dig + return () + -- | Initialize a new context for a specified hash algorithm hashInitWith :: HashAlgorithm alg => alg -> Context alg hashInitWith _ = hashInit @@ -102,6 +127,10 @@ hashInitWith _ = hashInit hashWith :: (ByteArrayAccess ba, HashAlgorithm alg) => alg -> ba -> Digest alg hashWith _ = hash +-- | Run the 'hashPrefix' function but takes an explicit hash algorithm parameter +hashPrefixWith :: (ByteArrayAccess ba, HashAlgorithmPrefix alg) => alg -> ba -> Int -> Digest alg +hashPrefixWith _ = hashPrefix + -- | Try to transform a bytearray into a Digest of specific algorithm. -- -- If the digest is not the right size for the algorithm specified, then diff --git a/Crypto/Hash/Algorithms.hs b/Crypto/Hash/Algorithms.hs index 1565c0b..41ab7ee 100644 --- a/Crypto/Hash/Algorithms.hs +++ b/Crypto/Hash/Algorithms.hs @@ -9,6 +9,7 @@ -- module Crypto.Hash.Algorithms ( HashAlgorithm + , HashAlgorithmPrefix -- * Hash algorithms , Blake2s_160(..) , Blake2s_224(..) @@ -54,7 +55,7 @@ module Crypto.Hash.Algorithms , Whirlpool(..) ) where -import Crypto.Hash.Types (HashAlgorithm) +import Crypto.Hash.Types (HashAlgorithm, HashAlgorithmPrefix) import Crypto.Hash.Blake2s import Crypto.Hash.Blake2sp import Crypto.Hash.Blake2b diff --git a/Crypto/Hash/Types.hs b/Crypto/Hash/Types.hs index 65a3b61..c5170fa 100644 --- a/Crypto/Hash/Types.hs +++ b/Crypto/Hash/Types.hs @@ -14,6 +14,7 @@ {-# LANGUAGE TypeFamilies #-} module Crypto.Hash.Types ( HashAlgorithm(..) + , HashAlgorithmPrefix(..) , Context(..) , Digest(..) ) where @@ -59,6 +60,17 @@ class HashAlgorithm a where -- | Finalize the context and set the digest raw memory to the right value hashInternalFinalize :: Ptr (Context a) -> Ptr (Digest a) -> IO () +-- | Hashing algorithms with a constant-time implementation. +class HashAlgorithm a => HashAlgorithmPrefix a where + -- | Update the context with the first N bytes of a buffer and finalize this + -- context. The code path executed is independent from N and depends only + -- on the complete buffer length. + hashInternalFinalizePrefix :: Ptr (Context a) + -> Ptr Word8 -> Word32 + -> Word32 + -> Ptr (Digest a) + -> IO () + {- hashContextGetAlgorithm :: HashAlgorithm a => Context a -> a hashContextGetAlgorithm = undefined From caec601cd1d00275572ceaab0de15a81f9b2002d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 26 Jun 2020 07:16:30 +0200 Subject: [PATCH 162/176] Add finalize_prefix functions --- cbits/cryptonite_align.h | 31 ++++++++++++ cbits/cryptonite_hash_prefix.c | 90 ++++++++++++++++++++++++++++++++++ cbits/cryptonite_hash_prefix.h | 65 ++++++++++++++++++++++++ cbits/cryptonite_md5.c | 27 ++++++++++ cbits/cryptonite_md5.h | 1 + cbits/cryptonite_sha1.c | 28 +++++++++++ cbits/cryptonite_sha1.h | 1 + cbits/cryptonite_sha256.c | 34 +++++++++++++ cbits/cryptonite_sha256.h | 2 + cbits/cryptonite_sha512.c | 40 +++++++++++++++ cbits/cryptonite_sha512.h | 2 + cryptonite.cabal | 1 + 12 files changed, 322 insertions(+) create mode 100644 cbits/cryptonite_hash_prefix.c create mode 100644 cbits/cryptonite_hash_prefix.h diff --git a/cbits/cryptonite_align.h b/cbits/cryptonite_align.h index 41172a9..01e8a36 100644 --- a/cbits/cryptonite_align.h +++ b/cbits/cryptonite_align.h @@ -44,11 +44,21 @@ static inline void store_le32_aligned(uint8_t *dst, const uint32_t v) *((uint32_t *) dst) = cpu_to_le32(v); } +static inline void xor_le32_aligned(uint8_t *dst, const uint32_t v) +{ + *((uint32_t *) dst) ^= cpu_to_le32(v); +} + static inline void store_be32_aligned(uint8_t *dst, const uint32_t v) { *((uint32_t *) dst) = cpu_to_be32(v); } +static inline void xor_be32_aligned(uint8_t *dst, const uint32_t v) +{ + *((uint32_t *) dst) ^= cpu_to_be32(v); +} + static inline void store_le64_aligned(uint8_t *dst, const uint64_t v) { *((uint64_t *) dst) = cpu_to_le64(v); @@ -59,6 +69,11 @@ static inline void store_be64_aligned(uint8_t *dst, const uint64_t v) *((uint64_t *) dst) = cpu_to_be64(v); } +static inline void xor_be64_aligned(uint8_t *dst, const uint64_t v) +{ + *((uint64_t *) dst) ^= cpu_to_be64(v); +} + #ifdef UNALIGNED_ACCESS_OK #define load_le32(a) load_le32_aligned(a) #else @@ -70,20 +85,30 @@ static inline uint32_t load_le32(const uint8_t *p) #ifdef UNALIGNED_ACCESS_OK #define store_le32(a, b) store_le32_aligned(a, b) +#define xor_le32(a, b) xor_le32_aligned(a, b) #else static inline void store_le32(uint8_t *dst, const uint32_t v) { dst[0] = v; dst[1] = v >> 8; dst[2] = v >> 16; dst[3] = v >> 24; } +static inline void xor_le32(uint8_t *dst, const uint32_t v) +{ + dst[0] ^= v; dst[1] ^= v >> 8; dst[2] ^= v >> 16; dst[3] ^= v >> 24; +} #endif #ifdef UNALIGNED_ACCESS_OK #define store_be32(a, b) store_be32_aligned(a, b) +#define xor_be32(a, b) xor_be32_aligned(a, b) #else static inline void store_be32(uint8_t *dst, const uint32_t v) { dst[3] = v; dst[2] = v >> 8; dst[1] = v >> 16; dst[0] = v >> 24; } +static inline void xor_be32(uint8_t *dst, const uint32_t v) +{ + dst[3] ^= v; dst[2] ^= v >> 8; dst[1] ^= v >> 16; dst[0] ^= v >> 24; +} #endif #ifdef UNALIGNED_ACCESS_OK @@ -98,12 +123,18 @@ static inline void store_le64(uint8_t *dst, const uint64_t v) #ifdef UNALIGNED_ACCESS_OK #define store_be64(a, b) store_be64_aligned(a, b) +#define xor_be64(a, b) xor_be64_aligned(a, b) #else static inline void store_be64(uint8_t *dst, const uint64_t v) { dst[7] = v ; dst[6] = v >> 8 ; dst[5] = v >> 16; dst[4] = v >> 24; dst[3] = v >> 32; dst[2] = v >> 40; dst[1] = v >> 48; dst[0] = v >> 56; } +static inline void xor_be64(uint8_t *dst, const uint64_t v) +{ + dst[7] ^= v ; dst[6] ^= v >> 8 ; dst[5] ^= v >> 16; dst[4] ^= v >> 24; + dst[3] ^= v >> 32; dst[2] ^= v >> 40; dst[1] ^= v >> 48; dst[0] ^= v >> 56; +} #endif #endif diff --git a/cbits/cryptonite_hash_prefix.c b/cbits/cryptonite_hash_prefix.c new file mode 100644 index 0000000..06df581 --- /dev/null +++ b/cbits/cryptonite_hash_prefix.c @@ -0,0 +1,90 @@ +/* + * Copyright (C) 2020 Olivier Chéron + * + * 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. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``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 AUTHOR 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. + */ + +#include + +void CRYPTONITE_HASHED(finalize_prefix)(struct HASHED_LOWER(ctx) *ctx, const uint8_t *data, uint32_t len, uint32_t n, uint8_t *out) +{ + uint64_t bits[HASHED(BITS_ELEMS)]; + uint8_t *p = (uint8_t *) &bits; + uint32_t index, padidx, padlen, pos, out_mask; + static const uint32_t cut_off = HASHED(BLOCK_SIZE) - sizeof(bits); + + /* Make sure n <= len */ + n += (len - n) & constant_time_lt(len, n); + + /* Initial index, based on current context state */ + index = CRYPTONITE_HASHED(get_index)(ctx); + + /* Final size after n bytes */ + CRYPTONITE_HASHED(incr_sz)(ctx, bits, n); + + /* Padding index and length */ + padidx = CRYPTONITE_HASHED(get_index)(ctx); + padlen = HASHED(BLOCK_SIZE) + cut_off - padidx; + padlen -= HASHED(BLOCK_SIZE) & constant_time_lt(padidx, cut_off); + + /* Initialize buffers because we will XOR into them */ + memset(ctx->buf + index, 0, HASHED(BLOCK_SIZE) - index); + memset(out, 0, HASHED(DIGEST_SIZE)); + pos = 0; + + /* Iterate based on the full buffer length, regardless of n, and include + * the maximum overhead with padding and size bytes + */ + while (pos < len + HASHED(BLOCK_SIZE) + sizeof(bits)) { + uint8_t b; + + /* Take as many bytes from the input buffer as possible */ + if (pos < len) + b = *(data++) & (uint8_t) constant_time_lt(pos, n); + else + b = 0; + + /* First padding byte */ + b |= 0x80 & (uint8_t) constant_time_eq(pos, n);; + + /* Size bytes are always at the end of a block */ + if (index >= cut_off) + b |= p[index - cut_off] & (uint8_t) constant_time_ge(pos, n + padlen); + + /* Store this byte into the buffer */ + ctx->buf[index++] ^= b; + pos++; + + /* Process a full block, at a boundary which is independent from n */ + if (index >= HASHED(BLOCK_SIZE)) { + index = 0; + HASHED_LOWER(do_chunk)(ctx, (void *) ctx->buf); + memset(ctx->buf, 0, HASHED(BLOCK_SIZE)); + + /* Try to store the result: this is a no-op except when we reach the + * actual size based on n, more iterations may continue after that + * when len is really larger + */ + out_mask = constant_time_eq(pos, n + padlen + sizeof(bits)); + CRYPTONITE_HASHED(select_digest)(ctx, out, out_mask); + } + } +} diff --git a/cbits/cryptonite_hash_prefix.h b/cbits/cryptonite_hash_prefix.h new file mode 100644 index 0000000..3eed4e0 --- /dev/null +++ b/cbits/cryptonite_hash_prefix.h @@ -0,0 +1,65 @@ +/* + * Copyright (C) 2020 Olivier Chéron + * + * 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. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``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 AUTHOR 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 CRYPTONITE_HASH_PREFIX_H +#define CRYPTONITE_HASH_PREFIX_H + +#include + +static inline uint32_t constant_time_msb(uint32_t a) +{ + return 0 - (a >> 31); +} + +static inline uint32_t constant_time_lt(uint32_t a, uint32_t b) +{ + return constant_time_msb(a ^ ((a ^ b) | ((a - b) ^ b))); +} + +static inline uint32_t constant_time_ge(uint32_t a, uint32_t b) +{ + return ~constant_time_lt(a, b); +} + +static inline uint32_t constant_time_is_zero(uint32_t a) +{ + return constant_time_msb(~a & (a - 1)); +} + +static inline uint32_t constant_time_eq(uint32_t a, uint32_t b) +{ + return constant_time_is_zero(a ^ b); +} + +static inline uint64_t constant_time_msb_64(uint64_t a) +{ + return 0 - (a >> 63); +} + +static inline uint64_t constant_time_lt_64(uint64_t a, uint64_t b) +{ + return constant_time_msb_64(a ^ ((a ^ b) | ((a - b) ^ b))); +} + +#endif diff --git a/cbits/cryptonite_md5.c b/cbits/cryptonite_md5.c index 126bac4..48ac4c6 100644 --- a/cbits/cryptonite_md5.c +++ b/cbits/cryptonite_md5.c @@ -185,3 +185,30 @@ void cryptonite_md5_finalize(struct md5_ctx *ctx, uint8_t *out) store_le32(out+ 8, ctx->h[2]); store_le32(out+12, ctx->h[3]); } + +#define HASHED(m) MD5_##m +#define HASHED_LOWER(m) md5_##m +#define CRYPTONITE_HASHED(m) cryptonite_md5_##m +#define MD5_BLOCK_SIZE 64 +#define MD5_BITS_ELEMS 1 + +static inline uint32_t cryptonite_md5_get_index(const struct md5_ctx *ctx) +{ + return (uint32_t) (ctx->sz & 0x3f); +} + +static inline void cryptonite_md5_incr_sz(struct md5_ctx *ctx, uint64_t *bits, uint32_t n) +{ + ctx->sz += n; + *bits = cpu_to_le64(ctx->sz << 3); +} + +static inline void cryptonite_md5_select_digest(const struct md5_ctx *ctx, uint8_t *out, uint32_t out_mask) +{ + xor_le32(out , ctx->h[0] & out_mask); + xor_le32(out+ 4, ctx->h[1] & out_mask); + xor_le32(out+ 8, ctx->h[2] & out_mask); + xor_le32(out+12, ctx->h[3] & out_mask); +} + +#include diff --git a/cbits/cryptonite_md5.h b/cbits/cryptonite_md5.h index 7187f96..e6fc67a 100644 --- a/cbits/cryptonite_md5.h +++ b/cbits/cryptonite_md5.h @@ -39,5 +39,6 @@ struct md5_ctx void cryptonite_md5_init(struct md5_ctx *ctx); void cryptonite_md5_update(struct md5_ctx *ctx, const uint8_t *data, uint32_t len); void cryptonite_md5_finalize(struct md5_ctx *ctx, uint8_t *out); +void cryptonite_md5_finalize_prefix(struct md5_ctx *ctx, const uint8_t *data, uint32_t len, uint32_t n, uint8_t *out); #endif diff --git a/cbits/cryptonite_sha1.c b/cbits/cryptonite_sha1.c index 533eded..3a94707 100644 --- a/cbits/cryptonite_sha1.c +++ b/cbits/cryptonite_sha1.c @@ -216,3 +216,31 @@ void cryptonite_sha1_finalize(struct sha1_ctx *ctx, uint8_t *out) store_be32(out+12, ctx->h[3]); store_be32(out+16, ctx->h[4]); } + +#define HASHED(m) SHA1_##m +#define HASHED_LOWER(m) sha1_##m +#define CRYPTONITE_HASHED(m) cryptonite_sha1_##m +#define SHA1_BLOCK_SIZE 64 +#define SHA1_BITS_ELEMS 1 + +static inline uint32_t cryptonite_sha1_get_index(const struct sha1_ctx *ctx) +{ + return (uint32_t) (ctx->sz & 0x3f); +} + +static inline void cryptonite_sha1_incr_sz(struct sha1_ctx *ctx, uint64_t *bits, uint32_t n) +{ + ctx->sz += n; + *bits = cpu_to_be64(ctx->sz << 3); +} + +static inline void cryptonite_sha1_select_digest(const struct sha1_ctx *ctx, uint8_t *out, uint32_t out_mask) +{ + xor_be32(out , ctx->h[0] & out_mask); + xor_be32(out+ 4, ctx->h[1] & out_mask); + xor_be32(out+ 8, ctx->h[2] & out_mask); + xor_be32(out+12, ctx->h[3] & out_mask); + xor_be32(out+16, ctx->h[4] & out_mask); +} + +#include diff --git a/cbits/cryptonite_sha1.h b/cbits/cryptonite_sha1.h index ee3f202..73cd306 100644 --- a/cbits/cryptonite_sha1.h +++ b/cbits/cryptonite_sha1.h @@ -41,5 +41,6 @@ struct sha1_ctx void cryptonite_sha1_init(struct sha1_ctx *ctx); void cryptonite_sha1_update(struct sha1_ctx *ctx, const uint8_t *data, uint32_t len); void cryptonite_sha1_finalize(struct sha1_ctx *ctx, uint8_t *out); +void cryptonite_sha1_finalize_prefix(struct sha1_ctx *ctx, const uint8_t *data, uint32_t len, uint32_t n, uint8_t *out); #endif diff --git a/cbits/cryptonite_sha256.c b/cbits/cryptonite_sha256.c index d82f5df..fb783a4 100644 --- a/cbits/cryptonite_sha256.c +++ b/cbits/cryptonite_sha256.c @@ -161,6 +161,14 @@ void cryptonite_sha224_finalize(struct sha224_ctx *ctx, uint8_t *out) memcpy(out, intermediate, SHA224_DIGEST_SIZE); } +void cryptonite_sha224_finalize_prefix(struct sha224_ctx *ctx, const uint8_t *data, uint32_t len, uint32_t n, uint8_t *out) +{ + uint8_t intermediate[SHA256_DIGEST_SIZE]; + + cryptonite_sha256_finalize_prefix(ctx, data, len, n, intermediate); + memcpy(out, intermediate, SHA224_DIGEST_SIZE); +} + void cryptonite_sha256_finalize(struct sha256_ctx *ctx, uint8_t *out) { static uint8_t padding[64] = { 0x80, }; @@ -182,3 +190,29 @@ void cryptonite_sha256_finalize(struct sha256_ctx *ctx, uint8_t *out) for (i = 0; i < 8; i++) store_be32(out+4*i, ctx->h[i]); } + +#define HASHED(m) SHA256_##m +#define HASHED_LOWER(m) sha256_##m +#define CRYPTONITE_HASHED(m) cryptonite_sha256_##m +#define SHA256_BLOCK_SIZE 64 +#define SHA256_BITS_ELEMS 1 + +static inline uint32_t cryptonite_sha256_get_index(const struct sha256_ctx *ctx) +{ + return (uint32_t) (ctx->sz & 0x3f); +} + +static inline void cryptonite_sha256_incr_sz(struct sha256_ctx *ctx, uint64_t *bits, uint32_t n) +{ + ctx->sz += n; + *bits = cpu_to_be64(ctx->sz << 3); +} + +static inline void cryptonite_sha256_select_digest(const struct sha256_ctx *ctx, uint8_t *out, uint32_t out_mask) +{ + uint32_t i; + for (i = 0; i < 8; i++) + xor_be32(out+4*i, ctx->h[i] & out_mask); +} + +#include diff --git a/cbits/cryptonite_sha256.h b/cbits/cryptonite_sha256.h index 705ff9a..49e18cc 100644 --- a/cbits/cryptonite_sha256.h +++ b/cbits/cryptonite_sha256.h @@ -47,9 +47,11 @@ struct sha256_ctx void cryptonite_sha224_init(struct sha224_ctx *ctx); void cryptonite_sha224_update(struct sha224_ctx *ctx, const uint8_t *data, uint32_t len); void cryptonite_sha224_finalize(struct sha224_ctx *ctx, uint8_t *out); +void cryptonite_sha224_finalize_prefix(struct sha224_ctx *ctx, const uint8_t *data, uint32_t len, uint32_t n, uint8_t *out); void cryptonite_sha256_init(struct sha256_ctx *ctx); void cryptonite_sha256_update(struct sha256_ctx *ctx, const uint8_t *data, uint32_t len); void cryptonite_sha256_finalize(struct sha256_ctx *ctx, uint8_t *out); +void cryptonite_sha256_finalize_prefix(struct sha256_ctx *ctx, const uint8_t *data, uint32_t len, uint32_t n, uint8_t *out); #endif diff --git a/cbits/cryptonite_sha512.c b/cbits/cryptonite_sha512.c index 7d345ae..cdc1eec 100644 --- a/cbits/cryptonite_sha512.c +++ b/cbits/cryptonite_sha512.c @@ -180,6 +180,14 @@ void cryptonite_sha384_finalize(struct sha384_ctx *ctx, uint8_t *out) memcpy(out, intermediate, SHA384_DIGEST_SIZE); } +void cryptonite_sha384_finalize_prefix(struct sha384_ctx *ctx, const uint8_t *data, uint32_t len, uint32_t n, uint8_t *out) +{ + uint8_t intermediate[SHA512_DIGEST_SIZE]; + + cryptonite_sha512_finalize_prefix(ctx, data, len, n, intermediate); + memcpy(out, intermediate, SHA384_DIGEST_SIZE); +} + void cryptonite_sha512_finalize(struct sha512_ctx *ctx, uint8_t *out) { static uint8_t padding[128] = { 0x80, }; @@ -203,6 +211,38 @@ void cryptonite_sha512_finalize(struct sha512_ctx *ctx, uint8_t *out) store_be64(out+8*i, ctx->h[i]); } +#define HASHED(m) SHA512_##m +#define HASHED_LOWER(m) sha512_##m +#define CRYPTONITE_HASHED(m) cryptonite_sha512_##m +#define SHA512_BLOCK_SIZE 128 +#define SHA512_BITS_ELEMS 2 + +#include + +static inline uint32_t cryptonite_sha512_get_index(const struct sha512_ctx *ctx) +{ + return (uint32_t) (ctx->sz[0] & 0x7f); +} + +static inline void cryptonite_sha512_incr_sz(struct sha512_ctx *ctx, uint64_t *bits, uint32_t n) +{ + ctx->sz[0] += n; + ctx->sz[1] += 1 & constant_time_lt_64(ctx->sz[0], n); + bits[0] = cpu_to_be64((ctx->sz[1] << 3 | ctx->sz[0] >> 61)); + bits[1] = cpu_to_be64((ctx->sz[0] << 3)); +} + +static inline void cryptonite_sha512_select_digest(const struct sha512_ctx *ctx, uint8_t *out, uint32_t out_mask) +{ + uint32_t i; + uint64_t out_mask_64 = out_mask; + out_mask_64 |= out_mask_64 << 32; + for (i = 0; i < 8; i++) + xor_be64(out+8*i, ctx->h[i] & out_mask_64); +} + +#include + #include void cryptonite_sha512t_init(struct sha512_ctx *ctx, uint32_t hashlen) diff --git a/cbits/cryptonite_sha512.h b/cbits/cryptonite_sha512.h index 38fc560..53893c0 100644 --- a/cbits/cryptonite_sha512.h +++ b/cbits/cryptonite_sha512.h @@ -46,10 +46,12 @@ struct sha512_ctx void cryptonite_sha384_init(struct sha384_ctx *ctx); void cryptonite_sha384_update(struct sha384_ctx *ctx, const uint8_t *data, uint32_t len); void cryptonite_sha384_finalize(struct sha384_ctx *ctx, uint8_t *out); +void cryptonite_sha384_finalize_prefix(struct sha384_ctx *ctx, const uint8_t *data, uint32_t len, uint32_t n, uint8_t *out); void cryptonite_sha512_init(struct sha512_ctx *ctx); void cryptonite_sha512_update(struct sha512_ctx *ctx, const uint8_t *data, uint32_t len); void cryptonite_sha512_finalize(struct sha512_ctx *ctx, uint8_t *out); +void cryptonite_sha512_finalize_prefix(struct sha512_ctx *ctx, const uint8_t *data, uint32_t len, uint32_t n, uint8_t *out); /* only multiples of 8 are supported as valid t values */ void cryptonite_sha512t_init(struct sha512_ctx *ctx, uint32_t hashlen); diff --git a/cryptonite.cabal b/cryptonite.cabal index b4bf6e5..b9af22f 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -57,6 +57,7 @@ extra-source-files: cbits/*.h cbits/argon2/*.h cbits/argon2/*.c cbits/aes/x86ni_impl.c + cbits/cryptonite_hash_prefix.c tests/*.hs source-repository head From e67d8fb22347f8f1d55fe095d3dc34fe6d474300 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 26 Jun 2020 07:16:41 +0200 Subject: [PATCH 163/176] Generate HashAlgorithmPrefix instances --- Crypto/Hash/MD5.hs | 6 ++++++ Crypto/Hash/SHA1.hs | 6 ++++++ Crypto/Hash/SHA224.hs | 6 ++++++ Crypto/Hash/SHA256.hs | 6 ++++++ Crypto/Hash/SHA384.hs | 6 ++++++ Crypto/Hash/SHA512.hs | 6 ++++++ gen/Gen.hs | 30 +++++++++++++++++------------- gen/Template.hs | 2 +- gen/template/hash.hs | 10 ++++++++-- 9 files changed, 62 insertions(+), 16 deletions(-) diff --git a/Crypto/Hash/MD5.hs b/Crypto/Hash/MD5.hs index 17a09ef..5574a79 100644 --- a/Crypto/Hash/MD5.hs +++ b/Crypto/Hash/MD5.hs @@ -34,6 +34,9 @@ instance HashAlgorithm MD5 where hashInternalUpdate = c_md5_update hashInternalFinalize = c_md5_finalize +instance HashAlgorithmPrefix MD5 where + hashInternalFinalizePrefix = c_md5_finalize_prefix + foreign import ccall unsafe "cryptonite_md5_init" c_md5_init :: Ptr (Context a)-> IO () @@ -42,3 +45,6 @@ foreign import ccall "cryptonite_md5_update" foreign import ccall unsafe "cryptonite_md5_finalize" c_md5_finalize :: Ptr (Context a) -> Ptr (Digest a) -> IO () + +foreign import ccall "cryptonite_md5_finalize_prefix" + c_md5_finalize_prefix :: Ptr (Context a) -> Ptr Word8 -> Word32 -> Word32 -> Ptr (Digest a) -> IO () diff --git a/Crypto/Hash/SHA1.hs b/Crypto/Hash/SHA1.hs index 87e44a3..4f60739 100644 --- a/Crypto/Hash/SHA1.hs +++ b/Crypto/Hash/SHA1.hs @@ -34,6 +34,9 @@ instance HashAlgorithm SHA1 where hashInternalUpdate = c_sha1_update hashInternalFinalize = c_sha1_finalize +instance HashAlgorithmPrefix SHA1 where + hashInternalFinalizePrefix = c_sha1_finalize_prefix + foreign import ccall unsafe "cryptonite_sha1_init" c_sha1_init :: Ptr (Context a)-> IO () @@ -42,3 +45,6 @@ foreign import ccall "cryptonite_sha1_update" foreign import ccall unsafe "cryptonite_sha1_finalize" c_sha1_finalize :: Ptr (Context a) -> Ptr (Digest a) -> IO () + +foreign import ccall "cryptonite_sha1_finalize_prefix" + c_sha1_finalize_prefix :: Ptr (Context a) -> Ptr Word8 -> Word32 -> Word32 -> Ptr (Digest a) -> IO () diff --git a/Crypto/Hash/SHA224.hs b/Crypto/Hash/SHA224.hs index a609d57..5d0569f 100644 --- a/Crypto/Hash/SHA224.hs +++ b/Crypto/Hash/SHA224.hs @@ -34,6 +34,9 @@ instance HashAlgorithm SHA224 where hashInternalUpdate = c_sha224_update hashInternalFinalize = c_sha224_finalize +instance HashAlgorithmPrefix SHA224 where + hashInternalFinalizePrefix = c_sha224_finalize_prefix + foreign import ccall unsafe "cryptonite_sha224_init" c_sha224_init :: Ptr (Context a)-> IO () @@ -42,3 +45,6 @@ foreign import ccall "cryptonite_sha224_update" foreign import ccall unsafe "cryptonite_sha224_finalize" c_sha224_finalize :: Ptr (Context a) -> Ptr (Digest a) -> IO () + +foreign import ccall "cryptonite_sha224_finalize_prefix" + c_sha224_finalize_prefix :: Ptr (Context a) -> Ptr Word8 -> Word32 -> Word32 -> Ptr (Digest a) -> IO () diff --git a/Crypto/Hash/SHA256.hs b/Crypto/Hash/SHA256.hs index eacd502..18211f3 100644 --- a/Crypto/Hash/SHA256.hs +++ b/Crypto/Hash/SHA256.hs @@ -34,6 +34,9 @@ instance HashAlgorithm SHA256 where hashInternalUpdate = c_sha256_update hashInternalFinalize = c_sha256_finalize +instance HashAlgorithmPrefix SHA256 where + hashInternalFinalizePrefix = c_sha256_finalize_prefix + foreign import ccall unsafe "cryptonite_sha256_init" c_sha256_init :: Ptr (Context a)-> IO () @@ -42,3 +45,6 @@ foreign import ccall "cryptonite_sha256_update" foreign import ccall unsafe "cryptonite_sha256_finalize" c_sha256_finalize :: Ptr (Context a) -> Ptr (Digest a) -> IO () + +foreign import ccall "cryptonite_sha256_finalize_prefix" + c_sha256_finalize_prefix :: Ptr (Context a) -> Ptr Word8 -> Word32 -> Word32 -> Ptr (Digest a) -> IO () diff --git a/Crypto/Hash/SHA384.hs b/Crypto/Hash/SHA384.hs index 2b19f52..22fc595 100644 --- a/Crypto/Hash/SHA384.hs +++ b/Crypto/Hash/SHA384.hs @@ -34,6 +34,9 @@ instance HashAlgorithm SHA384 where hashInternalUpdate = c_sha384_update hashInternalFinalize = c_sha384_finalize +instance HashAlgorithmPrefix SHA384 where + hashInternalFinalizePrefix = c_sha384_finalize_prefix + foreign import ccall unsafe "cryptonite_sha384_init" c_sha384_init :: Ptr (Context a)-> IO () @@ -42,3 +45,6 @@ foreign import ccall "cryptonite_sha384_update" foreign import ccall unsafe "cryptonite_sha384_finalize" c_sha384_finalize :: Ptr (Context a) -> Ptr (Digest a) -> IO () + +foreign import ccall "cryptonite_sha384_finalize_prefix" + c_sha384_finalize_prefix :: Ptr (Context a) -> Ptr Word8 -> Word32 -> Word32 -> Ptr (Digest a) -> IO () diff --git a/Crypto/Hash/SHA512.hs b/Crypto/Hash/SHA512.hs index 20449b3..9a66df9 100644 --- a/Crypto/Hash/SHA512.hs +++ b/Crypto/Hash/SHA512.hs @@ -34,6 +34,9 @@ instance HashAlgorithm SHA512 where hashInternalUpdate = c_sha512_update hashInternalFinalize = c_sha512_finalize +instance HashAlgorithmPrefix SHA512 where + hashInternalFinalizePrefix = c_sha512_finalize_prefix + foreign import ccall unsafe "cryptonite_sha512_init" c_sha512_init :: Ptr (Context a)-> IO () @@ -42,3 +45,6 @@ foreign import ccall "cryptonite_sha512_update" foreign import ccall unsafe "cryptonite_sha512_finalize" c_sha512_finalize :: Ptr (Context a) -> Ptr (Digest a) -> IO () + +foreign import ccall "cryptonite_sha512_finalize_prefix" + c_sha512_finalize_prefix :: Ptr (Context a) -> Ptr Word8 -> Word32 -> Word32 -> Ptr (Digest a) -> IO () diff --git a/gen/Gen.hs b/gen/Gen.hs index c2e43ad..2bf81d6 100644 --- a/gen/Gen.hs +++ b/gen/Gen.hs @@ -54,6 +54,7 @@ data Prop = data HashCustom = HashSimple Bits -- digest size in bits Bytes -- block length in bytes + Bool -- has HashAlgorithmPrefix instance? | HashMulti [Prop] [(Bits, Bytes)] -- list of (digest output size in *bits*, block size in bytes) hashModules = @@ -62,22 +63,22 @@ hashModules = , GenHashModule "Blake2sp" "blake2.h" "blake2sp" 1752 (HashMulti [] [(224,64), (256,64)]) , GenHashModule "Blake2b" "blake2.h" "blake2b" 248 (HashMulti [] [(160, 128), (224, 128), (256, 128), (384, 128), (512,128)]) , GenHashModule "Blake2bp" "blake2.h" "blake2bp" 1768 (HashMulti [] [(512,128)]) - , GenHashModule "MD2" "md2.h" "md2" 96 (HashSimple 128 16) - , GenHashModule "MD4" "md4.h" "md4" 96 (HashSimple 128 64) - , GenHashModule "MD5" "md5.h" "md5" 96 (HashSimple 128 64) - , GenHashModule "SHA1" "sha1.h" "sha1" 96 (HashSimple 160 64) - , GenHashModule "SHA224" "sha256.h" "sha224" 192 (HashSimple 224 64) - , GenHashModule "SHA256" "sha256.h" "sha256" 192 (HashSimple 256 64) - , GenHashModule "SHA384" "sha512.h" "sha384" 256 (HashSimple 384 128) - , GenHashModule "SHA512" "sha512.h" "sha512" 256 (HashSimple 512 128) + , GenHashModule "MD2" "md2.h" "md2" 96 (HashSimple 128 16 False) + , GenHashModule "MD4" "md4.h" "md4" 96 (HashSimple 128 64 False) + , GenHashModule "MD5" "md5.h" "md5" 96 (HashSimple 128 64 True) + , GenHashModule "SHA1" "sha1.h" "sha1" 96 (HashSimple 160 64 True) + , GenHashModule "SHA224" "sha256.h" "sha224" 192 (HashSimple 224 64 True) + , GenHashModule "SHA256" "sha256.h" "sha256" 192 (HashSimple 256 64 True) + , GenHashModule "SHA384" "sha512.h" "sha384" 256 (HashSimple 384 128 True) + , GenHashModule "SHA512" "sha512.h" "sha512" 256 (HashSimple 512 128 True) , GenHashModule "SHA512t" "sha512.h" "sha512t" 256 (HashMulti [] [(224,128),(256,128)]) , GenHashModule "Keccak" "keccak.h" "keccak" 352 (HashMulti [VarCtx sha3CtxSize] [(224,144),(256,136),(384,104),(512,72)]) , GenHashModule "SHA3" "sha3.h" "sha3" 352 (HashMulti [VarCtx sha3CtxSize] [(224,144),(256,136),(384,104),(512,72)]) - , GenHashModule "RIPEMD160" "ripemd.h" "ripemd160" 128 (HashSimple 160 64) + , GenHashModule "RIPEMD160" "ripemd.h" "ripemd160" 128 (HashSimple 160 64 False) , GenHashModule "Skein256" "skein256.h" "skein256" 96 (HashMulti [] [(224,32),(256,32)]) , GenHashModule "Skein512" "skein512.h" "skein512" 160 (HashMulti [] [(224,64),(256,64),(384,64),(512,64)]) - , GenHashModule "Tiger" "tiger.h" "tiger" 96 (HashSimple 192 64) - , GenHashModule "Whirlpool" "whirlpool.h" "whirlpool" 168 (HashSimple 512 64) + , GenHashModule "Tiger" "tiger.h" "tiger" 96 (HashSimple 192 64 False) + , GenHashModule "Whirlpool" "whirlpool.h" "whirlpool" 168 (HashSimple 512 64 False) ] sha3CtxSize :: Bits -> Bytes @@ -105,13 +106,16 @@ renderHashModules genOpts = do let (tpl, addVars, multiVars) = case ghmCustomizable ghm of - HashSimple digestSize blockLength -> + HashSimple digestSize blockLength hasPrefixInstance -> (hashTemplate, [ ("DIGEST_SIZE_BITS" , showBits digestSize) , ("DIGEST_SIZE_BYTES", showBytes digestSize) , ("BLOCK_SIZE_BYTES" , showBytes blockLength) + ], + [ ("HASPREFIXINSTANCE", + [[] | hasPrefixInstance] + ) ] - , [] ) HashMulti props customSizes -> let customCtxSize = diff --git a/gen/Template.hs b/gen/Template.hs index 2cfff18..43984e6 100644 --- a/gen/Template.hs +++ b/gen/Template.hs @@ -45,7 +45,7 @@ renderTemplate template attrs multiAttrs = renderAtom (Tpl n t) = case lookup n multiAttrs of Nothing -> error ("cannot find inner template attributes for: " ++ n) - Just [] -> error ("empty multiattrs for: " ++ n) + Just [] -> "" Just (i:is) -> renderTemplate t (i ++ attrs) [] ++ concatMap (\inAttrs -> renderTemplate t (inAttrs ++ attrs ++ [("COMMA", ",")]) []) is diff --git a/gen/template/hash.hs b/gen/template/hash.hs index 4748054..9682180 100644 --- a/gen/template/hash.hs +++ b/gen/template/hash.hs @@ -32,7 +32,10 @@ instance HashAlgorithm %%MODULENAME%% where hashInternalContextSize _ = %%CTX_SIZE_BYTES%% hashInternalInit = c_%%HASHNAME%%_init hashInternalUpdate = c_%%HASHNAME%%_update - hashInternalFinalize = c_%%HASHNAME%%_finalize + hashInternalFinalize = c_%%HASHNAME%%_finalize%{HASPREFIXINSTANCE%} + +instance HashAlgorithmPrefix %%MODULENAME%% where + hashInternalFinalizePrefix = c_%%HASHNAME%%_finalize_prefix%{HASPREFIXINSTANCE%} foreign import ccall unsafe "cryptonite_%%HASHNAME%%_init" c_%%HASHNAME%%_init :: Ptr (Context a)-> IO () @@ -41,4 +44,7 @@ foreign import ccall "cryptonite_%%HASHNAME%%_update" c_%%HASHNAME%%_update :: Ptr (Context a) -> Ptr Word8 -> Word32 -> IO () foreign import ccall unsafe "cryptonite_%%HASHNAME%%_finalize" - c_%%HASHNAME%%_finalize :: Ptr (Context a) -> Ptr (Digest a) -> IO () + c_%%HASHNAME%%_finalize :: Ptr (Context a) -> Ptr (Digest a) -> IO ()%{HASPREFIXINSTANCE%} + +foreign import ccall "cryptonite_%%HASHNAME%%_finalize_prefix" + c_%%HASHNAME%%_finalize_prefix :: Ptr (Context a) -> Ptr Word8 -> Word32 -> Word32 -> Ptr (Digest a) -> IO ()%{HASPREFIXINSTANCE%} From c8199872e7adfa8101c7c0795542b8b33d6bcacd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 26 Jun 2020 07:16:49 +0200 Subject: [PATCH 164/176] Test HashAlgorithmPrefix API --- tests/Hash.hs | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/tests/Hash.hs b/tests/Hash.hs index d0f82c0..dbe752b 100644 --- a/tests/Hash.hs +++ b/tests/Hash.hs @@ -221,6 +221,24 @@ runhashinc :: HashAlg -> [ByteString] -> ByteString runhashinc (HashAlg hashAlg) v = B.convertToBase B.Base16 $ hashinc $ v where hashinc = hashFinalize . foldl hashUpdate (hashInitWith hashAlg) +data HashPrefixAlg = forall alg . HashAlgorithmPrefix alg => HashPrefixAlg alg + +expectedPrefix :: [ (String, HashPrefixAlg) ] +expectedPrefix = + [ ("MD5", HashPrefixAlg MD5) + , ("SHA1", HashPrefixAlg SHA1) + , ("SHA224", HashPrefixAlg SHA224) + , ("SHA256", HashPrefixAlg SHA256) + , ("SHA384", HashPrefixAlg SHA384) + , ("SHA512", HashPrefixAlg SHA512) + ] + +runhashpfx :: HashPrefixAlg -> ByteString -> ByteString +runhashpfx (HashPrefixAlg hashAlg) v = B.convertToBase B.Base16 $ hashWith hashAlg v + +runhashpfxpfx :: HashPrefixAlg -> ByteString -> Int -> ByteString +runhashpfxpfx (HashPrefixAlg hashAlg) v len = B.convertToBase B.Base16 $ hashPrefixWith hashAlg v len + makeTestAlg (name, hashAlg, results) = testGroup name $ concatMap maketest (zip3 is vectors results) where @@ -236,6 +254,19 @@ makeTestChunk (hashName, hashAlg, _) = runhash hashAlg inp `propertyEq` runhashinc hashAlg (chunkS ckLen inp) ] +makeTestPrefix (hashName, hashAlg) = + [ testProperty hashName $ \(ArbitraryBS0_2901 inp) (Int0_2901 len) -> + runhashpfx hashAlg (B.take len inp) `propertyEq` runhashpfxpfx hashAlg inp len + ] + +makeTestHybrid (hashName, HashPrefixAlg alg) = + [ testProperty hashName $ \(ArbitraryBS0_2901 start) (ArbitraryBS0_2901 end) -> do + len <- choose (0, B.length end) + let ref = hashWith alg (start `B.append` B.take len end) + hyb = hashFinalizePrefix (hashUpdate (hashInitWith alg) start) end len + return (ref `propertyEq` hyb) + ] + -- SHAKE128 truncation example with expected byte at final position -- shake128TruncationBytes = [0x01, 0x03, 0x07, 0x0f, 0x0f, 0x2f, 0x6f, 0x6f] @@ -253,6 +284,8 @@ makeTestSHAKE128Truncation i byte = tests = testGroup "hash" [ testGroup "KATs" (map makeTestAlg expected) , testGroup "Chunking" (concatMap makeTestChunk expected) + , testGroup "Prefix" (concatMap makeTestPrefix expectedPrefix) + , testGroup "Hybrid" (concatMap makeTestHybrid expectedPrefix) , testGroup "Truncating" [ testGroup "SHAKE128" (zipWith makeTestSHAKE128Truncation [1..] shake128TruncationBytes) From 63d427ee778df4db4f31167924545f687e9ea029 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 28 Jun 2020 08:49:28 +0200 Subject: [PATCH 165/176] Add note about other package flags --- README.md | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/README.md b/README.md index a81e889..a2ce28a 100644 --- a/README.md +++ b/README.md @@ -52,6 +52,10 @@ On OSX <= 10.7, the system compiler doesn't understand the '-maes' option, and with the lack of autodetection feature builtin in .cabal file, it is left on the user to disable the aesni. See the [Disabling AESNI] section +On CentOS 7 the default C compiler includes intrinsic header files incompatible +with per-function target options. Solutions are to use GCC >= 4.9 or disable +flag *use_target_attributes* (see flag configuration examples below). + Disabling AESNI --------------- @@ -72,6 +76,13 @@ or as part of an installation: For help with cabal flags, see: [stackoverflow : is there a way to define flags for cabal](http://stackoverflow.com/questions/23523869/is-there-any-way-to-define-flags-for-cabal-dependencies) +Enabling PCLMULDQ +----------------- + +When the C toolchain supports it, enabling flag *support_pclmuldq* can bring +additional security and performance for AES GCM. A CPU with the necessary +instruction set will use an alternate implementation selected at runtime. + Links ----- From 72544ea9aafc101dc267489b22a2fa329992a842 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Thu, 2 Jul 2020 19:35:06 +0200 Subject: [PATCH 166/176] Removed extra semicolon --- cbits/cryptonite_hash_prefix.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cbits/cryptonite_hash_prefix.c b/cbits/cryptonite_hash_prefix.c index 06df581..b487708 100644 --- a/cbits/cryptonite_hash_prefix.c +++ b/cbits/cryptonite_hash_prefix.c @@ -63,7 +63,7 @@ void CRYPTONITE_HASHED(finalize_prefix)(struct HASHED_LOWER(ctx) *ctx, const uin b = 0; /* First padding byte */ - b |= 0x80 & (uint8_t) constant_time_eq(pos, n);; + b |= 0x80 & (uint8_t) constant_time_eq(pos, n); /* Size bytes are always at the end of a block */ if (index >= cut_off) From 81cc3518007309d915cd70ff84e30248a6acaad3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 5 Jul 2020 08:48:34 +0200 Subject: [PATCH 167/176] Note about drgNewTest and endianness --- Crypto/Random.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Crypto/Random.hs b/Crypto/Random.hs index 4cea74b..28d99ef 100644 --- a/Crypto/Random.hs +++ b/Crypto/Random.hs @@ -84,6 +84,9 @@ drgNewSeed (Seed seed) = initialize seed -- Note that the @Arbitrary@ instance provided by QuickCheck for 'Word64' does -- not have a uniform distribution. It is often better to use instead -- @arbitraryBoundedRandom@. +-- +-- System endianness impacts how the tuple is interpreted and therefore changes +-- the resulting DRG. drgNewTest :: (Word64, Word64, Word64, Word64, Word64) -> ChaChaDRG drgNewTest = initializeWords From d49408156eb4595da0a2147dfae1e185e8f56f6c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 5 Jul 2020 08:48:37 +0200 Subject: [PATCH 168/176] Warn about instances exposing internals --- Crypto/Cipher/RC4.hs | 5 +++++ Crypto/Hash/IO.hs | 5 +++++ Crypto/Hash/Types.hs | 5 +++++ Crypto/MAC/Poly1305.hs | 5 +++++ 4 files changed, 20 insertions(+) diff --git a/Crypto/Cipher/RC4.hs b/Crypto/Cipher/RC4.hs index a0aa92a..b6de2ce 100644 --- a/Crypto/Cipher/RC4.hs +++ b/Crypto/Cipher/RC4.hs @@ -30,6 +30,11 @@ import Crypto.Internal.Compat import Crypto.Internal.Imports -- | The encryption state for RC4 +-- +-- This type is an instance of 'ByteArrayAccess' for debugging purpose. Internal +-- layout is architecture dependent, may contain uninitialized data fragments, +-- and change in future versions. The bytearray should not be used as input to +-- cryptographic algorithms. newtype State = State ScrubbedBytes deriving (ByteArrayAccess,NFData) diff --git a/Crypto/Hash/IO.hs b/Crypto/Hash/IO.hs index 91cb0f7..cbdeebc 100644 --- a/Crypto/Hash/IO.hs +++ b/Crypto/Hash/IO.hs @@ -24,6 +24,11 @@ import qualified Crypto.Internal.ByteArray as B import Foreign.Ptr -- | A Mutable hash context +-- +-- This type is an instance of 'B.ByteArrayAccess' for debugging purpose. +-- Internal layout is architecture dependent, may contain uninitialized data +-- fragments, and change in future versions. The bytearray should not be used +-- as input to cryptographic algorithms. newtype MutableContext a = MutableContext B.Bytes deriving (B.ByteArrayAccess) diff --git a/Crypto/Hash/Types.hs b/Crypto/Hash/Types.hs index c5170fa..e24aae1 100644 --- a/Crypto/Hash/Types.hs +++ b/Crypto/Hash/Types.hs @@ -77,6 +77,11 @@ hashContextGetAlgorithm = undefined -} -- | Represent a context for a given hash algorithm. +-- +-- This type is an instance of 'ByteArrayAccess' for debugging purpose. Internal +-- layout is architecture dependent, may contain uninitialized data fragments, +-- and change in future versions. The bytearray should not be used as input to +-- cryptographic algorithms. newtype Context a = Context Bytes deriving (ByteArrayAccess,NFData) diff --git a/Crypto/MAC/Poly1305.hs b/Crypto/MAC/Poly1305.hs index 196f985..274687f 100644 --- a/Crypto/MAC/Poly1305.hs +++ b/Crypto/MAC/Poly1305.hs @@ -33,6 +33,11 @@ import Crypto.Internal.DeepSeq import Crypto.Error -- | Poly1305 State +-- +-- This type is an instance of 'ByteArrayAccess' for debugging purpose. Internal +-- layout is architecture dependent, may contain uninitialized data fragments, +-- and change in future versions. The bytearray should not be used as input to +-- cryptographic algorithms. newtype State = State ScrubbedBytes deriving (ByteArrayAccess) From fa19117dfec31b266c28cddffc14d583e1c088fd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 19 Jul 2020 15:44:10 +0200 Subject: [PATCH 169/176] Avoid thunk leak with AEAD state --- Crypto/Cipher/Types/AEAD.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Crypto/Cipher/Types/AEAD.hs b/Crypto/Cipher/Types/AEAD.hs index 4a4f613..ef306b0 100644 --- a/Crypto/Cipher/Types/AEAD.hs +++ b/Crypto/Cipher/Types/AEAD.hs @@ -27,7 +27,7 @@ data AEADModeImpl st = AEADModeImpl -- | Authenticated Encryption with Associated Data algorithms data AEAD cipher = forall st . AEAD { aeadModeImpl :: AEADModeImpl st - , aeadState :: st + , aeadState :: !st } -- | Append some header information to an AEAD context From 18ae7a7b409e4d286fca21de3dd8d6562be46073 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 19 Jul 2020 15:45:49 +0200 Subject: [PATCH 170/176] Remove redundant brackets --- Crypto/Cipher/Types/AEAD.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Crypto/Cipher/Types/AEAD.hs b/Crypto/Cipher/Types/AEAD.hs index ef306b0..23c1a25 100644 --- a/Crypto/Cipher/Types/AEAD.hs +++ b/Crypto/Cipher/Types/AEAD.hs @@ -32,19 +32,19 @@ data AEAD cipher = forall st . AEAD -- | Append some header information to an AEAD context aeadAppendHeader :: ByteArrayAccess aad => AEAD cipher -> aad -> AEAD cipher -aeadAppendHeader (AEAD impl st) aad = AEAD impl $ (aeadImplAppendHeader impl) st aad +aeadAppendHeader (AEAD impl st) aad = AEAD impl $ aeadImplAppendHeader impl st aad -- | Encrypt some data and update the AEAD context aeadEncrypt :: ByteArray ba => AEAD cipher -> ba -> (ba, AEAD cipher) -aeadEncrypt (AEAD impl st) ba = second (AEAD impl) $ (aeadImplEncrypt impl) st ba +aeadEncrypt (AEAD impl st) ba = second (AEAD impl) $ aeadImplEncrypt impl st ba -- | Decrypt some data and update the AEAD context aeadDecrypt :: ByteArray ba => AEAD cipher -> ba -> (ba, AEAD cipher) -aeadDecrypt (AEAD impl st) ba = second (AEAD impl) $ (aeadImplDecrypt impl) st ba +aeadDecrypt (AEAD impl st) ba = second (AEAD impl) $ aeadImplDecrypt impl st ba -- | Finalize the AEAD context and return the authentication tag aeadFinalize :: AEAD cipher -> Int -> AuthTag -aeadFinalize (AEAD impl st) n = (aeadImplFinalize impl) st n +aeadFinalize (AEAD impl st) = aeadImplFinalize impl st -- | Simple AEAD encryption aeadSimpleEncrypt :: (ByteArrayAccess aad, ByteArray ba) From b29dc159fb600eab756e9a92fb59eb06ce2379e3 Mon Sep 17 00:00:00 2001 From: Patrick Chilton Date: Fri, 7 Aug 2020 21:36:19 +0200 Subject: [PATCH 171/176] Hash data in 4GB chunks to avoid uint32_t overflow. --- Crypto/Hash.hs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/Crypto/Hash.hs b/Crypto/Hash.hs index 50abed6..9a53003 100644 --- a/Crypto/Hash.hs +++ b/Crypto/Hash.hs @@ -50,11 +50,11 @@ import Basement.Block.Mutable (copyFromPtr, new) import Crypto.Internal.Compat (unsafeDoIO) import Crypto.Hash.Types import Crypto.Hash.Algorithms -import Foreign.Ptr (Ptr) +import Foreign.Ptr (Ptr, plusPtr) import Crypto.Internal.ByteArray (ByteArrayAccess) import qualified Crypto.Internal.ByteArray as B import qualified Data.ByteString.Lazy as L -import Data.Word (Word8) +import Data.Word (Word8, Word32) -- | Hash a strict bytestring into a digest. hash :: (ByteArrayAccess ba, HashAlgorithm a) => ba -> Digest a @@ -88,9 +88,17 @@ hashUpdates :: forall a ba . (HashAlgorithm a, ByteArrayAccess ba) hashUpdates c l | null ls = c | otherwise = Context $ B.copyAndFreeze c $ \(ctx :: Ptr (Context a)) -> - mapM_ (\b -> B.withByteArray b $ \d -> hashInternalUpdate ctx d (fromIntegral $ B.length b)) ls + mapM_ (\b -> B.withByteArray b (processBlocks ctx (B.length b))) ls where ls = filter (not . B.null) l + -- process the data in 4GB chunks to fit in uint32_t + processBlocks ctx bytesLeft dataPtr + | bytesLeft == 0 = return () + | otherwise = do + hashInternalUpdate ctx dataPtr (fromIntegral actuallyProcessed) + processBlocks ctx (bytesLeft - actuallyProcessed) (dataPtr `plusPtr` actuallyProcessed) + where + actuallyProcessed = min bytesLeft (fromIntegral (maxBound :: Word32)) -- | Finalize a context and return a digest. hashFinalize :: forall a . HashAlgorithm a From 955f94b784c8a34c834d5b76d9116d0dab19f6bf Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Wed, 27 Jan 2021 10:48:00 +0800 Subject: [PATCH 172/176] release 0.28 --- CHANGELOG.md | 5 +++++ cryptonite.cabal | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 198c7b5..faa4468 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +## 0.28 + +* Add hash constant time capability +* Prevent possible overflow during hashing by hashing in 4GB chunks + ## 0.27 * Optimise AES GCM and CCM diff --git a/cryptonite.cabal b/cryptonite.cabal index b9af22f..ee01233 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -1,5 +1,5 @@ Name: cryptonite -version: 0.27 +version: 0.28 Synopsis: Cryptography Primitives sink Description: A repository of cryptographic primitives. From 95b247e5eb1a9e98a330f81f5afa9c8be9d0d797 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Wed, 14 Apr 2021 17:16:15 +1200 Subject: [PATCH 173/176] Fix for 32 bit platforms The use of `(fromIntegral (maxBound :: Word32))` causes problems. It is used to make an `Int` and 32 bit systems it winds up being -1. --- Crypto/Hash.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/Crypto/Hash.hs b/Crypto/Hash.hs index 9a53003..0568cb8 100644 --- a/Crypto/Hash.hs +++ b/Crypto/Hash.hs @@ -54,7 +54,8 @@ import Foreign.Ptr (Ptr, plusPtr) import Crypto.Internal.ByteArray (ByteArrayAccess) import qualified Crypto.Internal.ByteArray as B import qualified Data.ByteString.Lazy as L -import Data.Word (Word8, Word32) +import Data.Word (Word8) +import Data.Int (Int32) -- | Hash a strict bytestring into a digest. hash :: (ByteArrayAccess ba, HashAlgorithm a) => ba -> Digest a @@ -91,14 +92,14 @@ hashUpdates c l mapM_ (\b -> B.withByteArray b (processBlocks ctx (B.length b))) ls where ls = filter (not . B.null) l - -- process the data in 4GB chunks to fit in uint32_t + -- process the data in 2GB chunks to fit in uint32_t and Int on 32 bit systems processBlocks ctx bytesLeft dataPtr | bytesLeft == 0 = return () | otherwise = do hashInternalUpdate ctx dataPtr (fromIntegral actuallyProcessed) processBlocks ctx (bytesLeft - actuallyProcessed) (dataPtr `plusPtr` actuallyProcessed) where - actuallyProcessed = min bytesLeft (fromIntegral (maxBound :: Word32)) + actuallyProcessed = min bytesLeft (fromIntegral (maxBound :: Int32)) -- | Finalize a context and return a digest. hashFinalize :: forall a . HashAlgorithm a From b6981a4ea5eb26d283f89489ede2110faa758621 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Sat, 8 May 2021 22:57:01 +0800 Subject: [PATCH 174/176] latest integer-gmp breaks advance GMP functions again (...) --- Crypto/Number/Compat.hs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/Crypto/Number/Compat.hs b/Crypto/Number/Compat.hs index 01e0455..39acdc8 100644 --- a/Crypto/Number/Compat.hs +++ b/Crypto/Number/Compat.hs @@ -72,7 +72,9 @@ gmpLog2 _ = GmpUnsupported -- | Compute the power modulus using extra security to remain constant -- time wise through GMP gmpPowModSecInteger :: Integer -> Integer -> Integer -> GmpSupported Integer -#if MIN_VERSION_integer_gmp(1,0,2) +#if MIN_VERSION_integer_gmp(1,1,0) +gmpPowModSecInteger _ _ _ = GmpUnsupported +#elif MIN_VERSION_integer_gmp(1,0,2) gmpPowModSecInteger b e m = GmpSupported (powModSecInteger b e m) #elif MIN_VERSION_integer_gmp(1,0,0) gmpPowModSecInteger _ _ _ = GmpUnsupported @@ -103,7 +105,9 @@ gmpInverse _ _ = GmpUnsupported -- | Get the next prime from a specific value through GMP gmpNextPrime :: Integer -> GmpSupported Integer -#if MIN_VERSION_integer_gmp(0,5,1) +#if MIN_VERSION_integer_gmp(1,1,0) +gmpNextPrime _ = GmpUnsupported +#elif MIN_VERSION_integer_gmp(0,5,1) gmpNextPrime n = GmpSupported (nextPrimeInteger n) #else gmpNextPrime _ = GmpUnsupported @@ -111,7 +115,9 @@ gmpNextPrime _ = GmpUnsupported -- | Test if a number is prime using Miller Rabin gmpTestPrimeMillerRabin :: Int -> Integer -> GmpSupported Bool -#if MIN_VERSION_integer_gmp(0,5,1) +#if MIN_VERSION_integer_gmp(1,1,0) +gmpTestPrimeMillerRabin _ _ = GmpUnsupported +#elif MIN_VERSION_integer_gmp(0,5,1) gmpTestPrimeMillerRabin (I# tries) !n = GmpSupported $ case testPrimeInteger n tries of 0# -> False From a6fbe0ed4cbf4e7312279ad1dfc73f83cfa8fcc8 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Sat, 8 May 2021 22:57:36 +0800 Subject: [PATCH 175/176] fix miscompilation with ghc9 --- Crypto/PubKey/EdDSA.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Crypto/PubKey/EdDSA.hs b/Crypto/PubKey/EdDSA.hs index 95fa7fd..d60a340 100644 --- a/Crypto/PubKey/EdDSA.hs +++ b/Crypto/PubKey/EdDSA.hs @@ -353,7 +353,7 @@ instance EllipticCurveEdDSA Curve_Edwards25519 where scheduleSecret prx alg priv = (decodeScalarNoErr prx clamped, B.dropView hashed 32) where - hashed = digest alg ($ priv) + hashed = digest alg $ \update -> update priv clamped :: Bytes clamped = B.copyAndFreeze (B.takeView hashed 32) $ \p -> do From 4b4a6419707888a1cb3d3416cde051a843a7dd4b Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Sat, 8 May 2021 23:00:34 +0800 Subject: [PATCH 176/176] cryptonite-0.29 --- cryptonite.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cryptonite.cabal b/cryptonite.cabal index 0be2b2f..83d100b 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -1,5 +1,5 @@ Name: cryptonite -version: 0.28 +version: 0.29 Synopsis: Cryptography Primitives sink Description: A repository of cryptographic primitives.