Improve cardano-protocol-tpraos:testlib:

Recent PR #3333 changed semantics of Arbitrary instances, which ended
up breaking a test in consensus repo. In order to fix it we need to
expose previous generator functionality.

* Add `TestCardano.Protocol.Crypto`:
  * Create `VRFKeyPair` and `KESKeyPair` in `VRF` and `KES` modules
    respectively. And start using them everywhere instead of tuples.
  * Move `FakeVRF` from `cardano-ledger-shelley-test` to `VRF.Fake`
    module.

* Add `Test.Cardano.Protocol.TPraos.Create`:
  * Add `mkBHeader`
  * Move from `cardano-ledegr-shelley-test`: `mkOCert`, `mkBHBody`, `mkBlock`
  * Move `AllIssuerKeys` from `cardano-ledger-shelley-test`. Rename its fields:
    *  `cold` - > `aikCold`
    *  `hot` - > `aikHot`
    *  `vrf` - > `aikVrf`
    *  `hk` - > `aikColdKeyHash`
* New generators in `Test.Cardano.Protocol.TPraos.Arbitrary`:
  * Bring back `genBlock`
  * Move `genCoherentBlock` from `cardano-ledegr-shelley-test` and change it to
    accept `AllIssuerKeys` as an argument.

Author: lehins

cabal.project

@@ -74,7 +74,7 @@ package cardano-ledger-core
 package cardano-ledger-shelley
   flags: +asserts
 
--- Always write GHC env files, because they are needed by the doctests.
+-- Always write GHC env files, because they are needed by for repl and doctest.
 write-ghc-environment-files: always
 
 -- Always build tests and benchmarks.

eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Bbody.hs

@@ -27,7 +27,7 @@ import Cardano.Ledger.BaseTypes (BlocksMade, ShelleyBase, epochInfoPure)
 import Cardano.Ledger.Block (Block (..))
 import Cardano.Ledger.Core
 import Cardano.Ledger.Keys (DSignable, Hash, coerceKeyRole)
-import Cardano.Ledger.Shelley.BlockChain (bBodySize, incrBlocks)
+import Cardano.Ledger.Shelley.BlockChain (incrBlocks)
 import Cardano.Ledger.Shelley.Era (ShelleyBBODY)
 import Cardano.Ledger.Shelley.LedgerState (
   AccountState,

eras/shelley/test-suite/bench/Cardano/Ledger/Shelley/Bench/Rewards.hs

@@ -53,6 +53,7 @@ import Test.Cardano.Ledger.Shelley.Generator.Core (
   AllIssuerKeys (..),
   GenEnv (..),
   ScriptSpace (..),
+  VRFKeyPair (..),
   geConstants,
   geKeySpace,
   ksStakePools,
@@ -136,12 +137,12 @@ genChainInEpoch epoch = do
       ShelleyGenesisStaking
         { sgsPools =
             LM.ListMap
-              [ (hk, pp)
-              | (AllIssuerKeys {vrf, hk}, (owner : _)) <- stakeMap
+              [ (aikColdKeyHash, pp)
+              | (AllIssuerKeys {aikVrf, aikColdKeyHash}, (owner : _)) <- stakeMap
               , let pp =
                       PoolParams
-                        { ppId = hk
-                        , ppVrf = hashVerKeyVRF $ snd vrf
+                        { ppId = aikColdKeyHash
+                        , ppVrf = hashVerKeyVRF $ vrfVerKey aikVrf
                         , ppPledge = Coin 1
                         , ppCost = Coin 1
                         , ppMargin = minBound
@@ -153,8 +154,8 @@ genChainInEpoch epoch = do
               ]
         , sgsStake =
             LM.ListMap
-              [ (dlg, hk)
-              | (AllIssuerKeys {hk}, dlgs) <- stakeMap
+              [ (dlg, aikColdKeyHash)
+              | (AllIssuerKeys {aikColdKeyHash}, dlgs) <- stakeMap
               , dlg <- dlgs
               ]
         }

eras/shelley/test-suite/cardano-ledger-shelley-test.cabal

@@ -21,7 +21,6 @@ source-repository head
 
 library
     exposed-modules:
-        Test.Cardano.Crypto.VRF.Fake
         Test.Cardano.Ledger.TerseTools
         Test.Cardano.Ledger.Shelley.Address.Bootstrap
         Test.Cardano.Ledger.Shelley.BenchmarkFunctions
@@ -169,7 +168,7 @@ test-suite cardano-ledger-shelley-test
         cardano-ledger-pretty,
         cardano-ledger-shelley:{cardano-ledger-shelley, testlib},
         cardano-ledger-shelley-test >=1.1,
-        cardano-protocol-tpraos,
+        cardano-protocol-tpraos:{cardano-protocol-tpraos, testlib},
         cardano-slotting,
         cborg,
         containers,

eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/BenchmarkFunctions.hs

@@ -89,6 +89,7 @@ import qualified Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes as Original (
   C_Crypto,
  )
 import Test.Cardano.Ledger.Shelley.Generator.Core (
+  VRFKeyPair (..),
   genesisCoins,
  )
 import Test.Cardano.Ledger.Shelley.Generator.EraGen (genesisId)
@@ -394,18 +395,18 @@ firstStakePoolKeyHash :: KeyHash 'StakePool B_Crypto
 firstStakePoolKeyHash = mkPoolKeyHash firstStakePool
 
 vrfKeyHash :: Hash B_Crypto (VerKeyVRF B_Crypto)
-vrfKeyHash = hashVerKeyVRF . snd . mkVRFKeyPair $ RawSeed 0 0 0 0 0
+vrfKeyHash = hashVerKeyVRF . vrfVerKey . mkVRFKeyPair @B_Crypto $ RawSeed 0 0 0 0 0
 
 mkPoolParameters :: KeyPair 'StakePool B_Crypto -> PoolParams B_Crypto
 mkPoolParameters keys =
   PoolParams
-    { ppId = (hashKey . vKey) keys
+    { ppId = hashKey (vKey keys)
     , ppVrf = vrfKeyHash
     , ppPledge = Coin 0
     , ppCost = Coin 0
     , ppMargin = unsafeBoundRational 0
     , ppRewardAcnt = RewardAcnt Testnet firstStakeKeyCred
-    , ppOwners = Set.singleton $ (hashKey . vKey) stakeKeyOne
+    , ppOwners = Set.singleton $ hashKey (vKey stakeKeyOne)
     , ppRelays = StrictSeq.empty
     , ppMetadata = SNothing
     }

eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/ConcreteCryptoTypes.hs

@@ -24,7 +24,7 @@ import Cardano.Ledger.BaseTypes (Seed)
 import Cardano.Ledger.Crypto
 import Cardano.Ledger.Shelley (ShelleyEra)
 import Cardano.Protocol.TPraos.API (PraosCrypto)
-import Test.Cardano.Crypto.VRF.Fake (FakeVRF)
+import Test.Cardano.Protocol.Crypto.VRF.Fake (FakeVRF)
 
 -- | Mocking constraints used in generators
 type Mock c =

eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Cast.hs

@@ -51,7 +51,7 @@ import Cardano.Ledger.Credential (
   Ptr (..),
   StakeReference (..),
  )
-import qualified Cardano.Ledger.Crypto as CC (Crypto)
+import Cardano.Ledger.Crypto (Crypto)
 import Cardano.Ledger.Keys (
   Hash,
   KeyRole (..),
@@ -67,12 +67,14 @@ import Cardano.Ledger.Shelley.TxBody (
 import Cardano.Ledger.Slot (SlotNo (..))
 import Cardano.Protocol.TPraos.OCert (KESPeriod (..))
 import qualified Data.ByteString.Char8 as BS (pack)
+import qualified Data.List.NonEmpty as NE
 import Data.Maybe (fromJust)
 import qualified Data.Sequence.Strict as StrictSeq
 import qualified Data.Set as Set
 import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkAddr)
 import Test.Cardano.Ledger.Shelley.Generator.Core (
   AllIssuerKeys (..),
+  VRFKeyPair (..),
  )
 import Test.Cardano.Ledger.Shelley.Utils (
   RawSeed (..),
@@ -83,50 +85,50 @@ import Test.Cardano.Ledger.Shelley.Utils (
  )
 
 -- | Alice's payment key pair
-alicePay :: CC.Crypto c => KeyPair 'Payment c
+alicePay :: Crypto c => KeyPair 'Payment c
 alicePay = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair (RawSeed 0 0 0 0 0)
 
 -- | Alice's stake key pair
-aliceStake :: CC.Crypto c => KeyPair 'Staking c
+aliceStake :: Crypto c => KeyPair 'Staking c
 aliceStake = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair (RawSeed 1 1 1 1 1)
 
 -- | Alice's stake pool keys (cold keys, VRF keys, hot KES keys)
-alicePoolKeys :: CC.Crypto c => AllIssuerKeys c 'StakePool
+alicePoolKeys :: Crypto c => AllIssuerKeys c 'StakePool
 alicePoolKeys =
   AllIssuerKeys
     (KeyPair vkCold skCold)
     (mkVRFKeyPair (RawSeed 1 0 0 0 2))
-    [(KESPeriod 0, mkKESKeyPair (RawSeed 1 0 0 0 3))]
+    ((KESPeriod 0, mkKESKeyPair (RawSeed 1 0 0 0 3)) NE.:| [])
     (hashKey vkCold)
   where
     (skCold, vkCold) = mkKeyPair (RawSeed 1 0 0 0 1)
 
 -- | Alice's base address
-aliceAddr :: CC.Crypto c => Addr c
+aliceAddr :: Crypto c => Addr c
 aliceAddr = mkAddr (alicePay, aliceStake)
 
 -- | Alice's payment credential
-alicePHK :: CC.Crypto c => Credential 'Payment c
+alicePHK :: Crypto c => Credential 'Payment c
 alicePHK = (KeyHashObj . hashKey . vKey) alicePay
 
 -- | Alice's stake credential
-aliceSHK :: CC.Crypto c => Credential 'Staking c
+aliceSHK :: Crypto c => Credential 'Staking c
 aliceSHK = (KeyHashObj . hashKey . vKey) aliceStake
 
 -- | Alice's base address
-alicePtrAddr :: CC.Crypto c => Addr c
+alicePtrAddr :: Crypto c => Addr c
 alicePtrAddr = Addr Testnet alicePHK (StakeRefPtr $ Ptr (SlotNo 10) minBound minBound)
 
 -- | Alice's stake pool parameters
-alicePoolParams :: forall c. CC.Crypto c => PoolParams c
+alicePoolParams :: forall c. Crypto c => PoolParams c
 alicePoolParams =
   PoolParams
-    { ppId = (hashKey . vKey . cold) alicePoolKeys
-    , ppVrf = hashVerKeyVRF . snd $ vrf (alicePoolKeys @c)
+    { ppId = hashKey . vKey $ aikCold alicePoolKeys
+    , ppVrf = hashVerKeyVRF . vrfVerKey $ aikVrf (alicePoolKeys @c)
     , ppPledge = Coin 1
     , ppCost = Coin 5
     , ppMargin = unsafeBoundRational 0.1
@@ -144,99 +146,99 @@ alicePoolParams =
 -- | Alice's VRF key hash
 aliceVRFKeyHash ::
   forall c.
-  CC.Crypto c =>
+  Crypto c =>
   Hash c (VerKeyVRF c)
-aliceVRFKeyHash = hashVerKeyVRF (snd $ vrf (alicePoolKeys @c))
+aliceVRFKeyHash = hashVerKeyVRF (vrfVerKey $ aikVrf (alicePoolKeys @c))
 
 -- | Bob's payment key pair
-bobPay :: CC.Crypto c => KeyPair 'Payment c
+bobPay :: Crypto c => KeyPair 'Payment c
 bobPay = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair (RawSeed 2 2 2 2 2)
 
 -- | Bob's stake key pair
-bobStake :: CC.Crypto c => KeyPair 'Staking c
+bobStake :: Crypto c => KeyPair 'Staking c
 bobStake = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair (RawSeed 3 3 3 3 3)
 
 -- | Bob's address
-bobAddr :: CC.Crypto c => Addr c
+bobAddr :: Crypto c => Addr c
 bobAddr = mkAddr (bobPay, bobStake)
 
 -- | Bob's stake credential
-bobSHK :: CC.Crypto c => Credential 'Staking c
+bobSHK :: Crypto c => Credential 'Staking c
 bobSHK = (KeyHashObj . hashKey . vKey) bobStake
 
 -- | Bob's stake pool keys (cold keys, VRF keys, hot KES keys)
-bobPoolKeys :: CC.Crypto c => AllIssuerKeys c 'StakePool
+bobPoolKeys :: Crypto c => AllIssuerKeys c 'StakePool
 bobPoolKeys =
   AllIssuerKeys
     (KeyPair vkCold skCold)
     (mkVRFKeyPair (RawSeed 2 0 0 0 2))
-    [(KESPeriod 0, mkKESKeyPair (RawSeed 2 0 0 0 3))]
+    ((KESPeriod 0, mkKESKeyPair (RawSeed 2 0 0 0 3)) NE.:| [])
     (hashKey vkCold)
   where
     (skCold, vkCold) = mkKeyPair (RawSeed 2 0 0 0 1)
 
 -- | Bob's stake pool parameters
-bobPoolParams :: forall c. CC.Crypto c => PoolParams c
+bobPoolParams :: forall c. Crypto c => PoolParams c
 bobPoolParams =
   PoolParams
-    { ppId = (hashKey . vKey . cold) bobPoolKeys
-    , ppVrf = hashVerKeyVRF . snd $ vrf (bobPoolKeys @c)
+    { ppId = hashKey . vKey $ aikCold bobPoolKeys
+    , ppVrf = hashVerKeyVRF . vrfVerKey $ aikVrf (bobPoolKeys @c)
     , ppPledge = Coin 2
     , ppCost = Coin 1
     , ppMargin = unsafeBoundRational 0.1
     , ppRewardAcnt = RewardAcnt Testnet bobSHK
-    , ppOwners = Set.singleton $ (hashKey . vKey) bobStake
+    , ppOwners = Set.singleton $ hashKey (vKey bobStake)
     , ppRelays = StrictSeq.empty
     , ppMetadata = SNothing
     }
 
 -- | Bob's VRF key hash
 bobVRFKeyHash ::
   forall c.
-  CC.Crypto c =>
+  Crypto c =>
   Hash c (VerKeyVRF c)
-bobVRFKeyHash = hashVerKeyVRF (snd $ vrf (bobPoolKeys @c))
+bobVRFKeyHash = hashVerKeyVRF (vrfVerKey $ aikVrf (bobPoolKeys @c))
 
 -- Carl's payment key pair
-carlPay :: CC.Crypto c => KeyPair 'Payment c
+carlPay :: Crypto c => KeyPair 'Payment c
 carlPay = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair (RawSeed 4 4 4 4 4)
 
 -- | Carl's stake key pair
-carlStake :: CC.Crypto c => KeyPair 'Staking c
+carlStake :: Crypto c => KeyPair 'Staking c
 carlStake = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair (RawSeed 5 5 5 5 5)
 
 -- | Carl's address
-carlAddr :: CC.Crypto c => Addr c
+carlAddr :: Crypto c => Addr c
 carlAddr = mkAddr (carlPay, carlStake)
 
 -- | Carl's stake credential
-carlSHK :: CC.Crypto c => Credential 'Staking c
+carlSHK :: Crypto c => Credential 'Staking c
 carlSHK = (KeyHashObj . hashKey . vKey) carlStake
 
 -- | Daria's payment key pair
-dariaPay :: CC.Crypto c => KeyPair 'Payment c
+dariaPay :: Crypto c => KeyPair 'Payment c
 dariaPay = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair (RawSeed 6 6 6 6 6)
 
 -- | Daria's stake key pair
-dariaStake :: CC.Crypto c => KeyPair 'Staking c
+dariaStake :: Crypto c => KeyPair 'Staking c
 dariaStake = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair (RawSeed 7 7 7 7 7)
 
 -- | Daria's address
-dariaAddr :: CC.Crypto c => Addr c
+dariaAddr :: Crypto c => Addr c
 dariaAddr = mkAddr (dariaPay, dariaStake)
 
 -- | Daria's stake credential
-dariaSHK :: CC.Crypto c => Credential 'Staking c
+dariaSHK :: Crypto c => Credential 'Staking c
 dariaSHK = (KeyHashObj . hashKey . vKey) dariaStake