diff --git a/Crypto/Cipher/RSA.hs b/Crypto/Cipher/RSA.hs new file mode 100644 --- /dev/null +++ b/Crypto/Cipher/RSA.hs @@ -0,0 +1,140 @@ +{-# LANGUAGE FlexibleInstances, CPP #-} + +-- | +-- Module : Crypto.Cipher.RSA +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : Good +-- +module Crypto.Cipher.RSA + ( Error(..) + , PublicKey(..) + , PrivateKey(..) + , decrypt + , encrypt + ) where + +import Control.Arrow (first) +import Crypto.Random +import Data.Bits +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Number.ModArithmetic (exponantiation_rtl_binary) + +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) + | RandomGenFailure GenError -- ^ the random generator returns an error. give the opportunity to reseed for example. + | KeyInternalError -- ^ the whole key is probably not valid, since the message is bigger than the key size + deriving (Show,Eq) + +data PublicKey = PublicKey + { public_sz :: Int -- ^ size of key in bytes + , public_n :: Integer -- ^ public p*q + , public_e :: Integer -- ^ public exponant e + } deriving (Show) + +data PrivateKey = PrivateKey + { private_sz :: Int -- ^ size of key in bytes + , private_n :: Integer -- ^ private p*q + , private_d :: Integer -- ^ private exponant d + , private_p :: Integer -- ^ p prime number + , private_q :: Integer -- ^ q prime number + , private_dP :: Integer -- ^ d mod (p-1) + , private_dQ :: Integer -- ^ d mod (q-1) + , private_qinv :: Integer -- ^ q^(-1) mod p + } deriving (Show) + +#if !MIN_VERSION_base(4,3,0) +instance Monad (Either Error) where + return = Right + (Left x) >>= _ = Left x + (Right x) >>= f = f x +#endif + +padPKCS1 :: CryptoRandomGen g => g -> Int -> ByteString -> Either Error (ByteString, g) +padPKCS1 rng len m = do + (padding, rng') <- getRandomBytes rng (len - B.length m - 3) + return (B.concat [ B.singleton 0, B.singleton 2, padding, B.singleton 0, m ], rng') + +unpadPKCS1 :: ByteString -> Either Error ByteString +unpadPKCS1 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 = (B.unpack zt /= [0, 2]) || (B.unpack z /= [0]) || (B.length ps < 8) + +{- dpSlow computes the decrypted message not using any precomputed cache value. + only n and d need to valid. -} +dpSlow :: PrivateKey -> ByteString -> Either Error ByteString +dpSlow pk c = i2ospOf (private_sz 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 :: PrivateKey -> ByteString -> Either Error ByteString +dpFast pk c = i2ospOf (private_sz 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) + +{-| decrypt message using the private key. -} +decrypt :: PrivateKey -> ByteString -> Either Error ByteString +decrypt pk c + | B.length c /= (private_sz pk) = Left MessageSizeIncorrect + | otherwise = dp pk c >>= unpadPKCS1 + where dp = if private_p pk /= 0 && private_q pk /= 0 then dpFast else dpSlow + +{- | encrypt a bytestring using the public key and a CryptoRandomGen random generator. + - the message need to be smaller than the key size - 11 + -} +encrypt :: CryptoRandomGen g => g -> PublicKey -> ByteString -> Either Error (ByteString, g) +encrypt rng pk m + | B.length m > public_sz pk - 11 = Left MessageTooLong + | otherwise = do + (em, rng') <- padPKCS1 rng (public_sz pk) m + c <- i2ospOf (public_sz pk) $ expmod (os2ip em) (public_e pk) (public_n pk) + return (c, rng') + +{- get random non-null bytes for encryption padding. -} +getRandomBytes :: CryptoRandomGen g => g -> Int -> Either Error (ByteString, g) +getRandomBytes rng n = do + gend <- either (Left . RandomGenFailure) Right $ genBytes n rng + let (bytes, rng') = first (B.pack . filter (/= 0) . B.unpack) gend + let left = (n - B.length bytes) + if left == 0 + then return (bytes, rng') + else getRandomBytes rng' left >>= return . first (B.append bytes) + +{- convert a positive integer into a bytestring of specific size. + if the number is too big, this will returns an error, otherwise it will pad + the bytestring of 0 -} +i2ospOf :: Int -> Integer -> Either Error ByteString +i2ospOf len m + | lenbytes < len = Right $ B.replicate (len - lenbytes) 0 `B.append` bytes + | lenbytes == len = Right bytes + | otherwise = Left KeyInternalError + where + lenbytes = B.length bytes + bytes = i2osp m + +-- | os2ip converts a byte string into a positive integer +os2ip :: ByteString -> Integer +os2ip = B.foldl' (\a b -> (256 * a) .|. (fromIntegral b)) 0 + +-- | i2osp converts a positive integer into a byte string +i2osp :: Integer -> ByteString +i2osp m = B.reverse $ B.unfoldr divMod256 m + where + divMod256 0 = Nothing + divMod256 n = Just (fromIntegral a,b) where (b,a) = n `divMod` 256 + +expmod :: Integer -> Integer -> Integer -> Integer +expmod = exponantiation_rtl_binary diff --git a/Number/ModArithmetic.hs b/Number/ModArithmetic.hs new file mode 100644 --- /dev/null +++ b/Number/ModArithmetic.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE BangPatterns #-} +module Number.ModArithmetic + ( exponantiation_rtl_binary + , inverse + , gcde_binary + ) where + +import Data.Bits + +-- note on exponantiation: 0^0 is treated as 1 for mimicking the standard library; +-- the mathematic debate is still open on whether or not this is true, but pratically +-- in computer science it shouldn't be useful for anything anyway. + +-- | exponantiation_rtl_binary computes modular exponantiation as b^e mod m +-- using the right-to-left binary exponentiation algorithm (HAC 14.79) +exponantiation_rtl_binary :: Integer -> Integer -> Integer -> Integer +exponantiation_rtl_binary 0 0 m = 1 `mod` m +exponantiation_rtl_binary b e m = loop e b 1 + where + sq x = (x * x) `mod` m + loop !0 _ !a = a `mod` m + loop !i !s !a = loop (i `shiftR` 1) (sq s) (if odd i then a * s else a) + +-- | inverse computes the modular inverse as in g^(-1) mod m +inverse :: Integer -> Integer -> Maybe Integer +inverse g m = if d > 1 then Nothing else Just x + where (x,_,d) = gcde_binary g m + +-- | get the extended GCD of two integer using the extended binary algorithm (HAC 14.61) +-- get (x,y,d) where d = gcd(a,b) and x,y satisfying ax + by = d +gcde_binary :: Integer -> Integer -> (Integer, Integer, Integer) +gcde_binary a' b' + | b' == 0 = (1,0,a') + | a' >= b' = compute a' b' + | otherwise = (\(x,y,d) -> (y,x,d)) $ compute b' a' + where + getEvenMultiplier !g !x !y + | areEven [x,y] = getEvenMultiplier (g `shiftL` 1) (x `shiftR` 1) (y `shiftR` 1) + | otherwise = (x,y,g) + halfLoop !x !y !u !i !j + | areEven [u,i,j] = halfLoop x y (u `shiftR` 1) (i `shiftR` 1) (j `shiftR` 1) + | even u = halfLoop x y (u `shiftR` 1) ((i + y) `shiftR` 1) ((j - x) `shiftR` 1) + | otherwise = (u, i, j) + compute a b = + let (x,y,g) = getEvenMultiplier 1 a b in + loop g x y x y 1 0 0 1 + + loop g _ _ 0 !v _ _ !c !d = (c, d, g * v) + loop g x y !u !v !a !b !c !d = + let (u2,a2,b2) = halfLoop x y u a b in + let (v2,c2,d2) = halfLoop x y v c d in + if u2 >= v2 + then loop g x y (u2 - v2) v2 (a2 - c2) (b2 - d2) c2 d2 + else loop g x y u2 (v2 - u2) a2 b2 (c2 - a2) (d2 - b2) + +areEven :: [Integer] -> Bool +areEven = and . map even diff --git a/Tests.hs b/Tests.hs --- a/Tests.hs +++ b/Tests.hs @@ -1,33 +1,28 @@ +{-# LANGUAGE OverloadedStrings #-} + import Test.HUnit ((~:), (~=?)) import qualified Test.HUnit as Unit + +import Test.QuickCheck +import Test.QuickCheck.Test +import System.IO (hFlush, stdout) + +import Control.Monad + +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 + +-- numbers +import Number.ModArithmetic +-- ciphers import qualified Crypto.Cipher.RC4 as RC4 import qualified Crypto.Cipher.Camellia as Camellia - -{- CAMELLIA test vectors -} -{- - Here are test data for Camellia in hexadecimal form. - - 128-bit key - Key : 01 23 45 67 89 ab cd ef fe dc ba 98 76 54 32 10 - Plaintext : 01 23 45 67 89 ab cd ef fe dc ba 98 76 54 32 10 - Ciphertext: 67 67 31 38 54 96 69 73 08 57 06 56 48 ea be 43 - - 192-bit key - Key : 01 23 45 67 89 ab cd ef fe dc ba 98 76 54 32 10 - : 00 11 22 33 44 55 66 77 - Plaintext : 01 23 45 67 89 ab cd ef fe dc ba 98 76 54 32 10 - Ciphertext: b4 99 34 01 b3 e9 96 f8 4e e5 ce e7 d7 9b 09 b9 - - 256-bit key - Key : 01 23 45 67 89 ab cd ef fe dc ba 98 76 54 32 10 - : 00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff - Plaintext : 01 23 45 67 89 ab cd ef fe dc ba 98 76 54 32 10 - Ciphertext: 9a cc 23 7d ff 16 d7 6c 20 ef 7c 91 9e 3a 75 09 --} +import qualified Crypto.Cipher.RSA as RSA +import Crypto.Random encryptStream fi fc key plaintext = B.unpack $ snd $ fc (fi key) plaintext @@ -40,25 +35,41 @@ wordify :: [Char] -> [Word8] wordify = map (toEnum . fromEnum) -packString :: [Char] -> B.ByteString -packString = B.pack . wordify - vectors_rc4 = - [ (wordify "Key", packString "Plaintext", [ 0xBB,0xF3,0x16,0xE8,0xD9,0x40,0xAF,0x0A,0xD3 ]) - , (wordify "Wiki", packString "pedia", [ 0x10,0x21,0xBF,0x04,0x20 ]) - , (wordify "Secret", packString "Attack at dawn", [ 0x45,0xA0,0x1F,0x64,0x5F,0xC3,0x5B,0x38,0x35,0x52,0x54,0x4B,0x9B,0xF5 ]) + [ (wordify "Key", "Plaintext", [ 0xBB,0xF3,0x16,0xE8,0xD9,0x40,0xAF,0x0A,0xD3 ]) + , (wordify "Wiki", "pedia", [ 0x10,0x21,0xBF,0x04,0x20 ]) + , (wordify "Secret", "Attack at dawn", [ 0x45,0xA0,0x1F,0x64,0x5F,0xC3,0x5B,0x38,0x35,0x52,0x54,0x4B,0x9B,0xF5 ]) ] vectors_camellia128 = [ - ([0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], - B.pack [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], - [0x3d,0x02,0x80,0x25,0xb1,0x56,0x32,0x7c,0x17,0xf7,0x62,0xc1,0xf2,0xcb,0xca,0x71]), - ([0x01,0x23,0x45,0x67,0x89,0xab,0xcd,0xef,0xfe,0xdc,0xba,0x98,0x76,0x54,0x32,0x10], - B.pack [0x01,0x23,0x45,0x67,0x89,0xab,0xcd,0xef,0xfe,0xdc,0xba,0x98,0x76,0x54,0x32,0x10], - [0x67,0x67,0x31,0x38,0x54,0x96,0x69,0x73,0x08,0x57,0x06,0x56,0x48,0xea,0xbe,0x43]) + ( [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0] + , B.pack [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0] + , [0x3d,0x02,0x80,0x25,0xb1,0x56,0x32,0x7c,0x17,0xf7,0x62,0xc1,0xf2,0xcb,0xca,0x71] + ) + , ( [0x01,0x23,0x45,0x67,0x89,0xab,0xcd,0xef,0xfe,0xdc,0xba,0x98,0x76,0x54,0x32,0x10] + , B.pack [0x01,0x23,0x45,0x67,0x89,0xab,0xcd,0xef,0xfe,0xdc,0xba,0x98,0x76,0x54,0x32,0x10] + , [0x67,0x67,0x31,0x38,0x54,0x96,0x69,0x73,0x08,0x57,0x06,0x56,0x48,0xea,0xbe,0x43] + ) ] +vectors_camellia192 = + [ + ( [0x01,0x23,0x45,0x67,0x89,0xab,0xcd,0xef,0xfe,0xdc,0xba,0x98,0x76,0x54,0x32,0x10,0x00,0x11,0x22,0x33,0x44,0x55,0x66,0x77] + , B.pack [0x01,0x23,0x45,0x67,0x89,0xab,0xcd,0xef,0xfe,0xdc,0xba,0x98,0x76,0x54,0x32,0x10] + ,[0xb4,0x99,0x34,0x01,0xb3,0xe9,0x96,0xf8,0x4e,0xe5,0xce,0xe7,0xd7,0x9b,0x09,0xb9] + ) + ] + +vectors_camellia256 = + [ + ( [0x01,0x23,0x45,0x67,0x89,0xab,0xcd,0xef,0xfe,0xdc,0xba,0x98,0x76,0x54,0x32,0x10 + ,0x00,0x11,0x22,0x33,0x44,0x55,0x66,0x77,0x88,0x99,0xaa,0xbb,0xcc,0xdd,0xee,0xff] + , B.pack [0x01,0x23,0x45,0x67,0x89,0xab,0xcd,0xef,0xfe,0xdc,0xba,0x98,0x76,0x54,0x32,0x10] + , [0x9a,0xcc,0x23,0x7d,0xff,0x16,0xd7,0x6c,0x20,0xef,0x7c,0x91,0x9e,0x3a,0x75,0x09] + ) + ] + vectors = [ ("RC4", vectors_rc4, encryptStream RC4.initCtx RC4.encrypt) , ("Camellia", vectors_camellia128, encryptBlock Camellia.initKey Camellia.encrypt) @@ -67,4 +78,84 @@ utests :: [Unit.Test] utests = concatMap (\(name, v, f) -> map (\(k,p,e) -> name ~: name ~: e ~=? f k p) v) vectors -main = Unit.runTestTT (Unit.TestList utests) +{- end of units tests -} +{- start of QuickCheck verification -} + +-- FIXME better to tweak the property to generate positive integer instead of this. + +prop_gcde_binary_valid (a, b) + | a > 0 && b >= 0 = + let (x,y,v) = gcde_binary a b in + and [a*x + b*y == v, gcd a b == v] + | otherwise = True + +prop_modexp_rtl_valid (a, b, m) + | m > 0 && a >= 0 && b >= 0 = exponantiation_rtl_binary a b m == ((a ^ b) `mod` m) + | otherwise = True + +prop_modinv_valid (a, m) + | m > 1 && a > 0 = + case inverse a m of + Just ainv -> (ainv * a) `mod` m == 1 + Nothing -> True + | otherwise = True + +newtype RSAMessage = RSAMessage B.ByteString deriving (Show, Eq) + +instance Arbitrary RSAMessage where + arbitrary = do + sz <- choose (0, 128 - 11) + ws <- replicateM sz (choose (0,255) :: Gen Int) + return $ RSAMessage $ B.pack $ map fromIntegral ws + +data Rng = Rng Int + +instance CryptoRandomGen Rng where + newGen _ = Right (Rng 0) + genSeedLength = 0 + genBytes len g = Right (B.pack $ replicate len 0x2d, g) + +rng = Rng 0 + +prop_rsa_fast_valid (RSAMessage msg) = + (either Left (RSA.decrypt privatekey . fst) $ RSA.encrypt rng publickey msg) == Right msg + +prop_rsa_slow_valid (RSAMessage msg) = + (either Left (RSA.decrypt pk . fst) $ RSA.encrypt rng publickey msg) == Right msg + where pk = privatekey { RSA.private_p = 0, RSA.private_q = 0 } + +privatekey = RSA.PrivateKey + { RSA.private_sz = 128 + , RSA.private_n = 140203425894164333410594309212077886844966070748523642084363106504571537866632850620326769291612455847330220940078873180639537021888802572151020701352955762744921926221566899281852945861389488419179600933178716009889963150132778947506523961974222282461654256451508762805133855866018054403911588630700228345151 + , RSA.private_d = 133764127300370985476360382258931504810339098611363623122953018301285450176037234703101635770582297431466449863745848961134143024057267778947569638425565153896020107107895924597628599677345887446144410702679470631826418774397895304952287674790343620803686034122942606764275835668353720152078674967983573326257 + , RSA.private_p = 12909745499610419492560645699977670082358944785082915010582495768046269235061708286800087976003942261296869875915181420265794156699308840835123749375331319 + , RSA.private_q = 10860278066550210927914375228722265675263011756304443428318337179619069537063135098400347475029673115805419186390580990519363257108008103841271008948795129 + , RSA.private_dP = 5014229697614831746694710412330921341325464081424013940131184365711243776469716106024020620858146547161326009604054855316321928968077674343623831428796843 + , RSA.private_dQ = 3095337504083058271243917403868092841421453478127022884745383831699720766632624326762288333095492075165622853999872779070009098364595318242383709601515849 + , RSA.private_qinv = 11136639099661288633118187183300604127717437440459572124866697429021958115062007251843236337586667012492941414990095176435990146486852255802952814505784196 + } + +publickey = RSA.PublicKey + { RSA.public_sz = 128 + , RSA.public_n = 140203425894164333410594309212077886844966070748523642084363106504571537866632850620326769291612455847330220940078873180639537021888802572151020701352955762744921926221566899281852945861389488419179600933178716009889963150132778947506523961974222282461654256451508762805133855866018054403911588630700228345151 + , RSA.public_e = 65537 + } + +args = Args + { replay = Nothing + , maxSuccess = 1000 + , maxDiscard = 4000 + , maxSize = 1000 + } + +run_test n t = putStr (" " ++ n ++ " ... ") >> hFlush stdout >> quickCheckWith args t + +main = do + Unit.runTestTT (Unit.TestList utests) + + run_test "gcde binary valid" prop_gcde_binary_valid + run_test "exponantiation RTL valid" prop_modexp_rtl_valid + run_test "inverse valid" prop_modinv_valid + + run_test "RSA decrypt(slow).encrypt = id" prop_rsa_slow_valid + run_test "RSA decrypt(fast).encrypt = id" prop_rsa_fast_valid diff --git a/cryptocipher.cabal b/cryptocipher.cabal --- a/cryptocipher.cabal +++ b/cryptocipher.cabal @@ -1,5 +1,5 @@ Name: cryptocipher -Version: 0.1 +Version: 0.2 Description: Symmetrical Block and Stream Ciphers License: BSD3 License-file: LICENSE @@ -9,6 +9,7 @@ Synopsis: Symmetrical Block and Stream Ciphers Category: Cryptography Build-Type: Simple +Homepage: http://github.com/vincenthz/hs-cryptocipher Cabal-Version: >=1.6 Flag test @@ -16,16 +17,18 @@ Default: False Library - Build-Depends: base >= 3 && < 5, bytestring, haskell98, vector + Build-Depends: base >= 4 && < 7, bytestring, vector, crypto-api >= 0.2 Exposed-modules: Crypto.Cipher.RC4 Crypto.Cipher.Camellia + Crypto.Cipher.RSA + other-modules: Number.ModArithmetic ghc-options: -Wall Executable Tests Main-Is: Tests.hs if flag(test) Buildable: True - Build-depends: base >= 3 && < 5, HUnit, bytestring + Build-depends: base >= 4 && < 7, HUnit, bytestring, QuickCheck >= 2 else Buildable: False