1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
{-# LANGUAGE OverloadedStrings #-}
module Number (tests) where
import Imports
import Crypto.Number.Basic
import Crypto.Number.Generate
import Crypto.Number.ModArithmetic
import Crypto.Number.Prime
import qualified Crypto.Number.Serialize as BE
import qualified Crypto.Number.Serialize.LE as LE
import Data.Bits
import Data.ByteArray (Bytes)
import qualified Data.ByteArray as B
serializationVectors :: [(Int, Integer, ByteString)]
serializationVectors =
[
( 128
, 468189858948067662094510918729062682059955669513914188715630930503497261316361784677177564296207557978182700664806717692596876084916561811001371208806217360635705059859428069669992937334724312890015700331031248133952795914192719979937664050389500162437642525331653766885896869239678885404647468665996400635
, "\x00\xaa\xae\x74\xc8\xec\x3c\x36\x06\x5e\x46\xca\x8e\x57\xab\x09\x87\xfd\xcd\x1f\xa4\xe7\xf9\xd2\x60\xd5\x4a\x1b\x74\xdc\xa8\x75\xd8\xdd\xff\x2b\x74\x28\x14\x59\x67\x6c\x82\xae\xa3\xa5\x1d\x3f\xb4\xb7\xfe\x5c\xd2\xf0\x7f\xd8\xd9\xa9\xb0\xce\x26\xc1\x26\x74\x96\xf5\xf6\x4c\x8f\x66\x7f\x5d\xf1\x68\x38\xd4\x03\x62\xe9\x30\xc8\xa1\xc1\x84\x97\x62\x20\xfd\xd7\x03\x35\xc1\x25\x45\x1b\x86\x81\x3d\xa4\x92\xc0\xd3\xdd\xfa\x86\x1d\xdf\x0a\xbb\xf4\xc0\x56\xf7\xa2\xb0\x3b\x52\xf7\xa5\x89\x4c\x69\x34\x91\x46\xd9\x57\xfb"
)
,
( 128
, 40031303476923779996794876613623495515025748694978019540894726181695410095832601107261950025830235596060960914255795497479135806963313279476038687192202016132891881954743054164975707083302554941058329647014950354509055121290280892911153779672733723699997592027662953953692834215577119173225643193201177329
, "\x00\x0e\x97\xf9\xd5\x79\xb9\x90\x7c\x85\x48\x49\x01\x19\x64\xfb\x76\x31\xcd\x51\xfb\x8a\x9d\x55\xe5\xd3\x7b\x87\x2d\xad\x63\x2d\x6b\x1c\x84\x3f\x65\x95\xb6\xf3\x1a\xa9\x43\x3f\x06\x46\x7b\xf8\xf3\x35\x45\x84\x11\x56\x91\x53\x43\xd7\xe1\x6d\x80\x64\x14\x45\x35\x4e\x93\x7d\x5e\x48\xec\xe0\x79\x7b\x44\x8e\xab\x0f\xc4\x5f\xc6\xa1\x71\xee\x37\xb1\x55\x51\x98\x44\x57\xe3\xc3\x56\x3a\x50\x27\xaf\xa5\x1d\x1a\x0a\x90\x19\x0d\x14\xed\x3d\x93\x40\x62\x76\xa3\xaa\x00\x23\x86\xca\x98\xb2\x6e\x02\x43\xa7\xbc\xb1\xb2\xf1"
)
,
( 128
, 75152325976543603337003024341071663845101857195436434620947904288957274825323005869230041326941600298094896018190395352332646796347130114769768242670539699217743549573961461985255265474392937773768121046339453584830072421569334022498680626938734088755136253492360177084153487115846920446085149631919580041
, "\x00\x1b\x65\xb1\x73\x74\xed\xd2\xcb\xb8\xf3\x6b\x3f\xc2\x05\xaa\x91\xab\x48\x5b\x03\x30\xae\x24\xa3\xec\x7a\x6a\xf0\x34\x73\x18\x04\xea\xe4\xd6\x19\x97\xc4\xc1\x13\x7d\x12\x0d\xd5\xcb\xbd\x18\x05\xc2\xce\x87\x66\x84\x12\xe8\x24\xa3\x31\x69\xfa\xf4\x2c\x21\x53\xa6\x04\x74\x78\xc4\x93\x0d\x38\x7f\x28\xfe\x80\x8e\xd2\x7b\x20\xc8\xf5\x1f\x0f\x73\x68\xb2\xe5\x08\xf1\x94\xa1\xe6\xcf\x3a\x2c\x12\x63\xda\x08\x3a\x78\x12\xb8\x11\x23\x3c\x38\x38\x10\x94\x2b\xac\x64\x5d\x67\x0c\xb6\x0d\xc3\x9a\x45\x39\x50\x8a\x63\x89"
)
,
( 128
, 132094272981815297755209818914225029878347650582749561568514551350741192910991391836297682842650690115955454061006435646226436379226218676796260483719213285072886626400953065229934239690821114513313427305727000011361769875430428291375851099221794646192854831002408178061474948738788927399080262963320752452
, "\x00\x30\x27\xe0\xbf\x46\xec\x77\x2d\xc6\x06\x77\xbc\x68\x87\x3c\x1b\x2e\xc7\xb7\x6c\x88\x25\xec\x8c\x95\xbf\x74\xe5\x37\x01\x25\x96\xe1\x70\x33\x5c\x7d\xab\x1f\xc2\x9c\xad\xf7\xca\x26\x85\x2d\xfc\x8f\xc7\xab\x49\x28\xa4\x47\xe6\xd5\x6e\xfa\x0a\xbb\x57\xe4\xa2\x51\xc7\xc6\x12\x0f\xa9\x98\x69\xb8\x05\x84\xc5\xe3\x28\x86\x0f\x54\x1d\xf9\x92\x42\x9f\xb1\x77\x2b\x58\x89\xe2\xfc\x22\xb0\x1e\x71\x78\xea\x39\xc1\x87\x4f\xd4\x83\x2c\x96\x1d\xea\xd5\xf9\xf9\xb9\x7b\x86\xfa\xf6\xad\x5b\xb1\x3c\xe7\x11\xd7\x96\x89\x44"
)
,
( 128
, 577245873336454863811643140721674509319073059708446946821011267146688442860798353087462545395033001525475835015592425207995480357299993009193426638306801669333644226765032464458284920004140299209138389393494751627076239104390434285377314678827349631962212281858308570255468721491493027423799738158196939966
, "\x00\xd2\x70\x41\xdb\x3d\xb5\xfe\x8c\xef\x79\xcf\x5b\x7b\x37\xb0\x05\xb8\x5a\x9b\x7d\x01\x28\xc7\xf5\x5a\x02\xba\xce\xbc\xf5\x8e\x91\x59\xd0\x42\x6f\x04\x82\x4b\x78\xb0\xdd\x91\x2e\x15\x9d\xea\x4f\x0c\x21\xc0\x67\x54\xa2\x39\xa8\xe1\x13\x8f\xa9\xff\x46\x2d\x11\x56\x04\xa0\xde\x64\xc8\x0f\xf4\x2c\xd2\x31\xdf\x2a\xfd\xac\xc7\x25\x58\xc8\xea\xfd\x47\x6e\xdd\x2a\x53\x02\x77\x49\xa7\x0d\x18\xfb\x05\x18\x4b\x28\xd3\xa2\x39\x8c\x83\x80\x90\xd1\xa8\x81\x56\x6f\xd1\x94\x9d\x65\x34\x95\x79\xc1\x27\xbc\x76\xc3\x5c\xbe"
)
]
tests =
testGroup
"number"
[ testProperty "num-bits" $ \(Int1_2901 i) ->
and
[ (numBits (2 ^ i - 1) == i)
, (numBits (2 ^ i) == i + 1)
, (numBits (2 ^ i + (2 ^ i - 1)) == i + 1)
]
, testProperty "num-bits2" $ \(Positive i) ->
not (i `testBit` numBits i) && (i `testBit` (numBits i - 1))
, testProperty "generate-param" $ \testDRG (Int1_2901 bits) ->
let r = withTestDRG testDRG $ generateParams bits (Just SetHighest) False
in r >= 0 && numBits r == bits && testBit r (bits - 1)
, testProperty "generate-param2" $ \testDRG (Int1_2901 m1bits) ->
let bits = m1bits + 1 -- make sure minimum is 2
r = withTestDRG testDRG $ generateParams bits (Just SetTwoHighest) False
in r >= 0 && numBits r == bits && testBit r (bits - 1) && testBit r (bits - 2)
, testProperty "generate-param-odd" $ \testDRG (Int1_2901 bits) ->
let r = withTestDRG testDRG $ generateParams bits Nothing True
in r >= 0 && odd r
, testProperty "generate-range" $ \testDRG (Positive range) ->
let r = withTestDRG testDRG $ generateMax range
in 0 <= r && r < range
, testProperty "generate-prime" $ \testDRG (Int0_2901 baseBits') ->
let baseBits = baseBits' `mod` 800
bits = 5 + baseBits -- generating lower than 5 bits causes an error ..
prime = withTestDRG testDRG $ generatePrime bits
in bits == numBits prime
, testProperty "generate-safe-prime" $ \testDRG (Int0_2901 baseBits') ->
let baseBits = baseBits' `mod` 200
bits = 6 + baseBits
prime = withTestDRG testDRG $ generateSafePrime bits
in bits == numBits prime
, testProperty "as-power-of-2-and-odd" $ \n ->
let (e, a1) = asPowerOf2AndOdd n
in n == (2 ^ e) * a1
, testProperty "squareRoot" $ \testDRG (Int0_2901 baseBits') -> do
let baseBits = baseBits' `mod` 500
bits = 5 + baseBits -- generating lower than 5 bits causes an error ..
p = withTestDRG testDRG $ generatePrime bits
g <- choose (1, p - 1)
let square x = (x * x) `mod` p
r = square <$> squareRoot p g
case jacobi g p of
Just 1 -> return $ Just g `assertEq` r
Just (-1) -> return $ Nothing `assertEq` r
_ -> error "invalid jacobi result"
, testProperty "marshalling-be" $ \qaInt ->
getQAInteger qaInt == BE.os2ip (BE.i2osp (getQAInteger qaInt) :: Bytes)
, testProperty "marshalling-le" $ \qaInt ->
getQAInteger qaInt == LE.os2ip (LE.i2osp (getQAInteger qaInt) :: Bytes)
, testProperty "be-rev-le" $ \qaInt ->
getQAInteger qaInt
== LE.os2ip (B.reverse (BE.i2osp (getQAInteger qaInt) :: Bytes))
, testProperty "be-rev-le-40" $ \qaInt ->
getQAInteger qaInt
== LE.os2ip (B.reverse (BE.i2ospOf_ 40 (getQAInteger qaInt) :: Bytes))
, testProperty "le-rev-be" $ \qaInt ->
getQAInteger qaInt
== BE.os2ip (B.reverse (LE.i2osp (getQAInteger qaInt) :: Bytes))
, testProperty "le-rev-be-40" $ \qaInt ->
getQAInteger qaInt
== BE.os2ip (B.reverse (LE.i2ospOf_ 40 (getQAInteger qaInt) :: Bytes))
, testGroup "marshalling-kat-to-bytearray" $
zipWith toSerializationKat [katZero ..] serializationVectors
, testGroup "marshalling-kat-to-integer" $
zipWith toSerializationKatInteger [katZero ..] serializationVectors
]
where
toSerializationKat i (sz, n, ba) = testCase (show i) (ba @=? BE.i2ospOf_ sz n)
toSerializationKatInteger i (_, n, ba) = testCase (show i) (n @=? BE.os2ip ba)
|
