crypto-pubkey (empty) → 0.1.0
raw patch · 20 files changed
+1416/−0 lines, 20 filesdep +HUnitdep +QuickCheckdep +basesetup-changed
Dependencies added: HUnit, QuickCheck, base, bytestring, cprng-aes, criterion, crypto-numbers, crypto-pubkey, crypto-pubkey-types, crypto-random-api, cryptohash, mtl, test-framework, test-framework-hunit, test-framework-quickcheck2
Files
- Benchs/Bench.hs +66/−0
- Crypto/PubKey/DH.hs +46/−0
- Crypto/PubKey/DSA.hs +73/−0
- Crypto/PubKey/ElGamal.hs +144/−0
- Crypto/PubKey/HashDescr.hs +88/−0
- Crypto/PubKey/Internal.hs +24/−0
- Crypto/PubKey/MaskGenFunction.hs +31/−0
- Crypto/PubKey/RSA.hs +74/−0
- Crypto/PubKey/RSA/OAEP.hs +140/−0
- Crypto/PubKey/RSA/PKCS15.hs +140/−0
- Crypto/PubKey/RSA/PSS.hs +122/−0
- Crypto/PubKey/RSA/Prim.hs +64/−0
- Crypto/PubKey/RSA/Types.hs +26/−0
- LICENSE +24/−0
- Setup.hs +2/−0
- Tests/KAT.hs +42/−0
- Tests/PregenKeys.hs +38/−0
- Tests/RNG.hs +38/−0
- Tests/Tests.hs +157/−0
- crypto-pubkey.cabal +77/−0
+ Benchs/Bench.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE BangPatterns #-}+module Main where++import Criterion.Main+import PregenKeys++import qualified Crypto.Hash.SHA1 as SHA1+import Crypto.PubKey.RSA as RSA+import Crypto.PubKey.RSA.PKCS15 as PKCS15+import Crypto.PubKey.RSA.OAEP as OAEP+import Crypto.PubKey.RSA.PSS as PSS+import Crypto.PubKey.HashDescr++import Crypto.Random.AESCtr+import qualified Data.ByteString as B++right (Right r) = r+right (Left _) = error "left received"++main = do+ rng <- makeSystem+ let !bs = B.replicate 32 0+ !encryptedMsgPKCS = (right . fst . PKCS15.encrypt rng rsaPublickey) bs+ !encryptedMsgOAEP = (right . fst . OAEP.encrypt rng oaepParams rsaPublickey) bs+ !signedMsgPKCS = (right . PKCS15.sign Nothing hashDescrSHA1 rsaPrivatekey) bs+ !signedMsgPSS = (right . fst . PSS.sign rng Nothing pssParams rsaPrivatekey) bs+ privateKeySlow = rsaPrivatekey { RSA.private_p = 0, RSA.private_q = 0 }+ !blinder = fst $ generateBlinder rng (RSA.public_n rsaPublickey)+ oaepParams = OAEP.defaultOAEPParams SHA1.hash+ pssParams = PSS.defaultPSSParamsSHA1+ defaultMain+ [ bgroup "RSA PKCS15"+ [ bench "encryption" $ nf (right . fst . PKCS15.encrypt rng rsaPublickey) bs+ , bgroup "decryption"+ [ bench "slow" $ nf (right . PKCS15.decrypt Nothing privateKeySlow) encryptedMsgPKCS+ , bench "fast" $ nf (right . PKCS15.decrypt Nothing rsaPrivatekey) encryptedMsgPKCS+ , bench "slow+blinding" $ nf (right . PKCS15.decrypt (Just blinder) privateKeySlow) encryptedMsgPKCS+ , bench "fast+blinding" $ nf (right . PKCS15.decrypt (Just blinder) rsaPrivatekey) encryptedMsgPKCS+ ]+ , bgroup "signing"+ [ bench "slow" $ nf (right . PKCS15.sign Nothing hashDescrSHA1 privateKeySlow) bs+ , bench "fast" $ nf (right . PKCS15.sign Nothing hashDescrSHA1 rsaPrivatekey) bs+ , bench "slow+blinding" $ nf (right . PKCS15.sign (Just blinder) hashDescrSHA1 privateKeySlow) bs+ , bench "fast+blinding" $ nf (right . PKCS15.sign (Just blinder) hashDescrSHA1 rsaPrivatekey) bs+ ]+ , bench "verify" $ nf (PKCS15.verify hashDescrSHA1 rsaPublickey bs) signedMsgPKCS+ ]+ , bgroup "RSA OAEP"+ [ bench "encryption" $ nf (right . fst . OAEP.encrypt rng oaepParams rsaPublickey) bs+ , bgroup "decryption"+ [ bench "slow" $ nf (right . OAEP.decrypt Nothing oaepParams privateKeySlow) encryptedMsgOAEP+ , bench "fast" $ nf (right . OAEP.decrypt Nothing oaepParams rsaPrivatekey) encryptedMsgOAEP+ , bench "slow+blinding" $ nf (right . OAEP.decrypt (Just blinder) oaepParams privateKeySlow) encryptedMsgOAEP+ , bench "fast+blinding" $ nf (right . OAEP.decrypt (Just blinder) oaepParams rsaPrivatekey) encryptedMsgOAEP+ ]+ ]+ , bgroup "RSA PSS"+ [ bgroup "signing"+ [ bench "slow" $ nf (right . fst . PSS.sign rng Nothing pssParams privateKeySlow) bs+ , bench "fast" $ nf (right . fst . PSS.sign rng Nothing pssParams rsaPrivatekey) bs+ , bench "slow+blinding" $ nf (right . fst . PSS.sign rng (Just blinder) pssParams privateKeySlow) bs+ , bench "fast+blinding" $ nf (right . fst . PSS.sign rng (Just blinder) pssParams rsaPrivatekey) bs+ ]+ , bench "verify" $ nf (PSS.verify pssParams rsaPublickey bs) signedMsgPSS+ ]+ ]
+ Crypto/PubKey/DH.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- |+-- Module : Crypto.PubKey.DH+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : Good+--+module Crypto.PubKey.DH+ ( Params+ , PublicNumber+ , PrivateNumber+ , SharedKey+ , generateParams+ , generatePrivate+ , generatePublic+ , getShared+ ) where++import Crypto.Number.ModArithmetic (exponantiation)+import Crypto.Number.Prime (generateSafePrime)+import Crypto.Number.Generate (generateOfSize)+import Crypto.Types.PubKey.DH+import Crypto.Random.API+import Control.Arrow (first)++-- | generate params from a specific generator (2 or 5 are common values)+-- we generate a safe prime (a prime number of the form 2p+1 where p is also prime)+generateParams :: CPRG g => g -> Int -> Integer -> (Params, g)+generateParams rng bits generator =+ first (\p -> (p, generator)) $ generateSafePrime rng bits++-- | generate a private number with no specific property+-- this number is usually called X in DH text.+generatePrivate :: CPRG g => g -> Int -> (PrivateNumber, g)+generatePrivate rng bits = first PrivateNumber $ generateOfSize rng bits++-- | generate a public number that is for the other party benefits.+-- this number is usually called Y in DH text.+generatePublic :: Params -> PrivateNumber -> PublicNumber+generatePublic (p,g) (PrivateNumber x) = PublicNumber $ exponantiation g x p++-- | generate a shared key using our private number and the other party public number+getShared :: Params -> PrivateNumber -> PublicNumber -> SharedKey+getShared (p,_) (PrivateNumber x) (PublicNumber y) = SharedKey $ exponantiation y x p
+ Crypto/PubKey/DSA.hs view
@@ -0,0 +1,73 @@+-- |+-- Module : Crypto.PubKey.DSA+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : Good+--++module Crypto.PubKey.DSA+ ( Params+ , Signature+ , PublicKey(..)+ , PrivateKey(..)+ -- * signature primitive+ , sign+ , signWith+ -- * verification primitive+ , verify+ ) where++import Crypto.Random.API+import Data.Maybe+import Data.ByteString (ByteString)+import Crypto.Number.ModArithmetic (exponantiation, inverse)+import Crypto.Number.Serialize+import Crypto.Number.Generate+import Crypto.Types.PubKey.DSA+import Crypto.PubKey.HashDescr++-- | sign message using the private key and an explicit k number.+signWith :: Integer -- ^ k random number+ -> PrivateKey -- ^ private key+ -> HashFunction -- ^ hash function+ -> ByteString -- ^ message to sign+ -> Maybe Signature+signWith k pk hash msg+ | r == 0 || s == 0 = Nothing+ | otherwise = Just (r,s)+ where -- parameters+ (p,g,q) = private_params pk+ x = private_x pk+ -- compute r,s+ kInv = fromJust $ inverse k q+ hm = os2ip $ hash msg+ r = expmod g k p `mod` q+ s = (kInv * (hm + x * r)) `mod` q++-- | sign message using the private key.+sign :: CPRG g => g -> PrivateKey -> HashFunction -> ByteString -> (Signature, g)+sign rng pk hash msg =+ case signWith k pk hash msg of+ Nothing -> sign rng' pk hash msg+ Just sig -> (sig, rng')+ where (_,_,q) = private_params pk+ (k, rng') = generateMax rng q++-- | verify a bytestring using the public key.+verify :: HashFunction -> PublicKey -> Signature -> ByteString -> Bool+verify hash pk (r,s) m+ -- Reject the signature if either 0 < r < q or 0 < s < q is not satisfied.+ | r <= 0 || r >= q || s <= 0 || s >= q = False+ | otherwise = v == r+ where (p,g,q) = public_params pk+ y = public_y pk+ hm = os2ip $ hash m++ w = fromJust $ inverse s q+ u1 = (hm*w) `mod` q+ u2 = (r*w) `mod` q+ v = ((expmod g u1 p) * (expmod y u2 p)) `mod` p `mod` q++expmod :: Integer -> Integer -> Integer -> Integer+expmod = exponantiation
+ Crypto/PubKey/ElGamal.hs view
@@ -0,0 +1,144 @@+-- |+-- Module : Crypto.PubKey.ElGamal+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : Good+--+-- This module is a work in progress. do not use:+-- it might eat your dog, your data or even both.+--+-- TODO: provide a mapping between integer and ciphertext+-- generate numbers correctly+--+module Crypto.PubKey.ElGamal+ ( Params+ , PublicNumber+ , PrivateNumber+ , EphemeralKey(..)+ , SharedKey+ , Signature+ -- * generation+ , generatePrivate+ , generatePublic+ -- * encryption and decryption with no scheme+ , encryptWith+ , encrypt+ , decrypt+ -- * signature primitives+ , signWith+ , sign+ -- * verification primitives+ , verify+ ) where++import Data.ByteString (ByteString)+import Crypto.Number.ModArithmetic (exponantiation, inverse)+import Crypto.Number.Generate (generateMax)+import Crypto.Number.Serialize (os2ip)+import Crypto.Number.Basic (gcde_binary)+import Crypto.Types.PubKey.DH+import Crypto.Random.API+import Control.Arrow (first)+import Data.Maybe (fromJust)+import Crypto.PubKey.HashDescr (HashFunction)++-- | ElGamal Signature+data Signature = Signature (Integer, Integer)++-- | ElGamal Ephemeral key. also called Temporary key.+newtype EphemeralKey = EphemeralKey Integer++-- | generate a private number with no specific property+-- this number is usually called a and need to be between+-- 0 and q (order of the group G).+--+generatePrivate :: CPRG g => g -> Integer -> (PrivateNumber, g)+generatePrivate rng q = first PrivateNumber $ generateMax rng q++-- | generate an ephemeral key which is a number with no specific property,+-- and need to be between 0 and q (order of the group G).+--+generateEphemeral :: CPRG g => g -> Integer -> (EphemeralKey, g)+generateEphemeral rng q = first toEphemeral $ generatePrivate rng q+ where toEphemeral (PrivateNumber n) = EphemeralKey n++-- | generate a public number that is for the other party benefits.+-- this number is usually called h=g^a+generatePublic :: Params -> PrivateNumber -> PublicNumber+generatePublic (p,g) (PrivateNumber a) = PublicNumber $ exponantiation g a p++-- | encrypt with a specified ephemeral key+-- do not reuse ephemeral key.+encryptWith :: EphemeralKey -> Params -> PublicNumber -> Integer -> (Integer,Integer)+encryptWith (EphemeralKey b) (p,g) (PublicNumber h) m = (c1,c2)+ where s = exponantiation h b p+ c1 = exponantiation g b p+ c2 = (s * m) `mod` p++-- | encrypt a message using params and public keys+-- will generate b (called the ephemeral key)+encrypt :: CPRG g => g -> Params -> PublicNumber -> Integer -> ((Integer,Integer), g)+encrypt rng params@(p,_) public m = first (\b -> encryptWith b params public m) $ generateEphemeral rng q+ where q = p-1 -- p is prime, hence order of the group is p-1++-- | decrypt message+decrypt :: Params -> PrivateNumber -> (Integer, Integer) -> Integer+decrypt (p,_) (PrivateNumber a) (c1,c2) = (c2 * sm1) `mod` p+ where s = exponantiation c1 a p+ sm1 = fromJust $ inverse s p -- always inversible in Zp++-- | sign a message with an explicit k number+--+-- if k is not appropriate, then no signature is returned.+--+-- with some appropriate value of k, the signature generation can fail,+-- and no signature is returned. User of this function need to retry+-- with a different k value.+signWith :: Integer -- ^ random number k, between 0 and p-1 and gcd(k,p-1)=1+ -> Params -- ^ DH params (p,g)+ -> PrivateNumber -- ^ DH private key+ -> HashFunction -- ^ collision resistant hash function+ -> ByteString -- ^ message to sign+ -> Maybe Signature+signWith k (p,g) (PrivateNumber x) hashF msg+ | k >= p-1 || d > 1 = Nothing -- gcd(k,p-1) is not 1+ | s == 0 = Nothing+ | otherwise = Just $ Signature (r,s)+ where r = exponantiation g k p+ h = os2ip $ hashF msg+ s = ((h - x*r) * kInv) `mod` (p-1)+ (kInv,_,d) = gcde_binary k (p-1)++-- | sign message+--+-- This function will generate a random number, however+-- as the signature might fail, the function will automatically retry+-- until a proper signature has been created.+--+sign :: CPRG g+ => g -- ^ random number generator+ -> Params -- ^ DH params (p,g)+ -> PrivateNumber -- ^ DH private key+ -> HashFunction -- ^ collision resistant hash function+ -> ByteString -- ^ message to sign+ -> (Signature, g)+sign rng params@(p,_) priv hashF msg =+ let (k, rng') = generateMax rng (p-1)+ in case signWith k params priv hashF msg of+ Nothing -> sign rng' params priv hashF msg+ Just sig -> (sig, rng')++-- | verify a signature+verify :: Params+ -> PublicNumber+ -> HashFunction+ -> ByteString+ -> Signature+ -> Bool+verify (p,g) (PublicNumber y) hashF msg (Signature (r,s))+ | or [r <= 0,r >= p,s <= 0,s >= (p-1)] = False+ | otherwise = lhs == rhs+ where h = os2ip $ hashF msg+ lhs = exponantiation g h p+ rhs = (exponantiation y r p * exponantiation r s p) `mod` p
+ Crypto/PubKey/HashDescr.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module : Crypto.PubKey.HashDescr+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : Good+--+module Crypto.PubKey.HashDescr+ ( HashFunction+ , HashDescr(..)+ , hashDescrMD2+ , hashDescrMD5+ , hashDescrSHA1+ , hashDescrSHA224+ , hashDescrSHA256+ , hashDescrSHA384+ , hashDescrSHA512+ ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Crypto.Hash++-- | A standard hash function returning a digest object+type HashFunction = ByteString -> ByteString++-- | Describe a hash function and a way to wrap the digest into+-- an DER encoded ASN1 marshalled structure.+data HashDescr = HashDescr { hashFunction :: HashFunction+ , digestToASN1 :: ByteString -> ByteString+ }++-- | Describe the MD2 hashing algorithm+hashDescrMD2 :: HashDescr+hashDescrMD2 =+ HashDescr { hashFunction = digestToByteString . (hash :: ByteString -> Digest MD2)+ , digestToASN1 = toHashWithInfo "\x30\x20\x30\x0c\x06\x08\x2a\x86\x48\x86\xf7\x0d\x02\x02\x05\x00\x04\x10"+ }+-- | Describe the MD5 hashing algorithm+hashDescrMD5 :: HashDescr+hashDescrMD5 =+ HashDescr { hashFunction = digestToByteString . (hash :: ByteString -> Digest MD5)+ , digestToASN1 = toHashWithInfo "\x30\x20\x30\x0c\x06\x08\x2a\x86\x48\x86\xf7\x0d\x02\x05\x05\x00\x04\x10"+ }+-- | Describe the SHA1 hashing algorithm+hashDescrSHA1 :: HashDescr+hashDescrSHA1 =+ HashDescr { hashFunction = digestToByteString . (hash :: ByteString -> Digest SHA1)+ , digestToASN1 = toHashWithInfo "\x30\x21\x30\x09\x06\x05\x2b\x0e\x03\x02\x1a\x05\x00\x04\x14"+ }+-- | Describe the SHA224 hashing algorithm+hashDescrSHA224 :: HashDescr+hashDescrSHA224 =+ HashDescr { hashFunction = digestToByteString . (hash :: ByteString -> Digest SHA224)+ , digestToASN1 = toHashWithInfo "\x30\x2d\x30\x0d\x06\x09\x60\x86\x48\x01\x65\x03\x04\x02\x04\x05\x00\x04\x1c"+ }+-- | Describe the SHA256 hashing algorithm+hashDescrSHA256 :: HashDescr+hashDescrSHA256 =+ HashDescr { hashFunction = digestToByteString . (hash :: ByteString -> Digest SHA256)+ , digestToASN1 = toHashWithInfo "\x30\x31\x30\x0d\x06\x09\x60\x86\x48\x01\x65\x03\x04\x02\x01\x05\x00\x04\x20"+ }+-- | Describe the SHA384 hashing algorithm+hashDescrSHA384 :: HashDescr+hashDescrSHA384 =+ HashDescr { hashFunction = digestToByteString . (hash :: ByteString -> Digest SHA384)+ , digestToASN1 = toHashWithInfo "\x30\x41\x30\x0d\x06\x09\x60\x86\x48\x01\x65\x03\x04\x02\x02\x05\x00\x04\x30"+ }+-- | Describe the SHA512 hashing algorithm+hashDescrSHA512 :: HashDescr+hashDescrSHA512 =+ HashDescr { hashFunction = digestToByteString . (hash :: ByteString -> Digest SHA512)+ , digestToASN1 = toHashWithInfo "\x30\x51\x30\x0d\x06\x09\x60\x86\x48\x01\x65\x03\x04\x02\x03\x05\x00\x04\x40"+ }++-- | Generate the marshalled structure with the following ASN1 structure:+--+-- Start Sequence+-- ,Start Sequence+-- ,OID oid+-- ,Null+-- ,End Sequence+-- ,OctetString digest+-- ,End Sequence+--+toHashWithInfo :: ByteString -> ByteString -> ByteString+toHashWithInfo pre digest = pre `B.append` digest
+ Crypto/PubKey/Internal.hs view
@@ -0,0 +1,24 @@+-- |+-- Module : Crypto.PubKey.Internal+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : Good+--+module Crypto.PubKey.Internal+ ( and'+ , (&&!)+ ) where++import Data.List (foldl')++-- | This is a strict version of and+and' :: [Bool] -> Bool+and' l = foldl' (&&!) True l++-- | This is a strict version of &&.+(&&!) :: Bool -> Bool -> Bool+True &&! True = True+True &&! False = False+False &&! True = False+False &&! False = False
+ Crypto/PubKey/MaskGenFunction.hs view
@@ -0,0 +1,31 @@+-- |+-- Module : Crypto.PubKey.MaskGenFunction+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : Good+--+module Crypto.PubKey.MaskGenFunction+ ( MaskGenAlgorithm+ , mgf1+ ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Crypto.PubKey.HashDescr+import Crypto.Number.Serialize (i2ospOf_)++-- | Represent a mask generation algorithm+type MaskGenAlgorithm = HashFunction -- ^ hash function to use+ -> ByteString -- ^ seed+ -> Int -- ^ length to generate+ -> ByteString++-- | Mask generation algorithm MGF1+mgf1 :: MaskGenAlgorithm+mgf1 hashF seed len = loop B.empty 0+ where loop t counter+ | B.length t >= len = B.take len t+ | otherwise = let counterBS = i2ospOf_ 4 counter+ newT = t `B.append` hashF (seed `B.append` counterBS)+ in loop newT (counter+1)
+ Crypto/PubKey/RSA.hs view
@@ -0,0 +1,74 @@+-- |+-- Module : Crypto.PubKey.RSA+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : Good+--+module Crypto.PubKey.RSA+ ( Error(..)+ , PublicKey(..)+ , PrivateKey(..)+ , Blinder(..)+ -- * generation function+ , generateWith+ , generate+ , generateBlinder+ ) where++import Crypto.Random.API+import Crypto.Types.PubKey.RSA+import Crypto.Number.ModArithmetic (inverseCoprimes)+import Crypto.Number.Generate (generateMax)+import Crypto.Number.Prime (generatePrime)+import Crypto.PubKey.RSA.Types++-- | generate a public key and private key with p and q.+--+-- p and q need to be distinct primes numbers.+--+-- e need to be coprime to phi=(p-1)*(q-1). a small hamming weight results in better performance.+-- 0x10001 is a popular choice. 3 is popular as well, but proven to not be as secure for some cases.+generateWith :: (Integer, Integer) -> Int -> Integer -> (PublicKey, PrivateKey)+generateWith (p,q) size e = (pub,priv)+ where n = p*q+ phi = (p-1)*(q-1)+ d = inverseCoprimes e phi -- e and phi need to be coprime+ pub = PublicKey { public_size = size+ , public_n = n+ , public_e = e+ }+ priv = PrivateKey { private_pub = pub+ , private_d = d+ , private_p = p+ , private_q = q+ , private_dP = d `mod` (p-1)+ , private_dQ = d `mod` (q-1)+ , private_qinv = inverseCoprimes q p -- q and p are coprime+ }++-- | generate a pair of (private, public) key of size in bytes.+generate :: CPRG g => g -> Int -> Integer -> ((PublicKey, PrivateKey), g)+generate rng size e = do+ let (pq, rng') = generatePQ rng+ in (generateWith pq size e, rng')+ where+ generatePQ g =+ let (p, g') = generatePrime g (8 * (size `div` 2))+ (q, g'') = generateQ p g'+ in ((p,q), g'')+ generateQ p h =+ let (q, h') = generatePrime h (8 * (size - (size `div` 2)))+ in if p == q then generateQ p h' else (q, h')++-- | Generate a blinder to use with decryption and signing operation+--+-- the unique parameter apart from the random number generator is the+-- public key value N.+generateBlinder :: CPRG g+ => g -- ^ CPRG to use.+ -> Integer -- ^ RSA public N parameters.+ -> (Blinder, g)+generateBlinder rng n =+ let (r, rng') = generateMax rng n+ in (Blinder r (inverseCoprimes r n), rng')
+ Crypto/PubKey/RSA/OAEP.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE OverloadedStrings #-}+module Crypto.PubKey.RSA.OAEP+ (+ OAEPParams(..)+ , defaultOAEPParams+ -- * OAEP encryption+ , encryptWithSeed+ , encrypt+ -- * OAEP decryption+ , decrypt+ , decryptSafer+ ) where++import Crypto.Random.API+import Crypto.Types.PubKey.RSA+import Crypto.PubKey.HashDescr+import Crypto.PubKey.MaskGenFunction+import Crypto.PubKey.RSA.Prim+import Crypto.PubKey.RSA.Types+import Crypto.PubKey.RSA (generateBlinder)+import Crypto.PubKey.Internal (and')+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Data.Bits (xor)++-- | Parameters for OAEP encryption/decryption+data OAEPParams = OAEPParams+ { oaepHash :: HashFunction -- ^ Hash function to use.+ , oaepMaskGenAlg :: MaskGenAlgorithm -- ^ Mask Gen algorithm to use.+ , oaepLabel :: Maybe ByteString -- ^ Optional label prepended to message.+ }++-- | Default Params with a specified hash function+defaultOAEPParams :: HashFunction -> OAEPParams+defaultOAEPParams hashF =+ OAEPParams { oaepHash = hashF+ , oaepMaskGenAlg = mgf1+ , oaepLabel = Nothing+ }++encryptWithSeed :: ByteString+ -> OAEPParams+ -> PublicKey+ -> ByteString+ -> Either Error ByteString+encryptWithSeed seed oaep pk msg+ | k < 2*hashLen+2 = Left InvalidParameters+ | B.length seed /= hashLen = Left InvalidParameters+ | mLen > k - 2*hashLen-2 = Left MessageTooLong+ | otherwise = Right $ ep pk em+ where -- parameters+ k = public_size pk+ mLen = B.length msg+ hashF = oaepHash oaep+ mgf = (oaepMaskGenAlg oaep) hashF+ labelHash = hashF $ maybe B.empty id $ oaepLabel oaep+ hashLen = B.length labelHash++ -- put fields+ ps = B.replicate (k - mLen - 2*hashLen - 2) 0+ db = B.concat [labelHash, ps, B.singleton 0x1, msg]+ dbmask = mgf seed (k - hashLen - 1)+ maskedDB = B.pack $ B.zipWith xor db dbmask+ seedMask = mgf maskedDB hashLen+ maskedSeed = B.pack $ B.zipWith xor seed seedMask+ em = B.concat [B.singleton 0x0,maskedSeed,maskedDB]++-- | Encrypt a message using OAEP+encrypt :: CPRG g+ => g -- ^ random number generator.+ -> OAEPParams -- ^ OAEP params to use for encryption.+ -> PublicKey -- ^ Public key.+ -> ByteString -- ^ Message to encrypt+ -> (Either Error ByteString, g)+encrypt g oaep pk msg = (encryptWithSeed seed oaep pk msg, g')+ where hashF = oaepHash oaep+ hashLen = B.length (hashF B.empty)+ (seed, g') = genRandomBytes g hashLen++-- | un-pad a OAEP encoded message.+--+-- It doesn't apply the RSA decryption primitive+unpad :: OAEPParams -- ^ OAEP params to use+ -> Int -- ^ size of the key in bytes+ -> ByteString -- ^ encoded message (not encrypted)+ -> Either Error ByteString+unpad oaep k em+ | paddingSuccess = Right msg+ | otherwise = Left MessageNotRecognized+ where -- parameters+ hashF = oaepHash oaep+ mgf = (oaepMaskGenAlg oaep) hashF+ labelHash = hashF $ maybe B.empty id $ oaepLabel oaep+ hashLen = B.length labelHash+ -- getting em's fields+ (pb, em0) = B.splitAt 1 em+ (maskedSeed,maskedDB) = B.splitAt hashLen em0+ seedMask = mgf maskedDB hashLen+ seed = B.pack $ B.zipWith xor maskedSeed seedMask+ dbmask = mgf seed (k - hashLen - 1)+ db = B.pack $ B.zipWith xor maskedDB dbmask+ -- getting db's fields+ (labelHash',db1) = B.splitAt hashLen db+ (_,db2) = B.break (/= 0) db1+ (ps1,msg) = B.splitAt 1 db2++ paddingSuccess = and' [ labelHash' == labelHash -- no need for constant eq+ , ps1 == "\x01"+ , pb == "\x00"+ ]++-- | Decrypt a ciphertext using OAEP+--+-- When the signature is not in a context where an attacker could gain+-- information from the timing of the operation, the blinder can be set to None.+--+-- If unsure always set a blinder or use decryptSafer+decrypt :: Maybe Blinder -- ^ Optional blinder+ -> OAEPParams -- ^ OAEP params to use for decryption+ -> PrivateKey -- ^ Private key+ -> ByteString -- ^ Cipher text+ -> Either Error ByteString+decrypt blinder oaep pk cipher+ | B.length cipher /= k = Left MessageSizeIncorrect+ | k < 2*hashLen+2 = Left InvalidParameters+ | otherwise = unpad oaep (private_size pk) $ dp blinder pk cipher+ where -- parameters+ k = private_size pk+ hashF = oaepHash oaep+ hashLen = B.length (hashF B.empty)++-- | Decrypt a ciphertext using OAEP and by automatically generating a blinder.+decryptSafer :: CPRG g+ => g -- ^ random number generator+ -> OAEPParams -- ^ OAEP params to use for decryption+ -> PrivateKey -- ^ Private key+ -> ByteString -- ^ Cipher text+ -> (Either Error ByteString, g)+decryptSafer rng oaep pk cipher = (decrypt (Just blinder) oaep pk cipher, rng')+ where (blinder, rng') = generateBlinder rng (private_n pk)
+ Crypto/PubKey/RSA/PKCS15.hs view
@@ -0,0 +1,140 @@+-- |+-- Module : Crypto.PubKey.RSA.PKCS15+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : Good+--+{-# LANGUAGE OverloadedStrings #-}+module Crypto.PubKey.RSA.PKCS15+ (+ -- * padding and unpadding+ pad+ , padSignature+ , unpad+ -- * private key operations+ , decrypt+ , decryptSafer+ , sign+ , signSafer+ -- * public key operations+ , encrypt+ , verify+ ) where++import Crypto.Random.API+import Crypto.Types.PubKey.RSA+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Crypto.PubKey.RSA.Prim+import Crypto.PubKey.RSA.Types+import Crypto.PubKey.RSA (generateBlinder)+import Crypto.PubKey.HashDescr++-- | This produce a standard PKCS1.5 padding for encryption+pad :: CPRG g => g -> Int -> ByteString -> Either Error (ByteString, g)+pad rng len m+ | B.length m > len - 11 = Left MessageTooLong+ | otherwise =+ let (padding, rng') = getNonNullRandom rng (len - B.length m - 3)+ in Right (B.concat [ B.singleton 0, B.singleton 2, padding, B.singleton 0, m ], rng')++ where {- get random non-null bytes -}+ getNonNullRandom :: CPRG g => g -> Int -> (ByteString, g)+ getNonNullRandom g n =+ let (bs0,g') = genRandomBytes g n+ bytes = B.pack $ filter (/= 0) $ B.unpack $ bs0+ left = (n - B.length bytes)+ in if left == 0+ then (bytes, g')+ else let (bend, g'') = getNonNullRandom g' left+ in (bytes `B.append` bend, g'')++-- | Produce a standard PKCS1.5 padding for signature+padSignature :: Int -> ByteString -> Either Error ByteString+padSignature klen signature+ | klen < siglen+1 = Left SignatureTooLong+ | otherwise = Right $ B.concat [B.singleton 0,B.singleton 1,padding,B.singleton 0,signature]+ where+ siglen = B.length signature+ padding = B.replicate (klen - siglen - 3) 0xff++-- | Try to remove a standard PKCS1.5 encryption padding.+unpad :: ByteString -> Either Error ByteString+unpad packed+ | signal_error = Left MessageNotRecognized+ | otherwise = Right m+ where+ (zt, ps0m) = B.splitAt 2 packed+ (ps, zm) = B.span (/= 0) ps0m+ (z, m) = B.splitAt 1 zm+ signal_error = zt /= "\x00\x02" || z /= "\x00" || (B.length ps < 8)++-- | decrypt message using the private key.+--+-- When the decryption is not in a context where an attacker could gain+-- information from the timing of the operation, the blinder can be set to None.+--+-- If unsure always set a blinder or use decryptSafer+decrypt :: Maybe Blinder -- ^ optional blinder+ -> PrivateKey -- ^ RSA private key+ -> ByteString -- ^ cipher text+ -> Either Error ByteString+decrypt blinder pk c+ | B.length c /= (private_size pk) = Left MessageSizeIncorrect+ | otherwise = unpad $ dp blinder pk c++-- | decrypt message using the private key and by automatically generating a blinder.+decryptSafer :: CPRG g+ => g -- ^ random generator+ -> PrivateKey -- ^ RSA private key+ -> ByteString -- ^ cipher text+ -> (Either Error ByteString, g)+decryptSafer rng pk b =+ let (blinder, rng') = generateBlinder rng (private_n pk)+ in (decrypt (Just blinder) pk b, rng')++-- | encrypt a bytestring using the public key and a CPRG random generator.+--+-- the message need to be smaller than the key size - 11+encrypt :: CPRG g => g -> PublicKey -> ByteString -> (Either Error ByteString, g)+encrypt rng pk m = do+ case pad rng (public_size pk) m of+ Left err -> (Left err, rng)+ Right (em, rng') -> (Right (ep pk em), rng')++-- | sign message using private key, a hash and its ASN1 description+--+-- When the signature is not in a context where an attacker could gain+-- information from the timing of the operation, the blinder can be set to None.+--+-- If unsure always set a blinder or use signSafer+sign :: Maybe Blinder -- ^ optional blinder+ -> HashDescr -- ^ hash descriptor+ -> PrivateKey -- ^ private key+ -> ByteString -- ^ message to sign+ -> Either Error ByteString+sign blinder hashDescr pk m = dp blinder pk `fmap` makeSignature hashDescr (private_size pk) m++-- | sign message using the private key and by automatically generating a blinder.+signSafer :: CPRG g+ => g -- ^ random generator+ -> HashDescr -- ^ Hash descriptor+ -> PrivateKey -- ^ private key+ -> ByteString -- ^ message to sign+ -> (Either Error ByteString, g)+signSafer rng hashDescr pk m =+ let (blinder, rng') = generateBlinder rng (private_n pk)+ in (sign (Just blinder) hashDescr pk m, rng')++-- | verify message with the signed message+verify :: HashDescr -> PublicKey -> ByteString -> ByteString -> Bool+verify hashDescr pk m sm =+ case makeSignature hashDescr (public_size pk) m of+ Left _ -> False+ Right s -> s == (ep pk sm)++{- makeSignature for sign and verify -}+makeSignature :: HashDescr -> Int -> ByteString -> Either Error ByteString+makeSignature hashDescr klen m = padSignature klen signature+ where signature = (digestToASN1 hashDescr) $ (hashFunction hashDescr) m
+ Crypto/PubKey/RSA/PSS.hs view
@@ -0,0 +1,122 @@+-- |+-- Module : Crypto.PubKey.RSA.PSS+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : Good+--+module Crypto.PubKey.RSA.PSS+ ( PSSParams(..)+ , defaultPSSParams+ , defaultPSSParamsSHA1+ -- * Sign and verify functions+ , signWithSalt+ , sign+ , verify+ ) where++import Crypto.Random.API+import Crypto.Types.PubKey.RSA+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Crypto.PubKey.RSA.Prim+import Crypto.PubKey.RSA.Types+import Crypto.PubKey.HashDescr+import Crypto.PubKey.MaskGenFunction+import Crypto.Hash+import Data.Bits (xor, shiftR, (.&.))+import Data.Word++-- | Parameters for PSS signature/verification.+data PSSParams = PSSParams { pssHash :: HashFunction -- ^ Hash function to use+ , pssMaskGenAlg :: MaskGenAlgorithm -- ^ Mask Gen algorithm to use+ , pssSaltLength :: Int -- ^ Length of salt. need to be <= to hLen.+ , pssTrailerField :: Word8 -- ^ Trailer field, usually 0xbc+ }++-- | Default Params with a specified hash function+defaultPSSParams :: HashFunction -> PSSParams+defaultPSSParams hashF =+ PSSParams { pssHash = hashF+ , pssMaskGenAlg = mgf1+ , pssSaltLength = B.length $ hashF B.empty+ , pssTrailerField = 0xbc+ }++-- | Default Params using SHA1 algorithm.+defaultPSSParamsSHA1 :: PSSParams+defaultPSSParamsSHA1 = defaultPSSParams (digestToByteString . (hash :: ByteString -> Digest SHA1))++-- | Sign using the PSS parameters and the salt explicitely passed as parameters.+--+-- the function ignore SaltLength from the PSS Parameters+signWithSalt :: ByteString -- ^ Salt to use+ -> Maybe Blinder -- ^ optional blinder to use+ -> PSSParams -- ^ PSS Parameters to use+ -> PrivateKey -- ^ RSA Private Key+ -> ByteString -- ^ Message to sign+ -> Either Error ByteString+signWithSalt salt blinder params pk m+ | k < hashLen + saltLen + 2 = Left InvalidParameters+ | otherwise = Right $ dp blinder pk em+ where mHash = (pssHash params) m+ k = private_size pk+ dbLen = k - hashLen - 1+ saltLen = B.length salt+ hashLen = B.length (hashF B.empty)+ hashF = pssHash params+ pubBits = private_size pk * 8 -- to change if public_size is converted in bytes++ m' = B.concat [B.replicate 8 0,mHash,salt]+ h = hashF m'+ db = B.concat [B.replicate (dbLen - saltLen - 1) 0,B.singleton 1,salt]+ dbmask = (pssMaskGenAlg params) hashF h dbLen+ maskedDB = B.pack $ normalizeToKeySize pubBits $ B.zipWith xor db dbmask+ em = B.concat [maskedDB, h, B.singleton (pssTrailerField params)]++-- | Sign using the PSS Parameters+sign :: CPRG g+ => g -- ^ random generator to use to generate the salt+ -> Maybe Blinder -- ^ optional blinder to use+ -> PSSParams -- ^ PSS Parameters to use+ -> PrivateKey -- ^ RSA Private Key+ -> ByteString -- ^ Message to sign+ -> (Either Error ByteString, g)+sign rng blinder params pk m = (signWithSalt salt blinder params pk m, rng')+ where (salt,rng') = genRandomBytes rng (pssSaltLength params)++-- | Verify a signature using the PSS Parameters+verify :: PSSParams -- ^ PSS Parameters to use to verify,+ -- this need to be identical to the parameters when signing+ -> PublicKey -- ^ RSA Public Key+ -> ByteString -- ^ Message to verify+ -> ByteString -- ^ Signature+ -> Bool+verify params pk m s+ | public_size pk /= B.length s = False+ | B.last em /= pssTrailerField params = False+ | not (B.all (== 0) ps0) = False+ | b1 /= B.singleton 1 = False+ | otherwise = h == h'+ where -- parameters+ hashF = pssHash params+ hashLen = B.length (hashF B.empty)+ dbLen = public_size pk - hashLen - 1+ pubBits = public_size pk * 8 -- to change if public_size is converted in bytes+ -- unmarshall fields+ em = ep pk s+ maskedDB = B.take (B.length em - hashLen - 1) em+ h = B.take hashLen $ B.drop (B.length maskedDB) em+ dbmask = (pssMaskGenAlg params) hashF h dbLen+ db = B.pack $ normalizeToKeySize pubBits $ B.zipWith xor maskedDB dbmask+ (ps0,z) = B.break (== 1) db+ (b1,salt) = B.splitAt 1 z+ mHash = hashF m+ m' = B.concat [B.replicate 8 0,mHash,salt]+ h' = hashF m'++normalizeToKeySize :: Int -> [Word8] -> [Word8]+normalizeToKeySize _ [] = [] -- very unlikely+normalizeToKeySize bits (x:xs) = x .&. mask : xs+ where mask = if sh > 0 then 0xff `shiftR` (8-sh) else 0xff+ sh = ((bits-1) .&. 0x7)
+ Crypto/PubKey/RSA/Prim.hs view
@@ -0,0 +1,64 @@+-- |+-- Module : Crypto.PubKey.RSA.Prim+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : Good+--+module Crypto.PubKey.RSA.Prim+ (+ -- * decrypt primitive+ dp+ -- * encrypt primitive+ , ep+ ) where++import Data.ByteString (ByteString)+import Crypto.PubKey.RSA.Types (Blinder(..))+import Crypto.Types.PubKey.RSA+import Crypto.Number.ModArithmetic (exponantiation)+import Crypto.Number.Serialize (os2ip, i2ospOf_)++{- dpSlow computes the decrypted message not using any precomputed cache value.+ only n and d need to valid. -}+dpSlow :: PrivateKey -> ByteString -> ByteString+dpSlow pk c = i2ospOf_ (private_size pk) $ expmod (os2ip c) (private_d pk) (private_n pk)++{- dpFast computes the decrypted message more efficiently if the+ precomputed private values are available. mod p and mod q are faster+ to compute than mod pq -}+dpFast :: Blinder -> PrivateKey -> ByteString -> ByteString+dpFast (Blinder r rm1) pk c =+ i2ospOf_ (private_size pk) (multiplication rm1 (m2 + h * (private_q pk)) (private_n pk))+ where+ re = expmod r (public_e $ private_pub pk) (private_n pk)+ iC = multiplication re (os2ip c) (private_n pk)+ m1 = expmod iC (private_dP pk) (private_p pk)+ m2 = expmod iC (private_dQ pk) (private_q pk)+ h = ((private_qinv pk) * (m1 - m2)) `mod` (private_p pk)++dpFastNoBlinder :: PrivateKey -> ByteString -> ByteString+dpFastNoBlinder pk c = i2ospOf_ (private_size pk) (m2 + h * (private_q pk))+ where iC = os2ip c+ m1 = expmod iC (private_dP pk) (private_p pk)+ m2 = expmod iC (private_dQ pk) (private_q pk)+ h = ((private_qinv pk) * (m1 - m2)) `mod` (private_p pk)++-- | Compute the RSA decrypt primitive.+-- if the p and q numbers are available, then dpFast is used+-- otherwise, we use dpSlow which only need d and n.+dp :: Maybe Blinder -> PrivateKey -> ByteString -> ByteString+dp blinder pk+ | private_p pk /= 0 && private_q pk /= 0 = maybe dpFastNoBlinder dpFast blinder $ pk+ | otherwise = dpSlow pk++-- | Compute the RSA encrypt primitive+ep :: PublicKey -> ByteString -> ByteString+ep pk m = i2ospOf_ (public_size pk) $ expmod (os2ip m) (public_e pk) (public_n pk)++expmod :: Integer -> Integer -> Integer -> Integer+expmod = exponantiation++-- | multiply 2 integers in Zm only performing the modulo operation if necessary+multiplication :: Integer -> Integer -> Integer -> Integer+multiplication a b m = (a * b) `mod` m
+ Crypto/PubKey/RSA/Types.hs view
@@ -0,0 +1,26 @@+-- |+-- Module : Crypto.PubKey.RSA.Types+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : Good+--+module Crypto.PubKey.RSA.Types+ ( Error(..)+ , Blinder(..)+ ) where++-- | Blinder which is used to obfuscate the timing+-- of the decryption primitive (used by decryption and signing).+data Blinder = Blinder !Integer !Integer+ deriving (Show,Eq)++-- | error possible during encryption, decryption or signing.+data Error =+ MessageSizeIncorrect -- ^ the message to decrypt is not of the correct size (need to be == private_size)+ | MessageTooLong -- ^ the message to encrypt is too long (>= private_size - 11)+ | MessageNotRecognized -- ^ the message decrypted doesn't have a PKCS15 structure (0 2 .. 0 msg)+ | SignatureTooLong -- ^ the signature generated through the hash is too long to process with this key+ | InvalidParameters -- ^ some parameters lead to breaking assumptions.+ deriving (Show,Eq)+
+ LICENSE view
@@ -0,0 +1,24 @@+Copyright (c) 2010-2012 Vincent Hanquez <vincent@snarc.org>++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Tests/KAT.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE OverloadedStrings #-}+module KAT where++import Test.Framework (Test, defaultMain, testGroup)+import Test.Framework.Providers.HUnit (testCase)+import Test.QuickCheck+import Test.QuickCheck.Test+import Test.HUnit+import System.IO (hFlush, stdout)++import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC++import Crypto.PubKey.RSA+import Crypto.PubKey.MaskGenFunction+import qualified Crypto.Hash.SHA1 as SHA1++import KAT.OAEP+import KAT.PSS+import KAT.DSA++data VectorMgf = VectorMgf { seed :: ByteString+ , dbMask :: ByteString+ }++doMGFTest (i, vmgf) = testCase (show i) (dbMask vmgf @=? actual)+ where actual = mgf1 SHA1.hash (seed vmgf) (B.length $ dbMask vmgf)++vectorsMGF =+ [ VectorMgf+ { seed = "\xdf\x1a\x89\x6f\x9d\x8b\xc8\x16\xd9\x7c\xd7\xa2\xc4\x3b\xad\x54\x6f\xbe\x8c\xfe"+ , dbMask = "\x66\xe4\x67\x2e\x83\x6a\xd1\x21\xba\x24\x4b\xed\x65\x76\xb8\x67\xd9\xa4\x47\xc2\x8a\x6e\x66\xa5\xb8\x7d\xee\x7f\xbc\x7e\x65\xaf\x50\x57\xf8\x6f\xae\x89\x84\xd9\xba\x7f\x96\x9a\xd6\xfe\x02\xa4\xd7\x5f\x74\x45\xfe\xfd\xd8\x5b\x6d\x3a\x47\x7c\x28\xd2\x4b\xa1\xe3\x75\x6f\x79\x2d\xd1\xdc\xe8\xca\x94\x44\x0e\xcb\x52\x79\xec\xd3\x18\x3a\x31\x1f\xc8\x97\x39\xa9\x66\x43\x13\x6e\x8b\x0f\x46\x5e\x87\xa4\x53\x5c\xd4\xc5\x9b\x10\x02\x8d"+ }+ ]++katTests =+ [ testGroup "MGF1" $ map doMGFTest (zip [0..] vectorsMGF)+ , pssTests+ , oaepTests+ , dsaTests+ ]
+ Tests/PregenKeys.hs view
@@ -0,0 +1,38 @@+module PregenKeys where++import qualified Crypto.PubKey.RSA as RSA+import qualified Crypto.PubKey.DSA as DSA+import qualified Crypto.PubKey.DH as DH++rsaPrivatekey = RSA.PrivateKey+ { RSA.private_pub = rsaPublickey+ , RSA.private_d = 133764127300370985476360382258931504810339098611363623122953018301285450176037234703101635770582297431466449863745848961134143024057267778947569638425565153896020107107895924597628599677345887446144410702679470631826418774397895304952287674790343620803686034122942606764275835668353720152078674967983573326257+ , RSA.private_p = 12909745499610419492560645699977670082358944785082915010582495768046269235061708286800087976003942261296869875915181420265794156699308840835123749375331319+ , RSA.private_q = 10860278066550210927914375228722265675263011756304443428318337179619069537063135098400347475029673115805419186390580990519363257108008103841271008948795129+ , RSA.private_dP = 5014229697614831746694710412330921341325464081424013940131184365711243776469716106024020620858146547161326009604054855316321928968077674343623831428796843+ , RSA.private_dQ = 3095337504083058271243917403868092841421453478127022884745383831699720766632624326762288333095492075165622853999872779070009098364595318242383709601515849+ , RSA.private_qinv = 11136639099661288633118187183300604127717437440459572124866697429021958115062007251843236337586667012492941414990095176435990146486852255802952814505784196+ }++rsaPublickey = RSA.PublicKey+ { RSA.public_size = 128+ , RSA.public_n = 140203425894164333410594309212077886844966070748523642084363106504571537866632850620326769291612455847330220940078873180639537021888802572151020701352955762744921926221566899281852945861389488419179600933178716009889963150132778947506523961974222282461654256451508762805133855866018054403911588630700228345151+ , RSA.public_e = 65537+ }++dsaParams = (p,g,q)+ where+ p = 0x00a8c44d7d0bbce69a39008948604b9c7b11951993a5a1a1fa995968da8bb27ad9101c5184bcde7c14fb79f7562a45791c3d80396cefb328e3e291932a17e22edd+ g = 0x0bf9fe6c75d2367b88912b2252d20fdcad06b3f3a234b92863a1e30a96a123afd8e8a4b1dd953e6f5583ef8e48fc7f47a6a1c8f24184c76dba577f0fec2fcd1c+ q = 0x0096674b70ef58beaaab6743d6af16bb862d18d119++dsaPrivatekey = DSA.PrivateKey+ { DSA.private_params = dsaParams+ , DSA.private_x = 0x229bac7aa1c7db8121bfc050a3426eceae23fae8+ }++dsaPublickey = DSA.PublicKey+ { DSA.public_params = dsaParams+ , DSA.public_y = 0x4fa505e86e32922f1fa1702a120abdba088bb4be801d4c44f7fc6b9094d85cd52c429cbc2b39514e30909b31e2e2e0752b0fc05c1a7d9c05c3e52e49e6edef4c+ }+
+ Tests/RNG.hs view
@@ -0,0 +1,38 @@+module RNG where++import Data.Word+import Data.List (foldl')+import qualified Data.ByteString as B+import Crypto.Random.API+import Control.Arrow (first)++{- this is a just test rng. this is absolutely not a serious RNG. DO NOT use elsewhere -}+data Rng = Rng (Int, Int)++getByte :: Rng -> (Word8, Rng)+getByte (Rng (mz, mw)) = (r, g)+ where mz2 = 36969 * (mz `mod` 65536)+ mw2 = 18070 * (mw `mod` 65536)+ r = fromIntegral (mz2 + mw2)+ g = Rng (mz2, mw2)++getBytes :: Int -> Rng -> ([Word8], Rng)+getBytes 0 g = ([], g)+getBytes n g =+ let (b, g') = getByte g+ (l, g'') = getBytes (n-1) g'+ in (b:l, g'')++instance CPRG Rng where+ cprgGenBytes g len = first B.pack $ getBytes len g+ cprgSupplyEntropy g e = reseed e g+ cprgNeedReseed _ = maxBound++reseed :: B.ByteString -> Rng -> Rng+reseed bs (Rng (a,b)) = Rng (fromIntegral a', b')+ where a' = foldl' (\v i -> ((fromIntegral v) + (fromIntegral i) * 36969) `mod` 65536) a l+ b' = foldl' (\v i -> ((fromIntegral v) + (fromIntegral i) * 18070) `mod` 65536) b l+ l = B.unpack bs++rng :: Rng+rng = Rng (1,2)
+ Tests/Tests.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE OverloadedStrings #-}++import Test.Framework (Test, defaultMain, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Test.QuickCheck+import Test.QuickCheck.Test+import System.IO (hFlush, stdout)++import Control.Monad+import Control.Arrow (first)+import Control.Applicative ((<$>))++import Data.List (intercalate)+import Data.Char+import Data.Bits+import Data.Word+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC++import qualified Crypto.PubKey.RSA as RSA+import qualified Crypto.PubKey.RSA.PKCS15 as RSAPKCS15+import qualified Crypto.PubKey.RSA.OAEP as RSAOAEP+import qualified Crypto.PubKey.DSA as DSA+import qualified Crypto.PubKey.DH as DH+import Crypto.Number.Serialize (i2osp)+import Crypto.PubKey.HashDescr++import qualified Crypto.Hash.SHA1 as SHA1+import RNG+import KAT+import PregenKeys++withAleasInteger :: Rng -> Seed -> (Rng -> (a,Rng)) -> a+withAleasInteger rng (Seed i) f = fst $ f $ reseed (i2osp (if i < 0 then -i else i)) rng++withRNG :: Seed -> (Rng -> (a,Rng)) -> a+withRNG seed f = withAleasInteger rng seed f++--withArbitraryRNG :: (Rng -> (a,Rng)) -> Arbitrary a+withArbitraryRNG f = arbitrary >>= \seed -> return (withAleasInteger rng seed f)++newtype PositiveSmall = PositiveSmall Integer+ deriving (Show,Eq)++instance Arbitrary PositiveSmall where+ arbitrary = PositiveSmall `fmap` (resize (2^5) (arbitrarySizedIntegral `suchThat` (\i -> i > 0 && i < 2^5)))++data Range = Range Integer Integer+ deriving (Show,Eq)++instance Arbitrary Range where+ arbitrary = do x <- resize (2^30) (arbitrarySizedIntegral `suchThat` (\i -> i >= 40000 && i < 2^30))+ o <- resize (2^10) (arbitrarySizedIntegral `suchThat` (\i -> i >= 1000 && i < 2^10))+ return $ Range x (x+o)++newtype Seed = Seed Integer+ deriving (Eq)++instance Show Seed where+ show s = "Seed " ++ show s -- "seed"++instance Arbitrary Seed where+ arbitrary = Seed `fmap` (resize (2^30) (arbitrarySizedIntegral `suchThat` (\x -> x > 2^6 && x < 2^30)))++data RSAMessage = RSAMessage RSA.Blinder B.ByteString deriving (Show, Eq)++data RSAOAEPMessage = RSAOAEPMessage RSA.Blinder B.ByteString RSAOAEP.OAEPParams++instance Show RSAOAEPMessage where+ show (RSAOAEPMessage a1 b1 _) = "RSAOAEPMessage " ++ show a1 ++ " " ++ show b1++instance Eq RSAOAEPMessage where+ (RSAOAEPMessage a1 b1 _) == (RSAOAEPMessage a2 b2 _) = a1 == a2 && b1 == b2++genBS :: Int -> Gen B.ByteString+genBS sz = (B.pack . map fromIntegral) `fmap` replicateM sz (choose (0,255) :: Gen Int)++instance Arbitrary RSAOAEPMessage where+ arbitrary = do+ let hashLen = B.length (SHA1.hash B.empty)+ sz <- choose (0, 128 - 2*hashLen - 2)+ blinder <- withArbitraryRNG (\g -> RSA.generateBlinder g (RSA.public_n rsaPublickey))+ ws <- genBS sz+ return $ RSAOAEPMessage blinder ws (RSAOAEP.defaultOAEPParams SHA1.hash)++instance Arbitrary RSAMessage where+ arbitrary = do+ sz <- choose (0, 128 - 11)+ blinder <- withArbitraryRNG (\g -> RSA.generateBlinder g (RSA.public_n rsaPublickey))+ ws <- genBS sz+ return $ RSAMessage blinder ws++prop_rsa_pkcs15_valid fast blinding (RSAMessage blindR msg) =+ (either Left (doDecrypt pk) $ fst $ RSAPKCS15.encrypt rng rsaPublickey msg) == Right msg+ where pk = if fast then rsaPrivatekey else rsaPrivatekey { RSA.private_p = 0, RSA.private_q = 0 }+ doDecrypt = RSAPKCS15.decrypt (if blinding then Just blindR else Nothing)++prop_rsa_oaep_valid fast blinding (RSAOAEPMessage blindR msg oaepParams) =+ (either Left (doDecrypt oaepParams pk) $ fst $ RSAOAEP.encrypt rng oaepParams rsaPublickey msg) `assertEq` Right msg+ where pk = if fast then rsaPrivatekey else rsaPrivatekey { RSA.private_p = 0, RSA.private_q = 0 }+ doDecrypt = RSAOAEP.decrypt (if blinding then Just blindR else Nothing)++assertEq (Right got) (Right exp) = if got == exp then True else error ("got: " ++ show got ++ "\nexp: " ++ show exp)+assertEq (Left got) (Right exp) = error ("got Left: " ++ show got)++prop_rsa_sign_valid fast (RSAMessage _ msg) = (either (const False) (\smsg -> verify msg smsg) $ sign msg) == True+ where+ verify = RSAPKCS15.verify hashDescrSHA1 rsaPublickey+ sign = RSAPKCS15.sign Nothing hashDescrSHA1 pk+ pk = if fast then rsaPrivatekey else rsaPrivatekey { RSA.private_p = 0, RSA.private_q = 0 }++prop_rsa_sign_fast_valid = prop_rsa_sign_valid True+prop_rsa_sign_slow_valid = prop_rsa_sign_valid False++prop_dsa_valid (RSAMessage _ msg) = DSA.verify (SHA1.hash) dsaPublickey signature msg+ where (signature, rng') = DSA.sign rng dsaPrivatekey (SHA1.hash) msg++instance Arbitrary DH.PrivateNumber where+ arbitrary = fromIntegral <$> (suchThat (arbitrary :: Gen Integer) (\x -> x >= 1))++prop_dh_valid (xa, xb) = sa == sb+ where+ sa = DH.getShared dhparams xa yb+ sb = DH.getShared dhparams xb ya+ yb = DH.generatePublic dhparams xb+ ya = DH.generatePublic dhparams xa+ dhparams = (11, 7)+++asymEncryptionTests = testGroup "assymmetric cipher encryption"+ [ testProperty "RSA(PKCS15) (slow)" (prop_rsa_pkcs15_valid False False)+ , testProperty "RSA(PKCS15) (fast)" (prop_rsa_pkcs15_valid True False)+ , testProperty "RSA(PKCS15) (slow+blind)" (prop_rsa_pkcs15_valid False True)+ , testProperty "RSA(PKCS15) (fast+blind)" (prop_rsa_pkcs15_valid True True)+ , testProperty "RSA(OAEP) (slow)" (prop_rsa_oaep_valid False False)+ , testProperty "RSA(OAEP) (fast)" (prop_rsa_oaep_valid True False)+ , testProperty "RSA(OAEP) (slow+blind)" (prop_rsa_oaep_valid False True)+ , testProperty "RSA(OAEP) (fast+blind)" (prop_rsa_oaep_valid True True)+ ]++asymSignatureTests = testGroup "assymmetric cipher signature"+ [ testProperty "RSA(PKCS15) (slow)" prop_rsa_sign_slow_valid+ , testProperty "RSA(PKCS15) (fast)" prop_rsa_sign_fast_valid+ , testProperty "DSA" prop_dsa_valid+ ]++asymOtherTests = testGroup "assymetric other tests"+ [ testProperty "DH valid" prop_dh_valid+ ]++main = defaultMain+ [ asymEncryptionTests+ , asymSignatureTests+ , asymOtherTests+ , testGroup "KATs" katTests+ ]
+ crypto-pubkey.cabal view
@@ -0,0 +1,77 @@+Name: crypto-pubkey+Version: 0.1.0+Description:+ Public Key cryptography+ .+ Supports RSA PKCS15, RSA OAEP, RSA PSS, DSA, ElGamal signature.+ .+ Also have primitive support for Diffie Hellman, and ElGamal encryption+License: BSD3+License-file: LICENSE+Copyright: Vincent Hanquez <vincent@snarc.org>+Author: Vincent Hanquez <vincent@snarc.org>+Maintainer: Vincent Hanquez <vincent@snarc.org>+Synopsis: Public Key cryptography+Category: Cryptography+Build-Type: Simple+Homepage: http://github.com/vincenthz/hs-crypto-pubkey+Cabal-Version: >=1.8+Extra-Source-Files: Tests/*.hs++Flag benchmark+ Description: Build benchmarks+ Default: False++Library+ Build-Depends: base >= 4 && < 5+ , bytestring+ , crypto-random-api+ , crypto-pubkey-types >= 0.2 && < 0.3+ , cryptohash >= 0.8+ , crypto-numbers+ Exposed-modules: Crypto.PubKey.RSA+ Crypto.PubKey.RSA.PKCS15+ Crypto.PubKey.RSA.OAEP+ Crypto.PubKey.RSA.PSS+ Crypto.PubKey.RSA.Prim+ Crypto.PubKey.DSA+ Crypto.PubKey.DH+ Crypto.PubKey.HashDescr+ Crypto.PubKey.MaskGenFunction+ other-modules: Crypto.PubKey.ElGamal+ Crypto.PubKey.RSA.Types+ Crypto.PubKey.Internal+ ghc-options: -Wall -O2++Test-Suite test-crypto-pubkey+ type: exitcode-stdio-1.0+ hs-source-dirs: Tests+ Main-Is: Tests.hs+ Build-depends: base >= 4 && < 5+ , bytestring+ , cryptohash+ , crypto-pubkey+ , crypto-numbers+ , crypto-random-api+ , QuickCheck >= 2+ , HUnit+ , test-framework >= 0.3.3+ , test-framework-quickcheck2 >= 0.2.9+ , test-framework-hunit++Benchmark bench-crypto-pubkey+ hs-source-dirs: Benchs+ Main-Is: Bench.hs+ type: exitcode-stdio-1.0+ Build-depends: base >= 4 && < 5+ , bytestring+ , cprng-aes >= 0.3.0+ , cryptohash+ , crypto-random-api+ , crypto-pubkey+ , criterion+ , mtl++source-repository head+ type: git+ location: git://github.com/vincenthz/hs-cryptocipher