cryptocipher 0.1 → 0.2

raw patch · 4 files changed

+329/−38 lines, 4 filesdep +QuickCheckdep +crypto-apidep −haskell98dep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, crypto-api

Dependencies removed: haskell98

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Crypto/Cipher/RSA.hs +140/−0
• Number/ModArithmetic.hs +57/−0
• Tests.hs +126/−35
• cryptocipher.cabal +6/−3

@@ -0,0 +1,140 @@+{-# LANGUAGE FlexibleInstances, CPP #-}++-- |+-- Module      : Crypto.Cipher.RSA+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- 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

@@ -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

@@ -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

@@ -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