diff --git a/.stack-to-nix.cache b/.stack-to-nix.cache index 8f1ad83799d..46f9d839892 100644 --- a/.stack-to-nix.cache +++ b/.stack-to-nix.cache @@ -135,3 +135,7 @@ https://github.com/input-output-hk/cardano-sl 16f5095cbf5d1128e379b44c10ff411425 https://github.com/input-output-hk/cardano-sl 16f5095cbf5d1128e379b44c10ff4114253cefb9 crypto 1qhrf2mmnmmjvl325ha8vghc6mnm72q9vab0x0df70sxcknhv5ay cardano-sl-crypto cardano-sl-crypto.nix https://github.com/input-output-hk/cardano-sl 16f5095cbf5d1128e379b44c10ff4114253cefb9 crypto/test 1qhrf2mmnmmjvl325ha8vghc6mnm72q9vab0x0df70sxcknhv5ay cardano-sl-crypto-test cardano-sl-crypto-test.nix https://github.com/input-output-hk/cardano-sl 16f5095cbf5d1128e379b44c10ff4114253cefb9 networking 1qhrf2mmnmmjvl325ha8vghc6mnm72q9vab0x0df70sxcknhv5ay cardano-sl-networking cardano-sl-networking.nix +https://github.com/input-output-hk/cardano-ledger e2d4663f2251ef76bae94e48fef910b8f5f867bd cardano-ledger 04kynh9gnw1s0wvp3hx05scjz1h164qclwbkdx44j8qrgjxi4vn7 cardano-ledger cardano-ledger.nix +https://github.com/input-output-hk/cardano-ledger e2d4663f2251ef76bae94e48fef910b8f5f867bd cardano-ledger/test 04kynh9gnw1s0wvp3hx05scjz1h164qclwbkdx44j8qrgjxi4vn7 cardano-ledger-test cardano-ledger-test.nix +https://github.com/input-output-hk/cardano-ledger e2d4663f2251ef76bae94e48fef910b8f5f867bd crypto 04kynh9gnw1s0wvp3hx05scjz1h164qclwbkdx44j8qrgjxi4vn7 cardano-crypto-wrapper cardano-crypto-wrapper.nix +https://github.com/input-output-hk/cardano-ledger e2d4663f2251ef76bae94e48fef910b8f5f867bd crypto/test 04kynh9gnw1s0wvp3hx05scjz1h164qclwbkdx44j8qrgjxi4vn7 cardano-crypto-test cardano-crypto-test.nix diff --git a/byron-proxy/src/exec/Validator.hs b/byron-proxy/src/exec/Validator.hs index e919d5ebc7b..997d421238c 100644 --- a/byron-proxy/src/exec/Validator.hs +++ b/byron-proxy/src/exec/Validator.hs @@ -3,10 +3,11 @@ {-# LANGUAGE FlexibleInstances #-} import Codec.SerialiseTerm (CodecCBORTerm (..)) -import Control.Monad.Trans.Except (runExceptT) -import Control.Tracer (Tracer (..), contramap, traceWith) import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Except (runExceptT) +import Control.Monad.Trans.Reader (runReaderT) import Control.Monad.Trans.Resource (ResourceT) +import Control.Tracer (Tracer (..), contramap, traceWith) import Data.Text (Text, pack) import qualified Options.Applicative as Opt @@ -17,7 +18,8 @@ import qualified Cardano.Binary as Binary (unAnnotated) import Cardano.Chain.Block (ChainValidationState (..)) import qualified Cardano.Chain.Block as Block import qualified Cardano.Chain.Genesis as Genesis -import Cardano.Chain.Slotting (FlatSlotId(..)) +import Cardano.Chain.Slotting (SlotNumber(..)) +import Cardano.Chain.ValidationMode (fromBlockValidationMode) import Cardano.Crypto (RequiresNetworkMagic(..), decodeAbstractHash) import Cardano.Shell.Constants.Types (CardanoConfiguration (..), Core (..), Genesis (..)) @@ -51,14 +53,16 @@ clientFold -> Client.Fold (ResourceT IO) () -- Either ChainValidationError (t, ChainValidationState)) clientFold tracer genesisConfig stopCondition cvs = Client.Fold $ pure $ Client.Continue (\block _ -> Client.Fold $ do - outcome <- lift $ runExceptT (Block.updateChainBlockOrBoundary genesisConfig cvs (Binary.unAnnotated block)) + let validationMode = fromBlockValidationMode Block.BlockValidation + outcome <- lift $ (`runReaderT` validationMode) $ runExceptT + (Block.updateChainBlockOrBoundary genesisConfig cvs (Binary.unAnnotated block)) case outcome of Left err -> do let msg = pack $ mconcat ["Validation failed: ", show err] lift $ traceWith tracer msg pure $ Client.Stop () Right cvs' -> do - let msg = pack $ mconcat ["Validated block at slot ", show (unFlatSlotId $ cvsLastSlot cvs')] + let msg = pack $ mconcat ["Validated block at slot ", show (unSlotNumber $ cvsLastSlot cvs')] lift $ traceWith tracer msg maybeStop <- lift $ stopCondition block case maybeStop of diff --git a/byron-proxy/src/lib/Ouroboros/Byron/Proxy/DB.hs b/byron-proxy/src/lib/Ouroboros/Byron/Proxy/DB.hs index f0cce56420d..48ab3d45b8a 100644 --- a/byron-proxy/src/lib/Ouroboros/Byron/Proxy/DB.hs +++ b/byron-proxy/src/lib/Ouroboros/Byron/Proxy/DB.hs @@ -68,7 +68,7 @@ epochFileParser epochSlots hasFS = where takeSlot :: Cardano.ABlockOrBoundary a -> SlotNo takeSlot blk = case blk of - Cardano.ABOBBlock blk -> SlotNo $ Cardano.unFlatSlotId (Cardano.blockSlot blk) + Cardano.ABOBBlock blk -> SlotNo $ Cardano.unSlotNumber (Cardano.blockSlot blk) Cardano.ABOBBoundary ebb -> SlotNo $ Cardano.boundaryEpoch ebb * Cardano.unEpochSlots epochSlots decoder :: forall s . CBOR.Decoder s (Cardano.ABlockOrBoundary ByteSpan) decoder = Cardano.fromCBORABlockOrBoundary epochSlots @@ -282,10 +282,9 @@ dbAppendImpl err tracer epochSlots iwrite idb = DBAppend $ \blockToWrite -> do pure slot CardanoBlockToWrite (Annotated (Cardano.ABOBBlock blk) _) -> do let hash = Cardano.blockHashAnnotated blk - flatSlotId = Cardano.blockSlot blk - slot = Cardano.unFlatSlotId flatSlotId - slotId = Cardano.unflattenSlotId epochSlots flatSlotId - Cardano.EpochIndex epoch = Cardano.siEpoch slotId + slotNumber = Cardano.blockSlot blk + slot = Cardano.unSlotNumber slotNumber + Cardano.EpochNumber epoch = Cardano.slotNumberEpoch epochSlots slotNumber Index.updateTip iwrite (coerceHashToLegacy hash) (EpochNo epoch) (Index.RealSlot slot) Immutable.appendBinaryBlob idb (SlotNo slot) builder pure (SlotNo slot) diff --git a/cabal.project b/cabal.project index 858ac4ba451..c4ba3a70f16 100644 --- a/cabal.project +++ b/cabal.project @@ -44,25 +44,25 @@ source-repository-package source-repository-package type: git location: https://github.com/input-output-hk/cardano-ledger - tag: 7f5263eac329d73a0626fc0d9603dec2cd51d352 + tag: e2d4663f2251ef76bae94e48fef910b8f5f867bd subdir: cardano-ledger source-repository-package type: git location: https://github.com/input-output-hk/cardano-ledger - tag: 7f5263eac329d73a0626fc0d9603dec2cd51d352 + tag: e2d4663f2251ef76bae94e48fef910b8f5f867bd subdir: crypto source-repository-package type: git location: https://github.com/input-output-hk/cardano-ledger - tag: 7f5263eac329d73a0626fc0d9603dec2cd51d352 + tag: e2d4663f2251ef76bae94e48fef910b8f5f867bd subdir: cardano-ledger/test source-repository-package type: git location: https://github.com/input-output-hk/cardano-ledger - tag: 7f5263eac329d73a0626fc0d9603dec2cd51d352 + tag: e2d4663f2251ef76bae94e48fef910b8f5f867bd subdir: crypto/test source-repository-package diff --git a/nix/.stack.nix/cardano-crypto-test.nix b/nix/.stack.nix/cardano-crypto-test.nix index ae824a5d7fd..bd26f61133b 100644 --- a/nix/.stack.nix/cardano-crypto-test.nix +++ b/nix/.stack.nix/cardano-crypto-test.nix @@ -34,8 +34,8 @@ } // { src = (pkgs.lib).mkDefault (pkgs.fetchgit { url = "https://github.com/input-output-hk/cardano-ledger"; - rev = "7f5263eac329d73a0626fc0d9603dec2cd51d352"; - sha256 = "01nzpcmddrxzvm8jqiv7gm94cm3wixn8vsvvc77fxv94gc3bzzap"; + rev = "e2d4663f2251ef76bae94e48fef910b8f5f867bd"; + sha256 = "04kynh9gnw1s0wvp3hx05scjz1h164qclwbkdx44j8qrgjxi4vn7"; }); postUnpack = "sourceRoot+=/crypto/test; echo source root reset to \$sourceRoot"; } \ No newline at end of file diff --git a/nix/.stack.nix/cardano-crypto-wrapper.nix b/nix/.stack.nix/cardano-crypto-wrapper.nix index f0f0e5cb71e..7b31d96c82d 100644 --- a/nix/.stack.nix/cardano-crypto-wrapper.nix +++ b/nix/.stack.nix/cardano-crypto-wrapper.nix @@ -59,8 +59,8 @@ } // { src = (pkgs.lib).mkDefault (pkgs.fetchgit { url = "https://github.com/input-output-hk/cardano-ledger"; - rev = "7f5263eac329d73a0626fc0d9603dec2cd51d352"; - sha256 = "01nzpcmddrxzvm8jqiv7gm94cm3wixn8vsvvc77fxv94gc3bzzap"; + rev = "e2d4663f2251ef76bae94e48fef910b8f5f867bd"; + sha256 = "04kynh9gnw1s0wvp3hx05scjz1h164qclwbkdx44j8qrgjxi4vn7"; }); postUnpack = "sourceRoot+=/crypto; echo source root reset to \$sourceRoot"; } \ No newline at end of file diff --git a/nix/.stack.nix/cardano-ledger-test.nix b/nix/.stack.nix/cardano-ledger-test.nix index 5f7de02fba1..55b4b8fbd9c 100644 --- a/nix/.stack.nix/cardano-ledger-test.nix +++ b/nix/.stack.nix/cardano-ledger-test.nix @@ -47,8 +47,8 @@ } // { src = (pkgs.lib).mkDefault (pkgs.fetchgit { url = "https://github.com/input-output-hk/cardano-ledger"; - rev = "7f5263eac329d73a0626fc0d9603dec2cd51d352"; - sha256 = "01nzpcmddrxzvm8jqiv7gm94cm3wixn8vsvvc77fxv94gc3bzzap"; + rev = "e2d4663f2251ef76bae94e48fef910b8f5f867bd"; + sha256 = "04kynh9gnw1s0wvp3hx05scjz1h164qclwbkdx44j8qrgjxi4vn7"; }); postUnpack = "sourceRoot+=/cardano-ledger/test; echo source root reset to \$sourceRoot"; } \ No newline at end of file diff --git a/nix/.stack.nix/cardano-ledger.nix b/nix/.stack.nix/cardano-ledger.nix index 5d796b28b0c..3d88b09b90e 100644 --- a/nix/.stack.nix/cardano-ledger.nix +++ b/nix/.stack.nix/cardano-ledger.nix @@ -26,6 +26,7 @@ (hsPkgs.bytestring) (hsPkgs.canonical-json) (hsPkgs.cardano-binary) + (hsPkgs.cardano-crypto) (hsPkgs.cardano-crypto-wrapper) (hsPkgs.cardano-prelude) (hsPkgs.cardano-shell) @@ -113,8 +114,8 @@ } // { src = (pkgs.lib).mkDefault (pkgs.fetchgit { url = "https://github.com/input-output-hk/cardano-ledger"; - rev = "7f5263eac329d73a0626fc0d9603dec2cd51d352"; - sha256 = "01nzpcmddrxzvm8jqiv7gm94cm3wixn8vsvvc77fxv94gc3bzzap"; + rev = "e2d4663f2251ef76bae94e48fef910b8f5f867bd"; + sha256 = "04kynh9gnw1s0wvp3hx05scjz1h164qclwbkdx44j8qrgjxi4vn7"; }); postUnpack = "sourceRoot+=/cardano-ledger; echo source root reset to \$sourceRoot"; } \ No newline at end of file diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Crypto/DSIGN/Cardano.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Crypto/DSIGN/Cardano.hs index fb3b1d0e3e9..63b1c7b167e 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Crypto/DSIGN/Cardano.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Crypto/DSIGN/Cardano.hs @@ -20,12 +20,13 @@ module Ouroboros.Consensus.Crypto.DSIGN.Cardano import Cardano.Binary import qualified Cardano.Chain.Block as CC.Block +import qualified Cardano.Chain.Delegation as CC.Delegation import qualified Cardano.Chain.UTxO as CC.UTxO -import Cardano.Crypto (ProtocolMagicId, ProxyVerificationKey, - SignTag (..), Signature, SigningKey, VerificationKey, - keyGen, signEncoded, toVerification, verifySignature) -import Data.Constraint +import Cardano.Crypto (ProtocolMagicId, SignTag (..), Signature, + SigningKey, VerificationKey, keyGen, signEncoded, + toVerification, verifySignature) import Data.Coerce (coerce) +import Data.Constraint import Data.Function (on) import Data.Proxy (Proxy (..)) import Data.Reflection (Given (..)) @@ -65,8 +66,8 @@ instance Given (VerKeyDSIGN CardanoDSIGN) => HasSignTag CC.Block.ToSign where instance Given (VerKeyDSIGN CardanoDSIGN) :=> HasSignTag CC.Block.ToSign where ins = Sub Dict -instance HasSignTag (ProxyVerificationKey w) where - signTag = const SignProxyVK +instance HasSignTag CC.Delegation.Certificate where + signTag = const SignCertificate data CardanoDSIGN diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Demo/HasCreator.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Demo/HasCreator.hs index 2cacb939a89..dd4e9cdd5d4 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Demo/HasCreator.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Demo/HasCreator.hs @@ -11,6 +11,7 @@ import qualified Data.Bimap as Bimap import Data.Maybe (fromMaybe) import qualified Cardano.Chain.Block as CC.Block +import qualified Cardano.Chain.Delegation as CC.Delegation import qualified Cardano.Crypto as Cardano import Ouroboros.Consensus.NodeId (CoreNodeId (..)) @@ -63,7 +64,7 @@ instance HasCreator (ByronBlock ByronDemoConfig) where Bimap.lookup key pbftCoreNodes where key :: Cardano.VerificationKey - key = Cardano.pskIssuerVK + key = CC.Delegation.issuerVK . CC.Block.delegationCertificate . CC.Block.headerSignature . CC.Block.blockHeader diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Demo/Ledger/Byron/Forge.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Demo/Ledger/Byron/Forge.hs index e89c5852ed4..1894d2b5a2a 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Demo/Ledger/Byron/Forge.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Demo/Ledger/Byron/Forge.hs @@ -86,13 +86,13 @@ forgeBlock cfg curSlot curNo prevHash txs () = do GenesisHash -> CC.Block.genesisHeaderHash pbftGenesisHash BlockHash h -> h - slotId :: CC.Slot.SlotId - slotId = CC.Slot.unflattenSlotId pbftEpochSlots $ coerce curSlot + epochAndSlotCount :: CC.Slot.EpochAndSlotCount + epochAndSlotCount = CC.Slot.fromSlotNumber pbftEpochSlots $ coerce curSlot toSign :: CC.Block.ToSign toSign = CC.Block.ToSign { CC.Block.tsHeaderHash = prevHeaderHash - , CC.Block.tsSlot = slotId + , CC.Block.tsSlot = epochAndSlotCount , CC.Block.tsDifficulty = coerce curNo , CC.Block.tsBodyProof = proof , CC.Block.tsProtocolVersion = pbftProtocolVersion @@ -107,8 +107,8 @@ forgeBlock cfg curSlot curNo prevHash txs () = do where dlgMap = CC.Genesis.unGenesisDelegation pbftGenesisDlg VerKeyCardanoDSIGN issuer = pbftVerKey $ encNodeConfigP cfg - findDelegate = fmap (\crt -> (Crypto.pskIssuerVK crt, crt)) - . find (\crt -> Crypto.pskDelegateVK crt == issuer) + findDelegate = fmap (\crt -> (CC.Delegation.issuerVK crt, crt)) + . find (\crt -> CC.Delegation.delegateVK crt == issuer) $ Map.elems dlgMap forge :: PBftFields PBftCardanoCrypto CC.Block.ToSign diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Byron.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Byron.hs index 18940576c0d..ff4000bf26c 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Byron.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Byron.hs @@ -37,6 +37,7 @@ import Codec.CBOR.Encoding (Encoding) import qualified Codec.CBOR.Read as CBOR import qualified Codec.CBOR.Write as CBOR import Control.Monad.Except +import Control.Monad.Reader import qualified Data.Bimap as Bimap import qualified Data.ByteString.Lazy as Lazy import Data.Coerce (coerce) @@ -61,6 +62,7 @@ import qualified Cardano.Chain.Genesis as CC.Genesis import qualified Cardano.Chain.Slotting as CC.Slot import qualified Cardano.Chain.Update.Validation.Interface as CC.UPI import qualified Cardano.Chain.UTxO as CC.UTxO +import Cardano.Chain.ValidationMode (fromBlockValidationMode) import qualified Cardano.Crypto as Crypto import Ouroboros.Network.Block @@ -187,7 +189,9 @@ instance (ByronGiven, Typeable cfg, ConfigContainsGenesis cfg) (ByronLedgerState state snapshots) = do CC.Block.BodyState { CC.Block.utxo, CC.Block.updateState , CC.Block.delegationState } - <- CC.Block.updateBody bodyEnv bodyState block + <- runReaderT + (CC.Block.updateBody bodyEnv bodyState block) + (fromBlockValidationMode CC.Block.BlockValidation) let state' = state { CC.Block.cvsLastSlot = CC.Block.blockSlot block , CC.Block.cvsPreviousHash = Right $ CC.Block.blockHashAnnotated block @@ -236,10 +240,9 @@ instance (ByronGiven, Typeable cfg, ConfigContainsGenesis cfg) applyLedgerHeader (ByronLedgerConfig cfg) (ByronHeader hdr) (ByronLedgerState state snapshots) = mapExcept (fmap (\i -> ByronLedgerState i snapshots)) $ do - updateState <- CC.Block.updateHeader - headerEnv - (CC.Block.cvsUpdateState state) - hdr + updateState <- runReaderT + (CC.Block.updateHeader headerEnv (CC.Block.cvsUpdateState state) hdr) + (fromBlockValidationMode CC.Block.BlockValidation) return $ state { CC.Block.cvsLastSlot = CC.Block.headerSlot hdr , CC.Block.cvsPreviousHash = Right $ headerHashAnnotated hdr @@ -292,7 +295,7 @@ instance (ByronGiven, Typeable cfg) => HeaderSupportsPBft PBftCardanoCrypto (Header (ByronBlock cfg)) where headerPBftFields _ (ByronHeader hdr) = PBftFields { pbftIssuer = VerKeyCardanoDSIGN - . Crypto.pskDelegateVK + . CC.Delegation.delegateVK . CC.Block.delegationCertificate . CC.Block.headerSignature $ hdr @@ -418,10 +421,13 @@ applyByronGenTx :: Bool -- ^ Have we verified this transaction previously? applyByronGenTx _reapply (ByronLedgerConfig cfg) genTx st@ByronLedgerState{..} = (\x -> st { blsCurrent = x }) <$> go genTx blsCurrent where + validationMode = fromBlockValidationMode CC.Block.BlockValidation + go :: GenTx (ByronBlock cfg) -> CC.Block.ChainValidationState -> Except CC.UTxO.UTxOValidationError CC.Block.ChainValidationState - go (ByronTx tx) cvs = wrapCVS <$> CC.UTxO.updateUTxO env utxo [tx] + go (ByronTx tx) cvs = wrapCVS <$> + runReaderT (CC.UTxO.updateUTxO env utxo [tx]) validationMode where wrapCVS newUTxO = cvs { CC.Block.cvsUtxo = newUTxO } protocolMagic = fixPM $ CC.Genesis.configProtocolMagic cfg @@ -437,7 +443,7 @@ applyByronGenTx _reapply (ByronLedgerConfig cfg) genTx st@ByronLedgerState{..} = Auxiliary -------------------------------------------------------------------------------} -convertSlot :: CC.Slot.FlatSlotId -> SlotNo +convertSlot :: CC.Slot.SlotNumber -> SlotNo convertSlot = coerce {------------------------------------------------------------------------------- @@ -470,12 +476,12 @@ instance Condense (Header (ByronBlock cfg)) where ", delegate: " <> condenseKey delegate <> ")" where - psigPsk = CC.Block.delegationCertificate - . CC.Block.headerSignature - . unByronHeader - $ hdr - issuer = Crypto.pskIssuerVK psigPsk - delegate = Crypto.pskDelegateVK psigPsk + psigCert = CC.Block.delegationCertificate + . CC.Block.headerSignature + . unByronHeader + $ hdr + issuer = CC.Delegation.issuerVK psigCert + delegate = CC.Delegation.delegateVK psigCert condenseKey :: Crypto.VerificationKey -> String condenseKey = T.unpack . sformat build diff --git a/stack.yaml b/stack.yaml index 90f673f0717..a9c3c07c348 100644 --- a/stack.yaml +++ b/stack.yaml @@ -24,7 +24,7 @@ extra-deps: - binary/test - git: https://github.com/input-output-hk/cardano-ledger - commit: 7f5263eac329d73a0626fc0d9603dec2cd51d352 + commit: e2d4663f2251ef76bae94e48fef910b8f5f867bd subdirs: - cardano-ledger - cardano-ledger/test