{-# 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 = Gen (SigDSIGN MockDSIGN)
forall a.
(DSIGNAlgorithm a, ContextDSIGN a ~ (), Signable a Message) =>
Gen (SigDSIGN a)
defaultSigGen

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

ed448SigGen :: Gen (SigDSIGN Ed448DSIGN)
ed448SigGen :: Gen (SigDSIGN Ed448DSIGN)
ed448SigGen = Gen (SigDSIGN Ed448DSIGN)
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
  ContextDSIGN EcdsaSecp256k1DSIGN
-> MessageHash
-> SignKeyDSIGN EcdsaSecp256k1DSIGN
-> SigDSIGN EcdsaSecp256k1DSIGN
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
forall a.
(Signable EcdsaSecp256k1DSIGN a, HasCallStack) =>
ContextDSIGN EcdsaSecp256k1DSIGN
-> a
-> SignKeyDSIGN EcdsaSecp256k1DSIGN
-> SigDSIGN EcdsaSecp256k1DSIGN
signDSIGN () MessageHash
msg (SignKeyDSIGN EcdsaSecp256k1DSIGN -> SigDSIGN EcdsaSecp256k1DSIGN)
-> Gen (SignKeyDSIGN EcdsaSecp256k1DSIGN)
-> Gen (SigDSIGN EcdsaSecp256k1DSIGN)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (SignKeyDSIGN EcdsaSecp256k1DSIGN)
forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen

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

genEcdsaMsg :: Gen MessageHash
genEcdsaMsg :: Gen MessageHash
genEcdsaMsg =
  Gen ByteString
-> (ByteString -> Maybe MessageHash) -> Gen MessageHash
forall a b. Gen a -> (a -> Maybe b) -> Gen b
Gen.suchThatMap (Int -> [Item ByteString] -> ByteString
forall l. IsList l => Int -> [Item l] -> l
GHC.fromListN Int
32 ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
32 Gen Word8
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 = SignKeyDSIGN a -> VerKeyDSIGN a
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN (SignKeyDSIGN a -> VerKeyDSIGN a)
-> Gen (SignKeyDSIGN a) -> Gen (VerKeyDSIGN a)
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 =
  Seed -> SignKeyDSIGN a
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
genKeyDSIGN (Seed -> SignKeyDSIGN a) -> Gen Seed -> Gen (SignKeyDSIGN a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> Gen Seed
arbitrarySeedOfSize (Proxy a -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
seedSizeDSIGN (Proxy a
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 <- Gen Message
forall a. Arbitrary a => Gen a
arbitrary
  ContextDSIGN a -> Message -> SignKeyDSIGN a -> SigDSIGN a
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
forall a.
(Signable a a, HasCallStack) =>
ContextDSIGN a -> a -> SignKeyDSIGN a -> SigDSIGN a
signDSIGN () Message
msg (SignKeyDSIGN a -> SigDSIGN a)
-> Gen (SignKeyDSIGN a) -> Gen (SigDSIGN a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (SignKeyDSIGN a)
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 = QuickCheckTests -> QuickCheckTests -> QuickCheckTests
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"
      [ Gen (SigDSIGN MockDSIGN) -> Gen Message -> TestName -> TestTree
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"
      , Gen (SigDSIGN Ed25519DSIGN) -> Gen Message -> TestName -> TestTree
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"
      , Gen (SigDSIGN Ed448DSIGN) -> Gen Message -> TestName -> TestTree
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
      , Gen (SigDSIGN EcdsaSecp256k1DSIGN)
-> Gen MessageHash -> TestName -> TestTree
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"
      , Gen (SigDSIGN SchnorrSecp256k1DSIGN)
-> Gen Message -> TestName -> TestTree
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"
      , Proxy SHA3_256 -> TestName -> TestTree
forall h.
(HashAlgorithm h, SizeHash h ~ SECP256K1_ECDSA_MESSAGE_BYTES) =>
Proxy h -> TestName -> TestTree
testEcdsaWithHashAlgorithm (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SHA3_256) TestName
"EcdsaSecp256k1WithSHA3_256"
      , Proxy Blake2b_256 -> TestName -> TestTree
forall h.
(HashAlgorithm h, SizeHash h ~ SECP256K1_ECDSA_MESSAGE_BYTES) =>
Proxy h -> TestName -> TestTree
testEcdsaWithHashAlgorithm (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Blake2b_256) TestName
"EcdsaSecp256k1WithBlake2b_256"
      , Proxy SHA256 -> TestName -> TestTree
forall h.
(HashAlgorithm h, SizeHash h ~ SECP256K1_ECDSA_MESSAGE_BYTES) =>
Proxy h -> TestName -> TestTree
testEcdsaWithHashAlgorithm (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SHA256) TestName
"EcdsaSecp256k1WithSHA256"
      , Proxy Keccak256 -> TestName -> TestTree
forall h.
(HashAlgorithm h, SizeHash h ~ SECP256K1_ECDSA_MESSAGE_BYTES) =>
Proxy h -> TestName -> TestTree
testEcdsaWithHashAlgorithm (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Keccak256) TestName
"EcdsaSecp256k1WithKeccak256"
#endif
      ]
    , TestName -> [TestTree] -> TestTree
testGroup TestName
"MLocked"
      [ Lock -> Proxy Ed25519DSIGN -> TestName -> TestTree
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 t. Proxy t
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 = (QuickCheckTests -> QuickCheckTests) -> TestTree -> TestTree
forall v. IsOption v => (v -> v) -> TestTree -> TestTree
adjustOption QuickCheckTests -> QuickCheckTests
testEnough (TestTree -> TestTree)
-> ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> [TestTree] -> TestTree
testGroup TestName
name ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$ [
  TestName -> [TestTree] -> TestTree
testGroup TestName
"serialization" [
    TestName -> [TestTree] -> TestTree
testGroup TestName
"raw" [
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey serialization" (Property -> TestTree)
-> ((VerKeyDSIGN v -> Property) -> Property)
-> (VerKeyDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Gen (VerKeyDSIGN v)
-> (VerKeyDSIGN v -> TestName)
-> (VerKeyDSIGN v -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (VerKeyDSIGN a)
defaultVerKeyGen @v)
                   VerKeyDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((VerKeyDSIGN v -> Property) -> TestTree)
-> (VerKeyDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
                   (VerKeyDSIGN v -> ByteString)
-> (ByteString -> Maybe (VerKeyDSIGN v))
-> VerKeyDSIGN v
-> Property
forall a.
(Eq a, Show a) =>
(a -> ByteString) -> (ByteString -> Maybe a) -> a -> Property
prop_raw_serialise VerKeyDSIGN v -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN ByteString -> Maybe (VerKeyDSIGN v)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
rawDeserialiseVerKeyDSIGN,
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey deserialization (wrong length)" (Property -> TestTree)
-> ((BadInputFor (VerKeyDSIGN v) -> Property) -> Property)
-> (BadInputFor (VerKeyDSIGN v) -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Gen (BadInputFor (VerKeyDSIGN v))
-> (BadInputFor (VerKeyDSIGN v) -> [BadInputFor (VerKeyDSIGN v)])
-> (BadInputFor (VerKeyDSIGN v) -> TestName)
-> (BadInputFor (VerKeyDSIGN v) -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> [a]) -> (a -> TestName) -> (a -> prop) -> Property
forAllShrinkShow (Int -> Gen (BadInputFor (VerKeyDSIGN v))
forall a. Int -> Gen (BadInputFor a)
genBadInputFor (Int -> Gen (BadInputFor (VerKeyDSIGN v)))
-> (ExpectedLengths v -> Int)
-> ExpectedLengths v
-> Gen (BadInputFor (VerKeyDSIGN v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpectedLengths v -> Int
forall v. ExpectedLengths v -> Int
expectedVKLen (ExpectedLengths v -> Gen (BadInputFor (VerKeyDSIGN v)))
-> ExpectedLengths v -> Gen (BadInputFor (VerKeyDSIGN v))
forall a b. (a -> b) -> a -> b
$ ExpectedLengths v
expected)
                         (forall a. BadInputFor a -> [BadInputFor a]
shrinkBadInputFor @(VerKeyDSIGN v))
                         BadInputFor (VerKeyDSIGN v) -> TestName
forall a. BadInputFor a -> TestName
showBadInputFor ((BadInputFor (VerKeyDSIGN v) -> Property) -> TestTree)
-> (BadInputFor (VerKeyDSIGN v) -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
                         (ByteString -> Maybe (VerKeyDSIGN v))
-> BadInputFor (VerKeyDSIGN v) -> Property
forall a.
Show a =>
(ByteString -> Maybe a) -> BadInputFor a -> Property
prop_raw_deserialise ByteString -> Maybe (VerKeyDSIGN v)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
rawDeserialiseVerKeyDSIGN,
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey serialization" (Property -> TestTree)
-> ((SignKeyDSIGN v -> Property) -> Property)
-> (SignKeyDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Gen (SignKeyDSIGN v)
-> (SignKeyDSIGN v -> TestName)
-> (SignKeyDSIGN v -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen @v)
                   SignKeyDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((SignKeyDSIGN v -> Property) -> TestTree)
-> (SignKeyDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
                   (SignKeyDSIGN v -> ByteString)
-> (ByteString -> Maybe (SignKeyDSIGN v))
-> SignKeyDSIGN v
-> Property
forall a.
(Eq a, Show a) =>
(a -> ByteString) -> (ByteString -> Maybe a) -> a -> Property
prop_raw_serialise SignKeyDSIGN v -> ByteString
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> ByteString
rawSerialiseSignKeyDSIGN ByteString -> Maybe (SignKeyDSIGN v)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SignKeyDSIGN v)
rawDeserialiseSignKeyDSIGN,
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey deserialization (wrong length)" (Property -> TestTree)
-> ((BadInputFor (SignKeyDSIGN v) -> Property) -> Property)
-> (BadInputFor (SignKeyDSIGN v) -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Gen (BadInputFor (SignKeyDSIGN v))
-> (BadInputFor (SignKeyDSIGN v) -> [BadInputFor (SignKeyDSIGN v)])
-> (BadInputFor (SignKeyDSIGN v) -> TestName)
-> (BadInputFor (SignKeyDSIGN v) -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> [a]) -> (a -> TestName) -> (a -> prop) -> Property
forAllShrinkShow (Int -> Gen (BadInputFor (SignKeyDSIGN v))
forall a. Int -> Gen (BadInputFor a)
genBadInputFor (Int -> Gen (BadInputFor (SignKeyDSIGN v)))
-> (ExpectedLengths v -> Int)
-> ExpectedLengths v
-> Gen (BadInputFor (SignKeyDSIGN v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpectedLengths v -> Int
forall v. ExpectedLengths v -> Int
expectedSKLen (ExpectedLengths v -> Gen (BadInputFor (SignKeyDSIGN v)))
-> ExpectedLengths v -> Gen (BadInputFor (SignKeyDSIGN v))
forall a b. (a -> b) -> a -> b
$ ExpectedLengths v
expected)
                         (forall a. BadInputFor a -> [BadInputFor a]
shrinkBadInputFor @(SignKeyDSIGN v))
                         BadInputFor (SignKeyDSIGN v) -> TestName
forall a. BadInputFor a -> TestName
showBadInputFor ((BadInputFor (SignKeyDSIGN v) -> Property) -> TestTree)
-> (BadInputFor (SignKeyDSIGN v) -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
                         (ByteString -> Maybe (SignKeyDSIGN v))
-> BadInputFor (SignKeyDSIGN v) -> Property
forall a.
Show a =>
(ByteString -> Maybe a) -> BadInputFor a -> Property
prop_raw_deserialise ByteString -> Maybe (SignKeyDSIGN v)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SignKeyDSIGN v)
rawDeserialiseSignKeyDSIGN,
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig serialization" (Property -> TestTree)
-> ((SigDSIGN v -> Property) -> Property)
-> (SigDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Gen (SigDSIGN v)
-> (SigDSIGN v -> TestName) -> (SigDSIGN v -> Property) -> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow Gen (SigDSIGN v)
genSig
                   SigDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((SigDSIGN v -> Property) -> TestTree)
-> (SigDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
                   (SigDSIGN v -> ByteString)
-> (ByteString -> Maybe (SigDSIGN v)) -> SigDSIGN v -> Property
forall a.
(Eq a, Show a) =>
(a -> ByteString) -> (ByteString -> Maybe a) -> a -> Property
prop_raw_serialise SigDSIGN v -> ByteString
forall v. DSIGNAlgorithm v => SigDSIGN v -> ByteString
rawSerialiseSigDSIGN ByteString -> Maybe (SigDSIGN v)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SigDSIGN v)
rawDeserialiseSigDSIGN,
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig deserialization (wrong length)" (Property -> TestTree)
-> ((BadInputFor (SigDSIGN v) -> Property) -> Property)
-> (BadInputFor (SigDSIGN v) -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Gen (BadInputFor (SigDSIGN v))
-> (BadInputFor (SigDSIGN v) -> [BadInputFor (SigDSIGN v)])
-> (BadInputFor (SigDSIGN v) -> TestName)
-> (BadInputFor (SigDSIGN v) -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> [a]) -> (a -> TestName) -> (a -> prop) -> Property
forAllShrinkShow (Int -> Gen (BadInputFor (SigDSIGN v))
forall a. Int -> Gen (BadInputFor a)
genBadInputFor (Int -> Gen (BadInputFor (SigDSIGN v)))
-> (ExpectedLengths v -> Int)
-> ExpectedLengths v
-> Gen (BadInputFor (SigDSIGN v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpectedLengths v -> Int
forall v. ExpectedLengths v -> Int
expectedSigLen (ExpectedLengths v -> Gen (BadInputFor (SigDSIGN v)))
-> ExpectedLengths v -> Gen (BadInputFor (SigDSIGN v))
forall a b. (a -> b) -> a -> b
$ ExpectedLengths v
expected)
                         (forall a. BadInputFor a -> [BadInputFor a]
shrinkBadInputFor @(SigDSIGN v))
                         BadInputFor (SigDSIGN v) -> TestName
forall a. BadInputFor a -> TestName
showBadInputFor ((BadInputFor (SigDSIGN v) -> Property) -> TestTree)
-> (BadInputFor (SigDSIGN v) -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
                         (ByteString -> Maybe (SigDSIGN v))
-> BadInputFor (SigDSIGN v) -> Property
forall a.
Show a =>
(ByteString -> Maybe a) -> BadInputFor a -> Property
prop_raw_deserialise ByteString -> Maybe (SigDSIGN v)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SigDSIGN v)
rawDeserialiseSigDSIGN
      ],
    TestName -> [TestTree] -> TestTree
testGroup TestName
"size" [
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" (Property -> TestTree)
-> ((VerKeyDSIGN v -> Property) -> Property)
-> (VerKeyDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Gen (VerKeyDSIGN v)
-> (VerKeyDSIGN v -> TestName)
-> (VerKeyDSIGN v -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (VerKeyDSIGN a)
defaultVerKeyGen @v)
                   VerKeyDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((VerKeyDSIGN v -> Property) -> TestTree)
-> (VerKeyDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
                   (VerKeyDSIGN v -> ByteString) -> Word -> VerKeyDSIGN v -> Property
forall a. (a -> ByteString) -> Word -> a -> Property
prop_size_serialise VerKeyDSIGN v -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN (Proxy v -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v)),
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" (Property -> TestTree)
-> ((SignKeyDSIGN v -> Property) -> Property)
-> (SignKeyDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Gen (SignKeyDSIGN v)
-> (SignKeyDSIGN v -> TestName)
-> (SignKeyDSIGN v -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen @v)
                   SignKeyDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((SignKeyDSIGN v -> Property) -> TestTree)
-> (SignKeyDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
                   (SignKeyDSIGN v -> ByteString)
-> Word -> SignKeyDSIGN v -> Property
forall a. (a -> ByteString) -> Word -> a -> Property
prop_size_serialise SignKeyDSIGN v -> ByteString
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> ByteString
rawSerialiseSignKeyDSIGN (Proxy v -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSignKeyDSIGN (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v)),
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig" (Property -> TestTree)
-> ((SigDSIGN v -> Property) -> Property)
-> (SigDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Gen (SigDSIGN v)
-> (SigDSIGN v -> TestName) -> (SigDSIGN v -> Property) -> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow Gen (SigDSIGN v)
genSig
                   SigDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((SigDSIGN v -> Property) -> TestTree)
-> (SigDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
                   (SigDSIGN v -> ByteString) -> Word -> SigDSIGN v -> Property
forall a. (a -> ByteString) -> Word -> a -> Property
prop_size_serialise SigDSIGN v -> ByteString
forall v. DSIGNAlgorithm v => SigDSIGN v -> ByteString
rawSerialiseSigDSIGN (Proxy v -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSigDSIGN (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v))
      ],
    TestName -> [TestTree] -> TestTree
testGroup TestName
"direct CBOR" [
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" (Property -> TestTree)
-> ((VerKeyDSIGN v -> Property) -> Property)
-> (VerKeyDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Gen (VerKeyDSIGN v)
-> (VerKeyDSIGN v -> TestName)
-> (VerKeyDSIGN v -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (VerKeyDSIGN a)
defaultVerKeyGen @v)
                   VerKeyDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((VerKeyDSIGN v -> Property) -> TestTree)
-> (VerKeyDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
                   (VerKeyDSIGN v -> Encoding)
-> (forall s. Decoder s (VerKeyDSIGN v))
-> VerKeyDSIGN v
-> Property
forall a.
(Eq a, Show a) =>
(a -> Encoding) -> (forall s. Decoder s a) -> a -> Property
prop_cbor_with VerKeyDSIGN v -> Encoding
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> Encoding
encodeVerKeyDSIGN Decoder s (VerKeyDSIGN v)
forall s. Decoder s (VerKeyDSIGN v)
forall v s. DSIGNAlgorithm v => Decoder s (VerKeyDSIGN v)
decodeVerKeyDSIGN,
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" (Property -> TestTree)
-> ((SignKeyDSIGN v -> Property) -> Property)
-> (SignKeyDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Gen (SignKeyDSIGN v)
-> (SignKeyDSIGN v -> TestName)
-> (SignKeyDSIGN v -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen @v)
                   SignKeyDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((SignKeyDSIGN v -> Property) -> TestTree)
-> (SignKeyDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
                   (SignKeyDSIGN v -> Encoding)
-> (forall s. Decoder s (SignKeyDSIGN v))
-> SignKeyDSIGN v
-> Property
forall a.
(Eq a, Show a) =>
(a -> Encoding) -> (forall s. Decoder s a) -> a -> Property
prop_cbor_with SignKeyDSIGN v -> Encoding
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> Encoding
encodeSignKeyDSIGN Decoder s (SignKeyDSIGN v)
forall s. Decoder s (SignKeyDSIGN v)
forall v s. DSIGNAlgorithm v => Decoder s (SignKeyDSIGN v)
decodeSignKeyDSIGN,
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig" (Property -> TestTree)
-> ((SigDSIGN v -> Property) -> Property)
-> (SigDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Gen (SigDSIGN v)
-> (SigDSIGN v -> TestName) -> (SigDSIGN v -> Property) -> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow Gen (SigDSIGN v)
genSig
                   SigDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((SigDSIGN v -> Property) -> TestTree)
-> (SigDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
                   (SigDSIGN v -> Encoding)
-> (forall s. Decoder s (SigDSIGN v)) -> SigDSIGN v -> Property
forall a.
(Eq a, Show a) =>
(a -> Encoding) -> (forall s. Decoder s a) -> a -> Property
prop_cbor_with SigDSIGN v -> Encoding
forall v. DSIGNAlgorithm v => SigDSIGN v -> Encoding
encodeSigDSIGN Decoder s (SigDSIGN v)
forall s. Decoder s (SigDSIGN v)
forall v s. DSIGNAlgorithm v => Decoder s (SigDSIGN v)
decodeSigDSIGN
      ],
    TestName -> [TestTree] -> TestTree
testGroup TestName
"To/FromCBOR class" [
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" (Property -> TestTree)
-> ((VerKeyDSIGN v -> Property) -> Property)
-> (VerKeyDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen (VerKeyDSIGN v)
-> (VerKeyDSIGN v -> TestName)
-> (VerKeyDSIGN v -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (VerKeyDSIGN a)
defaultVerKeyGen @v) VerKeyDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((VerKeyDSIGN v -> Property) -> TestTree)
-> (VerKeyDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ VerKeyDSIGN v -> Property
forall a. (ToCBOR a, FromCBOR a, Eq a, Show a) => a -> Property
prop_cbor,
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" (Property -> TestTree)
-> ((SignKeyDSIGN v -> Property) -> Property)
-> (SignKeyDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen (SignKeyDSIGN v)
-> (SignKeyDSIGN v -> TestName)
-> (SignKeyDSIGN v -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen @v) SignKeyDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((SignKeyDSIGN v -> Property) -> TestTree)
-> (SignKeyDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN v -> Property
forall a. (ToCBOR a, FromCBOR a, Eq a, Show a) => a -> Property
prop_cbor,
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig" (Property -> TestTree)
-> ((SigDSIGN v -> Property) -> Property)
-> (SigDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen (SigDSIGN v)
-> (SigDSIGN v -> TestName) -> (SigDSIGN v -> Property) -> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow Gen (SigDSIGN v)
genSig SigDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((SigDSIGN v -> Property) -> TestTree)
-> (SigDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ SigDSIGN v -> Property
forall a. (ToCBOR a, FromCBOR a, Eq a, Show a) => a -> Property
prop_cbor
      ],
    TestName -> [TestTree] -> TestTree
testGroup TestName
"ToCBOR size" [
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" (Property -> TestTree)
-> ((VerKeyDSIGN v -> Property) -> Property)
-> (VerKeyDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen (VerKeyDSIGN v)
-> (VerKeyDSIGN v -> TestName)
-> (VerKeyDSIGN v -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (VerKeyDSIGN a)
defaultVerKeyGen @v) VerKeyDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((VerKeyDSIGN v -> Property) -> TestTree)
-> (VerKeyDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ VerKeyDSIGN v -> Property
forall a. ToCBOR a => a -> Property
prop_cbor_size,
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" (Property -> TestTree)
-> ((SignKeyDSIGN v -> Property) -> Property)
-> (SignKeyDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen (SignKeyDSIGN v)
-> (SignKeyDSIGN v -> TestName)
-> (SignKeyDSIGN v -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen @v) SignKeyDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((SignKeyDSIGN v -> Property) -> TestTree)
-> (SignKeyDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN v -> Property
forall a. ToCBOR a => a -> Property
prop_cbor_size,
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig" (Property -> TestTree)
-> ((SigDSIGN v -> Property) -> Property)
-> (SigDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen (SigDSIGN v)
-> (SigDSIGN v -> TestName) -> (SigDSIGN v -> Property) -> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow Gen (SigDSIGN v)
genSig SigDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((SigDSIGN v -> Property) -> TestTree)
-> (SigDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ SigDSIGN v -> Property
forall a. ToCBOR a => a -> Property
prop_cbor_size
      ],
    TestName -> [TestTree] -> TestTree
testGroup TestName
"direct matches class" [
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" (Property -> TestTree)
-> ((VerKeyDSIGN v -> Property) -> Property)
-> (VerKeyDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Gen (VerKeyDSIGN v)
-> (VerKeyDSIGN v -> TestName)
-> (VerKeyDSIGN v -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (VerKeyDSIGN a)
defaultVerKeyGen @v) VerKeyDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((VerKeyDSIGN v -> Property) -> TestTree)
-> (VerKeyDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
        (VerKeyDSIGN v -> Encoding) -> VerKeyDSIGN v -> Property
forall a. ToCBOR a => (a -> Encoding) -> a -> Property
prop_cbor_direct_vs_class VerKeyDSIGN v -> Encoding
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> Encoding
encodeVerKeyDSIGN,
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" (Property -> TestTree)
-> ((SignKeyDSIGN v -> Property) -> Property)
-> (SignKeyDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Gen (SignKeyDSIGN v)
-> (SignKeyDSIGN v -> TestName)
-> (SignKeyDSIGN v -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen @v) SignKeyDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((SignKeyDSIGN v -> Property) -> TestTree)
-> (SignKeyDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
        (SignKeyDSIGN v -> Encoding) -> SignKeyDSIGN v -> Property
forall a. ToCBOR a => (a -> Encoding) -> a -> Property
prop_cbor_direct_vs_class SignKeyDSIGN v -> Encoding
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> Encoding
encodeSignKeyDSIGN,
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig" (Property -> TestTree)
-> ((SigDSIGN v -> Property) -> Property)
-> (SigDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Gen (SigDSIGN v)
-> (SigDSIGN v -> TestName) -> (SigDSIGN v -> Property) -> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow Gen (SigDSIGN v)
genSig SigDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((SigDSIGN v -> Property) -> TestTree)
-> (SigDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
        (SigDSIGN v -> Encoding) -> SigDSIGN v -> Property
forall a. ToCBOR a => (a -> Encoding) -> a -> Property
prop_cbor_direct_vs_class SigDSIGN v -> Encoding
forall v. DSIGNAlgorithm v => SigDSIGN v -> Encoding
encodeSigDSIGN
      ]
    ],
    TestName -> [TestTree] -> TestTree
testGroup TestName
"verify" [
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"signing and verifying with matching keys" (Property -> TestTree)
-> (((a, SignKeyDSIGN v) -> Property) -> Property)
-> ((a, SignKeyDSIGN v) -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Gen (a, SignKeyDSIGN v)
-> ((a, SignKeyDSIGN v) -> TestName)
-> ((a, SignKeyDSIGN v) -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow ((,) (a -> SignKeyDSIGN v -> (a, SignKeyDSIGN v))
-> Gen a -> Gen (SignKeyDSIGN v -> (a, SignKeyDSIGN v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
genMsg Gen (SignKeyDSIGN v -> (a, SignKeyDSIGN v))
-> Gen (SignKeyDSIGN v) -> Gen (a, SignKeyDSIGN v)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen @v) (a, SignKeyDSIGN v) -> TestName
forall a. Show a => a -> TestName
ppShow (((a, SignKeyDSIGN v) -> Property) -> TestTree)
-> ((a, SignKeyDSIGN v) -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
        (a, SignKeyDSIGN v) -> Property
forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a) =>
(a, SignKeyDSIGN v) -> Property
prop_dsign_verify,
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"verifying with wrong key" (Property -> TestTree)
-> (((a, SignKeyDSIGN v, SignKeyDSIGN v) -> Property) -> Property)
-> ((a, SignKeyDSIGN v, SignKeyDSIGN v) -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Gen (a, SignKeyDSIGN v, SignKeyDSIGN v)
-> ((a, SignKeyDSIGN v, SignKeyDSIGN v) -> TestName)
-> ((a, SignKeyDSIGN v, SignKeyDSIGN v) -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow Gen (a, SignKeyDSIGN v, SignKeyDSIGN v)
genWrongKey (a, SignKeyDSIGN v, SignKeyDSIGN v) -> TestName
forall a. Show a => a -> TestName
ppShow (((a, SignKeyDSIGN v, SignKeyDSIGN v) -> Property) -> TestTree)
-> ((a, SignKeyDSIGN v, SignKeyDSIGN v) -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
        (a, SignKeyDSIGN v, SignKeyDSIGN v) -> Property
forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a) =>
(a, SignKeyDSIGN v, SignKeyDSIGN v) -> Property
prop_dsign_verify_wrong_key,
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"verifying wrong message" (Property -> TestTree)
-> (((a, a, SignKeyDSIGN v) -> Property) -> Property)
-> ((a, a, SignKeyDSIGN v) -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Gen (a, a, SignKeyDSIGN v)
-> ((a, a, SignKeyDSIGN v) -> TestName)
-> ((a, a, SignKeyDSIGN v) -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow Gen (a, a, SignKeyDSIGN v)
genWrongMsg (a, a, SignKeyDSIGN v) -> TestName
forall a. Show a => a -> TestName
ppShow (((a, a, SignKeyDSIGN v) -> Property) -> TestTree)
-> ((a, a, SignKeyDSIGN v) -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
        (a, a, SignKeyDSIGN v) -> Property
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" [
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" (Property -> TestTree)
-> ((VerKeyDSIGN v -> Property) -> Property)
-> (VerKeyDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen (VerKeyDSIGN v)
-> (VerKeyDSIGN v -> TestName)
-> (VerKeyDSIGN v -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (VerKeyDSIGN a)
defaultVerKeyGen @v) VerKeyDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((VerKeyDSIGN v -> Property) -> TestTree)
-> (VerKeyDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ VerKeyDSIGN v -> Property
forall a. NoThunks a => a -> Property
prop_no_thunks,
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" (Property -> TestTree)
-> ((SignKeyDSIGN v -> Property) -> Property)
-> (SignKeyDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen (SignKeyDSIGN v)
-> (SignKeyDSIGN v -> TestName)
-> (SignKeyDSIGN v -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen @v) SignKeyDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((SignKeyDSIGN v -> Property) -> TestTree)
-> (SignKeyDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN v -> Property
forall a. NoThunks a => a -> Property
prop_no_thunks,
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig" (Property -> TestTree)
-> ((SigDSIGN v -> Property) -> Property)
-> (SigDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen (SigDSIGN v)
-> (SigDSIGN v -> TestName) -> (SigDSIGN v -> Property) -> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow Gen (SigDSIGN v)
genSig SigDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((SigDSIGN v -> Property) -> TestTree)
-> (SigDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ SigDSIGN v -> Property
forall a. NoThunks a => a -> Property
prop_no_thunks,
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey rawSerialise" (Property -> TestTree)
-> ((VerKeyDSIGN v -> Property) -> Property)
-> (VerKeyDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen (VerKeyDSIGN v)
-> (VerKeyDSIGN v -> TestName)
-> (VerKeyDSIGN v -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (VerKeyDSIGN a)
defaultVerKeyGen @v) VerKeyDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((VerKeyDSIGN v -> Property) -> TestTree)
-> (VerKeyDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \VerKeyDSIGN v
vk ->
        ByteString -> Property
forall a. NoThunks a => a -> Property
prop_no_thunks (VerKeyDSIGN v -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN VerKeyDSIGN v
vk),
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey rawDeserialise" (Property -> TestTree)
-> ((VerKeyDSIGN v -> Property) -> Property)
-> (VerKeyDSIGN v -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen (VerKeyDSIGN v)
-> (VerKeyDSIGN v -> TestName)
-> (VerKeyDSIGN v -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow (forall a. DSIGNAlgorithm a => Gen (VerKeyDSIGN a)
defaultVerKeyGen @v) VerKeyDSIGN v -> TestName
forall a. Show a => a -> TestName
ppShow ((VerKeyDSIGN v -> Property) -> TestTree)
-> (VerKeyDSIGN v -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \VerKeyDSIGN v
vk ->
        VerKeyDSIGN v -> Property
forall a. NoThunks a => a -> Property
prop_no_thunks (Maybe (VerKeyDSIGN v) -> VerKeyDSIGN v
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (VerKeyDSIGN v) -> VerKeyDSIGN v)
-> Maybe (VerKeyDSIGN v) -> VerKeyDSIGN v
forall a b. (a -> b) -> a -> b
$! forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
rawDeserialiseVerKeyDSIGN @v (ByteString -> Maybe (VerKeyDSIGN v))
-> (VerKeyDSIGN v -> ByteString)
-> VerKeyDSIGN v
-> Maybe (VerKeyDSIGN v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN v -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN (VerKeyDSIGN v -> Maybe (VerKeyDSIGN v))
-> VerKeyDSIGN v -> Maybe (VerKeyDSIGN v)
forall a b. (a -> b) -> a -> b
$ VerKeyDSIGN v
vk)
    ]
  ]
  where
    expected :: ExpectedLengths v
    expected :: ExpectedLengths v
expected = ExpectedLengths v
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 <- Gen (SignKeyDSIGN v)
forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen
      SignKeyDSIGN v
sk2 <- Gen (SignKeyDSIGN v)
-> (SignKeyDSIGN v -> Bool) -> Gen (SignKeyDSIGN v)
forall a. Gen a -> (a -> Bool) -> Gen a
Gen.suchThat Gen (SignKeyDSIGN v)
forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen (SignKeyDSIGN v -> SignKeyDSIGN v -> Bool
forall a. Eq a => a -> a -> Bool
/= SignKeyDSIGN v
sk1)
      a
msg <- Gen a
genMsg
      (a, SignKeyDSIGN v, SignKeyDSIGN v)
-> Gen (a, SignKeyDSIGN v, SignKeyDSIGN v)
forall a. a -> Gen a
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 <- Gen a -> (a -> Bool) -> Gen a
forall a. Gen a -> (a -> Bool) -> Gen a
Gen.suchThat Gen a
genMsg (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
msg1)
      SignKeyDSIGN v
sk <- Gen (SignKeyDSIGN v)
forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen
      (a, a, SignKeyDSIGN v) -> Gen (a, a, SignKeyDSIGN v)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
msg1, a
msg2, SignKeyDSIGN v
sk)
    testEnough :: QuickCheckTests -> QuickCheckTests
    testEnough :: QuickCheckTests -> QuickCheckTests
testEnough = QuickCheckTests -> QuickCheckTests -> QuickCheckTests
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"
        [ TestName
-> (PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" ((PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree)
-> (PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree
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 ((SignKeyDSIGNM v -> IO Property)
 -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> (SignKeyDSIGNM v -> IO Property)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              VerKeyDSIGN v
vk <- SignKeyDSIGNM v -> IO (VerKeyDSIGN v)
forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
forall (m :: * -> *).
(MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM SignKeyDSIGNM v
sk
              Property -> IO Property
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Property -> IO Property) -> Property -> IO Property
forall a b. (a -> b) -> a -> b
$ (ByteString -> Maybe (VerKeyDSIGN v)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
rawDeserialiseVerKeyDSIGN (ByteString -> Maybe (VerKeyDSIGN v))
-> (VerKeyDSIGN v -> ByteString)
-> VerKeyDSIGN v
-> Maybe (VerKeyDSIGN v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN v -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN (VerKeyDSIGN v -> Maybe (VerKeyDSIGN v))
-> VerKeyDSIGN v -> Maybe (VerKeyDSIGN v)
forall a b. (a -> b) -> a -> b
$ VerKeyDSIGN v
vk) Maybe (VerKeyDSIGN v) -> Maybe (VerKeyDSIGN v) -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== VerKeyDSIGN v -> Maybe (VerKeyDSIGN v)
forall a. a -> Maybe a
Just VerKeyDSIGN v
vk
        , TestName
-> (PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" ((PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree)
-> (PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree
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 ((SignKeyDSIGNM v -> IO Bool)
 -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> (SignKeyDSIGNM v -> IO Bool)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              ByteString
serialized <- SignKeyDSIGNM v -> IO ByteString
forall v (m :: * -> *).
(UnsoundDSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyDSIGNM v -> m ByteString
forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
SignKeyDSIGNM v -> m ByteString
rawSerialiseSignKeyDSIGNM SignKeyDSIGNM v
sk
              IO (Maybe (SignKeyDSIGNM v))
-> (Maybe (SignKeyDSIGNM v) -> IO ())
-> (Maybe (SignKeyDSIGNM v) -> IO Bool)
-> IO Bool
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
                (ByteString -> IO (Maybe (SignKeyDSIGNM v))
forall v (m :: * -> *).
(UnsoundDSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
ByteString -> m (Maybe (SignKeyDSIGNM v))
rawDeserialiseSignKeyDSIGNM ByteString
serialized)
                (IO ()
-> (SignKeyDSIGNM v -> IO ()) -> Maybe (SignKeyDSIGNM v) -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) SignKeyDSIGNM v -> IO ()
forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyDSIGNM v -> m ()
forgetSignKeyDSIGNM)
                (\Maybe (SignKeyDSIGNM v)
msk' -> SignKeyDSIGNM v -> Maybe (SignKeyDSIGNM v)
forall a. a -> Maybe a
Just SignKeyDSIGNM v
sk Maybe (SignKeyDSIGNM v) -> Maybe (SignKeyDSIGNM v) -> IO Bool
forall (m :: * -> *) a. (MonadST m, EqST a) => a -> a -> m Bool
==! Maybe (SignKeyDSIGNM v)
msk')
        , TestName
-> (Message -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig" ((Message -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
 -> TestTree)
-> (Message -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> TestTree
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 ((SignKeyDSIGNM v -> IO Property)
 -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> (SignKeyDSIGNM v -> IO Property)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              SigDSIGN v
sig <- ContextDSIGN v -> Message -> SignKeyDSIGNM v -> IO (SigDSIGN v)
forall v a (m :: * -> *).
(DSIGNMAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
forall a (m :: * -> *).
(Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
signDSIGNM () Message
msg SignKeyDSIGNM v
sk
              Property -> IO Property
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Property -> IO Property) -> Property -> IO Property
forall a b. (a -> b) -> a -> b
$ (ByteString -> Maybe (SigDSIGN v)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SigDSIGN v)
rawDeserialiseSigDSIGN (ByteString -> Maybe (SigDSIGN v))
-> (SigDSIGN v -> ByteString) -> SigDSIGN v -> Maybe (SigDSIGN v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigDSIGN v -> ByteString
forall v. DSIGNAlgorithm v => SigDSIGN v -> ByteString
rawSerialiseSigDSIGN (SigDSIGN v -> Maybe (SigDSIGN v))
-> SigDSIGN v -> Maybe (SigDSIGN v)
forall a b. (a -> b) -> a -> b
$ SigDSIGN v
sig) Maybe (SigDSIGN v) -> Maybe (SigDSIGN v) -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== SigDSIGN v -> Maybe (SigDSIGN v)
forall a. a -> Maybe a
Just SigDSIGN v
sig
        ]
      , TestName -> [TestTree] -> TestTree
testGroup TestName
"size"
        [ TestName
-> (PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" ((PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree)
-> (PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree
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 ((SignKeyDSIGNM v -> IO Property)
 -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> (SignKeyDSIGNM v -> IO Property)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              VerKeyDSIGN v
vk <- SignKeyDSIGNM v -> IO (VerKeyDSIGN v)
forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
forall (m :: * -> *).
(MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM SignKeyDSIGNM v
sk
              Property -> IO Property
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Property -> IO Property) -> Property -> IO Property
forall a b. (a -> b) -> a -> b
$ (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> (VerKeyDSIGN v -> Int) -> VerKeyDSIGN v -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length (ByteString -> Int)
-> (VerKeyDSIGN v -> ByteString) -> VerKeyDSIGN v -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN v -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN (VerKeyDSIGN v -> Word) -> VerKeyDSIGN v -> Word
forall a b. (a -> b) -> a -> b
$ VerKeyDSIGN v
vk) Word -> Word -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Proxy v -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v)
        , TestName
-> (PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" ((PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree)
-> (PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree
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 ((SignKeyDSIGNM v -> IO Bool)
 -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> (SignKeyDSIGNM v -> IO Bool)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              ByteString
serialized <- SignKeyDSIGNM v -> IO ByteString
forall v (m :: * -> *).
(UnsoundDSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyDSIGNM v -> m ByteString
forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
SignKeyDSIGNM v -> m ByteString
rawSerialiseSignKeyDSIGNM SignKeyDSIGNM v
sk
              Bool -> IO Bool
forall a. a -> IO a
evaluate ((Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> (ByteString -> Int) -> ByteString -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length (ByteString -> Word) -> ByteString -> Word
forall a b. (a -> b) -> a -> b
$ ByteString
serialized) Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy v -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSignKeyDSIGN (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v))
        , TestName
-> (Message -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig" ((Message -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
 -> TestTree)
-> (Message -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> TestTree
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 ((SignKeyDSIGNM v -> IO Property)
 -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> (SignKeyDSIGNM v -> IO Property)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              SigDSIGN v
sig :: SigDSIGN v <- ContextDSIGN v -> Message -> SignKeyDSIGNM v -> IO (SigDSIGN v)
forall v a (m :: * -> *).
(DSIGNMAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
forall a (m :: * -> *).
(Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
signDSIGNM () Message
msg SignKeyDSIGNM v
sk
              Property -> IO Property
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Property -> IO Property) -> Property -> IO Property
forall a b. (a -> b) -> a -> b
$ (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> (SigDSIGN v -> Int) -> SigDSIGN v -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length (ByteString -> Int)
-> (SigDSIGN v -> ByteString) -> SigDSIGN v -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigDSIGN v -> ByteString
forall v. DSIGNAlgorithm v => SigDSIGN v -> ByteString
rawSerialiseSigDSIGN (SigDSIGN v -> Word) -> SigDSIGN v -> Word
forall a b. (a -> b) -> a -> b
$ SigDSIGN v
sig) Word -> Word -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Proxy v -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSigDSIGN (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v)
        ]

      , TestName -> [TestTree] -> TestTree
testGroup TestName
"direct CBOR"
        [ TestName
-> (PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" ((PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree)
-> (PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree
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 ((SignKeyDSIGNM v -> IO Property)
 -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> (SignKeyDSIGNM v -> IO Property)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              VerKeyDSIGN v
vk :: VerKeyDSIGN v <- SignKeyDSIGNM v -> IO (VerKeyDSIGN v)
forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
forall (m :: * -> *).
(MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM SignKeyDSIGNM v
sk
              Property -> IO Property
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Property -> IO Property) -> Property -> IO Property
forall a b. (a -> b) -> a -> b
$ (VerKeyDSIGN v -> Encoding)
-> (forall s. Decoder s (VerKeyDSIGN v))
-> VerKeyDSIGN v
-> Property
forall a.
(Eq a, Show a) =>
(a -> Encoding) -> (forall s. Decoder s a) -> a -> Property
prop_cbor_with VerKeyDSIGN v -> Encoding
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> Encoding
encodeVerKeyDSIGN Decoder s (VerKeyDSIGN v)
forall s. Decoder s (VerKeyDSIGN v)
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.
        , TestName
-> (Message -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig" ((Message -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
 -> TestTree)
-> (Message -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> TestTree
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 ((SignKeyDSIGNM v -> IO Property)
 -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> (SignKeyDSIGNM v -> IO Property)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
              SigDSIGN v
sig :: SigDSIGN v <- ContextDSIGN v -> Message -> SignKeyDSIGNM v -> IO (SigDSIGN v)
forall v a (m :: * -> *).
(DSIGNMAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
forall a (m :: * -> *).
(Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
signDSIGNM () Message
msg SignKeyDSIGNM v
sk
              Property -> IO Property
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Property -> IO Property) -> Property -> IO Property
forall a b. (a -> b) -> a -> b
$ (SigDSIGN v -> Encoding)
-> (forall s. Decoder s (SigDSIGN v)) -> SigDSIGN v -> Property
forall a.
(Eq a, Show a) =>
(a -> Encoding) -> (forall s. Decoder s a) -> a -> Property
prop_cbor_with SigDSIGN v -> Encoding
forall v. DSIGNAlgorithm v => SigDSIGN v -> Encoding
encodeSigDSIGN Decoder s (SigDSIGN v)
forall s. Decoder s (SigDSIGN v)
forall v s. DSIGNAlgorithm v => Decoder s (SigDSIGN v)
decodeSigDSIGN SigDSIGN v
sig
        ]

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

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

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

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

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

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

    , TestName -> [TestTree] -> TestTree
testGroup TestName
"NoThunks"
      [ TestName
-> (PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" ((PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree)
-> (PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree
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 ((SignKeyDSIGNM v -> IO Property)
 -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> (SignKeyDSIGNM v -> IO Property)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> IO (VerKeyDSIGN v) -> IO Property
forall a. NoThunks a => IO a -> IO Property
prop_no_thunks_IO (SignKeyDSIGNM v -> IO (VerKeyDSIGN v)
forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
forall (m :: * -> *).
(MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM SignKeyDSIGNM v
sk)
      , TestName
-> (PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" ((PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree)
-> (PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree
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 ((SignKeyDSIGNM v -> IO Property)
 -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> (SignKeyDSIGNM v -> IO Property)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
forall a b. (a -> b) -> a -> b
$ IO (SignKeyDSIGNM v) -> IO Property
forall a. NoThunks a => IO a -> IO Property
prop_no_thunks_IO (IO (SignKeyDSIGNM v) -> IO Property)
-> (SignKeyDSIGNM v -> IO (SignKeyDSIGNM v))
-> SignKeyDSIGNM v
-> IO Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignKeyDSIGNM v -> IO (SignKeyDSIGNM v)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
      , TestName
-> (Message -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig"     ((Message -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
 -> TestTree)
-> (Message -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> TestTree
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 ((SignKeyDSIGNM v -> IO Property)
 -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> (SignKeyDSIGNM v -> IO Property)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
forall a b. (a -> b) -> a -> b
$ IO (SigDSIGN v) -> IO Property
forall a. NoThunks a => IO a -> IO Property
prop_no_thunks_IO (IO (SigDSIGN v) -> IO Property)
-> (SignKeyDSIGNM v -> IO (SigDSIGN v))
-> SignKeyDSIGNM v
-> IO Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContextDSIGN v -> Message -> SignKeyDSIGNM v -> IO (SigDSIGN v)
forall v a (m :: * -> *).
(DSIGNMAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
forall a (m :: * -> *).
(Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
signDSIGNM () Message
msg
      , TestName
-> (PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey DirectSerialise" ((PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree)
-> (PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree
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 ((SignKeyDSIGNM v -> IO Property)
 -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> (SignKeyDSIGNM v -> IO Property)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
            ByteString
direct <- Int -> SignKeyDSIGNM v -> IO ByteString
forall (m :: * -> *) a.
(DirectSerialise a, MonadST m, MonadThrow m) =>
Int -> a -> m ByteString
directSerialiseToBS (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Proxy v -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSignKeyDSIGN (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v)) SignKeyDSIGNM v
sk
            IO ByteString -> IO Property
forall a. NoThunks a => IO a -> IO Property
prop_no_thunks_IO (ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! ByteString
direct)
      , TestName
-> (PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey DirectDeserialise" ((PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree)
-> (PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree
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 ((SignKeyDSIGNM v -> IO Property)
 -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> (SignKeyDSIGNM v -> IO Property)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
            ByteString
direct <- Int -> SignKeyDSIGNM v -> IO ByteString
forall (m :: * -> *) a.
(DirectSerialise a, MonadST m, MonadThrow m) =>
Int -> a -> m ByteString
directSerialiseToBS (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Proxy v -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSignKeyDSIGN (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v)) SignKeyDSIGNM v
sk
            IO (SignKeyDSIGNM v) -> IO Property
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) (ByteString -> IO (SignKeyDSIGNM v))
-> ByteString -> IO (SignKeyDSIGNM v)
forall a b. (a -> b) -> a -> b
$! ByteString
direct)
      , TestName
-> (PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey DirectSerialise" ((PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree)
-> (PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree
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 ((SignKeyDSIGNM v -> IO Property)
 -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> (SignKeyDSIGNM v -> IO Property)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
            VerKeyDSIGN v
vk <- SignKeyDSIGNM v -> IO (VerKeyDSIGN v)
forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
forall (m :: * -> *).
(MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM SignKeyDSIGNM v
sk
            ByteString
direct <- Int -> VerKeyDSIGN v -> IO ByteString
forall (m :: * -> *) a.
(DirectSerialise a, MonadST m, MonadThrow m) =>
Int -> a -> m ByteString
directSerialiseToBS (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Proxy v -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v)) VerKeyDSIGN v
vk
            IO ByteString -> IO Property
forall a. NoThunks a => IO a -> IO Property
prop_no_thunks_IO (ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! ByteString
direct)
      , TestName
-> (PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey DirectDeserialise" ((PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree)
-> (PinnedSizedBytes (SeedSizeDSIGN v) -> Property) -> TestTree
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 ((SignKeyDSIGNM v -> IO Property)
 -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> (SignKeyDSIGNM v -> IO Property)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
            VerKeyDSIGN v
vk <- SignKeyDSIGNM v -> IO (VerKeyDSIGN v)
forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
forall (m :: * -> *).
(MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM SignKeyDSIGNM v
sk
            ByteString
direct <- Int -> VerKeyDSIGN v -> IO ByteString
forall (m :: * -> *) a.
(DirectSerialise a, MonadST m, MonadThrow m) =>
Int -> a -> m ByteString
directSerialiseToBS (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Proxy v -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v)) VerKeyDSIGN v
vk
            IO (VerKeyDSIGN v) -> IO Property
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) (ByteString -> IO (VerKeyDSIGN v))
-> ByteString -> 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 =
  PinnedSizedBytes (SeedSizeDSIGN v)
-> (MLockedSeed (SeedSizeDSIGN v) -> IO b) -> IO b
forall (m :: * -> *) (n :: Nat) a.
(MonadST m, MonadThrow m, KnownNat n) =>
PinnedSizedBytes n -> (MLockedSeed n -> m a) -> m a
withMLockedSeedFromPSB PinnedSizedBytes (SeedSizeDSIGN v)
seedPSB ((MLockedSeed (SeedSizeDSIGN v) -> IO b) -> IO b)
-> (MLockedSeed (SeedSizeDSIGN v) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \MLockedSeed (SeedSizeDSIGN v)
seed ->
    IO (SignKeyDSIGNM v)
-> (SignKeyDSIGNM v -> IO ()) -> (SignKeyDSIGNM v -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
      (MLockedSeed (SeedSizeDSIGN v) -> IO (SignKeyDSIGNM v)
forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
MLockedSeed (SeedSizeDSIGN v) -> m (SignKeyDSIGNM v)
genKeyDSIGNM MLockedSeed (SeedSizeDSIGN v)
seed)
      SignKeyDSIGNM v -> IO ()
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 =
  IO a -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO a -> Property) -> (IO a -> IO a) -> IO a -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lock -> IO a -> IO a
forall a. Lock -> IO a -> IO a
withLock Lock
lock (IO a -> Property) -> IO a -> Property
forall a b. (a -> b) -> a -> b
$ PinnedSizedBytes (SeedSizeDSIGN v)
-> (SignKeyDSIGNM v -> IO a) -> IO a
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 =
  IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property)
-> ((MLockedSeed (SeedSizeDSIGN v) -> IO Property) -> IO Property)
-> (MLockedSeed (SeedSizeDSIGN v) -> IO Property)
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PinnedSizedBytes (SeedSizeDSIGN v)
-> (MLockedSeed (SeedSizeDSIGN v) -> IO Property) -> IO Property
forall (m :: * -> *) (n :: Nat) a.
(MonadST m, MonadThrow m, KnownNat n) =>
PinnedSizedBytes n -> (MLockedSeed n -> m a) -> m a
withMLockedSeedFromPSB PinnedSizedBytes (SeedSizeDSIGN v)
seedPSB ((MLockedSeed (SeedSizeDSIGN v) -> IO Property) -> Property)
-> (MLockedSeed (SeedSizeDSIGN v) -> IO Property) -> Property
forall a b. (a -> b) -> a -> b
$ \MLockedSeed (SeedSizeDSIGN v)
seed -> do
    SignKeyDSIGNM v
sk <- MLockedSeed (SeedSizeDSIGN v) -> IO (SignKeyDSIGNM v)
forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
MLockedSeed (SeedSizeDSIGN v) -> m (SignKeyDSIGNM v)
genKeyDSIGNM MLockedSeed (SeedSizeDSIGN v)
seed
    MLockedSeed (SeedSizeDSIGN v) -> IO ()
forall (m :: * -> *) (n :: Nat). MonadST m => MLockedSeed n -> m ()
mlockedSeedFinalize MLockedSeed (SeedSizeDSIGN v)
seed

    MLockedSeed (SeedSizeDSIGN v)
seedBefore <- Proxy v -> SignKeyDSIGNM v -> IO (MLockedSeed (SeedSizeDSIGN v))
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 <- MLockedSizedBytes (SeedSizeDSIGN v) -> IO ByteString
forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
MLockedSizedBytes n -> m ByteString
mlsbToByteString (MLockedSizedBytes (SeedSizeDSIGN v) -> IO ByteString)
-> (MLockedSeed (SeedSizeDSIGN v)
    -> MLockedSizedBytes (SeedSizeDSIGN v))
-> MLockedSeed (SeedSizeDSIGN v)
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MLockedSeed (SeedSizeDSIGN v)
-> MLockedSizedBytes (SeedSizeDSIGN v)
forall (n :: Nat). MLockedSeed n -> MLockedSizedBytes n
mlockedSeedMLSB (MLockedSeed (SeedSizeDSIGN v) -> IO ByteString)
-> MLockedSeed (SeedSizeDSIGN v) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ MLockedSeed (SeedSizeDSIGN v)
seedBefore
    MLockedSeed (SeedSizeDSIGN v) -> IO ()
forall (m :: * -> *) (n :: Nat). MonadST m => MLockedSeed n -> m ()
mlockedSeedFinalize MLockedSeed (SeedSizeDSIGN v)
seedBefore

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

    MLockedSeed (SeedSizeDSIGN v)
seedAfter <- Proxy v -> SignKeyDSIGNM v -> IO (MLockedSeed (SeedSizeDSIGN v))
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 <- MLockedSizedBytes (SeedSizeDSIGN v) -> IO ByteString
forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
MLockedSizedBytes n -> m ByteString
mlsbToByteString (MLockedSizedBytes (SeedSizeDSIGN v) -> IO ByteString)
-> (MLockedSeed (SeedSizeDSIGN v)
    -> MLockedSizedBytes (SeedSizeDSIGN v))
-> MLockedSeed (SeedSizeDSIGN v)
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MLockedSeed (SeedSizeDSIGN v)
-> MLockedSizedBytes (SeedSizeDSIGN v)
forall (n :: Nat). MLockedSeed n -> MLockedSizedBytes n
mlockedSeedMLSB (MLockedSeed (SeedSizeDSIGN v) -> IO ByteString)
-> MLockedSeed (SeedSizeDSIGN v) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ MLockedSeed (SeedSizeDSIGN v)
seedAfter
    MLockedSeed (SeedSizeDSIGN v) -> IO ()
forall (m :: * -> *) (n :: Nat). MonadST m => MLockedSeed n -> m ()
mlockedSeedFinalize MLockedSeed (SeedSizeDSIGN v)
seedAfter

    Property -> IO Property
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bsBefore ByteString -> ByteString -> Property
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 = IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property)
-> ((MLockedSeed (SeedSizeDSIGN v) -> IO Property) -> IO Property)
-> (MLockedSeed (SeedSizeDSIGN v) -> IO Property)
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PinnedSizedBytes (SeedSizeDSIGN v)
-> (MLockedSeed (SeedSizeDSIGN v) -> IO Property) -> IO Property
forall (m :: * -> *) (n :: Nat) a.
(MonadST m, MonadThrow m, KnownNat n) =>
PinnedSizedBytes n -> (MLockedSeed n -> m a) -> m a
withMLockedSeedFromPSB PinnedSizedBytes (SeedSizeDSIGN v)
seedPSB ((MLockedSeed (SeedSizeDSIGN v) -> IO Property) -> Property)
-> (MLockedSeed (SeedSizeDSIGN v) -> IO Property) -> Property
forall a b. (a -> b) -> a -> b
$ \MLockedSeed (SeedSizeDSIGN v)
seed -> do
  SignKeyDSIGNM v
sk <- MLockedSeed (SeedSizeDSIGN v) -> IO (SignKeyDSIGNM v)
forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
MLockedSeed (SeedSizeDSIGN v) -> m (SignKeyDSIGNM v)
genKeyDSIGNM MLockedSeed (SeedSizeDSIGN v)
seed
  MLockedSeed (SeedSizeDSIGN v)
seed' <- Proxy v -> SignKeyDSIGNM v -> IO (MLockedSeed (SeedSizeDSIGN v))
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 <- MLockedSizedBytes (SeedSizeDSIGN v) -> IO ByteString
forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
MLockedSizedBytes n -> m ByteString
mlsbToByteString (MLockedSizedBytes (SeedSizeDSIGN v) -> IO ByteString)
-> (MLockedSeed (SeedSizeDSIGN v)
    -> MLockedSizedBytes (SeedSizeDSIGN v))
-> MLockedSeed (SeedSizeDSIGN v)
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MLockedSeed (SeedSizeDSIGN v)
-> MLockedSizedBytes (SeedSizeDSIGN v)
forall (n :: Nat). MLockedSeed n -> MLockedSizedBytes n
mlockedSeedMLSB (MLockedSeed (SeedSizeDSIGN v) -> IO ByteString)
-> MLockedSeed (SeedSizeDSIGN v) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ MLockedSeed (SeedSizeDSIGN v)
seed
  ByteString
bs' <- MLockedSizedBytes (SeedSizeDSIGN v) -> IO ByteString
forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
MLockedSizedBytes n -> m ByteString
mlsbToByteString (MLockedSizedBytes (SeedSizeDSIGN v) -> IO ByteString)
-> (MLockedSeed (SeedSizeDSIGN v)
    -> MLockedSizedBytes (SeedSizeDSIGN v))
-> MLockedSeed (SeedSizeDSIGN v)
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MLockedSeed (SeedSizeDSIGN v)
-> MLockedSizedBytes (SeedSizeDSIGN v)
forall (n :: Nat). MLockedSeed n -> MLockedSizedBytes n
mlockedSeedMLSB (MLockedSeed (SeedSizeDSIGN v) -> IO ByteString)
-> MLockedSeed (SeedSizeDSIGN v) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ MLockedSeed (SeedSizeDSIGN v)
seed'
  SignKeyDSIGNM v -> IO ()
forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyDSIGNM v -> m ()
forgetSignKeyDSIGNM SignKeyDSIGNM v
sk
  MLockedSeed (SeedSizeDSIGN v) -> IO ()
forall (m :: * -> *) (n :: Nat). MonadST m => MLockedSeed n -> m ()
mlockedSeedFinalize MLockedSeed (SeedSizeDSIGN v)
seed'
  Property -> IO Property
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bs ByteString -> ByteString -> Property
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 = ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
forall a.
(Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
signDSIGN () a
msg SignKeyDSIGN v
sk
      vk :: VerKeyDSIGN v
vk = SignKeyDSIGN v -> VerKeyDSIGN v
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN v
sk
    in ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
forall a.
(Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
verifyDSIGN () VerKeyDSIGN v
vk a
msg SigDSIGN v
signed Either TestName () -> Either TestName () -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== () -> Either TestName ()
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 = ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
forall a.
(Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
signDSIGN () a
msg SignKeyDSIGN v
sk
      vk' :: VerKeyDSIGN v
vk' = SignKeyDSIGN v -> VerKeyDSIGN v
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN v
sk'
    in ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
forall a.
(Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
verifyDSIGN () VerKeyDSIGN v
vk' a
msg SigDSIGN v
signed Either TestName () -> Either TestName () -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=/= () -> Either TestName ()
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 ((SignKeyDSIGNM v -> IO Property)
 -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> (SignKeyDSIGNM v -> IO Property)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
    SigDSIGN v
sig <- ContextDSIGN v -> Message -> SignKeyDSIGNM v -> IO (SigDSIGN v)
forall v a (m :: * -> *).
(DSIGNMAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
forall a (m :: * -> *).
(Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
signDSIGNM () Message
msg SignKeyDSIGNM v
sk
    VerKeyDSIGN v
vk <- SignKeyDSIGNM v -> IO (VerKeyDSIGN v)
forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
forall (m :: * -> *).
(MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM SignKeyDSIGNM v
sk
    Property -> IO Property
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Property -> IO Property) -> Property -> IO Property
forall a b. (a -> b) -> a -> b
$ ContextDSIGN v
-> VerKeyDSIGN v -> Message -> SigDSIGN v -> Either TestName ()
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
forall a.
(Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
verifyDSIGN () VerKeyDSIGN v
vk Message
msg SigDSIGN v
sig Either TestName () -> Either TestName () -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== () -> Either TestName ()
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' =
  IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property)
-> (IO Property -> IO Property) -> IO Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lock -> IO Property -> IO Property
forall a. Lock -> IO a -> IO a
withLock Lock
lock (IO Property -> Property) -> IO Property -> Property
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 ((SignKeyDSIGNM v -> IO (SigDSIGN v)) -> IO (SigDSIGN v))
-> (SignKeyDSIGNM v -> IO (SigDSIGN v)) -> IO (SigDSIGN v)
forall a b. (a -> b) -> a -> b
$ ContextDSIGN v -> Message -> SignKeyDSIGNM v -> IO (SigDSIGN v)
forall v a (m :: * -> *).
(DSIGNMAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
forall a (m :: * -> *).
(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' SignKeyDSIGNM v -> IO (VerKeyDSIGN v)
forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
forall (m :: * -> *).
(MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM
    Property -> IO Property
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Property -> IO Property) -> Property -> IO Property
forall a b. (a -> b) -> a -> b
$
      PinnedSizedBytes (SeedSizeDSIGN v)
seedPSB PinnedSizedBytes (SeedSizeDSIGN v)
-> PinnedSizedBytes (SeedSizeDSIGN v) -> Bool
forall a. Eq a => a -> a -> Bool
/= PinnedSizedBytes (SeedSizeDSIGN v)
seedPSB' Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> ContextDSIGN v
-> VerKeyDSIGN v -> Message -> SigDSIGN v -> Either TestName ()
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
forall a.
(Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
verifyDSIGN () VerKeyDSIGN v
vk' Message
msg SigDSIGN v
sig Either TestName () -> Either TestName () -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=/= () -> Either TestName ()
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 = ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
forall a.
(Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
signDSIGN () a
msg SignKeyDSIGN v
sk
      vk :: VerKeyDSIGN v
vk = SignKeyDSIGN v -> VerKeyDSIGN v
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN v
sk
    in ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
forall a.
(Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
verifyDSIGN () VerKeyDSIGN v
vk a
msg' SigDSIGN v
signed Either TestName () -> Either TestName () -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=/= () -> Either TestName ()
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 = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> (Proxy v -> Word) -> Proxy v -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy v -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN (Proxy v -> Int) -> Proxy v -> Int
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v,
  expectedSKLen :: Int
expectedSKLen = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> (Proxy v -> Word) -> Proxy v -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy v -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSignKeyDSIGN (Proxy v -> Int) -> Proxy v -> Int
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v,
  expectedSigLen :: Int
expectedSigLen = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> (Proxy v -> Word) -> Proxy v -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy v -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSigDSIGN (Proxy v -> Int) -> Proxy v -> Int
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v
  }

#ifdef SECP256K1_ENABLED
testEcdsaInvalidMessageHash :: String -> TestTree
testEcdsaInvalidMessageHash :: TestName -> TestTree
testEcdsaInvalidMessageHash TestName
name = (QuickCheckTests -> QuickCheckTests) -> TestTree -> TestTree
forall v. IsOption v => (v -> v) -> TestTree -> TestTree
adjustOption QuickCheckTests -> QuickCheckTests
defaultTestEnough (TestTree -> TestTree)
-> ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> [TestTree] -> TestTree
testGroup TestName
name ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$ [
    TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"MessageHash deserialization (wrong length)" (Property -> TestTree)
-> ((BadInputFor MessageHash -> Property) -> Property)
-> (BadInputFor MessageHash -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Gen (BadInputFor MessageHash)
-> (BadInputFor MessageHash -> [BadInputFor MessageHash])
-> (BadInputFor MessageHash -> TestName)
-> (BadInputFor MessageHash -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> [a]) -> (a -> TestName) -> (a -> prop) -> Property
forAllShrinkShow (Int -> Gen (BadInputFor MessageHash)
forall a. Int -> Gen (BadInputFor a)
genBadInputFor Int
expectedMHLen)
                       (forall a. BadInputFor a -> [BadInputFor a]
shrinkBadInputFor @MessageHash)
                       BadInputFor MessageHash -> TestName
forall a. BadInputFor a -> TestName
showBadInputFor ((BadInputFor MessageHash -> Property) -> TestTree)
-> (BadInputFor MessageHash -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ (ByteString -> Maybe MessageHash)
-> BadInputFor MessageHash -> Property
forall a.
Show a =>
(ByteString -> Maybe a) -> BadInputFor a -> Property
prop_raw_deserialise ByteString -> Maybe MessageHash
toMessageHash
  ]
  where
    expectedMHLen :: Int
    expectedMHLen :: Int
expectedMHLen = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy SECP256K1_ECDSA_MESSAGE_BYTES -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy SECP256K1_ECDSA_MESSAGE_BYTES -> Integer)
-> Proxy SECP256K1_ECDSA_MESSAGE_BYTES -> Integer
forall a b. (a -> b) -> a -> b
$ forall (t :: Nat). Proxy t
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 = (QuickCheckTests -> QuickCheckTests) -> TestTree -> TestTree
forall v. IsOption v => (v -> v) -> TestTree -> TestTree
adjustOption QuickCheckTests -> QuickCheckTests
defaultTestEnough (TestTree -> TestTree)
-> ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> [TestTree] -> TestTree
testGroup TestName
name ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$ [
    TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Ecdsa sign and verify" (Property -> TestTree)
-> (((MessageHash, SignKeyDSIGN EcdsaSecp256k1DSIGN) -> Property)
    -> Property)
-> ((MessageHash, SignKeyDSIGN EcdsaSecp256k1DSIGN) -> Property)
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Gen (MessageHash, SignKeyDSIGN EcdsaSecp256k1DSIGN)
-> ((MessageHash, SignKeyDSIGN EcdsaSecp256k1DSIGN) -> TestName)
-> ((MessageHash, SignKeyDSIGN EcdsaSecp256k1DSIGN) -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> TestName) -> (a -> prop) -> Property
forAllShow ((,) (MessageHash
 -> SignKeyDSIGN EcdsaSecp256k1DSIGN
 -> (MessageHash, SignKeyDSIGN EcdsaSecp256k1DSIGN))
-> Gen MessageHash
-> Gen
     (SignKeyDSIGN EcdsaSecp256k1DSIGN
      -> (MessageHash, SignKeyDSIGN EcdsaSecp256k1DSIGN))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen MessageHash
genMsg Gen
  (SignKeyDSIGN EcdsaSecp256k1DSIGN
   -> (MessageHash, SignKeyDSIGN EcdsaSecp256k1DSIGN))
-> Gen (SignKeyDSIGN EcdsaSecp256k1DSIGN)
-> Gen (MessageHash, SignKeyDSIGN EcdsaSecp256k1DSIGN)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. DSIGNAlgorithm a => Gen (SignKeyDSIGN a)
defaultSignKeyGen @EcdsaSecp256k1DSIGN) (MessageHash, SignKeyDSIGN EcdsaSecp256k1DSIGN) -> TestName
forall a. Show a => a -> TestName
ppShow (((MessageHash, SignKeyDSIGN EcdsaSecp256k1DSIGN) -> Property)
 -> TestTree)
-> ((MessageHash, SignKeyDSIGN EcdsaSecp256k1DSIGN) -> Property)
-> TestTree
forall a b. (a -> b) -> a -> b
$
      (MessageHash, SignKeyDSIGN EcdsaSecp256k1DSIGN) -> Property
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 = Proxy h -> ByteString -> MessageHash
forall h.
(HashAlgorithm h, SizeHash h ~ SECP256K1_ECDSA_MESSAGE_BYTES) =>
Proxy h -> ByteString -> MessageHash
hashAndPack (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @h) (ByteString -> MessageHash)
-> (Message -> ByteString) -> Message -> MessageHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> ByteString
messageBytes (Message -> MessageHash) -> Gen Message -> Gen MessageHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Message
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 ((SignKeyDSIGNM v -> IO Property)
 -> PinnedSizedBytes (SeedSizeDSIGN v) -> Property)
-> (SignKeyDSIGNM v -> IO Property)
-> PinnedSizedBytes (SeedSizeDSIGN v)
-> Property
forall a b. (a -> b) -> a -> b
$ \SignKeyDSIGNM v
sk -> do
    SigDSIGN v
sig <- ContextDSIGN v -> Message -> SignKeyDSIGNM v -> IO (SigDSIGN v)
forall v a (m :: * -> *).
(DSIGNMAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
forall a (m :: * -> *).
(Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
signDSIGNM () Message
a SignKeyDSIGNM v
sk
    VerKeyDSIGN v
vk <- SignKeyDSIGNM v -> IO (VerKeyDSIGN v)
forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
forall (m :: * -> *).
(MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
deriveVerKeyDSIGNM SignKeyDSIGNM v
sk
    Property -> IO Property
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Property -> IO Property) -> Property -> IO Property
forall a b. (a -> b) -> a -> b
$
      Message
a Message -> Message -> Bool
forall a. Eq a => a -> a -> Bool
/= Message
a' Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> ContextDSIGN v
-> VerKeyDSIGN v -> Message -> SigDSIGN v -> Either TestName ()
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
forall a.
(Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
verifyDSIGN () VerKeyDSIGN v
vk Message
a' SigDSIGN v
sig Either TestName () -> Either TestName () -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=/= () -> Either TestName ()
forall a b. b -> Either a b
Right ()

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