diff --git a/DSA.cabal b/DSA.cabal new file mode 100644 --- /dev/null +++ b/DSA.cabal @@ -0,0 +1,74 @@ +name: DSA +category: Cryptography, Codec +version: 1 +license: BSD3 +license-file: LICENSE +author: Adam Wick +maintainer: Adam Wick +stability: stable +build-type: Simple +cabal-version: >= 1.8 +tested-with: GHC ==7.8.0 +synopsis: Implementation of DSA, based on the description of FIPS 186-4 +description: This library implements the DSA encryption and signature + algorithms for arbitrarily-sized ByteStrings. While the + implementations work, they are not necessarily the fastest ones + on the planet. Particularly key generation. The algorithms + included are based of NIST's FIPS 186-4 document. + +flag gmp + description: Whether or not the library can assume integer-gmp + +flag better-tests + description: Use better (but much slower) tests in the test suite. + default: False + +Library + hs-source-dirs: src + build-depends: base >= 4.6 && < 7.0, + binary > 0.7 && < 1.0, + bytestring > 0.8 && < 0.12, + crypto-api >= 0.10 && < 0.14, + crypto-pubkey-types >= 0.2 && < 0.6, + SHA >= 1.6.4.1 && < 2.0, + tagged >= 0.8.0.1 && < 1.0 + if flag(gmp) + build-depends: ghc-prim >= 0.3.1.0 && < 0.7, + integer-gmp >= 0.5.1.0 && < 1.2 + cpp-options: -DUSE_GMP_HELPERS + exposed-modules: Codec.Crypto.DSA, + Codec.Crypto.DSA.Pure, + Codec.Crypto.DSA.Exceptions + GHC-Options: -Wall -fno-warn-orphans + extensions: BangPatterns, CPP, MagicHash, MultiWayIf + +test-suite test-dsa + type: exitcode-stdio-1.0 + Main-Is: Test.hs + hs-source-dirs: src + build-depends: base >= 4.6 && < 7.0, + binary > 0.7 && < 1.0, + bytestring > 0.8 && < 0.12, + crypto-api >= 0.10 && < 0.14, + crypto-pubkey-types >= 0.4 && < 0.6, + DRBG >= 0.5.2 && < 0.7, + HUnit >= 1.2.5.2 && < 1.4, + QuickCheck >= 2.5 && < 3, + tagged >= 0.2 && < 0.9, + test-framework >= 0.8.0.3 && < 0.10, + test-framework-hunit >= 0.3 && < 0.5, + test-framework-quickcheck2 >= 0.3.0.2 && < 0.5, + SHA >= 1.6.4.1 && < 2.0 + if flag(gmp) + build-depends: ghc-prim >= 0.3.1.0 && < 0.7, + integer-gmp >= 0.5.1.0 && < 1.2 + cpp-options: -DUSE_GMP_HELPERS + if flag(better-tests) + cpp-options: -DBETTER_TESTS + GHC-Options: -Wall -fno-warn-orphans + extensions: DeriveDataTypeable, MultiWayIf, ScopedTypeVariables + +source-repository head + type: git + location: git://github.com/acw/RSA.git + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2013, Adam Wick + +All rights reserved. + +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 Adam Wick nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Codec/Crypto/DSA.hs b/src/Codec/Crypto/DSA.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Crypto/DSA.hs @@ -0,0 +1,6 @@ +module Codec.Crypto.DSA( + module Codec.Crypto.DSA.Exceptions + ) + where + +import Codec.Crypto.DSA.Exceptions diff --git a/src/Codec/Crypto/DSA/Exceptions.hs b/src/Codec/Crypto/DSA/Exceptions.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Crypto/DSA/Exceptions.hs @@ -0,0 +1,240 @@ +module Codec.Crypto.DSA.Exceptions( + -- * Basic DSA Concepts + ParameterSizes(..) + , Params(..) + , PublicKey(..) + , PrivateKey(..) + , Signature(..) + , DSAError(..) + , getN, getL + -- * DSA Key generation + , generateKeyPair + , generateKeyPairWithParams + -- * DSA Message Signing + -- ** Basic, Suggested Mechanisms + , signMessage + , verifyMessage + -- ** Advanced Methods + , HashFunction(..) + , signMessage' + , verifyMessage' + -- ** /k/ Generation Mechanisms + , KGenerator + , KSequence(..) + , kViaExtraRandomBits + , kViaTestingCandidates + , kViaRFC6979 + -- * Generation of /p/ and /q/ + -- ** Generation via the probable primes method + , ProbablePrimesEvidence(..) + , generateProbablePrimes + , validateProbablePrimes + -- ** Generation via the provable primes method + , ProvablePrimesEvidence(..) + , generateProvablePrimes + , validateProvablePrimes + -- * Generation of the generator /g/ + , generateUnverifiableGenerator + , generatorIsValid + , generateVerifiableGenerator + , validateVerifiableGenerator + ) + where + +import Codec.Crypto.DSA.Pure(ParameterSizes(..), HashFunction(..), + DSAError(..), ProbablePrimesEvidence(..), + ProvablePrimesEvidence(..), GenerationEvidence, + KGenerator, KSequence(..), getN, getL) +import qualified Codec.Crypto.DSA.Pure as Pure +import Control.Exception +import Crypto.Random +import Crypto.Types.PubKey.DSA +import Data.ByteString.Lazy(ByteString) +import Data.Word + +-- |Generate a DSA key pair. This will also generate the /p/, /q/, and /g/ +-- parameters using provable and verifiable algorithms, with SHA-256 as the +-- hash function. If you want to use your own /p/, /q/, and /g/ values or +-- specify your own generation or hash function,, use the +-- 'generateKeyPairWithParams' function, below. +generateKeyPair :: CryptoRandomGen g => + g -> ParameterSizes -> + (PublicKey, PrivateKey, ProvablePrimesEvidence, g) +generateKeyPair g s = throwLeft (Pure.generateKeyPair g s) + +-- |Generate a key pair given a set of DSA parameters. You really should have +-- validated this set (/p/, /q/, and /g/) using the relevant functions below +-- before you do this. Doing so even if you generated them is probably not a bad +-- practice. +-- +-- This uses the method using extra random bits from FIPS 186-4. You better be +-- using a good enough random number generator. +generateKeyPairWithParams :: CryptoRandomGen g => + Params -> g -> + (PublicKey, PrivateKey, g) +generateKeyPairWithParams p g = + throwLeft (Pure.generateKeyPairWithParams p g) + +-- |Sign a message using DSA. This method utilizes very good defaults for +-- message signing that should be acceptable for most use cases: it uses SHA-256 +-- for the hash function, and generates /k/ using the methods described in RFC +-- 6979. If you wish to change these defaults, please see `signMessaage'`. +signMessage :: PrivateKey -> ByteString -> Signature +signMessage p m = throwLeft (Pure.signMessage p m) + +-- |Verify a DSA message signature. This uses the same default mechanisms as +-- `signMessage`. +verifyMessage :: PublicKey -> ByteString -> Signature -> Bool +verifyMessage = Pure.verifyMessage' SHA256 + +-- |Sign a message given the hash function an /k/ generation routine. Returns +-- either an error the signature generated. You can define your own /k/ +-- generation routine ... but we don't recommend it. Actually, while we're +-- recommending, we recommend you use `kViaRFC6979`, if you're not sure +-- which to use. +signMessage' :: CryptoRandomGen g => + HashFunction -> KGenerator g -> g -> + PrivateKey -> ByteString -> + (Signature, g) +signMessage' h m g p b = throwLeft (Pure.signMessage' h m g p b) + +-- |Verify a signed message. You need to know what hash algorithm they used +-- to generate the signature, and pass it in. Returns True if the signature +-- was valid. +verifyMessage' :: HashFunction -> PublicKey -> ByteString -> Signature -> Bool +verifyMessage' = Pure.verifyMessage' + +kViaExtraRandomBits :: CryptoRandomGen g => KGenerator g +kViaExtraRandomBits = Pure.kViaExtraRandomBits + +kViaTestingCandidates :: CryptoRandomGen g => KGenerator g +kViaTestingCandidates = Pure.kViaTestingCandidates + +kViaRFC6979 :: CryptoRandomGen g => KGenerator g +kViaRFC6979 = Pure.kViaRFC6979 + +-- | Using an approved hash function -- at the point of writing, a SHA-2 +-- variant -- generate values of p and q for use in DSA, for which p and +-- q have a very high probability of being prime. In addition to p and q, +-- this routine returns the "domain parameter seed" and "counter" used to +-- generate the primes. These can be supplied to later validation functions; +-- their secrecy is not required for the algorithm to work. +-- +-- The inputs to the function are the DSA parameters we are generating a +-- key for, a source of entropy, the hash function to use, and (optionally) +-- the length of the domain parameter seed to use. The last item must be +-- greater to or later to the value of n, if supplied, and will be set to +-- (n + 8) if not. +-- +-- The security of this method depends on the strength of the hash being +-- used. To that end, FIPS 140-2 requires a SHA-2 variant. +generateProbablePrimes :: CryptoRandomGen g => + ParameterSizes -> + g -> + (ByteString -> ByteString) -> + Maybe Integer -> + (Integer,Integer, ProbablePrimesEvidence, g) +generateProbablePrimes p g h i = + throwLeft (Pure.generateProbablePrimes p g h i) + +-- |Validate that the probable primes that either you generated or that someone +-- provided to you are legitimate. +validateProbablePrimes :: CryptoRandomGen g => + g {- A random number source -} -> + Integer {- ^p -} -> + Integer {- ^q -} -> + ProbablePrimesEvidence {- ^The evidence -} -> + (Bool, g) +validateProbablePrimes = Pure.validateProbablePrimes + +-- |Using an approved hash function -- at the point of writing, a SHA-2 +-- variant -- generate values of p and q for use in DSA, for which p and +-- q are provably prime. In addition to p and q, this routine generates +-- a series of additional values that can be used to validate that this +-- algorithm performed correctly. +-- +-- The inputs to the function are the DSA parameters we are generating +-- key for, a source of entropy, the hash function to use, and (optionally) +-- an initial seed length in bits. The last item, if provided, must be +-- greater than or equal to the N value being tested against, and must +-- be a multiple of 8. +generateProvablePrimes :: CryptoRandomGen g => + ParameterSizes {- ^The DSA parameters to use -} -> + g {- ^source of randomness -} -> + (ByteString -> ByteString) {- ^Hash function -} -> + Maybe Integer {- ^Optional seed length, in bits. Must + be greater than or equal to N, and + divisible by 8. -} -> + (Integer, Integer, ProvablePrimesEvidence, g) +generateProvablePrimes a b c d = throwLeft (Pure.generateProvablePrimes a b c d) + +-- |Validate that the provable primes that either you generated or that +-- someone provided to you are legitimate. +validateProvablePrimes :: Integer -> Integer -> + ProvablePrimesEvidence -> + Bool +validateProvablePrimes = Pure.validateProvablePrimes + +-- |Generate the generator /g/ using a method that is not verifiable to a third +-- party. Quoth FIPS: "[This] method ... may be used when complete validation of +-- the generator /g/ is not required; it is recommended that this method be used +-- only when the party generating /g/ is trusted to not deliberately generate a +-- /g/ that has a potentially exploitable relationship to another generator +-- /g'/. +-- +-- The input to this function are a valid /p/ and /q/, generated using an +-- approved method. +-- +-- It may be possible (?) that this routine could fail to find a possible +-- generator. In that case, Nothing is returned. +generateUnverifiableGenerator :: Integer -> Integer -> Integer +generateUnverifiableGenerator p q = + throwNothing (Pure.generateUnverifiableGenerator p q) + +-- |Validate that the given generator /g/ works for the values /p/ and /q/ +-- provided. +generatorIsValid :: Integer {- ^p -} -> Integer {- ^q -} -> + Integer {- ^g -} -> + Bool +generatorIsValid = Pure.generatorIsValid + +-- |Generate a generator /g/, given the values of /p/, /q/, the evidence created +-- generating those values, and an index. Quoth FIPS: "This generation method +-- supports the generation of multiple values of /g/ for specific values of /p/ +-- and /q/. The use of different values of /g/ for the same /p/ and /q/ may be +-- used to support key separation; for example, using the /g/ that is generated +-- with @index = 1@ for digital signatures and with @index = 2@ for key +-- establishment." +-- +-- This method is replicatable, so that given the same inputs it will generate +-- the same outputs. Thus, you can validate that the /g/ generated using this +-- method was generated correctly using 'validateVerifiableGenerator', which +-- will be nice if you don't trust the person you're talking to. +generateVerifiableGenerator :: GenerationEvidence ev => + Integer {- ^p -} -> Integer {- ^q -} -> + ev {- ^The evidence created generating /p/ + and /q/ -} -> + Word8 {- ^an index (This allows multiple /g/s + from one pair) -} -> + Integer +generateVerifiableGenerator a b c d = + throwNothing (Pure.generateVerifiableGenerator a b c d) + +-- |Validate that the value /g/ was generated by 'generateVerifiableGenerator' +-- or someone using the same algorithm. This is probably a good idea if you +-- don't trust your compatriot. +validateVerifiableGenerator :: GenerationEvidence ev => + Integer {- ^p -} -> Integer {- ^q -} -> + ev {- ^The evidence created generating /p/ + and /q/ -} -> + Word8 {- ^an index (This allows multiple /g/s + from one pair) -} -> + Integer {- ^g -} -> + Bool +validateVerifiableGenerator = Pure.validateVerifiableGenerator + +-- + +throwNothing :: Maybe a -> a +throwNothing Nothing = throw DSAInvalidInput +throwNothing (Just x) = x diff --git a/src/Codec/Crypto/DSA/Pure.hs b/src/Codec/Crypto/DSA/Pure.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Crypto/DSA/Pure.hs @@ -0,0 +1,959 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE MultiWayIf #-} +module Codec.Crypto.DSA.Pure( + -- * Basic DSA Concepts + ParameterSizes(..) + , Params(..) + , PublicKey(..) + , PrivateKey(..) + , Signature(..) + , DSAError(..) + , getN, getL + -- * DSA Key generation + , generateKeyPair + , generateKeyPairWithParams + -- * DSA Message Signing + -- ** Basic, Suggested Mechanisms + , signMessage + , verifyMessage + -- ** Advanced Methods + , HashFunction(..) + , signMessage' + , verifyMessage' + -- ** /k/ Generation Mechanisms + , KGenerator + , KSequence(..) + , kViaExtraRandomBits + , kViaTestingCandidates + , kViaRFC6979 + -- * Generation of /p/ and /q/ + -- ** Generation via the probable primes method + , ProbablePrimesEvidence(..) + , generateProbablePrimes + , validateProbablePrimes + -- ** Generation via the provable primes method + , ProvablePrimesEvidence(..) + , generateProvablePrimes + , validateProvablePrimes + -- * Generation of the generator /g/ + , GenerationEvidence + , generateUnverifiableGenerator + , generatorIsValid + , generateVerifiableGenerator + , validateVerifiableGenerator + -- * Exported only for testing. + -- ** Prime number routines + , millerRabin + , isDeterministicallyPrime + , shaweTaylor + -- ** ByteString / Integer conversion + , bs2int + , bss2int + , int2bs + -- ** Miscellaneous numeric procedures + , findAandM + , modExp + ) + where + +import Control.Exception(Exception) +import Crypto.Random +import Crypto.Types.PubKey.DSA +import Data.Bits +import Data.ByteString.Lazy(ByteString) +import qualified Data.ByteString as BSS +import qualified Data.ByteString.Lazy as BS +import Data.Digest.Pure.SHA +import Data.Either +import Data.Int +import Data.Maybe +import Data.Tagged +import Data.Word +import Prelude hiding (length) + +#if defined(USE_GMP_HELPERS) +import GHC.Integer.GMP.Internals +import GHC.Types +#endif + +data ParameterSizes = L1024_N160 | L2048_N224 | L2048_N256 | L3072_N256 + deriving (Eq, Show) + +data DSAError = DSARandomGenerationError GenError + | DSAInvalidSeedLength + | DSAInvalidPrimeTestInput + | DSAInvalidInput + | DSAInternalInversionError + | DSAGaveUp + deriving (Eq, Show) + +instance Exception DSAError + +-- |Get the N parameter, in bits. +getN :: ParameterSizes -> Integer +getN L1024_N160 = 160 +getN L2048_N224 = 224 +getN L2048_N256 = 256 +getN L3072_N256 = 256 + +-- |Get the L parameter, in bits. +getL :: ParameterSizes -> Integer +getL L1024_N160 = 1024 +getL L2048_N224 = 2048 +getL L2048_N256 = 2048 +getL L3072_N256 = 3072 + +-- |Generate a DSA key pair. This will also generate the /p/, /q/, and /g/ +-- parameters using provable and verifiable algorithms, with SHA-256 as the +-- hash function. If you want to use your own /p/, /q/, and /g/ values or +-- specify your own generation or hash function,, use the +-- 'generateKeyPairWithParams' function, below. +generateKeyPair :: CryptoRandomGen g => + g -> ParameterSizes -> + Either DSAError (PublicKey, PrivateKey, + ProvablePrimesEvidence, g) +generateKeyPair gen sizes = + case generateProvablePrimes sizes gen sha256' Nothing of + Left err -> Left err + Right (p, q, ev, gen') -> + case generateVerifiableGenerator p q ev 0 of + Nothing -> generateKeyPair gen' sizes + Just g -> + case generateKeyPairWithParams (Params p g q) gen' of + Left err -> Left err + Right (pub, priv, gen'') -> Right (pub, priv, ev, gen'') + where sha256' = bytestringDigest . sha256 + +-- |Generate a key pair given a set of DSA parameters. You really should have +-- validated this set (/p/, /q/, and /g/) using the relevant functions below +-- before you do this. Doing so even if you generated them is probably not a bad +-- practice. +-- +-- This uses the method using extra random bits from FIPS 186-4. You better be +-- using a good enough random number generator. +generateKeyPairWithParams :: CryptoRandomGen g => + Params -> g -> + Either DSAError (PublicKey, PrivateKey, g) +generateKeyPairWithParams params gen = + case genBytes ((fromIntegral bigN + 64) `div` 8) gen of + Left err -> Left (DSARandomGenerationError err) + Right (returned_bits, gen') -> + let c = bss2int returned_bits + x = (c `mod` (q - 1)) + 1 + y = modExp g x p + in Right (PublicKey params y, PrivateKey params x, gen') + where + bigN = intlen g + p = params_p params + g = params_g params + q = params_q params + +-- |Sign a message using DSA. This method utilizes very good defaults for +-- message signing that should be acceptable for most use cases: it uses SHA-256 +-- for the hash function, and generates /k/ using the methods described in RFC +-- 6979. If you wish to change these defaults, please see `signMessaage'`. +signMessage :: PrivateKey -> ByteString -> Either DSAError Signature +signMessage priv msg = + case signMessage' SHA256 kViaRFC6979 NoGen priv msg of + Left err -> Left err + Right (res, _) -> Right res + +-- |Verify a DSA message signature. This uses the same default mechanisms as +-- `signMessage`. +verifyMessage :: PublicKey -> ByteString -> Signature -> Bool +verifyMessage = verifyMessage' SHA256 + +-- |The hash to use in generating the signature. We strongly recommend SHA256 +-- or better. +data HashFunction = SHA1 | SHA224 | SHA256 | SHA384 | SHA512 + deriving (Eq, Show) + +runHash :: HashFunction -> ByteString -> ByteString +runHash SHA1 = bytestringDigest . sha1 +runHash SHA224 = bytestringDigest . sha224 +runHash SHA256 = bytestringDigest . sha256 +runHash SHA384 = bytestringDigest . sha384 +runHash SHA512 = bytestringDigest . sha512 + +runHMac :: HashFunction -> ByteString -> ByteString -> ByteString +runHMac SHA1 k v = bytestringDigest (hmacSha1 k v) +runHMac SHA224 k v = bytestringDigest (hmacSha224 k v) +runHMac SHA256 k v = bytestringDigest (hmacSha256 k v) +runHMac SHA384 k v = bytestringDigest (hmacSha384 k v) +runHMac SHA512 k v = bytestringDigest (hmacSha512 k v) + +getHashLength :: HashFunction -> Int64 +getHashLength hash = BS.length (runHash hash BS.empty) + +-- |Sign a message given the hash function an /k/ generation routine. Returns +-- either an error the signature generated. You can define your own /k/ +-- generation routine ... but we don't recommend it. Actually, while we're +-- recommending, we recommend you use `kViaRFC6979`, if you're not sure +-- which to use. +signMessage' :: CryptoRandomGen g => + HashFunction -> KGenerator g -> g -> + PrivateKey -> ByteString -> + Either DSAError (Signature, g) +signMessage' hash genMeth gen privkey msg = loop kseq + where + params = private_params privkey + p = params_p params + q = params_q params + g = params_g params + x = private_x privkey + bigN = fromIntegral (intlen q) + outlen = getHashLength hash + kseq = genMeth gen hash privkey msg + -- + loop (KFailure err) = Left err + loop (KValue k gen' next) + | isNothing kinvres = Left DSAInternalInversionError + | (r == 0) || (s == 0) = loop next + | otherwise = Right (Signature r s, gen') + where + r = (modExp g k p) `mod` q + z = bs2int (BS.take (min bigN outlen) (runHash hash msg)) + s = (kinv * (z + (x * r))) `mod` q + kinvres = modInv k q + Just kinv = kinvres + +-- |Verify a signed message. You need to know what hash algorithm they used +-- to generate the signature, and pass it in. Returns True if the signature +-- was valid. +verifyMessage' :: HashFunction -> PublicKey -> ByteString -> Signature -> Bool +verifyMessage' hash pubkey msg sig + | ((r' <= 0) || (r' >= q)) = False + | ((s' <= 0) || (s' >= q)) = False + | isNothing mw = False + | otherwise = v == r' + where + r' = sign_r sig + s' = sign_s sig + p = params_p (public_params pubkey) + q = params_q (public_params pubkey) + g = params_g (public_params pubkey) + y = public_y pubkey + bigN = fromIntegral (intlen q) + outlen = BS.length (runHash hash BS.empty) + -- + mw = modInv s' q + w = fromJust mw + z = bs2int (BS.take (min bigN outlen) (runHash hash msg)) + u1 = (z * w) `mod` q + u2 = (r' * w) `mod` q + v = (((modExp g u1 p) * (modExp y u2 p)) `mod` p) `mod` q + +type KGenerator g = g -> HashFunction -> + PrivateKey -> ByteString -> + KSequence g + +data CryptoRandomGen g => KSequence g = KValue Integer g (KSequence g) + | KFailure DSAError + +kViaExtraRandomBits :: CryptoRandomGen g => KGenerator g +kViaExtraRandomBits g hash privkey msg + | isLeft randres = KFailure (DSARandomGenerationError err) + | otherwise = KValue k g' (kViaExtraRandomBits g' hash privkey msg) + where + q = params_q (private_params privkey) + bigN = intlen q + randres = genBytes (fromIntegral bigN + 64) g + Left err = randres + Right (returned_bits, g') = randres + c = bss2int returned_bits + k = (c `mod` (q - 1)) + 1 + +kViaTestingCandidates :: CryptoRandomGen g => KGenerator g +kViaTestingCandidates g hash privkey msg + | isLeft randres = KFailure (DSARandomGenerationError err) + | c > (q - 2) = kViaTestingCandidates g' hash privkey msg + | otherwise = KValue k g' (kViaTestingCandidates g' hash privkey msg) + where + params = private_params privkey + q = params_q params + bigN = intlen q + randres = genBytes (fromIntegral bigN) g + Left err = randres + Right (returned_bits, g') = randres + c = bss2int returned_bits + k = c + 1 + +kViaRFC6979 :: CryptoRandomGen g => KGenerator g +kViaRFC6979 g hash privkey msg = loop bigK_2 bigV_2 + where + x = private_x privkey + q = params_q (private_params privkey) + qlen = fromInteger (intlen q) + h1 = runHash hash msg + hlen = BS.length h1 + -- + bigV_0 = BS.replicate hlen 1 + bigK_0 = BS.replicate hlen 0 + bigK_1 = runHMac hash bigK_0 (BS.concat [bigV_0, BS.singleton 0, + int2octets x, bits2octets h1]) + bigV_1 = runHMac hash bigK_1 bigV_0 + bigK_2 = runHMac hash bigK_1 (BS.concat [bigV_1, BS.singleton 1, + int2octets x, bits2octets h1]) + bigV_2 = runHMac hash bigK_2 bigV_1 + -- + buildT bigK bigV bigT | BS.length bigT >= qlen = (bigV, bits2int bigT) + | otherwise = buildT bigK bigV' bigT' + where + bigV' = runHMac hash bigK bigV + bigT' = bigT `BS.append` bigV' + -- + loop bigK bigV | (1 <= k) && (k <= (q - 1)) = KValue k g (loop bigK' bigV'') + | otherwise = loop bigK' bigV'' + where + (bigV', k) = buildT bigK bigV BS.empty + bigK' = runHMac hash bigK (bigV' `BS.append` BS.singleton 0) + bigV'' = runHMac hash bigK' bigV' + -- + bitlen :: Integer -> Int + bitlen y = go y 0 + where + go 0 acc = acc + go v acc = go (v `shiftR` 1) (acc + 1) + -- + bits2int :: ByteString -> Integer + bits2int bstr | qbtlen < blen = value `shiftR` (blen - qbtlen) + | otherwise = value + where + blen = fromIntegral (BS.length bstr * 8) + qbtlen = bitlen q + value = bs2int bstr + -- + bits2octets :: ByteString -> ByteString + bits2octets bstr = BS.replicate (qlen - BS.length res) 0 `BS.append` res + where + res = int2bs (z1 `mod` q) + z1 = bits2int bstr + -- + int2octets :: Integer -> ByteString + int2octets y + | BS.length out < qlen = padding `BS.append` out + | BS.length out > qlen = BS.drop (BS.length out - qlen) out + | otherwise = out + where + out = int2bs y + padding = BS.replicate (qlen - BS.length out) 0 + +-- |The evidence generated when generating probably primes. This evidence can +-- be used to ensure that the /p/ and /q/ values provided were generated +-- appropriately. +data ProbablePrimesEvidence = ProbablePrimesEvidence { + prpeDomainParameterSeed :: Integer + , prpeCounter :: Integer + , prpeHash :: ByteString -> ByteString + } + +-- | Using an approved hash function -- at the point of writing, a SHA-2 +-- variant -- generate values of p and q for use in DSA, for which p and +-- q have a very high probability of being prime. In addition to p and q, +-- this routine returns the "domain parameter seed" and "counter" used to +-- generate the primes. These can be supplied to later validation functions; +-- their secrecy is not required for the algorithm to work. +-- +-- The inputs to the function are the DSA parameters we are generating a +-- key for, a source of entropy, the hash function to use, and (optionally) +-- the length of the domain parameter seed to use. The last item must be +-- greater to or later to the value of n, if supplied, and will be set to +-- (n + 8) if not. +-- +-- The security of this method depends on the strength of the hash being +-- used. To that end, FIPS 140-2 requires a SHA-2 variant. +generateProbablePrimes :: CryptoRandomGen g => + ParameterSizes -> + g -> + (ByteString -> ByteString) -> + Maybe Integer -> + Either DSAError (Integer,Integer, + ProbablePrimesEvidence, + g) +generateProbablePrimes dsaParam gen hash Nothing = + generateProbablePrimes dsaParam gen hash (Just (getN dsaParam + 8)) +generateProbablePrimes dsaParam gen hash (Just seedlen) + | seedlen < getN dsaParam = Left DSAInvalidSeedLength + | seedlen `mod` 8 /= 0 = Left DSAInvalidSeedLength + | otherwise = find_q gen + where + outlenB = fromIntegral (BS.length (hash BS.empty)) -- in bytes + outlen = outlenB * 8 -- in bits + outlenF = fromInteger outlen :: Double + bigL = fromIntegral (getL dsaParam) :: Integer -- in bits + bigN = fromIntegral (getN dsaParam) :: Integer -- in bits + n = ceiling (fromInteger bigL / outlenF) - 1 + b = bigL - 1 - (n * outlen) + -- + find_q g' + | isLeft dpsEth = Left (DSARandomGenerationError err) + | isLeft primeEth = Left primeErr + | isPrime = find_p g''' 1 0 q dpsI + | otherwise = find_q g''' + where + dpsEth = genBytes (fromIntegral ((seedlen + 7) `div` 8)) g' + Left err = dpsEth + Right (dpsBS, g'') = dpsEth + domParamSeed = BS.fromStrict dpsBS + dpsI = bs2int domParamSeed + mask = 2 ^ (bigN - 1) + bigU = bs2int (hash domParamSeed) `mod` mask + q = mask + bigU + 1 - (bigU `mod` 2) + primeEth = isPrimeC3 g'' dsaParam q + Left primeErr = primeEth + Right (isPrime, g''') = primeEth + -- + find_p g' !off !ctr !q !dps + | ctr == fourTimesL = find_q g' + | p < twoLm1 = find_p g' off' ctr' q dps + | isLeft primeEth = Left primeErr + | isPrime = Right (p, q, ProbablePrimesEvidence dps ctr hash, g'') + | otherwise = find_p g'' off' ctr' q dps + where + !bigW = computeW hash dps off n b seedlen + bigX = bigW + (2 ^ (bigL - 1)) + c = bigX `mod` (2 * q) + p = bigX - (c - 1) + primeEth = isPrimeC3 g' dsaParam p + Left primeErr = primeEth + Right (isPrime, g'') = primeEth + off' = off + n + 1 + ctr' = ctr + 1 + -- + fourTimesL = 4 * bigL + twoLm1 = 2 ^ (bigL - 1) + +computeW :: (ByteString -> ByteString) -> + Integer -> Integer -> Integer -> Integer -> Integer -> + Integer +computeW hash dps offset n b seedlen = loop 0 BS.empty + where + loop j acc | j == n = bs2int (vj' `BS.append` acc) + | otherwise = loop (j + 1) (vj `BS.append` acc) + where + vj = hash (int2bs ((dps + offset + j) `mod` (2 ^ seedlen))) + vj' = int2bs (bs2int vj `mod` (2 ^ b)) + +-- |Validate that the probable primes that either you generated or that someone +-- provided to you are legitimate. +validateProbablePrimes :: CryptoRandomGen g => + g {- A random number source -} -> + Integer {- ^p -} -> + Integer {- ^q -} -> + ProbablePrimesEvidence {- ^The evidence -} -> + (Bool, g) +validateProbablePrimes g p q (ProbablePrimesEvidence dps counter hash) = + if | not goodParam -> (False, g) + | counter > ((4 * bigL) - 1) -> (False, g) + | seedlen < bigN -> (False, g) + | computed_q /= q -> (False, g) + | not computed_q_prime -> (False, g') + | otherwise -> counter_right + where + -- 1. L = len (p). + bigL = intlen p * 8 + -- 2. N = len (q). + bigN = intlen q * 8 + -- 3. Check that the (L, N) pair is in the list of acceptable (L, N) pairs + -- (see Section 4.2). If the pair is not in the list, return INVALID. + -- [See the first line above] + (param, goodParam) = + case (bigL, bigN) of + (1024, 160) -> (L1024_N160, True) + (2048, 224) -> (L2048_N224, True) + (2048, 256) -> (L2048_N256, True) + (3072, 256) -> (L3072_N256, True) + _ -> ((error ("PARAM: "++show bigL++" "++show bigN)), False) + -- 4. If (counter > (4L – 1)), then return INVALID. + -- [See the second line above] + -- 5. seedlen = len (domain_parameter_seed). + seedlen = intlen dps * 8 + -- 6. If (seedlen < N), then return INVALID. + -- [See the third line above] + -- 7. U = Hash(domain_parameter_seed) mod 2N–1 + bigU = bs2int (hash (int2bs dps)) `mod` (2 ^ (bigN - 1)) + -- 8. computed_q = 2^(N–1) + U + 1 – ( U mod 2). + computed_q = (2 ^ (bigN - 1)) + bigU + 1 - (bigU `mod` 2) + -- 9. Test whether or not computed_q is prime as specified in Appendix C.3. + -- If (computed_q ≠ q) or (computed_q is not prime), then return INVALID. + -- [See the fourth line above] + (computed_q_prime, g') = case isPrimeC3 g param computed_q of + Left _ -> (False, g) + Right x -> x + outlenB = fromIntegral (BS.length (hash BS.empty)) -- in bytes + outlen = outlenB * 8 -- in bits + outlenF = fromInteger outlen :: Double + n = ceiling (fromInteger bigL / outlenF) - 1 + b = bigL - 1 - (n * outlen) + -- 12. offset = 1. + offset = 1 + -- 13. For i = 0 to counter do + counter_right = loop g' 0 offset + loop gen !i !off + | isLeft primeEth = (False, gen) + | i == counter = step14 gen i computed_p isPrime + | computed_p < (2 ^ (bigL - 1)) = loop gen (i + 1) off' + | isPrime = step14 gen i computed_p isPrime + | otherwise = loop gen' (i + 1) off' + where + bigW = computeW hash dps off n b seedlen + bigX = bigW + (2 ^ (bigL - 1)) + c = bigX `mod` (2 * q) + computed_p = bigX - (c - 1) + primeEth = isPrimeC3 gen param computed_p + Right (isPrime, gen') = primeEth + off' = off + n + 1 + -- + step14 gen i computed_p isPrime = (res, gen) + where res = (i == counter) && (computed_p == p) && isPrime + + +data ProvablePrimesEvidence = ProvablePrimesEvidence { + pvpeFirstSeed :: Integer + , pvpePSeed :: Integer + , pvpeQSeed :: Integer + , pvpePGenCounter :: Integer + , pvpeQGenCounter :: Integer + , pvpeHash :: ByteString -> ByteString + } + +instance Eq ProvablePrimesEvidence where + ev1 == ev2 = (pvpeFirstSeed ev1 == pvpeFirstSeed ev2) && + (pvpePSeed ev1 == pvpePSeed ev2) && + (pvpeQSeed ev1 == pvpeQSeed ev2) && + (pvpePGenCounter ev1 == pvpePGenCounter ev2) && + (pvpeQGenCounter ev1 == pvpeQGenCounter ev2) + +-- |Using an approved hash function -- at the point of writing, a SHA-2 +-- variant -- generate values of p and q for use in DSA, for which p and +-- q are provably prime. In addition to p and q, this routine generates +-- a series of additional values that can be used to validate that this +-- algorithm performed correctly. +-- +-- The inputs to the function are the DSA parameters we are generating +-- key for, a source of entropy, the hash function to use, and (optionally) +-- an initial seed length in bits. The last item, if provided, must be +-- greater than or equal to the N value being tested against, and must +-- be a multiple of 8. +generateProvablePrimes :: CryptoRandomGen g => + ParameterSizes {- ^The DSA parameters to use -} -> + g {- ^source of randomness -} -> + (ByteString -> ByteString) {- ^Hash function -} -> + Maybe Integer {- ^Optional seed length, in bits. Must + be greater than or equal to N, and + divisible by 8. -} -> + Either DSAError (Integer, Integer, + ProvablePrimesEvidence, g) +generateProvablePrimes params g hash Nothing = + generateProvablePrimes params g hash (Just (getN params)) +generateProvablePrimes params g hash (Just seedlen) + | seedlen < bigN = Left DSAInvalidSeedLength + | seedlen `mod` 8 /= 0 = Left DSAInvalidSeedLength + | isLeft mfirstseed = reLeft mfirstseed + | otherwise = + case constructivePrimeGen hash bigL bigN firstseed of + Left DSAGaveUp -> generateProvablePrimes params g' hash (Just seedlen) + Left err -> Left err + Right (p,q,ev) -> Right (p,q,ev,g') + where + bigN = getN params :: Integer + bigL = getL params :: Integer + twonm1 = 2 ^ (bigN - 1) + -- + mfirstseed = getFirstSeed g 0 + Right (firstseed, g') = getFirstSeed g 0 + -- + getFirstSeed gen first_seed + | first_seed >= twonm1 = Right (first_seed, gen) + | otherwise = + case genBytes (fromIntegral (bigN `div` 8)) gen of + Left err -> Left (DSARandomGenerationError err) + Right (bytes, gen') -> getFirstSeed gen' (bss2int bytes) + +constructivePrimeGen :: (ByteString -> ByteString) -> + Integer -> Integer -> Integer -> + Either DSAError (Integer,Integer,ProvablePrimesEvidence) +constructivePrimeGen hash bigL bigN firstseed + | isLeft mqseed = reLeft mqseed + | isLeft mpseed = reLeft mpseed + | otherwise = runCheck pgen_counter pseed' t0 + where + outlenF = fromIntegral (BS.length (hash BS.empty)) * (8.0 :: Double) + mqseed = shaweTaylor hash bigN firstseed + mpseed = shaweTaylor hash ((bigL `div` 2) + 1) qseed + Right (q, qseed, qgen_counter) = mqseed + Right (p0, pseed, pgen_counter) = mpseed + iterations = ceiling (fromInteger bigL / outlenF) - 1 + old_counter = pgen_counter + x = bs2int (BS.concat (map (\ i -> hash (int2bs (pseed + i))) + (reverse [0..iterations]))) + pseed' = pseed + iterations + 1 + x' = (2 ^ (bigL - 1)) + (x `mod` (2 ^ (bigL - 1))) + t0 = ceiling (fromInteger x' / + ((2.0 :: Double) * fromInteger q * fromInteger p0)) + runCheck pgc ps t + | (1 == gcd (z - 1) p) && (1 == modExp z p0 p) = + let ev = ProvablePrimesEvidence firstseed ps' qseed + pgc' qgen_counter hash + in Right (p, q, ev) + | pgc' > ((4 * bigL) + old_counter) = + Left DSAGaveUp + | otherwise = + runCheck pgc' ps' (t + 1) + where + t' | (2 * t * q * p0) + 1 > (2 ^ bigL) = + ceiling (((2.0 :: Double) ^ (bigL - 1)) / + ((2.0 :: Double) * fromInteger q * fromInteger p0)) + | otherwise = t + p = (2 * t' * q * p0) + 1 + pgc' = pgc + 1 + a = bs2int (BS.concat (map (\ i -> hash (int2bs (pseed + i))) + (reverse [0..iterations]))) + ps' = ps + iterations + 1 + a' = 2 + (a `mod` (p - 3)) + z = modExp a' (2 * t' * q) p + +reLeft :: Either a b -> Either a c +reLeft (Left a) = Left a +reLeft (Right _) = error "Re-left of a Right value" + +-- |Validate that the provable primes that either you generated or that +-- someone provided to you are legitimate. +validateProvablePrimes :: Integer -> Integer -> + ProvablePrimesEvidence -> + Bool +validateProvablePrimes p q ev = + ((bigL, bigN) `elem` [(1024,160),(2048,224),(2048,256),(3072,256)]) && -- 3 + (pvpeFirstSeed ev >= (2 ^ (bigN - 1))) && -- 4 + ((2 ^ bigN) > q) && -- 5 + ((2 ^ bigL) > p) && -- 6 + ((p - 1) `mod` q == 0) && -- 7 + isRight mres && (p == p') && (q == q') && (ev == ev') -- 8 + where + bigL = intlen p * 8 + bigN = intlen q * 8 + hash = pvpeHash ev + mres = constructivePrimeGen hash bigL bigN (pvpeFirstSeed ev) + Right (p', q', ev') = mres + +-- |Generate the generator /g/ using a method that is not verifiable to a third +-- party. Quoth FIPS: "[This] method ... may be used when complete validation of +-- the generator /g/ is not required; it is recommended that this method be used +-- only when the party generating /g/ is trusted to not deliberately generate a +-- /g/ that has a potentially exploitable relationship to another generator +-- /g'/. +-- +-- The input to this function are a valid /p/ and /q/, generated using an +-- approved method. +-- +-- It may be possible (?) that this routine could fail to find a possible +-- generator. In that case, Nothing is returned. +generateUnverifiableGenerator :: Integer -> Integer -> Maybe Integer +generateUnverifiableGenerator p q = loop 2 + where + e = (p - 1) `div` q + loop h | h >= (p - 1) = Nothing + | g == 1 = loop (h + 1) + | otherwise = Just g + where g = modExp h e p + +-- |Validate that the given generator /g/ works for the values /p/ and /q/ +-- provided. +generatorIsValid :: Integer {- ^p -} -> Integer {- ^q -} -> + Integer {- ^g -} -> + Bool +generatorIsValid p q g = rangeOK && modOK + where + rangeOK = (2 <= g) && (g <= (p - 1)) + modOK = modExp g q p == 1 + +class GenerationEvidence a where + getHash :: a -> (ByteString -> ByteString) + getDomainParameterSeed :: a -> ByteString + +instance GenerationEvidence ProbablePrimesEvidence where + getHash = prpeHash + getDomainParameterSeed = int2bs . prpeDomainParameterSeed + +instance GenerationEvidence ProvablePrimesEvidence where + getHash = pvpeHash + getDomainParameterSeed e = BS.concat [firstSeed, pseed, qseed] + where + firstSeed = int2bs (pvpeFirstSeed e) + pseed = int2bs (pvpePSeed e) + qseed = int2bs (pvpeQSeed e) + +-- |Generate a generator /g/, given the values of /p/, /q/, the evidence created +-- generating those values, and an index. Quoth FIPS: "This generation method +-- supports the generation of multiple values of /g/ for specific values of /p/ +-- and /q/. The use of different values of /g/ for the same /p/ and /q/ may be +-- used to support key separation; for example, using the /g/ that is generated +-- with @index = 1@ for digital signatures and with @index = 2@ for key +-- establishment." +-- +-- This method is replicatable, so that given the same inputs it will generate +-- the same outputs. Thus, you can validate that the /g/ generated using this +-- method was generated correctly using 'validateVerifiableGenerator', which +-- will be nice if you don't trust the person you're talking to. +generateVerifiableGenerator :: GenerationEvidence ev => + Integer {- ^p -} -> Integer {- ^q -} -> + ev {- ^The evidence created generating /p/ and /q/ -} -> + Word8 {- ^an index (This allows multiple /g/s from one pair) -} -> + Maybe Integer +generateVerifiableGenerator p q ev index = loop (1 :: Word16) + where +-- bigN = intlen q AW: Not sure why the spec asks us to compute this ... + e = (p - 1) `div` q + indexBS = BS.singleton index + ggen = int2bs 0x6767656e + -- + loop count | count == 0 = Nothing + | g < 2 = loop (count + 1) + | otherwise = Just g + where + countBS = BS.pack [fromIntegral (count `shiftR` 8), fromIntegral (count .&. 0xFF)] + bigU = getDomainParameterSeed ev `BS.append` ggen `BS.append` indexBS `BS.append` countBS + bigW = bs2int (getHash ev bigU) + g = modExp bigW e p + +-- |Validate that the value /g/ was generated by 'generateVerifiableGenerator' +-- or someone using the same algorithm. This is probably a good idea if you +-- don't trust your compatriot. +validateVerifiableGenerator :: GenerationEvidence ev => + Integer {- ^p -} -> Integer {- ^q -} -> + ev {- ^The evidence created generating /p/ and /q/ -} -> + Word8 {- ^an index (This allows multiple /g/s from one pair) -} -> + Integer {- ^g -} -> + Bool +validateVerifiableGenerator p q ev index g = rangeOK && modOK && genOK + where + rangeOK = (2 <= g) && (g <= (p - 1)) + modOK = modExp g q p == 1 + genOK = case generateVerifiableGenerator p q ev index of + Nothing -> False + Just computed_g -> computed_g == g + +-- |Determine if a given value is probably prime, using a testing procedure +-- appropriate for the given DSA parameters. (The probability of an error is +-- somewhere between 2^-80 and 2^-128, depending on the strength of the DSA +-- parameters.) +-- +-- This is based on the definitions in FIPS 186-4, Appendic C.3. +isPrimeC3 :: CryptoRandomGen g => + g -> ParameterSizes -> Integer -> + Either DSAError (Bool, g) +isPrimeC3 g L1024_N160 !x = millerRabin g 40 x +isPrimeC3 g L2048_N224 !x = millerRabin g 56 x +isPrimeC3 g L2048_N256 !x = millerRabin g 56 x +isPrimeC3 g L3072_N256 !x = millerRabin g 64 x + +-- |Perform the given number of iterations of the Miller-Rabin test to try +-- to determine if the given Integer is prime. +millerRabin :: CryptoRandomGen g => + g -> Int -> Integer -> + Either DSAError (Bool, g) +#if defined(USE_GMP_HELPERS) +millerRabin gen (I# its) w + | w == 1 = Right (False, gen) + | w == 2 = Right (True, gen) + | even w = Left DSAInvalidPrimeTestInput + | otherwise = + case testPrimeInteger w its of + 0# -> Right (False, gen) + _ -> Right (True, gen) +#else +millerRabin gen iterations w + | w == 0 = Left DSAInvalidPrimeTestInput + | w == 1 = Right (False, gen) + | w == 2 = Right (True, gen) + | w == 3 = Right (True, gen) + | even w = Left DSAInvalidPrimeTestInput + | otherwise = result + -- INPUT: + -- 1. w: The odd integer to be tested for primality. + -- 2. iterations: The number of iterations of the test to be performed; + -- the value SHALL be consistent with Table C.1, C.2, or C.3 + -- [in this case, Table C.1 is the isPrimeC3 -> millerRabin function, + -- above] + where + -- PROCESS: + -- 1. Let a bet the largest integer such that 2^a divides (w - 1) + -- 2. m = (w - 1) / 2^a + (a, m) = findAandM (w - 1) + -- 3. wlen = len (w) + wlen = intlen w + -- 4. For i = 1 to iterations do + result = go gen iterations + -- 5. Return PROBABLY PRIME / true + go g 0 = Right (True, g) + go g count + | isLeft genEth = Left (DSARandomGenerationError err) + | ((b <= 1) || (b >= w - 1)) = go g' count + | ((z == 1) || (z == w - 1)) = go g' (count - 1) + | otherwise = step45loop g' count z 1 + where + genEth = genBytes (fromIntegral wlen) g + Left err = genEth + Right (bstr, g') = genEth + -- + b = bss2int bstr + z = modExp b m w + -- + step45loop g count !z !j | j == a = Right (False, g) + | z' == (w - 1) = go g (count - 1) + | z' == 1 = Right (False, g) + | otherwise = step45loop g count z' (j + 1) + where z' = modExp z 2 w +#endif + +bss2int :: BSS.ByteString -> Integer +bss2int bstr = go 0 (BSS.unpack bstr) + where + go acc [] = acc + go acc (h:t) = go ((acc `shiftL` 8) + fromIntegral h) t + +modExp :: Integer -> Integer -> Integer -> Integer +#if defined(USE_GMP_HELPERS) +modExp !x !y !m = powModInteger x y m +#else +modExp !x !y !m = go x y 1 + where + go _ 0 !result = result + go !b !e !result = go ((b * b) `mod` m) (e `shiftR` 1) result' + where result' = if testBit e 0 then (result * b) `mod` m else result +#endif + +modInv :: Integer -> Integer -> Maybe Integer +modInv !z !a = loop a z 0 1 + where + loop i j y2 y1 | j' > 0 = loop i' j' y2' y1' + | i' /= 1 = Nothing + | otherwise = Just (y2' `mod` a) + where + quotient = i `div` j + remainder = i - (j * quotient) + y = y2 - (y1 * quotient) + i' = j + j' = remainder + y2' = y1 + y1' = y + +xorbs :: ByteString -> ByteString -> ByteString +xorbs a b = BS.pack (BS.zipWith xor a b) + +-- |Find 'a' and 'm' such that input = 2^a * m. +findAandM :: Integer -> (Integer, Integer) +findAandM x = go 0 x + where + go acc v | even v = go (acc + 1) (v `div` 2) + | otherwise = (acc, v) + +intlen :: Integer -> Integer +intlen 0 = 0 +intlen x = intlen (x `shiftR` 8) + 1 + +-- |Convert a ByteString into its obvious Integer representation. +bs2int :: ByteString -> Integer +bs2int bstr = go 0 (BS.unpack bstr) + where + go acc [] = acc + go acc (h:t) = go ((acc `shiftL` 8) + fromIntegral h) t + +-- |Convert an Integer into its obvious ByteString representation. +int2bs :: Integer -> ByteString +int2bs x + | x < 0 = error "int2bs: negative input" + | x == 0 = BS.empty + | otherwise = int2bs (x `shiftR` 8) `BS.append` + BS.singleton (fromIntegral (x .&. 0xFF)) + +shaweTaylor :: (ByteString -> ByteString) -> Integer -> Integer -> + Either DSAError (Integer, Integer, Integer) +shaweTaylor hash length input_seed + | length < 2 = Left DSAInvalidInput + | length >= 33 = largeVersion + | otherwise = smallVersion input_seed 0 + where + -- Steps 1 - 13 in Appendix C.6 + smallVersion prime_seed prime_gen_counter + | isDeterministicallyPrime c7 = Right (c7, prime_seed, prime_gen_counter) + | prime_gen_counter > (4 * length) = Left DSAGaveUp + | otherwise = smallVersion ps' pgc' + where + c5 = bs2int ((hash (int2bs prime_seed)) `xorbs` + (hash (int2bs (prime_seed + 1)))) + c6 = (2 ^ (length - 1)) + (c5 `mod` (2 ^ (length - 1))) + c7 = (2 * floor (fromInteger c6 / (2.0 :: Double))) + 1 + pgc' = prime_gen_counter + 1 + ps' = prime_seed + 2 + -- Steps 14 - 34 in Appendix C.6 + largeVersion + | isLeft mstatus = reLeft mstatus + | otherwise = findLoop prime_gen_counter prime_seed' t0 + where + outlenF = fromIntegral (BS.length (hash BS.empty)) * (8.0 :: Double) + ceildiv = ceiling (fromInteger length / (2 :: Double)) + 1 + mstatus = shaweTaylor hash ceildiv input_seed + Right (c0, prime_seed, prime_gen_counter) = mstatus + iterations = ceiling (fromInteger length / outlenF) - 1 + old_counter = prime_gen_counter + x = bs2int (BS.concat (map (\ i -> hash (int2bs (prime_seed + i))) + (reverse [0..iterations]))) + prime_seed' = prime_seed + iterations + 1 + x' = (2 ^ (length - 1)) + (x `mod` (2 ^ (length - 1))) + t0 = ceiling (fromInteger x' / ((2.0 :: Double) * fromInteger c0)) + -- steps 23 - 34 + findLoop pgc ps !t + | (1 == gcd (z - 1) c) && (1 == modExp z c0 c) = + Right (c, ps', pgc') + | pgc' >= ((4 * length) + old_counter) = + Left DSAGaveUp + | otherwise = + findLoop pgc' ps' (t' + 1) + where + t' | ((2 * t * c0) + 1) > (2 ^ length) = + ceiling (((2 :: Double) ^ (length - 1)) / + ((2.0 :: Double) * fromInteger c0)) + | otherwise = t + c = 2 * t * c0 + 1 + pgc' = pgc + 1 + a = bs2int (BS.concat (map (\ i -> hash (int2bs (ps + i))) + (reverse [0..iterations]))) + ps' = ps + iterations + 1 + a' = 2 + (a `mod` (c - 3)) + z = modExp a' (2 * t) c + +-- |A brute force check to determine if a number is prime. This answer is +-- guaranteed to be correct, but should only be used on small numbers (less +-- than 33 bits would be nice). +isDeterministicallyPrime :: Integer -> Bool +isDeterministicallyPrime !x + | x <= 1 = False + | x == 2 = True + | even x = False + | otherwise = go 2 + where + final = ceiling (sqrt (fromInteger x :: Double)) + go !d | d > final = True + | x `mod` d == 0 = False + | otherwise = go (nextDivisor d) + -- + nextDivisor 2 = 3 + nextDivisor 3 = 5 + nextDivisor 5 = 7 + nextDivisor d | d' `mod` 3 == 0 = nextDivisor (d + 2) + | d' `mod` 5 == 0 = nextDivisor (d + 2) + | otherwise = d' + where d' = d + 2 + +data NoGen = NoGen +instance CryptoRandomGen NoGen where + newGen _ = Left NotEnoughEntropy + genSeedLength = Tagged 0 + genBytes _ _ = Left NotEnoughEntropy + reseedInfo _ = Never + reseedPeriod _ = Never + reseed _ _ = Left NotEnoughEntropy + diff --git a/src/Test.hs b/src/Test.hs new file mode 100644 --- /dev/null +++ b/src/Test.hs @@ -0,0 +1,447 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ScopedTypeVariables #-} +import Codec.Crypto.DSA.Pure +import Crypto.Random.DRBG +import Data.Bits +import Data.ByteString.Lazy(ByteString, toStrict, pack) +import qualified Data.ByteString.Lazy.Char8 as BSC +import Data.Digest.Pure.SHA +import Data.Word +import Test.Framework(defaultMain, testGroup, Test) +import Test.Framework.Providers.QuickCheck2(testProperty) +import Test.Framework.Providers.HUnit(testCase) +import Test.HUnit.Base(Assertion,assertEqual) +import Test.QuickCheck hiding ((.&.)) +import Debug.Trace + +data ArbHashFunction = HF String (ByteString -> ByteString) + +instance Eq ArbHashFunction where + (HF a _) == (HF b _) = a == b + +instance Show ArbHashFunction where + show (HF a _) = "<" ++ a ++ ">" + +instance Arbitrary ParameterSizes where +#ifdef BETTER_TESTS + arbitrary = elements [L1024_N160, L2048_N224, L2048_N256, L3072_N256] +#else + arbitrary = return L1024_N160 +#endif + +instance Arbitrary ArbHashFunction where + arbitrary = elements [ HF "SHA224" (bytestringDigest . sha224) + , HF "SHA256" (bytestringDigest . sha256) + , HF "SHA384" (bytestringDigest . sha384) + , HF "SHA512" (bytestringDigest . sha512) + ] + +main :: IO () +main = + do g :: GenAutoReseed HashDRBG HashDRBG <- newGenIO + defaultMain [ + testGroup "Basic helper functions" [ + testProperty "ByteString / Integer conversion round-trips" + prop_int2bs_roundtrips + , testProperty "ByteString / Integer conversion round-trips (v2)" + prop_int2bs_roundtrips2 + , testProperty "Can find appropriate factors" + prop_findAandM_works + , testProperty "Fast modular exponentiation works." + prop_modExp_works + , testProperty "Deterministic prime checking works." + prop_isDetPrimeWorks + , testProperty "Miller-Rabin primality test seems to work" + (prop_mr_computes_primes g) + , testProperty "Shawe-Taylor algorithm generates primes" + (prop_shaweTaylorWorks g) + ] + , testGroup "DSA Generation functions" [ + testProperty "Probable primes validate" + (prop_validateProbPrimes g) + , testProperty "Provable primes validate" + (prop_validateProvPrimes g) + , testProperty "Unverifiable g generation works" (prop_validateUnvG g) + , testProperty "Verifiable g generation works" (prop_validateVerG g) + ] + , testGroup "RFC 6969 test cases" [ + testCase "Base RFC6979 k-generation test case" (test_RFCKGen g) + , testGroup "RFC6979 A.2.1 (SHA1 sample)" (test_RFCA21_1sample g) + , testGroup "RFC6979 A.2.1 (SHA224 sample)" (test_RFCA21_224sample g) + , testGroup "RFC6979 A.2.1 (SHA256 sample)" (test_RFCA21_256sample g) + , testGroup "RFC6979 A.2.1 (SHA384 sample)" (test_RFCA21_384sample g) + , testGroup "RFC6979 A.2.1 (SHA512 sample)" (test_RFCA21_512sample g) + , testGroup "RFC6979 A.2.1 (SHA1 test)" (test_RFCA21_1test g) + , testGroup "RFC6979 A.2.1 (SHA224 test)" (test_RFCA21_224test g) + , testGroup "RFC6979 A.2.1 (SHA256 test)" (test_RFCA21_256test g) + , testGroup "RFC6979 A.2.1 (SHA384 test)" (test_RFCA21_384test g) + , testGroup "RFC6979 A.2.1 (SHA512 test)" (test_RFCA21_512test g) + , testGroup "RFC6979 A.2.2 (SHA1 sample)" (test_RFCA22_1sample g) + , testGroup "RFC6979 A.2.2 (SHA224 sample)" (test_RFCA22_224sample g) + , testGroup "RFC6979 A.2.2 (SHA256 sample)" (test_RFCA22_256sample g) + , testGroup "RFC6979 A.2.2 (SHA384 sample)" (test_RFCA22_384sample g) + , testGroup "RFC6979 A.2.2 (SHA512 sample)" (test_RFCA22_512sample g) + , testGroup "RFC6979 A.2.2 (SHA1 test)" (test_RFCA22_1test g) + , testGroup "RFC6979 A.2.2 (SHA224 test)" (test_RFCA22_224test g) + , testGroup "RFC6979 A.2.2 (SHA256 test)" (test_RFCA22_256test g) + , testGroup "RFC6979 A.2.2 (SHA384 test)" (test_RFCA22_384test g) + , testGroup "RFC6979 A.2.2 (SHA512 test)" (test_RFCA22_512test g) + ] + , testGroup "End-to-end tests" [ + testProperty "Verify verifies signed messages" (prop_verifySig g) + , testProperty "Verify verifies signed messages (v2)" (prop_verifySig' g) + ] + ] + +prop_int2bs_roundtrips :: Positive Integer -> Bool +prop_int2bs_roundtrips px = x == bs2int (int2bs x) + where x = getPositive px + +prop_int2bs_roundtrips2 :: Positive Integer -> Bool +prop_int2bs_roundtrips2 px = x == bss2int (toStrict (int2bs x)) + where x = getPositive px + +prop_findAandM_works :: Positive Integer -> Bool +prop_findAandM_works px + | x <= 3 = True + | otherwise = x == ((2 ^ a) * m) + where + x = getPositive px + (a, m) = findAandM x + +prop_modExp_works :: Positive Integer -> + Positive Integer -> + Positive Integer -> + Bool +prop_modExp_works px py pm = modExp x y m == ((x ^ y) `mod` m) + where + x = getPositive px + y = getPositive py + m = getPositive pm + +prop_isDetPrimeWorks :: Positive Integer -> Bool +prop_isDetPrimeWorks px = isPrime x == isDeterministicallyPrime x + where x = getPositive px + +newtype OddPositive = OP Integer + +instance Arbitrary OddPositive where + arbitrary = do x <- arbitrary + return (OP (abs x .|. 1)) + +instance Show OddPositive where + show (OP x) = show x + +prop_mr_computes_primes :: CryptoRandomGen g => + g -> OddPositive -> Bool +prop_mr_computes_primes g (OP x) = + case millerRabin g 64 x of + Left _ -> False + Right (v, _) -> v == isDeterministicallyPrime x + +newtype RandBitLength = BL Integer + +instance Arbitrary RandBitLength where +#ifdef BETTER_TESTS + arbitrary = BL `fmap` choose (2,1538) +#else + arbitrary = BL `fmap` choose (2,128) +#endif + +instance Show RandBitLength where + show (BL x) = show x + +prop_shaweTaylorWorks :: CryptoRandomGen g => + g -> ArbHashFunction -> RandBitLength -> + Positive Integer -> + Bool +prop_shaweTaylorWorks g (HF _ h) (BL l) seed = + case shaweTaylor h l (getPositive seed) of + Left _ -> True + Right (x, _, _) -> + case millerRabin g 64 x of + Left _ -> False + Right (res, _) -> res + +isPrime :: Integer -> Bool +isPrime x | x <= 1 = False + | x == 2 = True + | even x = False + | otherwise = go 3 + where + go y | y >= x = True + | x `mod` y == 0 = False + | otherwise = go (y + 2) + +prop_validateProbPrimes :: CryptoRandomGen g => + g -> ParameterSizes -> ArbHashFunction -> + Maybe (Positive Integer) -> + Bool +prop_validateProbPrimes g params (HF _ hash) mseedlen = + case generateProbablePrimes params g hash mseedlen' of + Left err -> trace (show err) False + Right (p, q, ev, g') -> + let (res, _) = validateProbablePrimes g' p q ev + in if not res + then trace ("FAIL p = " ++ show p ++ " q = " ++ show q) False + else True + where mseedlen' = fmap (\ x -> (getPositive x * 8) + getN params) mseedlen + +prop_validateProvPrimes :: CryptoRandomGen g => + g -> ParameterSizes -> ArbHashFunction -> + Maybe (Positive Integer) -> + Bool +prop_validateProvPrimes g params (HF _ hash) mseedlen = + case generateProvablePrimes params g hash mseedlen' of + Left err -> trace (show err) False + Right (p, q, ev, _) -> + let res = validateProvablePrimes p q ev + in if not res + then trace ("FAIL p = " ++ show p ++ " q = " ++ show q ++ " mseedlen': " ++ show mseedlen' ++ " firstSeed: " ++ show (pvpeFirstSeed ev) ++ " pseed: " ++ show (pvpePSeed ev) ++ " qseed: " ++ show (pvpeQSeed ev) ++ " pgen: " ++ show (pvpePGenCounter ev) ++ " qgen: " ++ show (pvpeQGenCounter ev)) False + else True + where mseedlen' = fmap (\ x -> (getPositive x * 8) + getN params) mseedlen + +prop_validateUnvG :: CryptoRandomGen g => + g -> ParameterSizes -> ArbHashFunction -> + Bool +prop_validateUnvG gen params (HF _ hash) = + case generateProbablePrimes params gen hash Nothing of + Left _ -> error "Failed to generate p and q testing unverifiable g generation." + Right (p, q, _, _) -> + case generateUnverifiableGenerator p q of + Nothing -> error "Failed to generate g for p and q (unverifiable)." + Just g -> generatorIsValid p q g + +prop_validateVerG :: CryptoRandomGen g => + g -> ParameterSizes -> ArbHashFunction -> Word8 -> + Bool +prop_validateVerG gen params (HF _ hash) index = + case generateProbablePrimes params gen hash Nothing of + Left _ -> error "Failed to generate p and q testing unverifiable g generation." + Right (p, q, ev, _) -> + case generateVerifiableGenerator p q ev index of + Nothing -> error "Failed to generate g for p and q (unverifiable)." + Just g -> validateVerifiableGenerator p q ev index g + +sampleMsg :: ByteString +sampleMsg = BSC.pack "sample" + +test_RFCKGen :: CryptoRandomGen g => g -> Assertion +test_RFCKGen g = assertEqual "" myValue rfcValue + where + rfcValue = 0x23AF4074C90A02B3FE61D286D5C87F425E6BDD81B + KValue myValue _ _ = kViaRFC6979 g SHA256 privkey sampleMsg + -- + q = 0x4000000000000000000020108A2E0CC0D99F8A5EF + x = 0x09A4D6792295A7F730FC3F2B49CBC0F62E862272F + privkey = PrivateKey (Params (error "p") (error "g") q) x + +runRFCTest :: CryptoRandomGen g => + PrivateKey -> + g -> HashFunction -> String -> + Integer -> Integer -> Integer -> + [Test] +runRFCTest priv g hash s rfcK rfcR rfcS = + [ testCase "K correct" (assertEqual "" rfcK myK) + , testCase "R correct" (assertEqual "" rfcR myR) + , testCase "S correct" (assertEqual "" rfcS myS) ] + where + KValue myK _ _ = kViaRFC6979 g hash priv msg + Right (Signature myR myS, _) = signMessage' hash kViaRFC6979 g priv msg + msg = BSC.pack s + +a21KeyPriv :: PrivateKey +a21KeyPriv = PrivateKey (Params 0x86F5CA03DCFEB225063FF830A0C769B9DD9D6153AD91D7CE27F787C43278B447E6533B86B18BED6E8A48B784A14C252C5BE0DBF60B86D6385BD2F12FB763ED8873ABFD3F5BA2E0A8C0A59082EAC056935E529DAF7C610467899C77ADEDFC846C881870B7B19B2B58F9BE0521A17002E3BDD6B86685EE90B3D9A1B02B782B1779 0x07B0F92546150B62514BB771E2A0C0CE387F03BDA6C56B505209FF25FD3C133D89BBCD97E904E09114D9A7DEFDEADFC9078EA544D2E401AEECC40BB9FBBF78FD87995A10A1C27CB7789B594BA7EFB5C4326A9FE59A070E136DB77175464ADCA417BE5DCE2F40D10A46A3A3943F26AB7FD9C0398FF8C76EE0A56826A8A88F1DBD 0x996F967F6C8E388D9E28D01E205FBA957A5698B1) 0x411602CB19A6CCC34494D79D98EF1E7ED5AF25F7 + +runA21Test :: CryptoRandomGen g => + g -> HashFunction -> String -> + Integer -> Integer -> Integer -> + [Test] +runA21Test = runRFCTest a21KeyPriv + +a22KeyPriv :: PrivateKey +a22KeyPriv = PrivateKey (Params 0x9DB6FB5951B66BB6FE1E140F1D2CE5502374161FD6538DF1648218642F0B5C48C8F7A41AADFA187324B87674FA1822B00F1ECF8136943D7C55757264E5A1A44FFE012E9936E00C1D3E9310B01C7D179805D3058B2A9F4BB6F9716BFE6117C6B5B3CC4D9BE341104AD4A80AD6C94E005F4B993E14F091EB51743BF33050C38DE235567E1B34C3D6A5C0CEAA1A0F368213C3D19843D0B4B09DCB9FC72D39C8DE41F1BF14D4BB4563CA28371621CAD3324B6A2D392145BEBFAC748805236F5CA2FE92B871CD8F9C36D3292B5509CA8CAA77A2ADFC7BFD77DDA6F71125A7456FEA153E433256A2261C6A06ED3693797E7995FAD5AABBCFBE3EDA2741E375404AE25B 0x5C7FF6B06F8F143FE8288433493E4769C4D988ACE5BE25A0E24809670716C613D7B0CEE6932F8FAA7C44D2CB24523DA53FBE4F6EC3595892D1AA58C4328A06C46A15662E7EAA703A1DECF8BBB2D05DBE2EB956C142A338661D10461C0D135472085057F3494309FFA73C611F78B32ADBB5740C361C9F35BE90997DB2014E2EF5AA61782F52ABEB8BD6432C4DD097BC5423B285DAFB60DC364E8161F4A2A35ACA3A10B1C4D203CC76A470A33AFDCBDD92959859ABD8B56E1725252D78EAC66E71BA9AE3F1DD2487199874393CD4D832186800654760E1E34C09E4D155179F9EC0DC4473F996BDCE6EED1CABED8B6F116F7AD9CF505DF0F998E34AB27514B0FFE7 0xF2C3119374CE76C9356990B465374A17F23F9ED35089BD969F61C6DDE9998C1F) 0x69C7548C21D0DFEA6B9A51C9EAD4E27C33D3B3F180316E5BCAB92C933F0E4DBC + +runA22Test :: CryptoRandomGen g => + g -> HashFunction -> String -> + Integer -> Integer -> Integer -> + [Test] +runA22Test = runRFCTest a22KeyPriv + +test_RFCA21_1sample :: CryptoRandomGen g => g -> [Test] +test_RFCA21_1sample g = runA21Test g SHA1 "sample" k r s + where + k = 0x7BDB6B0FF756E1BB5D53583EF979082F9AD5BD5B + r = 0x2E1A0C2562B2912CAAF89186FB0F42001585DA55 + s = 0x29EFB6B0AFF2D7A68EB70CA313022253B9A88DF5 + +test_RFCA21_224sample :: CryptoRandomGen g => g -> [Test] +test_RFCA21_224sample g = runA21Test g SHA224 "sample" k r s + where + k = 0x562097C06782D60C3037BA7BE104774344687649 + r = 0x4BC3B686AEA70145856814A6F1BB53346F02101E + s = 0x410697B92295D994D21EDD2F4ADA85566F6F94C1 + +test_RFCA21_256sample :: CryptoRandomGen g => g -> [Test] +test_RFCA21_256sample g = runA21Test g SHA256 "sample" k r s + where + k = 0x519BA0546D0C39202A7D34D7DFA5E760B318BCFB + r = 0x81F2F5850BE5BC123C43F71A3033E9384611C545 + s = 0x4CDD914B65EB6C66A8AAAD27299BEE6B035F5E89 + +test_RFCA21_384sample :: CryptoRandomGen g => g -> [Test] +test_RFCA21_384sample g = runA21Test g SHA384 "sample" k r s + where + k = 0x95897CD7BBB944AA932DBC579C1C09EB6FCFC595 + r = 0x07F2108557EE0E3921BC1774F1CA9B410B4CE65A + s = 0x54DF70456C86FAC10FAB47C1949AB83F2C6F7595 + +test_RFCA21_512sample :: CryptoRandomGen g => g -> [Test] +test_RFCA21_512sample g = runA21Test g SHA512 "sample" k r s + where + k = 0x09ECE7CA27D0F5A4DD4E556C9DF1D21D28104F8B + r = 0x16C3491F9B8C3FBBDD5E7A7B667057F0D8EE8E1B + s = 0x02C36A127A7B89EDBB72E4FFBC71DABC7D4FC69C + +test_RFCA21_1test :: CryptoRandomGen g => g -> [Test] +test_RFCA21_1test g = runA21Test g SHA1 "test" k r s + where + k = 0x5C842DF4F9E344EE09F056838B42C7A17F4A6433 + r = 0x42AB2052FD43E123F0607F115052A67DCD9C5C77 + s = 0x183916B0230D45B9931491D4C6B0BD2FB4AAF088 + +test_RFCA21_224test :: CryptoRandomGen g => g -> [Test] +test_RFCA21_224test g = runA21Test g SHA224 "test" k r s + where + k = 0x4598B8EFC1A53BC8AECD58D1ABBB0C0C71E67297 + r = 0x6868E9964E36C1689F6037F91F28D5F2C30610F2 + s = 0x49CEC3ACDC83018C5BD2674ECAAD35B8CD22940F + +test_RFCA21_256test :: CryptoRandomGen g => g -> [Test] +test_RFCA21_256test g = runA21Test g SHA256 "test" k r s + where + k = 0x5A67592E8128E03A417B0484410FB72C0B630E1A + r = 0x22518C127299B0F6FDC9872B282B9E70D0790812 + s = 0x6837EC18F150D55DE95B5E29BE7AF5D01E4FE160 + +test_RFCA21_384test :: CryptoRandomGen g => g -> [Test] +test_RFCA21_384test g = runA21Test g SHA384 "test" k r s + where + k = 0x220156B761F6CA5E6C9F1B9CF9C24BE25F98CD89 + r = 0x854CF929B58D73C3CBFDC421E8D5430CD6DB5E66 + s = 0x91D0E0F53E22F898D158380676A871A157CDA622 + +test_RFCA21_512test :: CryptoRandomGen g => g -> [Test] +test_RFCA21_512test g = runA21Test g SHA512 "test" k r s + where + k = 0x65D2C2EEB175E370F28C75BFCDC028D22C7DBE9C + r = 0x8EA47E475BA8AC6F2D821DA3BD212D11A3DEB9A0 + s = 0x7C670C7AD72B6C050C109E1790008097125433E8 + +test_RFCA22_1sample :: CryptoRandomGen g => g -> [Test] +test_RFCA22_1sample g = runA22Test g SHA1 "sample" k r s + where + k = 0x888FA6F7738A41BDC9846466ABDB8174C0338250AE50CE955CA16230F9CBD53E + r = 0x3A1B2DBD7489D6ED7E608FD036C83AF396E290DBD602408E8677DAABD6E7445A + s = 0xD26FCBA19FA3E3058FFC02CA1596CDBB6E0D20CB37B06054F7E36DED0CDBBCCF + +test_RFCA22_224sample :: CryptoRandomGen g => g -> [Test] +test_RFCA22_224sample g = runA22Test g SHA224 "sample" k r s + where + k = 0xBC372967702082E1AA4FCE892209F71AE4AD25A6DFD869334E6F153BD0C4D806 + r = 0xDC9F4DEADA8D8FF588E98FED0AB690FFCE858DC8C79376450EB6B76C24537E2C + s = 0xA65A9C3BC7BABE286B195D5DA68616DA8D47FA0097F36DD19F517327DC848CEC + +test_RFCA22_256sample :: CryptoRandomGen g => g -> [Test] +test_RFCA22_256sample g = runA22Test g SHA256 "sample" k r s + where + k = 0x8926A27C40484216F052F4427CFD5647338B7B3939BC6573AF4333569D597C52 + r = 0xEACE8BDBBE353C432A795D9EC556C6D021F7A03F42C36E9BC87E4AC7932CC809 + s = 0x7081E175455F9247B812B74583E9E94F9EA79BD640DC962533B0680793A38D53 + +test_RFCA22_384sample :: CryptoRandomGen g => g -> [Test] +test_RFCA22_384sample g = runA22Test g SHA384 "sample" k r s + where + k = 0xC345D5AB3DA0A5BCB7EC8F8FB7A7E96069E03B206371EF7D83E39068EC564920 + r = 0xB2DA945E91858834FD9BF616EBAC151EDBC4B45D27D0DD4A7F6A22739F45C00B + s = 0x19048B63D9FD6BCA1D9BAE3664E1BCB97F7276C306130969F63F38FA8319021B + +test_RFCA22_512sample :: CryptoRandomGen g => g -> [Test] +test_RFCA22_512sample g = runA22Test g SHA512 "sample" k r s + where + k = 0x5A12994431785485B3F5F067221517791B85A597B7A9436995C89ED0374668FC + r = 0x2016ED092DC5FB669B8EFB3D1F31A91EECB199879BE0CF78F02BA062CB4C942E + s = 0xD0C76F84B5F091E141572A639A4FB8C230807EEA7D55C8A154A224400AFF2351 + +test_RFCA22_1test :: CryptoRandomGen g => g -> [Test] +test_RFCA22_1test g = runA22Test g SHA1 "test" k r s + where + k = 0x6EEA486F9D41A037B2C640BC5645694FF8FF4B98D066A25F76BE641CCB24BA4F + r = 0xC18270A93CFC6063F57A4DFA86024F700D980E4CF4E2CB65A504397273D98EA0 + s = 0x414F22E5F31A8B6D33295C7539C1C1BA3A6160D7D68D50AC0D3A5BEAC2884FAA + +test_RFCA22_224test :: CryptoRandomGen g => g -> [Test] +test_RFCA22_224test g = runA22Test g SHA224 "test" k r s + where + k = 0x06BD4C05ED74719106223BE33F2D95DA6B3B541DAD7BFBD7AC508213B6DA6670 + r = 0x272ABA31572F6CC55E30BF616B7A265312018DD325BE031BE0CC82AA17870EA3 + s = 0xE9CC286A52CCE201586722D36D1E917EB96A4EBDB47932F9576AC645B3A60806 + +test_RFCA22_256test :: CryptoRandomGen g => g -> [Test] +test_RFCA22_256test g = runA22Test g SHA256 "test" k r s + where + k = 0x1D6CE6DDA1C5D37307839CD03AB0A5CBB18E60D800937D67DFB4479AAC8DEAD7 + r = 0x8190012A1969F9957D56FCCAAD223186F423398D58EF5B3CEFD5A4146A4476F0 + s = 0x7452A53F7075D417B4B013B278D1BB8BBD21863F5E7B1CEE679CF2188E1AB19E + +test_RFCA22_384test :: CryptoRandomGen g => g -> [Test] +test_RFCA22_384test g = runA22Test g SHA384 "test" k r s + where + k = 0x206E61F73DBE1B2DC8BE736B22B079E9DACD974DB00EEBBC5B64CAD39CF9F91C + r = 0x239E66DDBE8F8C230A3D071D601B6FFBDFB5901F94D444C6AF56F732BEB954BE + s = 0x6BD737513D5E72FE85D1C750E0F73921FE299B945AAD1C802F15C26A43D34961 + +test_RFCA22_512test :: CryptoRandomGen g => g -> [Test] +test_RFCA22_512test g = runA22Test g SHA512 "test" k r s + where + k = 0xAFF1651E4CD6036D57AA8B2A05CCF1A9D5A40166340ECBBDC55BE10B568AA0AA + r = 0x89EC4BB1400ECCFF8E7D9AA515CD1DE7803F2DAFF09693EE7FD1353E90A68307 + s = 0xC9F0BDABCC0D880BB137A994CC7F3980CE91CC10FAF529FC46565B15CEA854E1 + +instance Arbitrary ByteString where + arbitrary = pack `fmap` arbitrary + +prop_verifySig :: CryptoRandomGen g => g -> ParameterSizes -> ByteString -> Bool +prop_verifySig gen sizes msg = + case generateKeyPair gen sizes of + Left _ -> False + Right (pub, priv, _, _) -> + case signMessage priv msg of + Left _ -> False + Right sig -> verifyMessage pub msg sig + +data KGen g = KGen (KGenerator g) String + +instance CryptoRandomGen g => Arbitrary (KGen g) where + arbitrary = elements [ KGen kViaRFC6979 "RFC" + , KGen kViaExtraRandomBits "Exrta" + , KGen kViaTestingCandidates "Testing"] + +instance Show (KGen g) where + show (KGen _ str) = "KGen:" ++ str + +instance Arbitrary HashFunction where + arbitrary = elements [SHA1, SHA224, SHA256, SHA384, SHA512] + +prop_verifySig' :: CryptoRandomGen g => + g -> ParameterSizes -> + HashFunction -> KGen g -> + ByteString -> + Bool +prop_verifySig' gen sizes hash (KGen kgen _) msg = + case generateKeyPair gen sizes of + Left _ -> False + Right (pub, priv, _, _) -> + case signMessage' hash kgen gen priv msg of + Left _ -> False + Right (sig, _) -> verifyMessage' hash pub msg sig