Skip to content

Commit

Permalink
PT tests
Browse files Browse the repository at this point in the history
  • Loading branch information
tdammers authored and iquerejeta committed Nov 29, 2022
1 parent 82933b6 commit 63fa4f3
Showing 1 changed file with 26 additions and 7 deletions.
33 changes: 26 additions & 7 deletions cardano-crypto-tests/src/Test/Crypto/EllipticCurve.hs
Expand Up @@ -35,6 +35,7 @@ tests =
, testScalar "Scalar"
, testBLSCurve "Curve 1" (Proxy @BLS.Curve1)
, testBLSCurve "Curve 2" (Proxy @BLS.Curve2)
, testPT "PT"
, testPairings "Pairings"
]
]
Expand Down Expand Up @@ -98,15 +99,27 @@ testBLSCurve name _ =
, testProperty "addition commutative" (testCommut (BLS.add :: BLS.P curve -> BLS.P curve -> BLS.P curve))
, testProperty "adding negation yields infinity" (testAddNegYieldsInf @curve)
, testProperty "round-trip serialization" $
testRoundTrip @curve BLS.serialize BLS.deserialize
testRoundTripEither @(BLS.P curve) BLS.serialize BLS.deserialize
, testProperty "round-trip compression" $
testRoundTrip @curve BLS.compress BLS.uncompress
testRoundTripEither @(BLS.P curve) BLS.compress BLS.uncompress
, testProperty "mult by p is inf" $ \(a :: BLS.P curve) ->
BLS.isInf (BLS.mult a BLS.scalarPeriod)
, testProperty "mult by p+1 is identity" $ \(a :: BLS.P curve) ->
BLS.mult a (BLS.scalarPeriod + 1) === a
]

testPT :: String -> TestTree
testPT name =
testGroup name
[ testProperty "mult associative"
(testAssoc BLS.ptMult)
, testProperty "mult commutative"
(testCommut BLS.ptMult)
, testProperty "inv reversible"
(testRoundTripEither BLS.ptInv (Right @() . BLS.ptInv))
, testProperty "self-equality" (\(a :: BLS.PT) -> a === a)
]

testPairings :: String -> TestTree
testPairings name =
testGroup name
Expand Down Expand Up @@ -145,12 +158,12 @@ testAddNegYieldsInf :: forall curve. BLS.BLS curve
testAddNegYieldsInf p =
BLS.isInf (BLS.add p (BLS.neg p))

testRoundTrip :: forall curve a. BLS.BLS curve
=> (BLS.P curve -> a)
-> (a -> Either BLS.BLSTError (BLS.P curve))
-> BLS.P curve
testRoundTripEither :: forall p a err. (Show p, Show err, Eq p, Eq err)
=> (p -> a)
-> (a -> Either err p)
-> p
-> Property
testRoundTrip encode decode p =
testRoundTripEither encode decode p =
Right p === (decode . encode) p

instance BLS.BLS curve => Arbitrary (BLS.P curve) where
Expand All @@ -162,6 +175,12 @@ instance BLS.BLS curve => Arbitrary (BLS.P curve) where
instance BLS.BLS curve => Arbitrary (BLS.Affine curve) where
arbitrary = BLS.toAffine <$> arbitrary

instance Arbitrary BLS.PT where
arbitrary = BLS.pairing <$> arbitrary <*> arbitrary

instance Show BLS.PT where
show = const "<<<PT>>>"

instance Arbitrary BLS.Scalar where
arbitrary =
(BLS.scalarFromBS . BS.pack <$> arbitrary)
Expand Down

0 comments on commit 63fa4f3

Please sign in to comment.