DSA (empty) → 1
raw patch · 7 files changed
+1758/−0 lines, 7 filesdep +DRBGdep +HUnitdep +QuickChecksetup-changed
Dependencies added: DRBG, HUnit, QuickCheck, SHA, base, binary, bytestring, crypto-api, crypto-pubkey-types, ghc-prim, integer-gmp, tagged, test-framework, test-framework-hunit, test-framework-quickcheck2
Files
- DSA.cabal +74/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- src/Codec/Crypto/DSA.hs +6/−0
- src/Codec/Crypto/DSA/Exceptions.hs +240/−0
- src/Codec/Crypto/DSA/Pure.hs +959/−0
- src/Test.hs +447/−0
+ DSA.cabal view
@@ -0,0 +1,74 @@+name: DSA+category: Cryptography, Codec+version: 1+license: BSD3+license-file: LICENSE+author: Adam Wick <awick@galois.com>+maintainer: Adam Wick <awick@galois.com>+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+
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Codec/Crypto/DSA.hs view
@@ -0,0 +1,6 @@+module Codec.Crypto.DSA(+ module Codec.Crypto.DSA.Exceptions+ )+ where++import Codec.Crypto.DSA.Exceptions
+ src/Codec/Crypto/DSA/Exceptions.hs view
@@ -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
+ src/Codec/Crypto/DSA/Pure.hs view
@@ -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+
+ src/Test.hs view
@@ -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