{-# 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.Vector.Unboxed as V
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
-- for DSA
import qualified Crypto.Hash.SHA1 as SHA1
-- numbers
{-
import Number.ModArithmetic
import Number.Basic
import Number.Prime
import Number.Serialize
-}
-- ciphers/Kexch
import AES (aesTests)
import qualified Crypto.Cipher.AES as AES
import qualified Crypto.Cipher.RSA as RSA
import qualified Crypto.Cipher.DSA as DSA
import qualified Crypto.Cipher.DH as DH
import Crypto.Random
import KAT
{-
prop_gcde_binary_valid (Positive a, Positive b) =
let (x,y,v) = gcde_binary a b in
let (x',y',v') = gcde a b in
and [v==v', a*x' + b*y' == v', a*x + b*y == v, gcd a b == v]
prop_modexp_rtl_valid (NonNegative a, NonNegative b, Positive m) =
exponantiation_rtl_binary a b m == ((a ^ b) `mod` m)
prop_modinv_valid (Positive a, Positive m)
| m > 1 =
case inverse a m of
Just ainv -> (ainv * a) `mod` m == 1
Nothing -> True
| otherwise = True
prop_sqrti_valid (Positive i) = l*l <= i && i <= u*u where (l, u) = sqrti i
prop_generate_prime_valid i =
-- becuase of the next naive test, we can't generate easily number above 32 bits
-- otherwise it slows down the tests to uselessness. when AKS or ECPP is implemented
-- we can revisit the number here
let p = withAleasInteger rng i (\g -> generatePrime g 32) in
-- FIXME test if p is around 32 bits
primalityTestNaive p
prop_miller_rabin_valid i
| i <= 3 = True
| otherwise =
-- miller rabin only returns with certitude that the integer is composite.
let b = withAleasInteger rng i (\g -> isProbablyPrime g i) in
(b == False && primalityTestNaive i == False) || b == True
withAleasInteger rng i f = case reseed (i2osp (if i < 0 then -i else i)) rng of
Left _ -> error "impossible"
Right rng' -> case f rng' of
Left _ -> error "impossible"
Right v -> fst v
-}
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
{- 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)) =
let mz2 = 36969 * (mz `mod` 65536) in
let mw2 = 18070 * (mw `mod` 65536) in
(fromIntegral (mz2 + mw2), Rng (mz2, mw2))
getBytes 0 rng = ([], rng)
getBytes n rng =
let (b, rng') = getByte rng in
let (l, rng'') = getBytes (n-1) rng' in
(b:l, rng'')
instance CryptoRandomGen Rng where
newGen _ = Right (Rng (2,3))
genSeedLength = 0
genBytes len g = Right $ first B.pack $ getBytes len g
reseed bs (Rng (a,b)) = Right $ Rng (fromIntegral a', b) where
a' = ((fromIntegral a) + i * 36969) `mod` 65536
i = B.head bs
rng = Rng (1,2)
{-----------------------------------------------------------------------------------------------}
{- testing RSA -}
{-----------------------------------------------------------------------------------------------}
{-
prop_rsa_generate_valid (Positive i, RSAMessage msgz) =
let keysz = 64 in
let (pub,priv) = withAleasInteger rng i (\g -> RSA.generate g keysz 65537) in
let msg = B.take (keysz - 11) msgz in
(RSA.private_p priv * RSA.private_q priv == RSA.private_n priv) &&
((RSA.private_d priv * RSA.public_e pub) `mod` ((RSA.private_p priv - 1) * (RSA.private_q priv - 1)) == 1) &&
(either Left (RSA.decrypt priv . fst) $ RSA.encrypt rng pub msg) == Right msg
-}
prop_rsa_valid fast (RSAMessage msg) =
(either Left (RSA.decrypt pk . fst) $ RSA.encrypt rng rsaPublickey msg) == Right msg
where pk = if fast then rsaPrivatekey else rsaPrivatekey { RSA.private_p = 0, RSA.private_q = 0 }
prop_rsa_fast_valid = prop_rsa_valid True
prop_rsa_slow_valid = prop_rsa_valid False
prop_rsa_sign_valid fast (RSAMessage msg) = (either Left (\smsg -> verify msg smsg) $ sign msg) == Right True
where
verify = RSA.verify (SHA1.hash) sha1desc rsaPublickey
sign = RSA.sign (SHA1.hash) sha1desc pk
sha1desc = B.pack [0x30,0x21,0x30,0x09,0x06,0x05,0x2b,0x0e,0x03, 0x02,0x1a,0x05,0x00,0x04,0x14]
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
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
}
{-----------------------------------------------------------------------------------------------}
{- testing DSA -}
{-----------------------------------------------------------------------------------------------}
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
}
prop_dsa_valid (RSAMessage msg) =
case DSA.verify signature (SHA1.hash) dsaPublickey msg of
Left err -> False
Right b -> b
where
Right (signature, rng') = DSA.sign rng (SHA1.hash) dsaPrivatekey msg
{-----------------------------------------------------------------------------------------------}
{- testing DH -}
{-----------------------------------------------------------------------------------------------}
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)
{-----------------------------------------------------------------------------------------------}
{- testing AES -}
{-----------------------------------------------------------------------------------------------}
data AES128Message = AES128Message B.ByteString B.ByteString B.ByteString deriving (Show, Eq)
data AES192Message = AES192Message B.ByteString B.ByteString B.ByteString deriving (Show, Eq)
data AES256Message = AES256Message B.ByteString B.ByteString B.ByteString deriving (Show, Eq)
arbitraryAES keysize = do
sz <- choose (1, 12)
ws <- replicateM (sz*16) (choose (0,255) :: Gen Int)
key <- replicateM keysize (choose (0,255) :: Gen Int)
iv <- replicateM 16 (choose (0,255) :: Gen Int)
return (ws, key, iv)
instance Arbitrary AES128Message where
arbitrary = do
(ws, key, iv) <- arbitraryAES 16
return $ AES128Message (B.pack $ map fromIntegral key)
(B.pack $ map fromIntegral iv)
(B.pack $ map fromIntegral ws)
instance Arbitrary AES192Message where
arbitrary = do
(ws, key, iv) <- arbitraryAES 24
return $ AES192Message (B.pack $ map fromIntegral key)
(B.pack $ map fromIntegral iv)
(B.pack $ map fromIntegral ws)
instance Arbitrary AES256Message where
arbitrary = do
(ws, key, iv) <- arbitraryAES 32
return $ AES256Message (B.pack $ map fromIntegral key)
(B.pack $ map fromIntegral iv)
(B.pack $ map fromIntegral ws)
prop_ecb_valid k msg = AES.decryptECB k (AES.encryptECB k msg) == msg
prop_cbc_valid k iv msg = AES.decryptCBC k (AES.IV iv) (AES.encryptCBC k (AES.IV iv) msg) == msg
prop_aes128_ecb_valid (AES128Message key _ msg) =
let k = AES.initKey key in
prop_ecb_valid k msg
prop_aes192_ecb_valid (AES192Message key _ msg) =
let k = AES.initKey key in
prop_ecb_valid k msg
prop_aes256_ecb_valid (AES256Message key _ msg) =
let k = AES.initKey key in
prop_ecb_valid k msg
prop_aes128_cbc_valid (AES128Message key iv msg) =
let k = AES.initKey key in
prop_cbc_valid k iv msg
prop_aes192_cbc_valid (AES192Message key iv msg) =
let k = AES.initKey key in
prop_cbc_valid k iv msg
prop_aes256_cbc_valid (AES256Message key iv msg) =
let k = AES.initKey key in
prop_cbc_valid k iv msg
{-----------------------------------------------------------------------------------------------}
{- main -}
{-----------------------------------------------------------------------------------------------}
symCipherExpectedTests = testGroup "symmetric cipher KAT" katTests
symCipherMarshallTests = testGroup "symmetric cipher marshall"
[ testProperty "AES128 (ECB)" prop_aes128_ecb_valid
, testProperty "AES128 (CBC)" prop_aes128_cbc_valid
, testProperty "AES192 (ECB)" prop_aes192_ecb_valid
, testProperty "AES192 (CBC)" prop_aes192_cbc_valid
, testProperty "AES256 (ECB)" prop_aes256_ecb_valid
, testProperty "AES256 (CBC)" prop_aes256_cbc_valid
]
asymEncryptionTests = testGroup "assymmetric cipher encryption"
[ testProperty "RSA (slow)" prop_rsa_slow_valid
, testProperty "RSA (fast)" prop_rsa_fast_valid
]
asymSignatureTests = testGroup "assymmetric cipher signature"
[ testProperty "RSA (slow)" prop_rsa_sign_slow_valid
, testProperty "RSA (fast)" prop_rsa_sign_fast_valid
, testProperty "DSA" prop_dsa_valid
]
asymOtherTests = testGroup "assymetric other tests"
[ testProperty "DH valid" prop_dh_valid
]
arithmeticTests = testGroup "arithmetic"
[]
{- run_test "RSA generate" prop_rsa_generate_valid -}
tests :: [Test]
tests =
[ symCipherExpectedTests
, symCipherMarshallTests
, testGroup "AES" aesTests
, arithmeticTests
, asymEncryptionTests
, asymSignatureTests
, asymOtherTests
]
main = defaultMain tests
{-
-- Number Tests
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 "sqrt integer valid" prop_sqrti_valid
run_test "primality test Miller Rabin" prop_miller_rabin_valid
run_test "Generate prime" prop_generate_prime_valid
-}