From 07baf50fb18d0be7582ad342596a72076e484514 Mon Sep 17 00:00:00 2001 From: Thomas Winant Date: Wed, 28 Oct 2020 15:47:40 +0100 Subject: [PATCH] Update dependency on cardano-ledger-specs The main reason is to pull in: https://github.com/input-output-hk/cardano-ledger-specs/pull/1943 --- cabal.project | 4 +-- .../src/Test/ThreadNet/TxGen/Cardano.hs | 32 +++++++++---------- .../src/Test/Consensus/Shelley/Examples.hs | 4 +-- .../src/Test/Consensus/Shelley/MockCrypto.hs | 7 ++++ .../src/Test/ThreadNet/Infra/Shelley.hs | 26 +++++++-------- .../src/Ouroboros/Consensus/Shelley/Eras.hs | 1 + .../Consensus/Shelley/Ledger/Inspect.hs | 1 - .../Consensus/Shelley/Ledger/Ledger.hs | 3 +- 8 files changed, 39 insertions(+), 39 deletions(-) diff --git a/cabal.project b/cabal.project index f9ad37583b7..9c9aeb95cd3 100644 --- a/cabal.project +++ b/cabal.project @@ -152,8 +152,8 @@ source-repository-package source-repository-package type: git location: https://github.com/input-output-hk/cardano-ledger-specs - tag: 1a2d7717682f8191cf818362df28ac20fac19b83 - --sha256: 136pp0653w8chk53wnz6mlkdhf0ldglrb74p1i93d1xnf6ssvjhs + tag: 623bbb8d4b13bcb0157c5c576a69536387f1b5be + --sha256: 0nspz67p6ixw4zr6q4r2gzn37583mlag8f1g5pk0i4f1yisi69d1 subdir: byron/chain/executable-spec byron/crypto diff --git a/ouroboros-consensus-cardano-test/src/Test/ThreadNet/TxGen/Cardano.hs b/ouroboros-consensus-cardano-test/src/Test/ThreadNet/TxGen/Cardano.hs index 77f8b283a81..7322078b552 100644 --- a/ouroboros-consensus-cardano-test/src/Test/ThreadNet/TxGen/Cardano.hs +++ b/ouroboros-consensus-cardano-test/src/Test/ThreadNet/TxGen/Cardano.hs @@ -31,8 +31,6 @@ import Ouroboros.Consensus.Ledger.Basics (LedgerConfig, LedgerState, applyChainTick) import Ouroboros.Consensus.NodeId (CoreNodeId (..)) -import Cardano.Binary (toCBOR) - import Cardano.Crypto (toVerification) import qualified Cardano.Crypto.Signing as Byron @@ -45,9 +43,10 @@ import qualified Shelley.Spec.Ledger.Address.Bootstrap as SL (makeBootstrapWitness) import qualified Shelley.Spec.Ledger.API as SL import qualified Shelley.Spec.Ledger.BaseTypes as SL (truncateUnitInterval) -import qualified Shelley.Spec.Ledger.Keys as SL (hashWithSerialiser, - signedDSIGN) import qualified Shelley.Spec.Ledger.Tx as SL (WitnessSetHKD (..)) +import qualified Shelley.Spec.Ledger.TxBody as SL (EraIndependentTxBody, + eraIndTxBodyHash) +import qualified Shelley.Spec.Ledger.UTxO as SL (makeWitnessVKey) import Ouroboros.Consensus.Shelley.Ledger (GenTx, ShelleyBlock, mkShelleyTx) @@ -187,8 +186,8 @@ migrateUTxO migrationInfo curSlot lcfg lst , SL._wdrls = SL.Wdrl Map.empty } - bodyHash :: SL.Hash c (SL.TxBody (ShelleyEra c)) - bodyHash = SL.hashWithSerialiser toCBOR body + bodyHash :: SL.Hash c SL.EraIndependentTxBody + bodyHash = SL.eraIndTxBodyHash body -- Witness the use of bootstrap address's utxo. byronWit :: SL.BootstrapWitness (ShelleyEra c) @@ -199,16 +198,16 @@ migrateUTxO migrationInfo curSlot lcfg lst -- Witness the stake delegation. delegWit :: SL.WitVKey 'SL.Witness (ShelleyEra c) delegWit = - SL.WitVKey - (Shelley.mkVerKey stakingSK) - (SL.signedDSIGN @c stakingSK bodyHash) + SL.makeWitnessVKey + bodyHash + (Shelley.mkKeyPair stakingSK) -- Witness the pool registration. poolWit :: SL.WitVKey 'SL.Witness (ShelleyEra c) poolWit = - SL.WitVKey - (Shelley.mkVerKey poolSK) - (SL.signedDSIGN @c poolSK bodyHash) + SL.makeWitnessVKey + bodyHash + (Shelley.mkKeyPair poolSK) in if Map.null picked then Nothing else @@ -217,10 +216,9 @@ migrateUTxO migrationInfo curSlot lcfg lst { SL._body = body , SL._metadata = SL.SNothing , SL._witnessSet = SL.WitnessSet - { SL.addrWits = Set.fromList [delegWit, poolWit] - , SL.bootWits = Set.singleton byronWit - , SL.msigWits = Map.empty - } + (Set.fromList [delegWit, poolWit]) + mempty + (Set.singleton byronWit) } | otherwise = Nothing @@ -262,7 +260,7 @@ migrateUTxO migrationInfo curSlot lcfg lst , SL._poolMargin = SL.truncateUnitInterval 0 , SL._poolOwners = Set.singleton $ Shelley.mkKeyHash poolSK , SL._poolPledge = pledge - , SL._poolPubKey = Shelley.mkKeyHash poolSK + , SL._poolId = Shelley.mkKeyHash poolSK , SL._poolRAcnt = SL.RewardAcnt Shelley.networkId $ Shelley.mkCredential poolSK , SL._poolRelays = StrictSeq.empty diff --git a/ouroboros-consensus-shelley-test/src/Test/Consensus/Shelley/Examples.hs b/ouroboros-consensus-shelley-test/src/Test/Consensus/Shelley/Examples.hs index 079f68f6f72..a05d0d5cd43 100644 --- a/ouroboros-consensus-shelley-test/src/Test/Consensus/Shelley/Examples.hs +++ b/ouroboros-consensus-shelley-test/src/Test/Consensus/Shelley/Examples.hs @@ -440,7 +440,7 @@ exampleNewEpochState = SL.NewEpochState { rewardUpdate :: SL.RewardUpdate era rewardUpdate = SL.RewardUpdate { deltaT = SL.Coin 10 - , deltaR = SL.Coin (- 100) + , deltaR = SL.DeltaCoin (- 100) , rs = Map.singleton (keyToCredential exampleStakeKey) (SL.Coin 10) , deltaF = SL.DeltaCoin (- 3) , nonMyopic = nonMyopic @@ -491,7 +491,7 @@ exampleKeys = examplePoolParams :: forall era. ShelleyBasedEra era => SL.PoolParams era examplePoolParams = SL.PoolParams { - _poolPubKey = SL.hashKey $ SL.vKey $ SL.cold poolKeys + _poolId = SL.hashKey $ SL.vKey $ SL.cold poolKeys , _poolVrf = SL.hashVerKeyVRF $ snd $ SL.vrf poolKeys , _poolPledge = SL.Coin 1 , _poolCost = SL.Coin 5 diff --git a/ouroboros-consensus-shelley-test/src/Test/Consensus/Shelley/MockCrypto.hs b/ouroboros-consensus-shelley-test/src/Test/Consensus/Shelley/MockCrypto.hs index df260bd9a4e..d1a6729ad41 100644 --- a/ouroboros-consensus-shelley-test/src/Test/Consensus/Shelley/MockCrypto.hs +++ b/ouroboros-consensus-shelley-test/src/Test/Consensus/Shelley/MockCrypto.hs @@ -12,11 +12,16 @@ module Test.Consensus.Shelley.MockCrypto ( , CanMock ) where +import Test.QuickCheck (Arbitrary) + import Cardano.Crypto.DSIGN (MockDSIGN) import Cardano.Crypto.Hash (HashAlgorithm) import Cardano.Crypto.KES (MockKES) +import Cardano.Ledger.Core (Value) import Cardano.Ledger.Crypto (Crypto (..)) +import qualified Shelley.Spec.Ledger.API as SL + import Test.Cardano.Crypto.VRF.Fake (FakeVRF) import qualified Test.Shelley.Spec.Ledger.ConcreteCryptoTypes as SL (Mock) import qualified Test.Shelley.Spec.Ledger.Utils as SL (ShelleyTest) @@ -53,4 +58,6 @@ type CanMock era = , SL.Mock (EraCrypto era) -- TODO #2677 the generators in the ledger impose this constraint , SL.ShelleyTest era + , Arbitrary (SL.WitnessSet era) + , Arbitrary (Value era) ) diff --git a/ouroboros-consensus-shelley-test/src/Test/ThreadNet/Infra/Shelley.hs b/ouroboros-consensus-shelley-test/src/Test/ThreadNet/Infra/Shelley.hs index 634612aa9b0..4a09d85f9c4 100644 --- a/ouroboros-consensus-shelley-test/src/Test/ThreadNet/Infra/Shelley.hs +++ b/ouroboros-consensus-shelley-test/src/Test/ThreadNet/Infra/Shelley.hs @@ -28,6 +28,7 @@ module Test.ThreadNet.Infra.Shelley ( , mkProtocolShelley , mkSetDecentralizationParamTxs , mkVerKey + , mkKeyPair , networkId , tpraosSlotLength , initialLovelacePerCoreNode @@ -85,7 +86,6 @@ import Ouroboros.Consensus.Shelley.Ledger (GenTx (..), import Ouroboros.Consensus.Shelley.Node import Ouroboros.Consensus.Shelley.Protocol -import qualified Test.Shelley.Spec.Ledger.ConcreteCryptoTypes as CSL import qualified Test.Shelley.Spec.Ledger.Generator.Core as Gen {------------------------------------------------------------------------------- @@ -143,13 +143,13 @@ data CoreNodeKeyInfo c = CoreNodeKeyInfo ) } -coreNodeKeys :: forall c. CSL.Mock c => CoreNode c -> CoreNodeKeyInfo c +coreNodeKeys :: forall c. TPraosCrypto c => CoreNode c -> CoreNodeKeyInfo c coreNodeKeys CoreNode{cnGenesisKey, cnDelegateKey, cnStakingKey} = CoreNodeKeyInfo { cnkiCoreNode = - ( mkDSIGNKeyPair cnGenesisKey + ( mkKeyPair cnGenesisKey , Gen.AllIssuerKeys - { Gen.cold = mkDSIGNKeyPair cnDelegateKey + { Gen.cold = mkKeyPair cnDelegateKey -- 'CoreNodeKeyInfo' is used for all sorts of generators, not -- only transaction generators. To generate transactions we -- don't need all these keys, hence the 'error's. @@ -158,11 +158,8 @@ coreNodeKeys CoreNode{cnGenesisKey, cnDelegateKey, cnStakingKey} = , Gen.hk = error "hk used while generating transactions" } ) - , cnkiKeyPair = (mkDSIGNKeyPair cnDelegateKey, mkDSIGNKeyPair cnStakingKey) + , cnkiKeyPair = (mkKeyPair cnDelegateKey, mkKeyPair cnStakingKey) } - where - mkDSIGNKeyPair :: SL.SignKeyDSIGN c -> SL.KeyPair kd c - mkDSIGNKeyPair k = SL.KeyPair (SL.VKey $ deriveVerKeyDSIGN k) k genCoreNode :: forall c. TPraosCrypto c @@ -358,7 +355,7 @@ mkGenesisConfig pVer k f d maxLovelaceSupply slotLength kesCfg coreNodes = initialStake = ShelleyGenesisStaking { sgsPools = Map.fromList [ (pk, pp) - | pp@(SL.PoolParams { _poolPubKey = pk }) <- Map.elems coreNodeToPoolMapping + | pp@(SL.PoolParams { _poolId = pk }) <- Map.elems coreNodeToPoolMapping ] -- The staking key maps to the key hash of the pool, which is set to the -- "delegate key" in order that nodes may issue blocks both as delegates @@ -376,7 +373,7 @@ mkGenesisConfig pVer k f d maxLovelaceSupply slotLength kesCfg coreNodes = coreNodeToPoolMapping = Map.fromList [ ( SL.hashKey . SL.VKey . deriveVerKeyDSIGN $ cnStakingKey , SL.PoolParams - { SL._poolPubKey = poolHash + { SL._poolId = poolHash , SL._poolVrf = vrfHash -- Each core node pledges its full stake to the pool. , SL._poolPledge = SL.Coin $ fromIntegral initialLovelacePerCoreNode @@ -441,11 +438,7 @@ mkSetDecentralizationParamTxs coreNodes pVer ttl dNew = scheduledEpoch = EpochNo 0 witnessSet :: SL.WitnessSet (ShelleyEra c) - witnessSet = SL.WitnessSet - { addrWits = signatures - , bootWits = Set.empty - , msigWits = Map.empty - } + witnessSet = SL.WitnessSet signatures mempty mempty -- Every node signs the transaction body, since it includes a " vote " from -- every node. @@ -527,6 +520,9 @@ mkKeyHash = SL.hashKey . mkVerKey mkVerKey :: TPraosCrypto c => SL.SignKeyDSIGN c -> SL.VKey r c mkVerKey = SL.VKey . deriveVerKeyDSIGN +mkKeyPair :: TPraosCrypto c => SL.SignKeyDSIGN c -> SL.KeyPair r c +mkKeyPair sk = SL.KeyPair { vKey = mkVerKey sk, sKey = sk } + mkKeyHashVrf :: (HashAlgorithm h, VRFAlgorithm vrf) => SignKeyVRF vrf -> Hash h (VerKeyVRF vrf) diff --git a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Eras.hs b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Eras.hs index cbee5af730f..e4d99056d18 100644 --- a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Eras.hs +++ b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Eras.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableSuperClasses #-} module Ouroboros.Consensus.Shelley.Eras ( -- * Eras based on the Shelley ledger diff --git a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Ledger/Inspect.hs b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Ledger/Inspect.hs index 05fcd642ecf..1c4b9e772a7 100644 --- a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Ledger/Inspect.hs +++ b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Ledger/Inspect.hs @@ -29,7 +29,6 @@ import Ouroboros.Consensus.Util.Condense import qualified Shelley.Spec.Ledger.API as SL import Shelley.Spec.Ledger.BaseTypes (strictMaybeToMaybe) -import qualified Shelley.Spec.Ledger.LedgerState as SL (proposals) import qualified Shelley.Spec.Ledger.PParams as SL (PParamsUpdate) import Ouroboros.Consensus.Shelley.Eras (EraCrypto) diff --git a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs index 5d44961cdb6..5d4191afe4c 100644 --- a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs +++ b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs @@ -93,8 +93,7 @@ import Ouroboros.Consensus.Util.CBOR (decodeWithOrigin, import Ouroboros.Consensus.Util.Versioned import qualified Shelley.Spec.Ledger.API as SL -import qualified Shelley.Spec.Ledger.LedgerState as SL (RewardAccounts, - proposals) +import qualified Shelley.Spec.Ledger.LedgerState as SL (RewardAccounts) import qualified Shelley.Spec.Ledger.STS.Chain as SL (PredicateFailure) import Ouroboros.Consensus.Shelley.Eras (EraCrypto)