diff --git a/Crypto/Number/Basic.hs b/Crypto/Number/Basic.hs index 52b6e4e..e624b42 100644 --- a/Crypto/Number/Basic.hs +++ b/Crypto/Number/Basic.hs @@ -13,8 +13,11 @@ module Crypto.Number.Basic , log2 , numBits , numBytes + , asPowerOf2AndOdd ) where +import Data.Bits + import Crypto.Number.Compat -- | @sqrti@ returns two integers @(l,b)@ so that @l <= sqrt i <= b@. @@ -98,3 +101,16 @@ numBits n = gmpSizeInBits n `onGmpUnsupported` (if n == 0 then 1 else computeBit -- | Compute the number of bytes for an integer numBytes :: Integer -> Int numBytes n = gmpSizeInBytes n `onGmpUnsupported` ((numBits n + 7) `div` 8) + +-- | Express an integer as an odd number and a power of 2 +asPowerOf2AndOdd :: Integer -> (Int, Integer) +asPowerOf2AndOdd a + | a == 0 = (0, 0) + | odd a = (0, a) + | a < 0 = let (e, a1) = asPowerOf2AndOdd $ abs a in (e, -a1) + | isPowerOf2 a = (log2 a, 1) + | otherwise = loop a 0 + where + isPowerOf2 n = (n /= 0) && ((n .&. (n - 1)) == 0) + loop n pw = if n `mod` 2 == 0 then loop (n `div` 2) (pw + 1) + else (pw, n) \ No newline at end of file diff --git a/Crypto/Number/ModArithmetic.hs b/Crypto/Number/ModArithmetic.hs index 11a618e..ef59d7e 100644 --- a/Crypto/Number/ModArithmetic.hs +++ b/Crypto/Number/ModArithmetic.hs @@ -15,6 +15,7 @@ module Crypto.Number.ModArithmetic -- * Inverse computing , inverse , inverseCoprimes + , jacobi ) where import Control.Exception (throw, Exception) @@ -94,3 +95,29 @@ inverseCoprimes g m = case inverse g m of Nothing -> throw CoprimesAssertionError Just i -> i + +-- | Computes the Jacobi symbol (a/n). +-- 0 ≤ a < n; n ≥ 3 and odd. +-- +-- The Legendre and Jacobi symbols are indistinguishable exactly when the +-- lower argument is an odd prime, in which case they have the same value. +-- +-- See algorithm 2.149 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al. +jacobi :: Integer -> Integer -> Maybe Integer +jacobi a n + | n < 3 || even n = Nothing + | a == 0 || a == 1 = Just a + | n <= a = jacobi (a `mod` n) n + | a < 0 = + let b = if n `mod` 4 == 1 then 1 else -1 + in fmap (*b) (jacobi (-a) n) + | otherwise = + let (e, a1) = asPowerOf2AndOdd a + nMod8 = n `mod` 8 + nMod4 = n `mod` 4 + a1Mod4 = a1 `mod` 4 + s' = if even e || nMod8 == 1 || nMod8 == 7 then 1 else -1 + s = if nMod4 == 3 && a1Mod4 == 3 then -s' else s' + n1 = n `mod` a1 + in if a1 == 1 then Just s + else fmap (*s) (jacobi n1 a1) diff --git a/Crypto/PubKey/Rabin/Basic.hs b/Crypto/PubKey/Rabin/Basic.hs new file mode 100644 index 0000000..bcce97a --- /dev/null +++ b/Crypto/PubKey/Rabin/Basic.hs @@ -0,0 +1,231 @@ +-- | +-- Module : Crypto.PubKey.Rabin.Basic +-- License : BSD-style +-- Maintainer : Carlos Rodriguez-Vega +-- Stability : experimental +-- Portability : unknown +-- +-- Rabin cryptosystem for public-key cryptography and digital signature. +-- +{-# LANGUAGE DeriveDataTypeable #-} +module Crypto.PubKey.Rabin.Basic + ( PublicKey(..) + , PrivateKey(..) + , Signature(..) + , generate + , encrypt + , encryptWithSeed + , decrypt + , sign + , signWith + , verify + ) where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Data +import Data.Either (rights) + +import Crypto.Hash +import Crypto.Number.Basic (gcde, numBytes, asPowerOf2AndOdd) +import Crypto.Number.ModArithmetic (expSafe, jacobi) +import Crypto.Number.Prime (isProbablyPrime) +import Crypto.Number.Serialize (i2osp, i2ospOf_, os2ip) +import Crypto.PubKey.Rabin.OAEP +import Crypto.PubKey.Rabin.Types +import Crypto.Random (MonadRandom, getRandomBytes) + +-- | Represent a Rabin public key. +data PublicKey = PublicKey + { public_size :: Int -- ^ size of key in bytes + , public_n :: Integer -- ^ public p*q + } deriving (Show, Read, Eq, Data, Typeable) + +-- | Represent a Rabin private key. +data PrivateKey = PrivateKey + { private_pub :: PublicKey + , private_p :: Integer -- ^ p prime number + , private_q :: Integer -- ^ q prime number + , private_a :: Integer + , private_b :: Integer + } deriving (Show, Read, Eq, Data, Typeable) + +-- | Rabin Signature. +data Signature = Signature (Integer, Integer) deriving (Show, Read, Eq, Data, Typeable) + +-- | Generate a pair of (private, public) key of size in bytes. +-- Primes p and q are both congruent 3 mod 4. +-- +-- See algorithm 8.11 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al. +generate :: MonadRandom m + => Int + -> m (PublicKey, PrivateKey) +generate size = do + (p, q) <- generatePrimes size (\p -> p `mod` 4 == 3) (\q -> q `mod` 4 == 3) + return $ generateKeys p q + where + generateKeys p q = + let n = p*q + (a, b, _) = gcde p q + publicKey = PublicKey { public_size = size + , public_n = n } + privateKey = PrivateKey { private_pub = publicKey + , private_p = p + , private_q = q + , private_a = a + , private_b = b } + in (publicKey, privateKey) + +-- | Encrypt plaintext using public key an a predefined OAEP seed. +-- +-- See algorithm 8.11 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al. +encryptWithSeed :: HashAlgorithm hash + => ByteString -- ^ Seed + -> OAEPParams hash ByteString ByteString -- ^ OAEP padding + -> PublicKey -- ^ public key + -> ByteString -- ^ plaintext + -> Either Error ByteString +encryptWithSeed seed oaep pk m = + let n = public_n pk + k = numBytes n + in do + m' <- pad seed oaep k m + let m'' = os2ip m' + return $ i2osp $ expSafe m'' 2 n + +-- | Encrypt plaintext using public key. +encrypt :: (HashAlgorithm hash, MonadRandom m) + => OAEPParams hash ByteString ByteString -- ^ OAEP padding parameters + -> PublicKey -- ^ public key + -> ByteString -- ^ plaintext + -> m (Either Error ByteString) +encrypt oaep pk m = do + seed <- getRandomBytes hashLen + return $ encryptWithSeed seed oaep pk m + where + hashLen = hashDigestSize (oaepHash oaep) + +-- | Decrypt ciphertext using private key. +-- +-- See algorithm 8.12 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al. +decrypt :: HashAlgorithm hash + => OAEPParams hash ByteString ByteString -- ^ OAEP padding parameters + -> PrivateKey -- ^ private key + -> ByteString -- ^ ciphertext + -> Maybe ByteString +decrypt oaep pk c = + let p = private_p pk + q = private_q pk + a = private_a pk + b = private_b pk + n = public_n $ private_pub pk + k = numBytes n + c' = os2ip c + solutions = rights $ toList $ mapTuple (unpad oaep k . i2ospOf_ k) $ sqroot' c' p q a b n + in if length solutions /= 1 then Nothing + else Just $ head solutions + where toList (w, x, y, z) = w:x:y:z:[] + mapTuple f (w, x, y, z) = (f w, f x, f y, f z) + +-- | Sign message using padding, hash algorithm and private key. +-- +-- See . +signWith :: HashAlgorithm hash + => ByteString -- ^ padding + -> PrivateKey -- ^ private key + -> hash -- ^ hash function + -> ByteString -- ^ message to sign + -> Either Error Signature +signWith padding pk hashAlg m = do + h <- calculateHash padding pk hashAlg m + signature <- calculateSignature h + return signature + where + calculateSignature h = + let p = private_p pk + q = private_q pk + a = private_a pk + b = private_b pk + n = public_n $ private_pub pk + in if h >= n then Left MessageTooLong + else let (r, _, _, _) = sqroot' h p q a b n + in Right $ Signature (os2ip padding, r) + +-- | Sign message using hash algorithm and private key. +-- +-- See . +sign :: (MonadRandom m, HashAlgorithm hash) + => PrivateKey -- ^ private key + -> hash -- ^ hash function + -> ByteString -- ^ message to sign + -> m (Either Error Signature) +sign pk hashAlg m = do + padding <- findPadding + return $ signWith padding pk hashAlg m + where + findPadding = do + padding <- getRandomBytes 8 + case calculateHash padding pk hashAlg m of + Right _ -> return padding + _ -> findPadding + +-- | Calculate hash of message and padding. +-- If the padding is valid, then the result of the hash operation is returned, otherwise an error. +calculateHash :: HashAlgorithm hash + => ByteString -- ^ padding + -> PrivateKey -- ^ private key + -> hash -- ^ hash function + -> ByteString -- ^ message to sign + -> Either Error Integer +calculateHash padding pk hashAlg m = + let p = private_p pk + q = private_q pk + h = os2ip $ hashWith hashAlg $ B.append padding m + in case (jacobi (h `mod` p) p, jacobi (h `mod` q) q) of + (Just 1, Just 1) -> Right h + _ -> Left InvalidParameters + +-- | Verify signature using hash algorithm and public key. +-- +-- See . +verify :: HashAlgorithm hash + => PublicKey -- ^ private key + -> hash -- ^ hash function + -> ByteString -- ^ message + -> Signature -- ^ signature + -> Bool +verify pk hashAlg m (Signature (padding, s)) = + let n = public_n pk + p = i2osp padding + h = os2ip $ hashWith hashAlg $ B.append p m + h' = expSafe s 2 n + in h' == h + +-- | Square roots modulo prime p where p is congruent 3 mod 4 +-- Value a must be a quadratic residue modulo p (i.e. jacobi symbol (a/n) = 1). +-- +-- See algorithm 3.36 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al. +sqroot :: Integer + -> Integer -- ^ prime p + -> (Integer, Integer) +sqroot a p = + let r = expSafe a ((p + 1) `div` 4) p + in (r, -r) + +-- | Square roots modulo n given its prime factors p and q (both congruent 3 mod 4) +-- Value a must be a quadratic residue of both modulo p and modulo q (i.e. jacobi symbols (a/p) = (a/q) = 1). +-- +-- See algorithm 3.44 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al. +sqroot' :: Integer + -> Integer -- ^ prime p + -> Integer -- ^ prime q + -> Integer -- ^ c such that c*p + d*q = 1 + -> Integer -- ^ d such that c*p + d*q = 1 + -> Integer -- ^ n = p*q + -> (Integer, Integer, Integer, Integer) +sqroot' a p q c d n = + let (r, _) = sqroot a p + (s, _) = sqroot a q + x = (r*d*q + s*c*p) `mod` n + y = (r*d*q - s*c*p) `mod` n + in (x, (-x) `mod` n, y, (-y) `mod` n) diff --git a/Crypto/PubKey/Rabin/Modified.hs b/Crypto/PubKey/Rabin/Modified.hs new file mode 100644 index 0000000..f3836ab --- /dev/null +++ b/Crypto/PubKey/Rabin/Modified.hs @@ -0,0 +1,103 @@ +-- | +-- Module : Crypto.PubKey.Rabin.Modified +-- License : BSD-style +-- Maintainer : Carlos Rodriguez-Vega +-- Stability : experimental +-- Portability : unknown +-- +-- Modified-Rabin public-key digital signature algorithm. +-- See algorithm 11.30 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al. +-- +{-# LANGUAGE DeriveDataTypeable #-} +module Crypto.PubKey.Rabin.Modified + ( PublicKey(..) + , PrivateKey(..) + , generate + , sign + , verify + ) where + +import Data.ByteString +import qualified Data.ByteString as B +import Data.Data + +import Crypto.Hash +import Crypto.Number.Basic (gcde) +import Crypto.Number.ModArithmetic (expSafe, jacobi) +import Crypto.Number.Serialize (i2osp, os2ip) +import Crypto.PubKey.Rabin.Types +import Crypto.Random.Types + +-- | Represent a Modified-Rabin public key. +data PublicKey = PublicKey + { public_size :: Int -- ^ size of key in bytes + , public_n :: Integer -- ^ public p*q + } deriving (Show, Read, Eq, Data, Typeable) + +-- | Represent a Modified-Rabin private key. +data PrivateKey = PrivateKey + { private_pub :: PublicKey + , private_p :: Integer -- ^ p prime number + , private_q :: Integer -- ^ q prime number + , private_d :: Integer + } deriving (Show, Read, Eq, Data, Typeable) + +-- | Generate a pair of (private, public) key of size in bytes. +-- Prime p is congruent 3 mod 8 and prime q is congruent 7 mod 8. +generate :: MonadRandom m + => Int + -> m (PublicKey, PrivateKey) +generate size = do + (p, q) <- generatePrimes size (\p -> p `mod` 8 == 3) (\q -> q `mod` 8 == 7) + return $ generateKeys p q + where + generateKeys p q = + let n = p*q + d = (n - p - q + 5) `div` 8 + publicKey = PublicKey { public_size = size + , public_n = n } + privateKey = PrivateKey { private_pub = publicKey + , private_p = p + , private_q = q + , private_d = d } + in (publicKey, privateKey) + +-- | Sign message using hash algorithm and private key. +sign :: HashAlgorithm hash + => PrivateKey -- ^ private key + -> hash -- ^ hash function + -> ByteString -- ^ message to sign + -> Either Error Integer +sign pk hashAlg m = + let d = private_d pk + n = public_n $ private_pub pk + h = os2ip $ hashWith hashAlg m + limit = (n - 6) `div` 16 + in if h > limit then Left MessageTooLong + else let h' = 16*h + 6 + in case jacobi h' n of + Just 1 -> Right $ expSafe h' d n + Just (-1) -> Right $ expSafe (h' `div` 2) d n + _ -> Left InvalidParameters + +-- | Verify signature using hash algorithm and public key. +verify :: HashAlgorithm hash + => PublicKey -- ^ public key + -> hash -- ^ hash function + -> ByteString -- ^ message + -> Integer -- ^ signature + -> Bool +verify pk hashAlg m s = + let n = public_n pk + h = os2ip $ hashWith hashAlg m + s' = expSafe s 2 n + s'' = case s' `mod` 8 of + 6 -> s' + 3 -> 2*s' + 7 -> n - s' + 2 -> 2*(n - s') + _ -> 0 + in case s'' `mod` 16 of + 6 -> let h' = (s'' - 6) `div` 16 + in h' == h + _ -> False diff --git a/Crypto/PubKey/Rabin/OAEP.hs b/Crypto/PubKey/Rabin/OAEP.hs new file mode 100644 index 0000000..2274767 --- /dev/null +++ b/Crypto/PubKey/Rabin/OAEP.hs @@ -0,0 +1,100 @@ +-- | +-- Module : Crypto.PubKey.Rabin.OAEP +-- License : BSD-style +-- Maintainer : Carlos Rodriguez-Vega +-- Stability : experimental +-- Portability : unknown +-- +-- OAEP padding scheme. +-- See . +-- +module Crypto.PubKey.Rabin.OAEP + ( OAEPParams(..) + , defaultOAEPParams + , pad + , unpad + ) where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Bits (xor) + +import Crypto.Hash +import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray) +import qualified Crypto.Internal.ByteArray as B (convert) +import Crypto.PubKey.MaskGenFunction +import Crypto.PubKey.Internal (and') +import Crypto.PubKey.Rabin.Types + +-- | Parameters for OAEP padding. +data OAEPParams hash seed output = OAEPParams + { oaepHash :: hash -- ^ hash function to use + , oaepMaskGenAlg :: MaskGenAlgorithm seed output -- ^ mask Gen algorithm to use + , oaepLabel :: Maybe ByteString -- ^ optional label prepended to message + } + +-- | Default Params with a specified hash function. +defaultOAEPParams :: (ByteArrayAccess seed, ByteArray output, HashAlgorithm hash) + => hash + -> OAEPParams hash seed output +defaultOAEPParams hashAlg = + OAEPParams { oaepHash = hashAlg + , oaepMaskGenAlg = mgf1 hashAlg + , oaepLabel = Nothing + } + +-- | Pad a message using OAEP. +pad :: HashAlgorithm hash + => ByteString -- ^ Seed + -> OAEPParams hash ByteString ByteString -- ^ OAEP params to use + -> Int -- ^ size of public key in bytes + -> ByteString -- ^ Message pad + -> Either Error ByteString +pad seed oaep k msg + | k < 2*hashLen+2 = Left InvalidParameters + | B.length seed /= hashLen = Left InvalidParameters + | mLen > k - 2*hashLen-2 = Left MessageTooLong + | otherwise = Right em + where -- parameters + mLen = B.length msg + mgf = oaepMaskGenAlg oaep + labelHash = hashWith (oaepHash oaep) (maybe B.empty id $ oaepLabel oaep) + hashLen = hashDigestSize (oaepHash oaep) + -- put fields + ps = B.replicate (k - mLen - 2*hashLen - 2) 0 + db = B.concat [B.convert labelHash, ps, B.singleton 0x1, msg] + dbmask = mgf seed (k - hashLen - 1) + maskedDB = B.pack $ B.zipWith xor db dbmask + seedMask = mgf maskedDB hashLen + maskedSeed = B.pack $ B.zipWith xor seed seedMask + em = B.concat [B.singleton 0x0, maskedSeed, maskedDB] + +-- | Un-pad a OAEP encoded message. +unpad :: HashAlgorithm hash + => OAEPParams hash ByteString ByteString -- ^ OAEP params to use + -> Int -- ^ size of public key in bytes + -> ByteString -- ^ encoded message (not encrypted) + -> Either Error ByteString +unpad oaep k em + | paddingSuccess = Right msg + | otherwise = Left MessageNotRecognized + where -- parameters + mgf = oaepMaskGenAlg oaep + labelHash = B.convert $ hashWith (oaepHash oaep) (maybe B.empty id $ oaepLabel oaep) + hashLen = hashDigestSize (oaepHash oaep) + -- getting em's fields + (pb, em0) = B.splitAt 1 em + (maskedSeed, maskedDB) = B.splitAt hashLen em0 + seedMask = mgf maskedDB hashLen + seed = B.pack $ B.zipWith xor maskedSeed seedMask + dbmask = mgf seed (k - hashLen - 1) + db = B.pack $ B.zipWith xor maskedDB dbmask + -- getting db's fields + (labelHash', db1) = B.splitAt hashLen db + (_, db2) = B.break (/= 0) db1 + (ps1, msg) = B.splitAt 1 db2 + + paddingSuccess = and' [ labelHash' == labelHash -- no need for constant eq + , ps1 == B.replicate 1 0x1 + , pb == B.replicate 1 0x0 + ] diff --git a/Crypto/PubKey/Rabin/RW.hs b/Crypto/PubKey/Rabin/RW.hs new file mode 100644 index 0000000..7b0bcaa --- /dev/null +++ b/Crypto/PubKey/Rabin/RW.hs @@ -0,0 +1,167 @@ +-- | +-- Module : Crypto.PubKey.Rabin.RW +-- License : BSD-style +-- Maintainer : Carlos Rodriguez-Vega +-- Stability : experimental +-- Portability : unknown +-- +-- Rabin-Williams cryptosystem for public-key encryption and digital signature. +-- See pages 323 - 324 in "Computational Number Theory and Modern Cryptography" by Song Y. Yan. +-- Also inspired by https://github.com/vanilala/vncrypt/blob/master/vncrypt/vnrw_gmp.c. +-- +{-# LANGUAGE DeriveDataTypeable #-} +module Crypto.PubKey.Rabin.RW + ( PublicKey(..) + , PrivateKey(..) + , generate + , encrypt + , encryptWithSeed + , decrypt + , sign + , verify + ) where + +import Data.ByteString +import qualified Data.ByteString as B +import Data.Data + +import Crypto.Hash +import Crypto.Number.Basic (numBytes, gcde) +import Crypto.Number.ModArithmetic (expSafe, jacobi) +import Crypto.Number.Serialize (i2osp, i2ospOf_, os2ip) +import Crypto.PubKey.Rabin.OAEP +import Crypto.PubKey.Rabin.Types +import Crypto.Random.Types + +-- | Represent a Rabin-Williams public key. +data PublicKey = PublicKey + { public_size :: Int -- ^ size of key in bytes + , public_n :: Integer -- ^ public p*q + } deriving (Show, Read, Eq, Data, Typeable) + +-- | Represent a Rabin-Williams private key. +data PrivateKey = PrivateKey + { private_pub :: PublicKey + , private_p :: Integer -- ^ p prime number + , private_q :: Integer -- ^ q prime number + , private_d :: Integer + } deriving (Show, Read, Eq, Data, Typeable) + +-- | Generate a pair of (private, public) key of size in bytes. +-- Prime p is congruent 3 mod 8 and prime q is congruent 7 mod 8. +generate :: MonadRandom m + => Int + -> m (PublicKey, PrivateKey) +generate size = do + (p, q) <- generatePrimes size (\p -> p `mod` 8 == 3) (\q -> q `mod` 8 == 7) + return (generateKeys p q) + where + generateKeys p q = + let n = p*q + d = ((p - 1)*(q - 1) `div` 4 + 1) `div` 2 + publicKey = PublicKey { public_size = size + , public_n = n } + privateKey = PrivateKey { private_pub = publicKey + , private_p = p + , private_q = q + , private_d = d } + in (publicKey, privateKey) + +-- | Encrypt plaintext using public key an a predefined OAEP seed. +-- +-- See algorithm 8.11 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al. +encryptWithSeed :: HashAlgorithm hash + => ByteString -- ^ Seed + -> OAEPParams hash ByteString ByteString -- ^ OAEP padding + -> PublicKey -- ^ public key + -> ByteString -- ^ plaintext + -> Either Error ByteString +encryptWithSeed seed oaep pk m = + let n = public_n pk + k = numBytes n + in do + m' <- pad seed oaep k m + m'' <- ep1 n $ os2ip m' + return $ i2osp $ ep2 n m'' + +-- | Encrypt plaintext using public key. +encrypt :: (HashAlgorithm hash, MonadRandom m) + => OAEPParams hash ByteString ByteString -- ^ OAEP padding parameters + -> PublicKey -- ^ public key + -> ByteString -- ^ plaintext + -> m (Either Error ByteString) +encrypt oaep pk m = do + seed <- getRandomBytes hashLen + return $ encryptWithSeed seed oaep pk m + where + hashLen = hashDigestSize (oaepHash oaep) + +-- | Decrypt ciphertext using private key. +decrypt :: HashAlgorithm hash + => OAEPParams hash ByteString ByteString -- ^ OAEP padding parameters + -> PrivateKey -- ^ private key + -> ByteString -- ^ ciphertext + -> Maybe ByteString +decrypt oaep pk c = + let d = private_d pk + n = public_n $ private_pub pk + k = numBytes n + c' = i2ospOf_ k $ dp2 n $ dp1 d n $ os2ip c + in case unpad oaep k c' of + Left _ -> Nothing + Right p -> Just p + +-- | Sign message using hash algorithm and private key. +sign :: HashAlgorithm hash + => PrivateKey -- ^ private key + -> hash -- ^ hash function + -> ByteString -- ^ message to sign + -> Either Error Integer +sign pk hashAlg m = + let d = private_d pk + n = public_n $ private_pub pk + in do + m' <- ep1 n $ os2ip $ hashWith hashAlg m + return $ dp1 d n m' + +-- | Verify signature using hash algorithm and public key. +verify :: HashAlgorithm hash + => PublicKey -- ^ public key + -> hash -- ^ hash function + -> ByteString -- ^ message + -> Integer -- ^ signature + -> Bool +verify pk hashAlg m s = + let n = public_n pk + h = os2ip $ hashWith hashAlg m + h' = dp2 n $ ep2 n s + in h' == h + +-- | Encryption primitive 1 +ep1 :: Integer -> Integer -> Either Error Integer +ep1 n m = + let m' = 2*m + 1 + m'' = 2*m' + m''' = 2*m'' + in case jacobi m' n of + Just (-1) | m'' < n -> Right m'' + Just 1 | m''' < n -> Right m''' + _ -> Left InvalidParameters + +-- | Encryption primitive 2 +ep2 :: Integer -> Integer -> Integer +ep2 n m = expSafe m 2 n + +-- | Decryption primitive 1 +dp1 :: Integer -> Integer -> Integer -> Integer +dp1 d n c = expSafe c d n + +-- | Decryption primitive 2 +dp2 :: Integer -> Integer -> Integer +dp2 n c = let c' = c `div` 2 + c'' = (n - c) `div` 2 + in case c `mod` 4 of + 0 -> ((c' `div` 2 - 1) `div` 2) + 1 -> ((c'' `div` 2 - 1) `div` 2) + 2 -> ((c' - 1) `div` 2) + _ -> ((c'' - 1) `div` 2) diff --git a/Crypto/PubKey/Rabin/Types.hs b/Crypto/PubKey/Rabin/Types.hs new file mode 100644 index 0000000..2d00823 --- /dev/null +++ b/Crypto/PubKey/Rabin/Types.hs @@ -0,0 +1,43 @@ +-- | +-- Module : Crypto.PubKey.Rabin.Types +-- License : BSD-style +-- Maintainer : Carlos Rodriguez-Vega +-- Stability : experimental +-- Portability : unknown +-- +module Crypto.PubKey.Rabin.Types + ( Error(..) + , generatePrimes + ) where + +import Crypto.Number.Basic (numBits) +import Crypto.Number.Prime (generatePrime, findPrimeFromWith) +import Crypto.Random.Types + +type PrimeCondition = Integer -> Bool + +-- | Error possible during encryption, decryption or signing. +data Error = MessageTooLong -- ^ the message to encrypt is too long + | MessageNotRecognized -- ^ the message decrypted doesn't have a OAEP structure + | InvalidParameters -- ^ some parameters lead to breaking assumptions + deriving (Show, Eq) + +-- | Generate primes p & q +generatePrimes :: MonadRandom m + => Int -- ^ size in bytes + -> PrimeCondition -- ^ condition prime p must satisfy + -> PrimeCondition -- ^ condition prime q must satisfy + -> m (Integer, Integer) -- ^ chosen distinct primes p and q +generatePrimes size pCond qCond = + let pBits = (8*(size `div` 2)) + qBits = (8*(size - (size `div` 2))) + in do + p <- generatePrime' pBits pCond + q <- generatePrime' qBits qCond + return (p, q) + where + generatePrime' bits cond = do + pr' <- generatePrime bits + let pr = findPrimeFromWith cond pr' + if numBits pr == bits then return pr + else generatePrime' bits cond diff --git a/cryptonite.cabal b/cryptonite.cabal index 9878725..2c09c5c 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -162,6 +162,11 @@ Library Crypto.PubKey.RSA.PSS Crypto.PubKey.RSA.OAEP Crypto.PubKey.RSA.Types + Crypto.PubKey.Rabin.OAEP + Crypto.PubKey.Rabin.Basic + Crypto.PubKey.Rabin.Modified + Crypto.PubKey.Rabin.RW + Crypto.PubKey.Rabin.Types Crypto.Random Crypto.Random.Types Crypto.Random.Entropy @@ -407,6 +412,7 @@ Test-Suite test-cryptonite KAT_PubKey.PSS KAT_PubKey.P256 KAT_PubKey.RSA + KAT_PubKey.Rabin KAT_PubKey KAT_RC4 KAT_Scrypt diff --git a/tests/KAT_PubKey.hs b/tests/KAT_PubKey.hs index a45a4a2..ba619e8 100644 --- a/tests/KAT_PubKey.hs +++ b/tests/KAT_PubKey.hs @@ -17,6 +17,7 @@ import KAT_PubKey.DSA import KAT_PubKey.ECC import KAT_PubKey.ECDSA import KAT_PubKey.RSA +import KAT_PubKey.Rabin import Utils import qualified KAT_PubKey.P256 as P256 @@ -43,6 +44,7 @@ tests = testGroup "PubKey" , eccTests , ecdsaTests , P256.tests + , rabinTests ] --newKats = [ eccKatTests ] diff --git a/tests/KAT_PubKey/Rabin.hs b/tests/KAT_PubKey/Rabin.hs new file mode 100644 index 0000000..2f44260 --- /dev/null +++ b/tests/KAT_PubKey/Rabin.hs @@ -0,0 +1,145 @@ +{-# LANGUAGE OverloadedStrings #-} +module KAT_PubKey.Rabin (rabinTests) where + +import qualified Data.ByteString as B + +import Crypto.Hash +import Crypto.Number.Serialize (os2ip) +import qualified Crypto.PubKey.Rabin.Basic as BRabin +import qualified Crypto.PubKey.Rabin.Modified as MRabin +import qualified Crypto.PubKey.Rabin.OAEP as OAEP +import qualified Crypto.PubKey.Rabin.RW as RW + +import Imports + +basicRabinKey = BRabin.PrivateKey + { BRabin.private_pub = BRabin.PublicKey + { BRabin.public_n = 0xc9c4b0df9db989d93df4137fc2de2a9cee2610523f7a450ecbbf252babe98fba2f8e389c3e420c081e18f584c5746ca43f77f6af1fc79161f8bf8fbcb9564779986ecbe656dd16740cb8e399c33ff1dcc679e73c9c98a58c65a8673b7de57290a2d3191cb27e29d627f7ec6e874b1406051ffe9181e4d90d1b487b100ad30685 + , BRabin.public_size = 128 + } + , BRabin.private_p = 0xe071f231ab5912285a1f8db199795f5efdea4c32f646a3436eaec091ba853a3092216f26b539bbac1fe2ab2e4fbb20aad272a434a1e909bf6d3028aecae2a7b7 + , BRabin.private_q = 0xe6229470dc7da58bfcd962f1b3ddcf52304efbfb91d31c8ed84dbae2380c1ad2e338a523b4250863a689b3f262f949bd7a9f1a603c36634bb932dd71bf5daba3 + , BRabin.private_a = 0x65956653f711a63b776ce45862d4cd78f1ad7b1f8ed118bb8b5ea5fffd59762da5dc7c5298e236a8e45d5c93477cbc51f214b1cd1a4980eda859c1cb05e55666 + , BRabin.private_b = -0x63126dd9c5d6b5215f62012885570e1306b6a47ec1c46553f3b13ceae869149d14544438dbb976800cd62fbb52266f9a6405bc91f192a462c974bc8a6f832e03 + } + +modifiedRabinKey = MRabin.PrivateKey + { MRabin.private_pub = MRabin.PublicKey + { MRabin.public_n = 0x9461a6e7c55cb610f20fd9af5d642404a63332a8d7c4fe7aa559cbcaec691e7216eed5d9322cb6a8619c220a0241b44e0d0a7cefda01fb84e59722b4e842ab5e190d214424bbdfed6d523426fc57a28045dfbb6e8159123077c542c0278ee2daf2d8993e286bf709a10a948da6b13008441581a22233f0ad3d5ebc5858ff7be5 + , MRabin.public_size = 128 + } + , MRabin.private_p = 0xc401e0ddbe565a8797292389bebb561c35eb019116ba25cc6c865a8d3d7bc599626ddf0bc4f575c22f89144fe99fc3300dd497ec2b7acc0221e729a61756b3f3 + , MRabin.private_q = 0xc1cc0e35f23f5086691a18c755881e3fe6937581948b109f47605b45d055e7b352e19ff729dfb33fbecb1d28b115e590449e5e4e228ab1876d889d3d41d87ec7 + , MRabin.private_d = 0x128c34dcf8ab96c21e41fb35ebac848094c666551af89fcf54ab39795d8d23ce42dddabb264596d50c33844140483689c1a14f9dfb403f709cb2e4569d08556b9267e6460e84c69beda1defabd0285c4852c288b7ac27b78987bd19da337a6b1c7b123476732d9c0f656cc62a17f70e8fe34516cfa85ce6475bddeae9ffa0926 + } + +rwKey = RW.PrivateKey + { RW.private_pub = RW.PublicKey + { RW.public_n = 0x992db4c84564c68d4ee2fe0903d938b41e83bcac48dfe8f2219ccee2ccbdefda4cbeea9f1c98a515c5f39a458f5ea11bca97102aaa3d9ac69e000093024e7b968359287cdf57bdacff5df1893df3539c7e358f037d49b5c6ae7110ab8117220c73b6265987039c2c97078fccacdd3f5a560aff5076fdc3958c532db28ab9a855 + , RW.public_size = 128 + } + , RW.private_p = 0xc144dd739c45397d61868ca944a9729a7ad34cf90466c8f5c98a88f5ab5e3288bcfd31d4af1d441d23a756a60abd4cf05c3e0b0053eb150166a327ae31e9347b + , RW.private_q = 0xcae5a381f25a27ae2c359068753118fc384471cd6027e88b8b910306fb940781261089259a3c569546677aebd268704c767a071dbd4f50cb9f15fe448788856f + , RW.private_d = 0x1325b69908ac98d1a9dc5fc1207b271683d07795891bfd1e443399dc5997bdfb4997dd53e39314a2b8be7348b1ebd4237952e2055547b358d3c000126049cf729ee5d4f0ea170b902e343a8ef0831900b963ba07a3176088ab2ab095db449d0052150d6be7b5402f459f17c759f6f043b06a5da64cb86bb910d340f7fa28fdce + } + +data EncryptionVector = EncryptionVector + { seed :: ByteString + , plainText :: ByteString + , cipherText :: ByteString + } + +data SignatureVector = SignatureVector + { message :: ByteString + , padding :: ByteString + , signature :: Integer + } + +basicRabinEncryptionVectors = + [ EncryptionVector + { plainText = "\x75\x0c\x40\x47\xf5\x47\xe8\xe4\x14\x11\x85\x65\x23\x29\x8a\xc9\xba\xe2\x45\xef\xaf\x13\x97\xfb\xe5\x6f\x9d\xd5" + , seed = "\x0c\xc7\x42\xce\x4a\x9b\x7f\x32\xf9\x51\xbc\xb2\x51\xef\xd9\x25\xfe\x4f\xe3\x5f" + , cipherText = "\xaf\xc7\x03\xe3\x9d\x2f\x81\xc6\x3a\x80\x2a\xd1\x44\x26\x3f\x17\x0c\x0a\xe6\x48\x68\x98\x23\x14\x8f\x95\xd2\xce\xbb\xe7\x3f\x49\x34\x76\x1d\x99\x30\x7b\xeb\x84\xe5\x2a\x10\xd2\x1e\x11\x7e\x65\xe8\x88\x24\xc1\x12\xeb\x19\x0d\x97\xcd\x12\x25\x6b\x1f\x9b\x0c\x40\x40\xa3\x47\x00\xb7\x11\xf8\x50\x08\x51\x79\xe8\x1b\xd1\x77\xe0\x99\xa7\xe1\x5c\x63\xda\x29\xc7\xde\x28\x5d\x60\xed\x8e\xb2\x12\xd4\xfe\xb8\x1a\x5d\x17\x65\x80\x62\x6e\x65\x5c\x37\x07\x1c\xfa\xff\xe6\x21\xa5\x9f\xcd\x6a\x6a\xce\xa6\x96\xb2\xc5\x08\xe6" + } + ] + +basicRabinSignatureVectors = + [ SignatureVector + { message = "\x75\x0c\x40\x47\xf5\x47\xe8\xe4\x14\x11\x85\x65\x23\x29\x8a\xc9\xba\xe2\x45\xef\xaf\x13\x97\xfb\xe5\x6f\x9d\xd5" + , padding = "\xe9\x87\x17\x15\xa2\xe4\x30\x15" + , signature = 0xac95807bdd03ca975690151d39d23d75e5db2731c4ba30b83c3f3ea74709e4d4e340d7dab952356a76c9b8705b214e28d59f5bdc7c7fdff4e104569e30359b5c65c2dcd5b94db58505cd8b188267121700beebd7edbee492e374514646471b5c3fa252a2580dc7343f455683815d6d7c590dd3bcaa7df41d8b08197ccb183408 + } + ] + +modifiedRabinSignatureVectors = + [ SignatureVector + { message = "\x75\x0c\x40\x47\xf5\x47\xe8\xe4\x14\x11\x85\x65\x23\x29\x8a\xc9\xba\xe2\x45\xef\xaf\x13\x97\xfb\xe5\x6f\x9d\xd5" + , padding = B.empty -- not used + , signature = 0x278c7c269119218ab7f501ea53a97ab15a3a5a263c6daed8980abec78291e9729e0e3457731cdea8ec31a7566e93d10fc9b2615fe3e54f4533a5506ac24a3bd286e270324e538066f0ddf503f9b5e0c18e18379659834906ebd99c0d31588c66e70fc653bc8865b9239999cbd35704917d8647d1199286c533233e3e03582dd + } + ] + +rwEncryptionVectors = + [ EncryptionVector + { plainText = "\x75\x0c\x40\x47\xf5\x47\xe8\xe4\x14\x11\x85\x65\x23\x29\x8a\xc9\xba\xe2\x45\xef\xaf\x13\x97\xfb\xe5\x6f\x9d\xd5" + , seed = "\x0c\xc7\x42\xce\x4a\x9b\x7f\x32\xf9\x51\xbc\xb2\x51\xef\xd9\x25\xfe\x4f\xe3\x5f" + , cipherText = "\x40\xc2\xe3\x36\xac\x46\x72\x8a\xaf\x33\x75\xe1\x27\xd0\x38\x40\xe2\x24\x4e\x20\xa7\x5d\x85\xd3\x74\x81\x21\xfd\xc9\x40\x90\x80\x8c\xed\x2d\xd3\x5b\xc4\xb7\xc9\x7c\x80\xa5\x2f\x63\x86\x34\x4e\x8c\x92\x07\x86\x9e\xda\xfd\xf8\x11\x83\x8a\x5a\x23\xc1\xe6\x77\x37\x5d\xf9\x5c\x60\xd1\x6d\xfd\x0c\x54\xd1\x00\xe9\xab\x97\x6d\x8e\x83\x8b\x6e\x1a\x38\x73\x43\xe2\x24\xc2\xe2\x4e\x74\x3f\xe4\x4d\xdd\x27\xed\xc7\x72\x88\xd3\x0f\x93\xb3\xdb\xa2\xb7\xaf\x6d\xe9\xab\x76\x53\x63\xf9\x62\xd7\x52\x44\x61\x60\x5d\x2e\x9b\xf7" + } + ] + +rwSignatureVectors = + [ SignatureVector + { message = "\x75\x0c\x40\x47\xf5\x47\xe8\xe4\x14\x11\x85\x65\x23\x29\x8a\xc9\xba\xe2\x45\xef\xaf\x13\x97\xfb\xe5\x6f\x9d\xd5" + , padding = B.empty -- not used + , signature = 0x1e57b554a8e83aacd9d4067f9535991e7db47803250cded5cc8af5458a6bb11fea852139e0afe143f9339dd94a518e354e702134d1ae222460127829d92e8bf6441336f5ae7044ec7b6c3ad8b9aeeb1ea02a49798e020cb5b558120bbb51f060eb1608ba68f90cac7edb1051c177d3bdbb99d1ad92e8d75d6f72f1d06f1d25be + } + ] + +doBasicRabinEncryptTest key (i, vector) = testCase (show i) (Right (cipherText vector) @=? actual) + where actual = BRabin.encryptWithSeed (seed vector) (OAEP.defaultOAEPParams SHA1) key (plainText vector) + +doBasicRabinDecryptTest key (i, vector) = testCase (show i) (Just (plainText vector) @=? actual) + where actual = BRabin.decrypt (OAEP.defaultOAEPParams SHA1) key (cipherText vector) + +doBasicRabinSignTest key (i, vector) = testCase (show i) (Right (BRabin.Signature ((os2ip $ padding vector), (signature vector))) @=? actual) + where actual = BRabin.signWith (padding vector) key SHA1 (message vector) + +doBasicRabinVerifyTest key (i, vector) = testCase (show i) (True @=? actual) + where actual = BRabin.verify key SHA1 (message vector) (BRabin.Signature ((os2ip $ padding vector), (signature vector))) + +doModifiedRabinSignTest key (i, vector) = testCase (show i) (Right (signature vector) @=? actual) + where actual = MRabin.sign key SHA1 (message vector) + +doModifiedRabinVerifyTest key (i, vector) = testCase (show i) (True @=? actual) + where actual = MRabin.verify key SHA1 (message vector) (signature vector) + +doRwEncryptTest key (i, vector) = testCase (show i) (Right (cipherText vector) @=? actual) + where actual = RW.encryptWithSeed (seed vector) (OAEP.defaultOAEPParams SHA1) key (plainText vector) + +doRwDecryptTest key (i, vector) = testCase (show i) (Just (plainText vector) @=? actual) + where actual = RW.decrypt (OAEP.defaultOAEPParams SHA1) key (cipherText vector) + +doRwSignTest key (i, vector) = testCase (show i) (Right (signature vector) @=? actual) + where actual = RW.sign key SHA1 (message vector) + +doRwVerifyTest key (i, vector) = testCase (show i) (True @=? actual) + where actual = RW.verify key SHA1 (message vector) (signature vector) + +rabinTests = testGroup "Rabin" + [ testGroup "Basic" + [ testGroup "encrypt" $ map (doBasicRabinEncryptTest $ BRabin.private_pub basicRabinKey) (zip [katZero..] basicRabinEncryptionVectors) + , testGroup "decrypt" $ map (doBasicRabinDecryptTest $ basicRabinKey) (zip [katZero..] basicRabinEncryptionVectors) + , testGroup "sign" $ map (doBasicRabinSignTest $ basicRabinKey) (zip [katZero..] basicRabinSignatureVectors) + , testGroup "verify" $ map (doBasicRabinVerifyTest $ BRabin.private_pub basicRabinKey) (zip [katZero..] basicRabinSignatureVectors) + ] + , testGroup "Modified" + [ testGroup "sign" $ map (doModifiedRabinSignTest $ modifiedRabinKey) (zip [katZero..] modifiedRabinSignatureVectors) + , testGroup "verify" $ map (doModifiedRabinVerifyTest $ MRabin.private_pub modifiedRabinKey) (zip [katZero..] modifiedRabinSignatureVectors) + ] + , testGroup "RW" + [ testGroup "encrypt" $ map (doRwEncryptTest $ RW.private_pub rwKey) (zip [katZero..] rwEncryptionVectors) + , testGroup "decrypt" $ map (doRwDecryptTest $ rwKey) (zip [katZero..] rwEncryptionVectors) + , testGroup "sign" $ map (doRwSignTest $ rwKey) (zip [katZero..] rwSignatureVectors) + , testGroup "verify" $ map (doRwVerifyTest $ RW.private_pub rwKey) (zip [katZero..] rwSignatureVectors) + ] + ] diff --git a/tests/Number.hs b/tests/Number.hs index 8016e70..fd77fa7 100644 --- a/tests/Number.hs +++ b/tests/Number.hs @@ -52,6 +52,9 @@ tests = testGroup "number" in bits == numBits prime , testProperty "marshalling" $ \qaInt -> getQAInteger qaInt == os2ip (i2osp (getQAInteger qaInt) :: Bytes) + , testProperty "as-power-of-2-and-odd" $ \n -> + let (e, a1) = asPowerOf2AndOdd n + in n == (2^e)*a1 , testGroup "marshalling-kat-to-bytearray" $ map toSerializationKat $ zip [katZero..] serializationVectors , testGroup "marshalling-kat-to-integer" $ map toSerializationKatInteger $ zip [katZero..] serializationVectors ]