{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Shelley.WitVKeys (
  tests,
)
where

import Cardano.Ledger.Core (EraIndependentTxBody)
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import Cardano.Ledger.Keys (DSignable, Hash)
import Cardano.Ledger.SafeHash (SafeHash)
import Data.List (nub, sort)
import Data.Set as Set (fromList, singleton)
import Test.Cardano.Ledger.Core.KeyPair (mkWitnessVKey)
import Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators ()
import Test.Cardano.Ledger.Shelley.Utils (RawSeed, mkKeyPair')
import Test.QuickCheck (conjoin, (===), (==>))
import Test.Tasty (TestTree)
import Test.Tasty.QuickCheck (testProperty)
import qualified Test.Tasty.QuickCheck as TQC

tests ::
  forall c.
  (CC.Crypto c, DSignable c (Hash c EraIndependentTxBody)) =>
  TestTree
tests :: forall c.
(Crypto c, DSignable c (Hash c EraIndependentTxBody)) =>
TestTree
tests = forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"WitVKey does not brake containers due to invalid Ord" forall a b. (a -> b) -> a -> b
$ forall c.
(Crypto c, DSignable c (Hash c EraIndependentTxBody)) =>
RawSeed
-> SafeHash c EraIndependentTxBody
-> SafeHash c EraIndependentTxBody
-> Property
witVKeysProp @c

witVKeysProp ::
  forall c.
  (CC.Crypto c, DSignable c (Hash c EraIndependentTxBody)) =>
  RawSeed ->
  SafeHash c EraIndependentTxBody ->
  SafeHash c EraIndependentTxBody ->
  TQC.Property
witVKeysProp :: forall c.
(Crypto c, DSignable c (Hash c EraIndependentTxBody)) =>
RawSeed
-> SafeHash c EraIndependentTxBody
-> SafeHash c EraIndependentTxBody
-> Property
witVKeysProp RawSeed
seed SafeHash c EraIndependentTxBody
h1 SafeHash c EraIndependentTxBody
h2 =
  let kp :: KeyPair kd c
kp = forall c (kd :: KeyRole).
DSIGNAlgorithm (DSIGN c) =>
RawSeed -> KeyPair kd c
mkKeyPair' RawSeed
seed
      w1 :: WitVKey 'Witness c
w1 = forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey SafeHash c EraIndependentTxBody
h1 forall {kd :: KeyRole}. KeyPair kd c
kp
      w2 :: WitVKey 'Witness c
w2 = forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey SafeHash c EraIndependentTxBody
h2 forall {kd :: KeyRole}. KeyPair kd c
kp
   in forall prop. Testable prop => [prop] -> Property
conjoin
        [ forall a. Ord a => [a] -> [a]
sort [WitVKey 'Witness c
w1, WitVKey 'Witness c
w2] forall a. (Eq a, Show a) => a -> a -> Property
=== forall a. Ord a => [a] -> [a]
sort [WitVKey 'Witness c
w2, WitVKey 'Witness c
w1]
        , forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Eq a => [a] -> [a]
nub [WitVKey 'Witness c
w1, WitVKey 'Witness c
w2]) forall a. (Eq a, Show a) => a -> a -> Property
=== forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Ord a => [a] -> Set a
Set.fromList [WitVKey 'Witness c
w1, WitVKey 'Witness c
w2])
        , WitVKey 'Witness c
w1 forall a. Eq a => a -> a -> Bool
/= WitVKey 'Witness c
w2 forall prop. Testable prop => Bool -> prop -> Property
==> forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. a -> Set a
Set.singleton WitVKey 'Witness c
w1 forall a. Semigroup a => a -> a -> a
<> forall a. a -> Set a
Set.singleton WitVKey 'Witness c
w2) forall a. (Eq a, Show a) => a -> a -> Property
=== Int
2
        ]