{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{- FOURMOLU_DISABLE -}
module Test.Crypto.DSIGN
  ( tests
  )
where

{- HLINT ignore "Use <$>" -}
{- HLINT ignore "Reduce duplication" -}

import Test.QuickCheck (
  (=/=),
  (===),
  (==>),
  Arbitrary(..),
  Gen,
  Property,
  Testable,
  forAllShow,
  forAllShrinkShow,
  ioProperty,
  counterexample,
  )
import Test.Tasty (TestTree, testGroup, adjustOption)
import Test.Tasty.QuickCheck (testProperty, QuickCheckTests)

import qualified Data.ByteString as BS
import Cardano.Crypto.Libsodium

import Text.Show.Pretty (ppShow)

#ifdef SECP256K1_ENABLED
import Control.Monad (replicateM)
import qualified GHC.Exts as GHC
#endif

import qualified Test.QuickCheck.Gen as Gen
import Data.Kind (Type)
import Data.Proxy (Proxy (..))
import Data.Maybe (fromJust)

import Control.Exception (evaluate, bracket)

import Cardano.Crypto.DSIGN (
  MockDSIGN,
  Ed25519DSIGN,
  Ed448DSIGN,
  DSIGNAlgorithm (
    SeedSizeDSIGN,
    VerKeyDSIGN,
    SignKeyDSIGN,
    SigDSIGN,
    ContextDSIGN,
    Signable,
    rawSerialiseVerKeyDSIGN,
    rawDeserialiseVerKeyDSIGN,
    rawSerialiseSignKeyDSIGN,
    rawDeserialiseSignKeyDSIGN,
    rawSerialiseSigDSIGN,
    rawDeserialiseSigDSIGN
    ),
  sizeVerKeyDSIGN,
  sizeSignKeyDSIGN,
  sizeSigDSIGN,
  encodeVerKeyDSIGN,
  decodeVerKeyDSIGN,
  encodeSignKeyDSIGN,
  decodeSignKeyDSIGN,
  encodeSigDSIGN,
  decodeSigDSIGN,
  signDSIGN,
  deriveVerKeyDSIGN,
  verifyDSIGN,
  genKeyDSIGN,
  seedSizeDSIGN,

  DSIGNMAlgorithm (SignKeyDSIGNM, deriveVerKeyDSIGNM),
  UnsoundDSIGNMAlgorithm,
  rawSerialiseSignKeyDSIGNM,
  rawDeserialiseSignKeyDSIGNM,
  signDSIGNM,
  deriveVerKeyDSIGN,
  genKeyDSIGNM,

  getSeedDSIGNM,
  forgetSignKeyDSIGNM
  )
import Cardano.Binary (FromCBOR, ToCBOR)
import Cardano.Crypto.PinnedSizedBytes (PinnedSizedBytes)
import Cardano.Crypto.DirectSerialise
import Test.Crypto.Util (
  Message,
  prop_raw_serialise,
  prop_raw_deserialise,
  prop_size_serialise,
  prop_cbor_with,
  prop_cbor,
  prop_cbor_size,
  prop_cbor_direct_vs_class,
  prop_no_thunks,
  prop_no_thunks_IO,
  arbitrarySeedOfSize,
  genBadInputFor,
  shrinkBadInputFor,
  showBadInputFor,
  Lock,
  withLock,
  directSerialiseToBS,
  directDeserialiseFromBS,
  hexBS,
  )
import Cardano.Crypto.Libsodium.MLockedSeed

import Test.Crypto.Instances (withMLockedSeedFromPSB)
import Test.Crypto.EqST (EqST (..), (==!))

#ifdef SECP256K1_ENABLED
import Cardano.Crypto.DSIGN (
  EcdsaSecp256k1DSIGN,
  SchnorrSecp256k1DSIGN,
  MessageHash,
  toMessageHash,
  hashAndPack,
  )
import Test.Crypto.Util (
  Message (messageBytes),
  )
import Cardano.Crypto.SECP256K1.Constants (SECP256K1_ECDSA_MESSAGE_BYTES)
import GHC.TypeLits (natVal)
import Cardano.Crypto.Hash (SHA3_256, HashAlgorithm (SizeHash), Blake2b_256, SHA256, Keccak256)
#endif

mockSigGen :: Gen (SigDSIGN MockDSIGN)
mockSigGen :: Gen (SigDSIGN MockDSIGN)
mockSigGen = forall a.
(DSIGNAlgorithm a, ContextDSIGN a ~ (), Signable a Message) =>
Gen (SigDSIGN a)
defaultSigGen

ed25519SigGen :: Gen (SigDSIGN Ed25519DSIGN)
ed25519SigGen :: Gen (SigDSIGN Ed25519DSIGN)
ed25519SigGen = forall a.
(DSIGNAlgorithm a, ContextDSIGN a ~ (), Signable a Message) =>
Gen (SigDSIGN a)
defaultSigGen

ed448SigGen :: Gen (SigDSIGN Ed448DSIGN)
ed448SigGen :: Gen (SigDSIGN Ed448DSIGN)
ed448SigGen = forall a.
(DSIGNAlgorithm a, ContextDSIGN a ~ (), Signable a Message) =>
Gen (SigDSIGN a)
defaultSigGen

#ifdef SECP256K1_ENABLED
ecdsaSigGen :: Gen (SigDSIGN EcdsaSecp256k1DSIGN)
ecdsaSigGen :: Gen (SigDSIGN EcdsaSecp256k1DSIGN)
ecdsaSigGen = do
  MessageHash
msg <- Gen MessageHash
genEcdsaMsg
  forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
signDSIGN () MessageHash
msg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen

schnorrSigGen :: Gen (SigDSIGN SchnorrSecp256k1DSIGN)
schnorrSigGen :: Gen (SigDSIGN SchnorrSecp256k1DSIGN)
schnorrSigGen = forall a.
(DSIGNAlgorithm a, ContextDSIGN a ~ (), Signable a Message) =>
Gen (SigDSIGN a)
defaultSigGen

genEcdsaMsg :: Gen MessageHash
genEcdsaMsg :: Gen MessageHash
genEcdsaMsg =
  forall a b. Gen a -> (a -> Maybe b) -> Gen b
Gen.suchThatMap (forall l. IsList l => Int -> [Item l] -> l
GHC.fromListN Int
32 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
32 forall a. Arbitrary a => Gen a
arbitrary)
                  ByteString -> Maybe MessageHash
toMessageHash
#endif

defaultVerKeyGen :: forall (a :: Type) .
  (DSIGNAlgorithm a) => Gen (VerKeyDSIGN a)
defaultVerKeyGen :: forall a. DSIGNAlgorithm a => Gen (VerKeyDSIGN a)
defaultVerKeyGen = forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen @a

defaultSignKeyGen :: forall (a :: Type).
  (DSIGNAlgorithm a) => Gen (SignKeyDSIGN a)
defaultSignKeyGen :: forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen =
  forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
genKeyDSIGN forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> Gen Seed
arbitrarySeedOfSize (forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
seedSizeDSIGN (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))

defaultSigGen :: forall (a :: Type) .
  (DSIGNAlgorithm a, ContextDSIGN a ~ (), Signable a Message) =>
  Gen (SigDSIGN a)
defaultSigGen :: forall a.
(DSIGNAlgorithm a, ContextDSIGN a ~ (), Signable a Message) =>
Gen (SigDSIGN a)
defaultSigGen = do
  Message
msg :: Message <- forall a. Arbitrary a => Gen a
arbitrary
  forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
signDSIGN () Message
msg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen

#ifdef SECP256K1_ENABLED
-- Used for adjusting no of quick check tests
-- By default up to 100 tests are performed which may not be enough to catch hidden bugs
defaultTestEnough :: QuickCheckTests -> QuickCheckTests
defaultTestEnough :: QuickCheckTests -> QuickCheckTests
defaultTestEnough = forall a. Ord a => a -> a -> a
max QuickCheckTests
10_000
#endif

{- HLINT ignore "Use <$>" -}
{- HLINT ignore "Reduce duplication" -}

--
-- The list of all tests
--
tests :: Lock -> TestTree
tests :: Lock -> TestTree
tests Lock
lock =
  TestName -> [TestTree] -> TestTree
testGroup TestName
"Crypto.DSIGN"
    [ TestName -> [TestTree] -> TestTree
testGroup TestName
"Pure"
      [ forall v a.
(DSIGNAlgorithm v, Signable v a, ContextDSIGN v ~ (), Show a,
 Eq (SignKeyDSIGN v), Eq a, ToCBOR (VerKeyDSIGN v),
 FromCBOR (VerKeyDSIGN v), ToCBOR (SignKeyDSIGN v),
 FromCBOR (SignKeyDSIGN v), ToCBOR (SigDSIGN v),
 FromCBOR (SigDSIGN v)) =>
Gen (SigDSIGN v) -> Gen a -> TestName -> TestTree
testDSIGNAlgorithm Gen (SigDSIGN MockDSIGN)
mockSigGen (forall a. Arbitrary a => Gen a
arbitrary @Message) TestName
"MockDSIGN"
      , forall v a.
(DSIGNAlgorithm v, Signable v a, ContextDSIGN v ~ (), Show a,
 Eq (SignKeyDSIGN v), Eq a, ToCBOR (VerKeyDSIGN v),
 FromCBOR (VerKeyDSIGN v), ToCBOR (SignKeyDSIGN v),
 FromCBOR (SignKeyDSIGN v), ToCBOR (SigDSIGN v),
 FromCBOR (SigDSIGN v)) =>
Gen (SigDSIGN v) -> Gen a -> TestName -> TestTree
testDSIGNAlgorithm Gen (SigDSIGN Ed25519DSIGN)
ed25519SigGen (forall a. Arbitrary a => Gen a
arbitrary @Message) TestName
"Ed25519DSIGN"
      , forall v a.
(DSIGNAlgorithm v, Signable v a, ContextDSIGN v ~ (), Show a,
 Eq (SignKeyDSIGN v), Eq a, ToCBOR (VerKeyDSIGN v),
 FromCBOR (VerKeyDSIGN v), ToCBOR (SignKeyDSIGN v),
 FromCBOR (SignKeyDSIGN v), ToCBOR (SigDSIGN v),
 FromCBOR (SigDSIGN v)) =>
Gen (SigDSIGN v) -> Gen a -> TestName -> TestTree
testDSIGNAlgorithm Gen (SigDSIGN Ed448DSIGN)
ed448SigGen (forall a. Arbitrary a => Gen a
arbitrary @Message) TestName
"Ed448DSIGN"
#ifdef SECP256K1_ENABLED
      , forall v a.
(DSIGNAlgorithm v, Signable v a, ContextDSIGN v ~ (), Show a,
 Eq (SignKeyDSIGN v), Eq a, ToCBOR (VerKeyDSIGN v),
 FromCBOR (VerKeyDSIGN v), ToCBOR (SignKeyDSIGN v),
 FromCBOR (SignKeyDSIGN v), ToCBOR (SigDSIGN v),
 FromCBOR (SigDSIGN v)) =>
Gen (SigDSIGN v) -> Gen a -> TestName -> TestTree
testDSIGNAlgorithm Gen (SigDSIGN EcdsaSecp256k1DSIGN)
ecdsaSigGen Gen MessageHash
genEcdsaMsg TestName
"EcdsaSecp256k1DSIGN"
      , forall v a.
(DSIGNAlgorithm v, Signable v a, ContextDSIGN v ~ (), Show a,
 Eq (SignKeyDSIGN v), Eq a, ToCBOR (VerKeyDSIGN v),
 FromCBOR (VerKeyDSIGN v), ToCBOR (SignKeyDSIGN v),
 FromCBOR (SignKeyDSIGN v), ToCBOR (SigDSIGN v),
 FromCBOR (SigDSIGN v)) =>
Gen (SigDSIGN v) -> Gen a -> TestName -> TestTree
testDSIGNAlgorithm Gen (SigDSIGN SchnorrSecp256k1DSIGN)
schnorrSigGen (forall a. Arbitrary a => Gen a
arbitrary @Message) TestName
"SchnorrSecp256k1DSIGN"
      -- Specific tests related only to ecdsa
      , TestName -> TestTree
testEcdsaInvalidMessageHash TestName
"EcdsaSecp256k1InvalidMessageHash"
      , forall h.
(HashAlgorithm h, SizeHash h ~ SECP256K1_ECDSA_MESSAGE_BYTES) =>
Proxy h -> TestName -> TestTree
testEcdsaWithHashAlgorithm (forall {k} (t :: k). Proxy t
Proxy @SHA3_256) TestName
"EcdsaSecp256k1WithSHA3_256"
      , forall h.
(HashAlgorithm h, SizeHash h ~ SECP256K1_ECDSA_MESSAGE_BYTES) =>
Proxy h -> TestName -> TestTree
testEcdsaWithHashAlgorithm (forall {k} (t :: k). Proxy t
Proxy @Blake2b_256) TestName
"EcdsaSecp256k1WithBlake2b_256"
      , forall h.
(HashAlgorithm h, SizeHash h ~ SECP256K1_ECDSA_MESSAGE_BYTES) =>
Proxy h -> TestName -> TestTree
testEcdsaWithHashAlgorithm (forall {k} (t :: k). Proxy t
Proxy @SHA256) TestName
"EcdsaSecp256k1WithSHA256"
      , forall h.
(HashAlgorithm h, SizeHash h ~ SECP256K1_ECDSA_MESSAGE_BYTES) =>
Proxy h -> TestName -> TestTree
testEcdsaWithHashAlgorithm (forall {k} (t :: k). Proxy t
Proxy @Keccak256) TestName
"EcdsaSecp256k1WithKeccak256"
#endif
      ]
    , TestName -> [TestTree] -> TestTree
testGroup TestName
"MLocked"
      [ forall v.
(UnsoundDSIGNMAlgorithm v, ToCBOR (VerKeyDSIGN v),
 FromCBOR (VerKeyDSIGN v), EqST (SignKeyDSIGNM v),
 ToCBOR (SigDSIGN v), FromCBOR (SigDSIGN v), ContextDSIGN v ~ (),
 Signable v Message, DirectSerialise (SignKeyDSIGNM v),
 DirectDeserialise (SignKeyDSIGNM v),
 DirectSerialise (VerKeyDSIGN v),
 DirectDeserialise (VerKeyDSIGN v)) =>
Lock -> Proxy v -> TestName -> TestTree
testDSIGNMAlgorithm Lock
lock (forall {k} (t :: k). Proxy t
Proxy @Ed25519DSIGN) TestName
"Ed25519DSIGN"
      ]
    ]

testDSIGNAlgorithm :: forall (v :: Type) (a :: Type).
  (DSIGNAlgorithm v,
   Signable v a,
   ContextDSIGN v ~ (),
   Show a,
   Eq (SignKeyDSIGN v),
   Eq a,
   ToCBOR (VerKeyDSIGN v),
   FromCBOR (VerKeyDSIGN v),
   ToCBOR (SignKeyDSIGN v),
   FromCBOR (SignKeyDSIGN v),
   ToCBOR (SigDSIGN v),
   FromCBOR (SigDSIGN v)) =>
  Gen (SigDSIGN v) ->
  Gen a ->
  String ->
  TestTree
testDSIGNAlgorithm :: forall v a.
(DSIGNAlgorithm v, Signable v a, ContextDSIGN v ~ (), Show a,
 Eq (SignKeyDSIGN v), Eq a, ToCBOR (VerKeyDSIGN v),
 FromCBOR (VerKeyDSIGN v), ToCBOR (SignKeyDSIGN v),
 FromCBOR (SignKeyDSIGN v), ToCBOR (SigDSIGN v),
 FromCBOR (SigDSIGN v)) =>
Gen (SigDSIGN v) -> Gen a -> TestName -> TestTree
testDSIGNAlgorithm Gen (SigDSIGN v)
genSig Gen a
genMsg TestName
name = forall v. IsOption v => (v -> v) -> TestTree -> TestTree
adjustOption QuickCheckTests -> QuickCheckTests
testEnough forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> [TestTree] -> TestTree
testGroup TestName
name forall a b. (a -> b) -> a -> b
$ [
  TestName -> [TestTree] -> TestTree
testGroup TestName
"serialization" [
    TestName -> [TestTree] -> TestTree
testGroup TestName
"raw" [
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey serialization" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (VerKeyDSIGN a)
defaultVerKeyGen @v)
                   forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$
                   forall a.
(Eq a, Show a) =>
(a -> ByteString) -> (ByteString -> Maybe a) -> a -> Property
prop_raw_serialise forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
rawDeserialiseVerKeyDSIGN,
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey deserialization (wrong length)" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall prop a.
Testable prop =>
Gen a -> (a -> [a]) -> (a -> TestName) -> (a -> prop) -> Property
forAllShrinkShow (forall a. Int -> Gen (BadInputFor a)
genBadInputFor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. ExpectedLengths v -> Int
expectedVKLen forall a b. (a -> b) -> a -> b
$ ExpectedLengths v
expected)
                         (forall a. BadInputFor a -> [BadInputFor a]
shrinkBadInputFor @(VerKeyDSIGN v))
                         forall a. BadInputFor a -> TestName
showBadInputFor forall a b. (a -> b) -> a -> b
$
                         forall a.
Show a =>
(ByteString -> Maybe a) -> BadInputFor a -> Property
prop_raw_deserialise forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
rawDeserialiseVerKeyDSIGN,
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey serialization" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen @v)
                   forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$
                   forall a.
(Eq a, Show a) =>
(a -> ByteString) -> (ByteString -> Maybe a) -> a -> Property
prop_raw_serialise forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> ByteString
rawSerialiseSignKeyDSIGN forall v. DSIGNAlgorithm v => ByteString -> Maybe (SignKeyDSIGN v)
rawDeserialiseSignKeyDSIGN,
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey deserialization (wrong length)" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall prop a.
Testable prop =>
Gen a -> (a -> [a]) -> (a -> TestName) -> (a -> prop) -> Property
forAllShrinkShow (forall a. Int -> Gen (BadInputFor a)
genBadInputFor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. ExpectedLengths v -> Int
expectedSKLen forall a b. (a -> b) -> a -> b
$ ExpectedLengths v
expected)
                         (forall a. BadInputFor a -> [BadInputFor a]
shrinkBadInputFor @(SignKeyDSIGN v))
                         forall a. BadInputFor a -> TestName
showBadInputFor forall a b. (a -> b) -> a -> b
$
                         forall a.
Show a =>
(ByteString -> Maybe a) -> BadInputFor a -> Property
prop_raw_deserialise forall v. DSIGNAlgorithm v => ByteString -> Maybe (SignKeyDSIGN v)
rawDeserialiseSignKeyDSIGN,
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig serialization" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow Gen (SigDSIGN v)
genSig
                   forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$
                   forall a.
(Eq a, Show a) =>
(a -> ByteString) -> (ByteString -> Maybe a) -> a -> Property
prop_raw_serialise forall v. DSIGNAlgorithm v => SigDSIGN v -> ByteString
rawSerialiseSigDSIGN forall v. DSIGNAlgorithm v => ByteString -> Maybe (SigDSIGN v)
rawDeserialiseSigDSIGN,
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig deserialization (wrong length)" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall prop a.
Testable prop =>
Gen a -> (a -> [a]) -> (a -> TestName) -> (a -> prop) -> Property
forAllShrinkShow (forall a. Int -> Gen (BadInputFor a)
genBadInputFor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. ExpectedLengths v -> Int
expectedSigLen forall a b. (a -> b) -> a -> b
$ ExpectedLengths v
expected)
                         (forall a. BadInputFor a -> [BadInputFor a]
shrinkBadInputFor @(SigDSIGN v))
                         forall a. BadInputFor a -> TestName
showBadInputFor forall a b. (a -> b) -> a -> b
$
                         forall a.
Show a =>
(ByteString -> Maybe a) -> BadInputFor a -> Property
prop_raw_deserialise forall v. DSIGNAlgorithm v => ByteString -> Maybe (SigDSIGN v)
rawDeserialiseSigDSIGN
      ],
    TestName -> [TestTree] -> TestTree
testGroup TestName
"size" [
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (VerKeyDSIGN a)
defaultVerKeyGen @v)
                   forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$
                   forall a. (a -> ByteString) -> Word -> a -> Property
prop_size_serialise forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN (forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN (forall {k} (t :: k). Proxy t
Proxy @v)),
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen @v)
                   forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$
                   forall a. (a -> ByteString) -> Word -> a -> Property
prop_size_serialise forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> ByteString
rawSerialiseSignKeyDSIGN (forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSignKeyDSIGN (forall {k} (t :: k). Proxy t
Proxy @v)),
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow Gen (SigDSIGN v)
genSig
                   forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$
                   forall a. (a -> ByteString) -> Word -> a -> Property
prop_size_serialise forall v. DSIGNAlgorithm v => SigDSIGN v -> ByteString
rawSerialiseSigDSIGN (forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSigDSIGN (forall {k} (t :: k). Proxy t
Proxy @v))
      ],
    TestName -> [TestTree] -> TestTree
testGroup TestName
"direct CBOR" [
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (VerKeyDSIGN a)
defaultVerKeyGen @v)
                   forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$
                   forall a.
(Eq a, Show a) =>
(a -> Encoding) -> (forall s. Decoder s a) -> a -> Property
prop_cbor_with forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> Encoding
encodeVerKeyDSIGN forall v s. DSIGNAlgorithm v => Decoder s (VerKeyDSIGN v)
decodeVerKeyDSIGN,
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen @v)
                   forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$
                   forall a.
(Eq a, Show a) =>
(a -> Encoding) -> (forall s. Decoder s a) -> a -> Property
prop_cbor_with forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> Encoding
encodeSignKeyDSIGN forall v s. DSIGNAlgorithm v => Decoder s (SignKeyDSIGN v)
decodeSignKeyDSIGN,
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow Gen (SigDSIGN v)
genSig
                   forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$
                   forall a.
(Eq a, Show a) =>
(a -> Encoding) -> (forall s. Decoder s a) -> a -> Property
prop_cbor_with forall v. DSIGNAlgorithm v => SigDSIGN v -> Encoding
encodeSigDSIGN forall v s. DSIGNAlgorithm v => Decoder s (SigDSIGN v)
decodeSigDSIGN
      ],
    TestName -> [TestTree] -> TestTree
testGroup TestName
"To/FromCBOR class" [
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (VerKeyDSIGN a)
defaultVerKeyGen @v) forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$ forall a. (ToCBOR a, FromCBOR a, Eq a, Show a) => a -> Property
prop_cbor,
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen @v) forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$ forall a. (ToCBOR a, FromCBOR a, Eq a, Show a) => a -> Property
prop_cbor,
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow Gen (SigDSIGN v)
genSig forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$ forall a. (ToCBOR a, FromCBOR a, Eq a, Show a) => a -> Property
prop_cbor
      ],
    TestName -> [TestTree] -> TestTree
testGroup TestName
"ToCBOR size" [
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (VerKeyDSIGN a)
defaultVerKeyGen @v) forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$ forall a. ToCBOR a => a -> Property
prop_cbor_size,
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen @v) forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$ forall a. ToCBOR a => a -> Property
prop_cbor_size,
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow Gen (SigDSIGN v)
genSig forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$ forall a. ToCBOR a => a -> Property
prop_cbor_size
      ],
    TestName -> [TestTree] -> TestTree
testGroup TestName
"direct matches class" [
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (VerKeyDSIGN a)
defaultVerKeyGen @v) forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$
        forall a. ToCBOR a => (a -> Encoding) -> a -> Property
prop_cbor_direct_vs_class forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> Encoding
encodeVerKeyDSIGN,
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen @v) forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$
        forall a. ToCBOR a => (a -> Encoding) -> a -> Property
prop_cbor_direct_vs_class forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> Encoding
encodeSignKeyDSIGN,
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow Gen (SigDSIGN v)
genSig forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$
        forall a. ToCBOR a => (a -> Encoding) -> a -> Property
prop_cbor_direct_vs_class forall v. DSIGNAlgorithm v => SigDSIGN v -> Encoding
encodeSigDSIGN
      ]
    ],
    TestName -> [TestTree] -> TestTree
testGroup TestName
"verify" [
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"signing and verifying with matching keys" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
genMsg forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen @v) forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$
        forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a) =>
(a, SignKeyDSIGN v) -> Property
prop_dsign_verify,
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"verifying with wrong key" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow Gen (a, SignKeyDSIGN v, SignKeyDSIGN v)
genWrongKey forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$
        forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a) =>
(a, SignKeyDSIGN v, SignKeyDSIGN v) -> Property
prop_dsign_verify_wrong_key,
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"verifying wrong message" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow Gen (a, a, SignKeyDSIGN v)
genWrongMsg forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$
        forall v a.
(DSIGNAlgorithm v, Signable v a, ContextDSIGN v ~ ()) =>
(a, a, SignKeyDSIGN v) -> Property
prop_dsign_verify_wrong_msg
    ],
    TestName -> [TestTree] -> TestTree
testGroup TestName
"NoThunks" [
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (VerKeyDSIGN a)
defaultVerKeyGen @v) forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$ forall a. NoThunks a => a -> Property
prop_no_thunks,
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen @v) forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$ forall a. NoThunks a => a -> Property
prop_no_thunks,
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow Gen (SigDSIGN v)
genSig forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$ forall a. NoThunks a => a -> Property
prop_no_thunks,
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey rawSerialise" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (VerKeyDSIGN a)
defaultVerKeyGen @v) forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$ \VerKeyDSIGN v
vk ->
        forall a. NoThunks a => a -> Property
prop_no_thunks (forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN VerKeyDSIGN v
vk),
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey rawDeserialise" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (VerKeyDSIGN a)
defaultVerKeyGen @v) forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$ \VerKeyDSIGN v
vk ->
        forall a. NoThunks a => a -> Property
prop_no_thunks (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$! forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
rawDeserialiseVerKeyDSIGN @v forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN forall a b. (a -> b) -> a -> b
$ VerKeyDSIGN v
vk)
    ]
  ]
  where
    expected :: ExpectedLengths v
    expected :: ExpectedLengths v
expected = forall v. DSIGNAlgorithm v => ExpectedLengths v
defaultExpected
    genWrongKey :: Gen (a, SignKeyDSIGN v, SignKeyDSIGN v)
    genWrongKey :: Gen (a, SignKeyDSIGN v, SignKeyDSIGN v)
genWrongKey = do
      SignKeyDSIGN v
sk1 <- forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen
      SignKeyDSIGN v
sk2 <- forall a. Gen a -> (a -> Bool) -> Gen a
Gen.suchThat forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen (forall a. Eq a => a -> a -> Bool
/= SignKeyDSIGN v
sk1)
      a
msg <- Gen a
genMsg
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
msg, SignKeyDSIGN v
sk1, SignKeyDSIGN v
sk2)
    genWrongMsg :: Gen (a, a, SignKeyDSIGN v)
    genWrongMsg :: Gen (a, a, SignKeyDSIGN v)
genWrongMsg = do
      a
msg1 <- Gen a
genMsg
      a
msg2 <- forall a. Gen a -> (a -> Bool) -> Gen a
Gen.suchThat Gen a
genMsg (forall a. Eq a => a -> a -> Bool
/= a
msg1)
      SignKeyDSIGN v
sk <- forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
msg1, a
msg2, SignKeyDSIGN v
sk)
    testEnough :: QuickCheckTests -> QuickCheckTests
    testEnough :: QuickCheckTests -> QuickCheckTests
testEnough = forall a. Ord a => a -> a -> a
max QuickCheckTests
10_000

testDSIGNMAlgorithm
  :: forall v. ( -- change back to DSIGNMAlgorithm when unsound API is phased out
                 UnsoundDSIGNMAlgorithm v
               , ToCBOR (VerKeyDSIGN v)
               , FromCBOR (VerKeyDSIGN v)
               -- DSIGNM cannot satisfy To/FromCBOR (not even with
               -- UnsoundDSIGNMAlgorithm), because those typeclasses assume
               -- that a non-monadic encoding/decoding exists. Hence, we only
               -- test direct encoding/decoding for 'SignKeyDSIGNM'.
               -- , ToCBOR (SignKeyDSIGNM v)
               -- , FromCBOR (SignKeyDSIGNM v)
               , EqST (SignKeyDSIGNM v)   -- only monadic EqST for signing keys
               , ToCBOR (SigDSIGN v)
               , FromCBOR (SigDSIGN v)
               , ContextDSIGN v ~ ()
               , Signable v Message
               , DirectSerialise (SignKeyDSIGNM v)
               , DirectDeserialise (SignKeyDSIGNM v)
               , DirectSerialise (VerKeyDSIGN v)
               , DirectDeserialise (VerKeyDSIGN v)
               )
  => Lock
  -> Proxy v
  -> String
  -> TestTree
testDSIGNMAlgorithm :: forall v.
(UnsoundDSIGNMAlgorithm v, ToCBOR (VerKeyDSIGN v),
 FromCBOR (VerKeyDSIGN v), EqST (SignKeyDSIGNM v),
 ToCBOR (SigDSIGN v), FromCBOR (SigDSIGN v), ContextDSIGN v ~ (),
 Signable v Message, DirectSerialise (SignKeyDSIGNM v),
 DirectDeserialise (SignKeyDSIGNM v),
 DirectSerialise (VerKeyDSIGN v),
 DirectDeserialise (VerKeyDSIGN v)) =>
Lock -> Proxy v -> TestName -> TestTree
testDSIGNMAlgorithm Lock
lock Proxy v
_ TestName
n =
  TestName -> [TestTree] -> TestTree
testGroup TestName
n
    [ TestName -> [TestTree] -> TestTree
testGroup TestName
"serialisation"
      [ TestName -> [TestTree] -> TestTree
testGroup TestName
"raw"
        [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" forall a b. (a -> b) -> a -> b
$
            forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              VerKeyDSIGN v
vk <- forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM SignKeyDSIGNM v
sk
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
rawDeserialiseVerKeyDSIGN forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN forall a b. (a -> b) -> a -> b
$ VerKeyDSIGN v
vk) forall a. (Eq a, Show a) => a -> a -> Property
=== forall a. a -> Maybe a
Just VerKeyDSIGN v
vk
        , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" forall a b. (a -> b) -> a -> b
$
            forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              ByteString
serialized <- forall v (m :: * -> *).
(UnsoundDSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyDSIGNM v -> m ByteString
rawSerialiseSignKeyDSIGNM SignKeyDSIGNM v
sk
              forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
                (forall v (m :: * -> *).
(UnsoundDSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
ByteString -> m (Maybe (SignKeyDSIGNM v))
rawDeserialiseSignKeyDSIGNM ByteString
serialized)
                (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyDSIGNM v -> m ()
forgetSignKeyDSIGNM)
                (\Maybe (SignKeyDSIGNM v)
msk' -> forall a. a -> Maybe a
Just SignKeyDSIGNM v
sk forall (m :: * -> *) a. (MonadST m, EqST a) => a -> a -> m Bool
==! Maybe (SignKeyDSIGNM v)
msk')
        , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig" forall a b. (a -> b) -> a -> b
$ \(Message
msg :: Message) ->
            forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              SigDSIGN v
sig <- forall v a (m :: * -> *).
(DSIGNMAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
signDSIGNM () Message
msg SignKeyDSIGNM v
sk
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall v. DSIGNAlgorithm v => ByteString -> Maybe (SigDSIGN v)
rawDeserialiseSigDSIGN forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. DSIGNAlgorithm v => SigDSIGN v -> ByteString
rawSerialiseSigDSIGN forall a b. (a -> b) -> a -> b
$ SigDSIGN v
sig) forall a. (Eq a, Show a) => a -> a -> Property
=== forall a. a -> Maybe a
Just SigDSIGN v
sig
        ]
      , TestName -> [TestTree] -> TestTree
testGroup TestName
"size"
        [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" forall a b. (a -> b) -> a -> b
$
            forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              VerKeyDSIGN v
vk <- forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM SignKeyDSIGNM v
sk
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN forall a b. (a -> b) -> a -> b
$ VerKeyDSIGN v
vk) forall a. (Eq a, Show a) => a -> a -> Property
=== forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN (forall {k} (t :: k). Proxy t
Proxy @v)
        , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" forall a b. (a -> b) -> a -> b
$
            forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              ByteString
serialized <- forall v (m :: * -> *).
(UnsoundDSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyDSIGNM v -> m ByteString
rawSerialiseSignKeyDSIGNM SignKeyDSIGNM v
sk
              forall a. a -> IO a
evaluate ((forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length forall a b. (a -> b) -> a -> b
$ ByteString
serialized) forall a. Eq a => a -> a -> Bool
== forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSignKeyDSIGN (forall {k} (t :: k). Proxy t
Proxy @v))
        , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig" forall a b. (a -> b) -> a -> b
$ \(Message
msg :: Message) ->
            forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              SigDSIGN v
sig :: SigDSIGN v <- forall v a (m :: * -> *).
(DSIGNMAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
signDSIGNM () Message
msg SignKeyDSIGNM v
sk
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. DSIGNAlgorithm v => SigDSIGN v -> ByteString
rawSerialiseSigDSIGN forall a b. (a -> b) -> a -> b
$ SigDSIGN v
sig) forall a. (Eq a, Show a) => a -> a -> Property
=== forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSigDSIGN (forall {k} (t :: k). Proxy t
Proxy @v)
        ]

      , TestName -> [TestTree] -> TestTree
testGroup TestName
"direct CBOR"
        [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" forall a b. (a -> b) -> a -> b
$
            forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              VerKeyDSIGN v
vk :: VerKeyDSIGN v <- forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM SignKeyDSIGNM v
sk
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(Eq a, Show a) =>
(a -> Encoding) -> (forall s. Decoder s a) -> a -> Property
prop_cbor_with forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> Encoding
encodeVerKeyDSIGN forall v s. DSIGNAlgorithm v => Decoder s (VerKeyDSIGN v)
decodeVerKeyDSIGN VerKeyDSIGN v
vk
        -- No CBOR testing for SignKey: sign keys are stored in MLocked memory
        -- and require IO for access.
        , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig" forall a b. (a -> b) -> a -> b
$ \(Message
msg :: Message) -> do
            forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              SigDSIGN v
sig :: SigDSIGN v <- forall v a (m :: * -> *).
(DSIGNMAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
signDSIGNM () Message
msg SignKeyDSIGNM v
sk
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(Eq a, Show a) =>
(a -> Encoding) -> (forall s. Decoder s a) -> a -> Property
prop_cbor_with forall v. DSIGNAlgorithm v => SigDSIGN v -> Encoding
encodeSigDSIGN forall v s. DSIGNAlgorithm v => Decoder s (SigDSIGN v)
decodeSigDSIGN SigDSIGN v
sig
        ]

      , TestName -> [TestTree] -> TestTree
testGroup TestName
"To/FromCBOR class"
        [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey"  forall a b. (a -> b) -> a -> b
$
            forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              VerKeyDSIGN v
vk :: VerKeyDSIGN v <- forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM SignKeyDSIGNM v
sk
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (ToCBOR a, FromCBOR a, Eq a, Show a) => a -> Property
prop_cbor VerKeyDSIGN v
vk
        -- No To/FromCBOR for 'SignKeyDSIGNM', see above.
        , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig" forall a b. (a -> b) -> a -> b
$ \(Message
msg :: Message) ->
            forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              SigDSIGN v
sig :: SigDSIGN v <- forall v a (m :: * -> *).
(DSIGNMAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
signDSIGNM () Message
msg SignKeyDSIGNM v
sk
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (ToCBOR a, FromCBOR a, Eq a, Show a) => a -> Property
prop_cbor SigDSIGN v
sig
        ]

      , TestName -> [TestTree] -> TestTree
testGroup TestName
"ToCBOR size"
        [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey"  forall a b. (a -> b) -> a -> b
$
            forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              VerKeyDSIGN v
vk :: VerKeyDSIGN v <- forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM SignKeyDSIGNM v
sk
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ToCBOR a => a -> Property
prop_cbor_size VerKeyDSIGN v
vk
        -- No To/FromCBOR for 'SignKeyDSIGNM', see above.
        , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig" forall a b. (a -> b) -> a -> b
$ \(Message
msg :: Message) ->
            forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              SigDSIGN v
sig :: SigDSIGN v <- forall v a (m :: * -> *).
(DSIGNMAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
signDSIGNM () Message
msg SignKeyDSIGNM v
sk
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ToCBOR a => a -> Property
prop_cbor_size SigDSIGN v
sig
        ]

      , TestName -> [TestTree] -> TestTree
testGroup TestName
"direct matches class"
        [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" forall a b. (a -> b) -> a -> b
$
            forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              VerKeyDSIGN v
vk :: VerKeyDSIGN v <- forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM SignKeyDSIGNM v
sk
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ToCBOR a => (a -> Encoding) -> a -> Property
prop_cbor_direct_vs_class forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> Encoding
encodeVerKeyDSIGN VerKeyDSIGN v
vk
        -- No CBOR testing for SignKey: sign keys are stored in MLocked memory
        -- and require IO for access.
        , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig" forall a b. (a -> b) -> a -> b
$ \(Message
msg :: Message) ->
            forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              SigDSIGN v
sig :: SigDSIGN v <- forall v a (m :: * -> *).
(DSIGNMAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
signDSIGNM () Message
msg SignKeyDSIGNM v
sk
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ToCBOR a => (a -> Encoding) -> a -> Property
prop_cbor_direct_vs_class forall v. DSIGNAlgorithm v => SigDSIGN v -> Encoding
encodeSigDSIGN SigDSIGN v
sig
        ]
      , TestName -> [TestTree] -> TestTree
testGroup TestName
"DirectSerialise"
        [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" forall a b. (a -> b) -> a -> b
$
            forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              VerKeyDSIGN v
vk :: VerKeyDSIGN v <- forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM SignKeyDSIGNM v
sk
              ByteString
serialized <- forall (m :: * -> *) a.
(DirectSerialise a, MonadST m, MonadThrow m) =>
Int -> a -> m ByteString
directSerialiseToBS (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN (forall {k} (t :: k). Proxy t
Proxy @v)) VerKeyDSIGN v
vk
              VerKeyDSIGN v
vk' <- forall (m :: * -> *) a.
(DirectDeserialise a, MonadST m, MonadThrow m) =>
ByteString -> m a
directDeserialiseFromBS ByteString
serialized
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ VerKeyDSIGN v
vk forall a. (Eq a, Show a) => a -> a -> Property
=== VerKeyDSIGN v
vk'
        , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" forall a b. (a -> b) -> a -> b
$
            forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              ByteString
serialized <- forall (m :: * -> *) a.
(DirectSerialise a, MonadST m, MonadThrow m) =>
Int -> a -> m ByteString
directSerialiseToBS (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSignKeyDSIGN (forall {k} (t :: k). Proxy t
Proxy @v)) SignKeyDSIGNM v
sk
              SignKeyDSIGNM v
sk' <- forall (m :: * -> *) a.
(DirectDeserialise a, MonadST m, MonadThrow m) =>
ByteString -> m a
directDeserialiseFromBS ByteString
serialized
              Bool
equals <- SignKeyDSIGNM v
sk forall (m :: * -> *) a. (MonadST m, EqST a) => a -> a -> m Bool
==! SignKeyDSIGNM v
sk'
              forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyDSIGNM v -> m ()
forgetSignKeyDSIGNM SignKeyDSIGNM v
sk'
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"Serialized: " forall a. [a] -> [a] -> [a]
++ ByteString -> TestName
hexBS ByteString
serialized forall a. [a] -> [a] -> [a]
++ TestName
" (length: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show (ByteString -> Int
BS.length ByteString
serialized) forall a. [a] -> [a] -> [a]
++ TestName
")") forall a b. (a -> b) -> a -> b
$
                Bool
equals
        ]
      , TestName -> [TestTree] -> TestTree
testGroup TestName
"DirectSerialise matches raw"
        [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" forall a b. (a -> b) -> a -> b
$
            forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              VerKeyDSIGN v
vk :: VerKeyDSIGN v <- forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM SignKeyDSIGNM v
sk
              ByteString
direct <- forall (m :: * -> *) a.
(DirectSerialise a, MonadST m, MonadThrow m) =>
Int -> a -> m ByteString
directSerialiseToBS (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN (forall {k} (t :: k). Proxy t
Proxy @v)) VerKeyDSIGN v
vk
              let raw :: ByteString
raw = forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN VerKeyDSIGN v
vk
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString
direct forall a. (Eq a, Show a) => a -> a -> Property
=== ByteString
raw
        , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" forall a b. (a -> b) -> a -> b
$
            forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              ByteString
direct <- forall (m :: * -> *) a.
(DirectSerialise a, MonadST m, MonadThrow m) =>
Int -> a -> m ByteString
directSerialiseToBS (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSignKeyDSIGN (forall {k} (t :: k). Proxy t
Proxy @v)) SignKeyDSIGNM v
sk
              ByteString
raw <- forall v (m :: * -> *).
(UnsoundDSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyDSIGNM v -> m ByteString
rawSerialiseSignKeyDSIGNM SignKeyDSIGNM v
sk
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString
direct forall a. (Eq a, Show a) => a -> a -> Property
=== ByteString
raw
        ]
      ]

    , TestName -> [TestTree] -> TestTree
testGroup TestName
"verify"
      [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"verify positive" forall a b. (a -> b) -> a -> b
$
          forall v.
(DSIGNMAlgorithm v, ContextDSIGN v ~ (), Signable v Message) =>
Lock
-> Proxy v
-> Message
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
prop_dsignm_verify_pos Lock
lock (forall {k} (t :: k). Proxy t
Proxy @v)
      , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"verify negative (wrong key)" forall a b. (a -> b) -> a -> b
$
          forall v.
(DSIGNMAlgorithm v, ContextDSIGN v ~ (), Signable v Message) =>
Lock
-> Proxy v
-> Message
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
prop_dsignm_verify_neg_key Lock
lock (forall {k} (t :: k). Proxy t
Proxy @v)
      , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"verify negative (wrong message)" forall a b. (a -> b) -> a -> b
$
          forall v.
(DSIGNMAlgorithm v, ContextDSIGN v ~ (), Signable v Message) =>
Lock
-> Proxy v
-> Message
-> Message
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
prop_dsignm_verify_neg_msg Lock
lock (forall {k} (t :: k). Proxy t
Proxy @v)
      ]

    , TestName -> [TestTree] -> TestTree
testGroup TestName
"seed extraction"
      [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"extracted seed equals original seed" forall a b. (a -> b) -> a -> b
$ forall v.
DSIGNMAlgorithm v =>
Proxy v -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property
prop_dsignm_seed_roundtrip (forall {k} (t :: k). Proxy t
Proxy @v)
      ]

    , TestName -> [TestTree] -> TestTree
testGroup TestName
"forgetting"
      [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"key overwritten after forget" forall a b. (a -> b) -> a -> b
$ forall v.
DSIGNMAlgorithm v =>
Proxy v -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property
prop_key_overwritten_after_forget (forall {k} (t :: k). Proxy t
Proxy @v)
      ]

    , TestName -> [TestTree] -> TestTree
testGroup TestName
"NoThunks"
      [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" forall a b. (a -> b) -> a -> b
$
          forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> forall a. NoThunks a => IO a -> IO Property
prop_no_thunks_IO (forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM SignKeyDSIGNM v
sk)
      , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" forall a b. (a -> b) -> a -> b
$
          forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ forall a. NoThunks a => IO a -> IO Property
prop_no_thunks_IO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
      , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig"     forall a b. (a -> b) -> a -> b
$ \(Message
msg :: Message) ->
          forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ forall a. NoThunks a => IO a -> IO Property
prop_no_thunks_IO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v a (m :: * -> *).
(DSIGNMAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
signDSIGNM () Message
msg
      , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey DirectSerialise" forall a b. (a -> b) -> a -> b
$
          forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
            ByteString
direct <- forall (m :: * -> *) a.
(DirectSerialise a, MonadST m, MonadThrow m) =>
Int -> a -> m ByteString
directSerialiseToBS (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSignKeyDSIGN (forall {k} (t :: k). Proxy t
Proxy @v)) SignKeyDSIGNM v
sk
            forall a. NoThunks a => IO a -> IO Property
prop_no_thunks_IO (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ByteString
direct)
      , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey DirectDeserialise" forall a b. (a -> b) -> a -> b
$
          forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
            ByteString
direct <- forall (m :: * -> *) a.
(DirectSerialise a, MonadST m, MonadThrow m) =>
Int -> a -> m ByteString
directSerialiseToBS (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSignKeyDSIGN (forall {k} (t :: k). Proxy t
Proxy @v)) SignKeyDSIGNM v
sk
            forall a. NoThunks a => IO a -> IO Property
prop_no_thunks_IO (forall (m :: * -> *) a.
(DirectDeserialise a, MonadST m, MonadThrow m) =>
ByteString -> m a
directDeserialiseFromBS @IO @(SignKeyDSIGNM v) forall a b. (a -> b) -> a -> b
$! ByteString
direct)
      , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey DirectSerialise" forall a b. (a -> b) -> a -> b
$
          forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
            VerKeyDSIGN v
vk <- forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM SignKeyDSIGNM v
sk
            ByteString
direct <- forall (m :: * -> *) a.
(DirectSerialise a, MonadST m, MonadThrow m) =>
Int -> a -> m ByteString
directSerialiseToBS (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN (forall {k} (t :: k). Proxy t
Proxy @v)) VerKeyDSIGN v
vk
            forall a. NoThunks a => IO a -> IO Property
prop_no_thunks_IO (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ByteString
direct)
      , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey DirectDeserialise" forall a b. (a -> b) -> a -> b
$
          forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
            VerKeyDSIGN v
vk <- forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM SignKeyDSIGNM v
sk
            ByteString
direct <- forall (m :: * -> *) a.
(DirectSerialise a, MonadST m, MonadThrow m) =>
Int -> a -> m ByteString
directSerialiseToBS (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN (forall {k} (t :: k). Proxy t
Proxy @v)) VerKeyDSIGN v
vk
            forall a. NoThunks a => IO a -> IO Property
prop_no_thunks_IO (forall (m :: * -> *) a.
(DirectDeserialise a, MonadST m, MonadThrow m) =>
ByteString -> m a
directDeserialiseFromBS @IO @(VerKeyDSIGN v) forall a b. (a -> b) -> a -> b
$! ByteString
direct)
      ]
    ]

-- | Wrap an IO action that requires a 'SignKeyDSIGNM' into one that takes an
-- mlocked seed to generate the key from. The key is bracketed off to ensure
-- timely forgetting. Special care must be taken to not leak the key outside of
-- the wrapped action (be particularly mindful of thunks and unsafe key access
-- here).
withSK :: (DSIGNMAlgorithm v) => PinnedSizedBytes (SeedSizeDSIGN v) -> (SignKeyDSIGNM v -> IO b) -> IO b
withSK :: forall v b.
DSIGNMAlgorithm v =>
PinnedSizedBytes (SeedSizeDSIGN v)
-> (SignKeyDSIGNM v -> IO b) -> IO b
withSK PinnedSizedBytes (SeedSizeDSIGN v)
seedPSB SignKeyDSIGNM v -> IO b
action =
  forall (m :: * -> *) (n :: Nat) a.
(MonadST m, MonadThrow m, KnownNat n) =>
PinnedSizedBytes n -> (MLockedSeed n -> m a) -> m a
withMLockedSeedFromPSB PinnedSizedBytes (SeedSizeDSIGN v)
seedPSB forall a b. (a -> b) -> a -> b
$ \MLockedSeed (SeedSizeDSIGN v)
seed ->
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
      (forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
MLockedSeed (SeedSizeDSIGN v) -> m (SignKeyDSIGNM v)
genKeyDSIGNM MLockedSeed (SeedSizeDSIGN v)
seed)
      forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyDSIGNM v -> m ()
forgetSignKeyDSIGNM
      SignKeyDSIGNM v -> IO b
action

-- | Wrap an IO action that requires a 'SignKeyDSIGNM' into a 'Property' that
-- takes a non-mlocked seed (provided as a 'PinnedSizedBytes' of the
-- appropriate size). The key, and the mlocked seed necessary to generate it,
-- are bracketed off, to ensure timely forgetting and avoid leaking mlocked
-- memory. Special care must be taken to not leak the key outside of the
-- wrapped action (be particularly mindful of thunks and unsafe key access
-- here).
ioPropertyWithSK :: forall v a. (Testable a, DSIGNMAlgorithm v)
                 => Lock
                 -> (SignKeyDSIGNM v -> IO a)
                 -> PinnedSizedBytes (SeedSizeDSIGN v)
                 -> Property
ioPropertyWithSK :: forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK Lock
lock SignKeyDSIGNM v -> IO a
action PinnedSizedBytes (SeedSizeDSIGN v)
seedPSB =
  forall prop. Testable prop => IO prop -> Property
ioProperty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lock -> IO a -> IO a
withLock Lock
lock forall a b. (a -> b) -> a -> b
$ forall v b.
DSIGNMAlgorithm v =>
PinnedSizedBytes (SeedSizeDSIGN v)
-> (SignKeyDSIGNM v -> IO b) -> IO b
withSK PinnedSizedBytes (SeedSizeDSIGN v)
seedPSB SignKeyDSIGNM v -> IO a
action

prop_key_overwritten_after_forget
  :: forall v.
     (DSIGNMAlgorithm v
     )
  => Proxy v
  -> PinnedSizedBytes (SeedSizeDSIGN v)
  -> Property
prop_key_overwritten_after_forget :: forall v.
DSIGNMAlgorithm v =>
Proxy v -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property
prop_key_overwritten_after_forget Proxy v
p PinnedSizedBytes (SeedSizeDSIGN v)
seedPSB =
  forall prop. Testable prop => IO prop -> Property
ioProperty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (n :: Nat) a.
(MonadST m, MonadThrow m, KnownNat n) =>
PinnedSizedBytes n -> (MLockedSeed n -> m a) -> m a
withMLockedSeedFromPSB PinnedSizedBytes (SeedSizeDSIGN v)
seedPSB forall a b. (a -> b) -> a -> b
$ \MLockedSeed (SeedSizeDSIGN v)
seed -> do
    SignKeyDSIGNM v
sk <- forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
MLockedSeed (SeedSizeDSIGN v) -> m (SignKeyDSIGNM v)
genKeyDSIGNM MLockedSeed (SeedSizeDSIGN v)
seed
    forall (m :: * -> *) (n :: Nat). MonadST m => MLockedSeed n -> m ()
mlockedSeedFinalize MLockedSeed (SeedSizeDSIGN v)
seed

    MLockedSeed (SeedSizeDSIGN v)
seedBefore <- forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
Proxy v -> SignKeyDSIGNM v -> m (MLockedSeed (SeedSizeDSIGN v))
getSeedDSIGNM Proxy v
p SignKeyDSIGNM v
sk
    ByteString
bsBefore <- forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
MLockedSizedBytes n -> m ByteString
mlsbToByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat). MLockedSeed n -> MLockedSizedBytes n
mlockedSeedMLSB forall a b. (a -> b) -> a -> b
$ MLockedSeed (SeedSizeDSIGN v)
seedBefore
    forall (m :: * -> *) (n :: Nat). MonadST m => MLockedSeed n -> m ()
mlockedSeedFinalize MLockedSeed (SeedSizeDSIGN v)
seedBefore

    forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyDSIGNM v -> m ()
forgetSignKeyDSIGNM SignKeyDSIGNM v
sk

    MLockedSeed (SeedSizeDSIGN v)
seedAfter <- forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
Proxy v -> SignKeyDSIGNM v -> m (MLockedSeed (SeedSizeDSIGN v))
getSeedDSIGNM Proxy v
p SignKeyDSIGNM v
sk
    ByteString
bsAfter <- forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
MLockedSizedBytes n -> m ByteString
mlsbToByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat). MLockedSeed n -> MLockedSizedBytes n
mlockedSeedMLSB forall a b. (a -> b) -> a -> b
$ MLockedSeed (SeedSizeDSIGN v)
seedAfter
    forall (m :: * -> *) (n :: Nat). MonadST m => MLockedSeed n -> m ()
mlockedSeedFinalize MLockedSeed (SeedSizeDSIGN v)
seedAfter

    forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bsBefore forall a. (Eq a, Show a) => a -> a -> Property
=/= ByteString
bsAfter)

prop_dsignm_seed_roundtrip
  :: forall v.
     ( DSIGNMAlgorithm v
     )
  => Proxy v
  -> PinnedSizedBytes (SeedSizeDSIGN v)
  -> Property
prop_dsignm_seed_roundtrip :: forall v.
DSIGNMAlgorithm v =>
Proxy v -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property
prop_dsignm_seed_roundtrip Proxy v
p PinnedSizedBytes (SeedSizeDSIGN v)
seedPSB = forall prop. Testable prop => IO prop -> Property
ioProperty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (n :: Nat) a.
(MonadST m, MonadThrow m, KnownNat n) =>
PinnedSizedBytes n -> (MLockedSeed n -> m a) -> m a
withMLockedSeedFromPSB PinnedSizedBytes (SeedSizeDSIGN v)
seedPSB forall a b. (a -> b) -> a -> b
$ \MLockedSeed (SeedSizeDSIGN v)
seed -> do
  SignKeyDSIGNM v
sk <- forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
MLockedSeed (SeedSizeDSIGN v) -> m (SignKeyDSIGNM v)
genKeyDSIGNM MLockedSeed (SeedSizeDSIGN v)
seed
  MLockedSeed (SeedSizeDSIGN v)
seed' <- forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
Proxy v -> SignKeyDSIGNM v -> m (MLockedSeed (SeedSizeDSIGN v))
getSeedDSIGNM Proxy v
p SignKeyDSIGNM v
sk
  ByteString
bs <- forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
MLockedSizedBytes n -> m ByteString
mlsbToByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat). MLockedSeed n -> MLockedSizedBytes n
mlockedSeedMLSB forall a b. (a -> b) -> a -> b
$ MLockedSeed (SeedSizeDSIGN v)
seed
  ByteString
bs' <- forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
MLockedSizedBytes n -> m ByteString
mlsbToByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat). MLockedSeed n -> MLockedSizedBytes n
mlockedSeedMLSB forall a b. (a -> b) -> a -> b
$ MLockedSeed (SeedSizeDSIGN v)
seed'
  forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyDSIGNM v -> m ()
forgetSignKeyDSIGNM SignKeyDSIGNM v
sk
  forall (m :: * -> *) (n :: Nat). MonadST m => MLockedSeed n -> m ()
mlockedSeedFinalize MLockedSeed (SeedSizeDSIGN v)
seed'
  forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bs forall a. (Eq a, Show a) => a -> a -> Property
=== ByteString
bs')

-- If we sign a message with the key, we can verify the signature with the
-- corresponding verification key.
prop_dsign_verify
  :: forall (v :: Type) (a :: Type) .
     ( DSIGNAlgorithm v
     , ContextDSIGN v ~ ()
     , Signable v a
     )
  => (a, SignKeyDSIGN v)
  -> Property
prop_dsign_verify :: forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a) =>
(a, SignKeyDSIGN v) -> Property
prop_dsign_verify (a
msg, SignKeyDSIGN v
sk) =
  let signed :: SigDSIGN v
signed = forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
signDSIGN () a
msg SignKeyDSIGN v
sk
      vk :: VerKeyDSIGN v
vk = forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN v
sk
    in forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
verifyDSIGN () VerKeyDSIGN v
vk a
msg SigDSIGN v
signed forall a. (Eq a, Show a) => a -> a -> Property
=== forall a b. b -> Either a b
Right ()

-- If we sign a message with one key, and try to verify with another, then
-- verification fails.
prop_dsign_verify_wrong_key
  :: forall (v :: Type) (a :: Type) .
     ( DSIGNAlgorithm v
     , ContextDSIGN v ~ ()
     , Signable v a
     )
  => (a, SignKeyDSIGN v, SignKeyDSIGN v)
  -> Property
prop_dsign_verify_wrong_key :: forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a) =>
(a, SignKeyDSIGN v, SignKeyDSIGN v) -> Property
prop_dsign_verify_wrong_key (a
msg, SignKeyDSIGN v
sk, SignKeyDSIGN v
sk') =
  let signed :: SigDSIGN v
signed = forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
signDSIGN () a
msg SignKeyDSIGN v
sk
      vk' :: VerKeyDSIGN v
vk' = forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN v
sk'
    in forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
verifyDSIGN () VerKeyDSIGN v
vk' a
msg SigDSIGN v
signed forall a. (Eq a, Show a) => a -> a -> Property
=/= forall a b. b -> Either a b
Right ()

prop_dsignm_verify_pos
  :: forall v. (DSIGNMAlgorithm v, ContextDSIGN v ~ (), Signable v Message)
  => Lock
  -> Proxy v
  -> Message
  -> PinnedSizedBytes (SeedSizeDSIGN v)
  -> Property
prop_dsignm_verify_pos :: forall v.
(DSIGNMAlgorithm v, ContextDSIGN v ~ (), Signable v Message) =>
Lock
-> Proxy v
-> Message
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
prop_dsignm_verify_pos Lock
lock Proxy v
_ Message
msg =
  forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
    SigDSIGN v
sig <- forall v a (m :: * -> *).
(DSIGNMAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
signDSIGNM () Message
msg SignKeyDSIGNM v
sk
    VerKeyDSIGN v
vk <- forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM SignKeyDSIGNM v
sk
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
verifyDSIGN () VerKeyDSIGN v
vk Message
msg SigDSIGN v
sig forall a. (Eq a, Show a) => a -> a -> Property
=== forall a b. b -> Either a b
Right ()

-- | If we sign a message @a@ with one signing key, if we try to verify the
-- signature (and message @a@) using a verification key corresponding to a
-- different signing key, then the verification fails.
--
prop_dsignm_verify_neg_key
  :: forall v. (DSIGNMAlgorithm v, ContextDSIGN v ~ (), Signable v Message)
  => Lock
  -> Proxy v
  -> Message
  -> PinnedSizedBytes (SeedSizeDSIGN v)
  -> PinnedSizedBytes (SeedSizeDSIGN v)
  -> Property
prop_dsignm_verify_neg_key :: forall v.
(DSIGNMAlgorithm v, ContextDSIGN v ~ (), Signable v Message) =>
Lock
-> Proxy v
-> Message
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
prop_dsignm_verify_neg_key Lock
lock Proxy v
_ Message
msg PinnedSizedBytes (SeedSizeDSIGN v)
seedPSB PinnedSizedBytes (SeedSizeDSIGN v)
seedPSB' =
  forall prop. Testable prop => IO prop -> Property
ioProperty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lock -> IO a -> IO a
withLock Lock
lock forall a b. (a -> b) -> a -> b
$ do
    SigDSIGN v
sig <- forall v b.
DSIGNMAlgorithm v =>
PinnedSizedBytes (SeedSizeDSIGN v)
-> (SignKeyDSIGNM v -> IO b) -> IO b
withSK @v PinnedSizedBytes (SeedSizeDSIGN v)
seedPSB forall a b. (a -> b) -> a -> b
$ forall v a (m :: * -> *).
(DSIGNMAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
signDSIGNM () Message
msg
    VerKeyDSIGN v
vk' <- forall v b.
DSIGNMAlgorithm v =>
PinnedSizedBytes (SeedSizeDSIGN v)
-> (SignKeyDSIGNM v -> IO b) -> IO b
withSK @v PinnedSizedBytes (SeedSizeDSIGN v)
seedPSB' forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      PinnedSizedBytes (SeedSizeDSIGN v)
seedPSB forall a. Eq a => a -> a -> Bool
/= PinnedSizedBytes (SeedSizeDSIGN v)
seedPSB' forall prop. Testable prop => Bool -> prop -> Property
==> forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
verifyDSIGN () VerKeyDSIGN v
vk' Message
msg SigDSIGN v
sig forall a. (Eq a, Show a) => a -> a -> Property
=/= forall a b. b -> Either a b
Right ()

-- If we sign a message with a key, but then try to verify with a different
-- message, then verification fails.
prop_dsign_verify_wrong_msg
  :: forall (v :: Type) (a :: Type) .
  (DSIGNAlgorithm v, Signable v a, ContextDSIGN v ~ ())
  => (a, a, SignKeyDSIGN v)
  -> Property
prop_dsign_verify_wrong_msg :: forall v a.
(DSIGNAlgorithm v, Signable v a, ContextDSIGN v ~ ()) =>
(a, a, SignKeyDSIGN v) -> Property
prop_dsign_verify_wrong_msg (a
msg, a
msg', SignKeyDSIGN v
sk) =
  let signed :: SigDSIGN v
signed = forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
signDSIGN () a
msg SignKeyDSIGN v
sk
      vk :: VerKeyDSIGN v
vk = forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN v
sk
    in forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
verifyDSIGN () VerKeyDSIGN v
vk a
msg' SigDSIGN v
signed forall a. (Eq a, Show a) => a -> a -> Property
=/= forall a b. b -> Either a b
Right ()

data ExpectedLengths (v :: Type) =
  ExpectedLengths {
    forall v. ExpectedLengths v -> Int
expectedVKLen :: Int,
    forall v. ExpectedLengths v -> Int
expectedSKLen :: Int,
    forall v. ExpectedLengths v -> Int
expectedSigLen :: Int
    }

defaultExpected ::
  forall (v :: Type) .
  (DSIGNAlgorithm v) =>
  ExpectedLengths v
defaultExpected :: forall v. DSIGNAlgorithm v => ExpectedLengths v
defaultExpected = ExpectedLengths {
  expectedVKLen :: Int
expectedVKLen = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @v,
  expectedSKLen :: Int
expectedSKLen = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSignKeyDSIGN forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @v,
  expectedSigLen :: Int
expectedSigLen = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSigDSIGN forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @v
  }

#ifdef SECP256K1_ENABLED
testEcdsaInvalidMessageHash :: String -> TestTree
testEcdsaInvalidMessageHash :: TestName -> TestTree
testEcdsaInvalidMessageHash TestName
name = forall v. IsOption v => (v -> v) -> TestTree -> TestTree
adjustOption QuickCheckTests -> QuickCheckTests
defaultTestEnough forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> [TestTree] -> TestTree
testGroup TestName
name forall a b. (a -> b) -> a -> b
$ [
    forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"MessageHash deserialization (wrong length)" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall prop a.
Testable prop =>
Gen a -> (a -> [a]) -> (a -> TestName) -> (a -> prop) -> Property
forAllShrinkShow (forall a. Int -> Gen (BadInputFor a)
genBadInputFor Int
expectedMHLen)
                       (forall a. BadInputFor a -> [BadInputFor a]
shrinkBadInputFor @MessageHash)
                       forall a. BadInputFor a -> TestName
showBadInputFor forall a b. (a -> b) -> a -> b
$ forall a.
Show a =>
(ByteString -> Maybe a) -> BadInputFor a -> Property
prop_raw_deserialise ByteString -> Maybe MessageHash
toMessageHash
  ]
  where
    expectedMHLen :: Int
    expectedMHLen :: Int
expectedMHLen = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @SECP256K1_ECDSA_MESSAGE_BYTES

testEcdsaWithHashAlgorithm ::
  forall (h :: Type).
  (HashAlgorithm h, SizeHash h ~ SECP256K1_ECDSA_MESSAGE_BYTES) =>
  Proxy h -> String -> TestTree
testEcdsaWithHashAlgorithm :: forall h.
(HashAlgorithm h, SizeHash h ~ SECP256K1_ECDSA_MESSAGE_BYTES) =>
Proxy h -> TestName -> TestTree
testEcdsaWithHashAlgorithm Proxy h
_ TestName
name = forall v. IsOption v => (v -> v) -> TestTree -> TestTree
adjustOption QuickCheckTests -> QuickCheckTests
defaultTestEnough forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> [TestTree] -> TestTree
testGroup TestName
name forall a b. (a -> b) -> a -> b
$ [
    forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Ecdsa sign and verify" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen MessageHash
genMsg forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen @EcdsaSecp256k1DSIGN) forall a. Show a => a -> TestName
ppShow forall a b. (a -> b) -> a -> b
$
      forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a) =>
(a, SignKeyDSIGN v) -> Property
prop_dsign_verify
  ]
  where
    genMsg :: Gen MessageHash
    genMsg :: Gen MessageHash
genMsg = forall h.
(HashAlgorithm h, SizeHash h ~ SECP256K1_ECDSA_MESSAGE_BYTES) =>
Proxy h -> ByteString -> MessageHash
hashAndPack (forall {k} (t :: k). Proxy t
Proxy @h) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> ByteString
messageBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
#endif

prop_dsignm_verify_neg_msg
  :: forall v. (DSIGNMAlgorithm v, ContextDSIGN v ~ (), Signable v Message)
  => Lock
  -> Proxy v
  -> Message
  -> Message
  -> PinnedSizedBytes (SeedSizeDSIGN v)
  -> Property
prop_dsignm_verify_neg_msg :: forall v.
(DSIGNMAlgorithm v, ContextDSIGN v ~ (), Signable v Message) =>
Lock
-> Proxy v
-> Message
-> Message
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
prop_dsignm_verify_neg_msg Lock
lock Proxy v
_ Message
a Message
a' =
  forall v a.
(Testable a, DSIGNMAlgorithm v) =>
Lock
-> (SignKeyDSIGNM v -> IO a)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
ioPropertyWithSK @v Lock
lock forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
    SigDSIGN v
sig <- forall v a (m :: * -> *).
(DSIGNMAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
signDSIGNM () Message
a SignKeyDSIGNM v
sk
    VerKeyDSIGN v
vk <- forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM SignKeyDSIGNM v
sk
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      Message
a forall a. Eq a => a -> a -> Bool
/= Message
a' forall prop. Testable prop => Bool -> prop -> Property
==> forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
verifyDSIGN () VerKeyDSIGN v
vk Message
a' SigDSIGN v
sig forall a. (Eq a, Show a) => a -> a -> Property
=/= forall a b. b -> Either a b
Right ()

-- TODO: verify that DSIGN and DSIGNM implementations match (see #363)