diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 9326ae064..6aca50a07 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -20,7 +20,7 @@ jobs: matrix: os: [ubuntu-latest] # TODO: Add ghc910 when input-output-hk/devx is fixed - compiler-nix-name: [ghc810, ghc96, ghc98] + compiler-nix-name: [ghc810, ghc96, ghc98, ghc912] include: # We want a single job, because macOS runners are scarce. - os: macos-latest diff --git a/cabal.project b/cabal.project index e897f7a98..7ef510568 100644 --- a/cabal.project +++ b/cabal.project @@ -10,8 +10,8 @@ repository cardano-haskell-packages d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee index-state: - , hackage.haskell.org 2024-10-10T00:52:24Z - , cardano-haskell-packages 2024-11-26T16:00:26Z + , hackage.haskell.org 2025-05-23T06:30:40Z + , cardano-haskell-packages 2025-05-16T20:03:45Z packages: cardano-db @@ -67,34 +67,35 @@ package snap-server -- only if the `cardano-node` is compiled with `+rtview`. flags: -openssl -allow-newer: - , swagger2:aeson - -- The version of ouroboros-consensus specified by cardano-node uses an earlier version of - -- quickcheck-state-machine that does not compile with ghc-9.10 so we allow a never version - -- that builds with ghc-9.10 (and earlier). - , ouroboros-consensus:quickcheck-state-machine +-- --------------------------------------------------------- constraints: - -- STM 2.5.2 is broken: https://github.com/haskell/stm/issues/76 - , stm >= 2.5.3.1 - -- Earlier versions do not compile with ghc-9.10. - , quickcheck-state-machine ^>= 0.10 + -- esqueleto >= 3.6 has API chamges + , esqueleto ^>= 3.5.11.2 --- --------------------------------------------------------- + -- New version of `text` exposes a `show` function and in the `node` + -- code,`Data.Text` is being imported unqualified (bad idea IMO) which + -- then clashes with the `show` in `Prelude`. + , text < 2.1.2 + + , cardano-node ^>= 10.3 + +if impl (ghc >= 9.12) + allow-newer: + -- https://github.com/kapralVV/Unique/issues/11 + , Unique:hashable + + -- https://github.com/Gabriella439/Haskell-Pipes-Safe-Library/pull/70 + , pipes-safe:base + + -- https://github.com/haskellari/postgresql-simple/issues/152 + , postgresql-simple:base + , postgresql-simple:template-haskell + + -- https://github.com/haskell-hvr/int-cast/issues/10 + , int-cast:base -- The two following one-liners will cut off / restore the remainder of this file (for nix-shell users): -- when using the "cabal" wrapper script provided by nix-shell. -- --------------------------- 8< -------------------------- -- Please do not put any `source-repository-package` clause above this line. - -source-repository-package - type: git - location: https://github.com/IntersectMBO/cardano-node - tag: 36871ba0cd3e86a5dbcfd6878cdb7168bb4e56a1 - --sha256: sha256-v0q8qHdI6LKc8mP43QZt3UGdTNDQXE0aF6QapvZsTvU= - subdir: - cardano-node - cardano-submit-api - trace-dispatcher - trace-forward - trace-resources diff --git a/cardano-chain-gen/cardano-chain-gen.cabal b/cardano-chain-gen/cardano-chain-gen.cabal index a584602f5..12306f88f 100644 --- a/cardano-chain-gen/cardano-chain-gen.cabal +++ b/cardano-chain-gen/cardano-chain-gen.cabal @@ -75,6 +75,7 @@ library , cardano-ledger-shelley >= 1.12.3.0 , cardano-ledger-mary , cardano-prelude + , cardano-protocol-tpraos , cardano-slotting , cardano-strict-containers , cborg @@ -85,6 +86,7 @@ library , extra , mtl , microlens + , network-mux , nothunks , ouroboros-consensus , ouroboros-consensus-cardano @@ -101,6 +103,7 @@ library , strict-stm , text , typed-protocols + , typed-protocols-stateful test-suite cardano-chain-gen type: exitcode-stdio-1.0 @@ -182,6 +185,7 @@ test-suite cardano-chain-gen , esqueleto , extra , filepath + , int-cast , silently , stm , strict-stm diff --git a/cardano-chain-gen/src/Cardano/Mock/ChainDB.hs b/cardano-chain-gen/src/Cardano/Mock/ChainDB.hs index b7b31e59c..c281adb3b 100644 --- a/cardano-chain-gen/src/Cardano/Mock/ChainDB.hs +++ b/cardano-chain-gen/src/Cardano/Mock/ChainDB.hs @@ -62,7 +62,7 @@ replaceGenesisDB chainDB st = chainDB {cchain = Genesis st} extendChainDB :: LedgerSupportsProtocol block => ChainDB block -> block -> ChainDB block extendChainDB chainDB blk = do let !chain = cchain chainDB - !st = tickThenReapply (Consensus.ExtLedgerCfg $ chainConfig chainDB) blk (getTipState chain) + !st = tickThenReapply ComputeLedgerEvents (Consensus.ExtLedgerCfg $ chainConfig chainDB) blk (getTipState chain) in chainDB {cchain = chain :> (blk, st)} findFirstPoint :: HasHeader block => [Point block] -> ChainDB block -> Maybe (Point block) diff --git a/cardano-chain-gen/src/Cardano/Mock/ChainSync/Server.hs b/cardano-chain-gen/src/Cardano/Mock/ChainSync/Server.hs index d77d28b3a..d742e5865 100644 --- a/cardano-chain-gen/src/Cardano/Mock/ChainSync/Server.hs +++ b/cardano-chain-gen/src/Cardano/Mock/ChainSync/Server.hs @@ -2,6 +2,7 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -48,11 +49,14 @@ import Data.ByteString.Lazy.Char8 (ByteString) import qualified Data.Map.Strict as Map import Data.Maybe (fromJust) import Data.Void (Void) -import Network.TypedProtocol.Core (Peer (..)) +import qualified Network.Mux as Mux +import Network.TypedProtocol.Peer (Peer (..)) +import Network.TypedProtocol.Stateful.Codec () +import qualified Network.TypedProtocol.Stateful.Peer as St import Ouroboros.Consensus.Block (CodecConfig, HasHeader, Point, StandardHash, castPoint) import Ouroboros.Consensus.Config (TopLevelConfig, configCodec) import Ouroboros.Consensus.Ledger.Query (BlockQuery, ShowQuery) -import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx) +import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx, TxId) import Ouroboros.Consensus.Ledger.SupportsProtocol (LedgerSupportsProtocol) import Ouroboros.Consensus.Network.NodeToClient (Apps (..), Codecs' (..), DefaultCodecs) import qualified Ouroboros.Consensus.Network.NodeToClient as NTC @@ -83,10 +87,11 @@ import Ouroboros.Network.Block ( ) import Ouroboros.Network.Channel (Channel) import Ouroboros.Network.Driver.Simple (runPeer) +import qualified Ouroboros.Network.Driver.Stateful as St (runPeer) import Ouroboros.Network.IOManager (IOManager) import qualified Ouroboros.Network.IOManager as IOManager import Ouroboros.Network.Magic (NetworkMagic) -import Ouroboros.Network.Mux (MuxMode (..), OuroborosApplicationWithMinimalCtx) +import Ouroboros.Network.Mux (OuroborosApplicationWithMinimalCtx) import Ouroboros.Network.NodeToClient (NodeToClientVersionData (..)) import qualified Ouroboros.Network.NodeToClient as NodeToClient import Ouroboros.Network.NodeToNode (Versions) @@ -98,9 +103,10 @@ import Ouroboros.Network.Protocol.ChainSync.Server ( chainSyncServerPeer, ) import Ouroboros.Network.Protocol.Handshake.Version (simpleSingletonVersions) +import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQuery import Ouroboros.Network.Snocket (LocalAddress, LocalSnocket, LocalSocket (..)) import qualified Ouroboros.Network.Snocket as Snocket -import Ouroboros.Network.Util.ShowProxy (Proxy (..), ShowProxy) +import Ouroboros.Network.Util.ShowProxy (Proxy (..), ShowProxy (..)) {- HLINT ignore "Use readTVarIO" -} @@ -157,6 +163,7 @@ type MockServerConstraint blk = , ShowProxy (GenTx blk) , SupportedNetworkProtocolVersion blk , EncodeDisk blk blk + , ShowProxy (TxId (GenTx blk)) ) forkServerThread :: @@ -216,7 +223,7 @@ runLocalServer iom codecConfig netMagic localDomainSock chainProdState = Versions NodeToClientVersion NodeToClientVersionData - (OuroborosApplicationWithMinimalCtx 'ResponderMode LocalAddress ByteString IO Void ()) + (OuroborosApplicationWithMinimalCtx 'Mux.ResponderMode LocalAddress ByteString IO Void ()) versions state = let version = fromJust $ snd $ latestReleasedNodeVersion (Proxy @blk) allVersions = supportedNodeToClientVersions (Proxy @blk) @@ -224,7 +231,7 @@ runLocalServer iom codecConfig netMagic localDomainSock chainProdState = in simpleSingletonVersions version (NodeToClientVersionData netMagic False) - (NTC.responder version $ mkApps state version blockVersion (NTC.defaultCodecs codecConfig blockVersion version)) + (\versionData -> NTC.responder version versionData $ mkApps state version blockVersion (NTC.defaultCodecs codecConfig blockVersion version)) mkApps :: StrictTVar IO (ChainProducerState blk) -> @@ -268,11 +275,12 @@ runLocalServer iom codecConfig netMagic localDomainSock chainProdState = Channel IO ByteString -> IO ((), Maybe ByteString) stateQueryServer _them channel = - runPeer + St.runPeer nullTracer (cStateQueryCodec codecs) channel - (Effect (forever $ threadDelay 3_600_000_000)) + LocalStateQuery.StateIdle + (St.Effect (forever $ threadDelay 3_600_000_000)) txMonitorServer :: localPeer -> @@ -281,7 +289,7 @@ runLocalServer iom codecConfig netMagic localDomainSock chainProdState = txMonitorServer _them channel = runPeer nullTracer - (cStateQueryCodec codecs) + (cTxMonitorCodec codecs) channel (Effect (forever $ threadDelay 3_600_000_000)) diff --git a/cardano-chain-gen/src/Cardano/Mock/Forging/Interpreter.hs b/cardano-chain-gen/src/Cardano/Mock/Forging/Interpreter.hs index 0856e9fe5..568ea181e 100644 --- a/cardano-chain-gen/src/Cardano/Mock/Forging/Interpreter.hs +++ b/cardano-chain-gen/src/Cardano/Mock/Forging/Interpreter.hs @@ -33,7 +33,6 @@ module Cardano.Mock.Forging.Interpreter ( ) where import Cardano.Ledger.Core (txIdTx) -import Cardano.Ledger.Crypto (StandardCrypto) import qualified Cardano.Ledger.Shelley.API.Mempool as Ledger import Cardano.Ledger.Shelley.LedgerState (NewEpochState (..)) import qualified Cardano.Ledger.TxIn as Ledger @@ -75,11 +74,11 @@ import Ouroboros.Consensus.Block ( ) import qualified Ouroboros.Consensus.Block as Block import Ouroboros.Consensus.Cardano.Block ( + AlonzoEra, + BabbageEra, + ConwayEra, LedgerState (..), - StandardAlonzo, - StandardBabbage, - StandardConway, - StandardShelley, + ShelleyEra, ) import Ouroboros.Consensus.Cardano.CanHardFork () import Ouroboros.Consensus.Config ( @@ -88,12 +87,14 @@ import Ouroboros.Consensus.Config ( configLedger, topLevelConfigLedger, ) + import Ouroboros.Consensus.Forecast (Forecast (..)) import qualified Ouroboros.Consensus.HardFork.Combinator.AcrossEras as Consensus import Ouroboros.Consensus.HardFork.Combinator.Ledger () import qualified Ouroboros.Consensus.HardFork.Combinator.Mempool as Consensus import Ouroboros.Consensus.HeaderValidation (headerStateChainDep) import Ouroboros.Consensus.Ledger.Abstract (TickedLedgerState, applyChainTick) +import Ouroboros.Consensus.Ledger.Basics (ComputeLedgerEvents (..)) import Ouroboros.Consensus.Ledger.Extended (ExtLedgerState, headerState, ledgerState) import Ouroboros.Consensus.Ledger.SupportsMempool ( ApplyTxErr, @@ -362,6 +363,7 @@ forgeNextLeaders interpreter txes possibleLeaders = do let tickedLedgerSt :: Ticked (LedgerState CardanoBlock) !tickedLedgerSt = applyChainTick + ComputeLedgerEvents (configLedger cfg) currentSlot (ledgerState . currentState $ istChain interState) @@ -493,7 +495,7 @@ getCurrentSlot interp = istSlot <$> readTVarIO (interpState interp) withBabbageLedgerState :: Interpreter -> - (LedgerState (ShelleyBlock PraosStandard StandardBabbage) -> Either ForgingError a) -> + (LedgerState (ShelleyBlock PraosStandard BabbageEra) -> Either ForgingError a) -> IO a withBabbageLedgerState inter mk = do st <- getCurrentLedgerState inter @@ -505,7 +507,7 @@ withBabbageLedgerState inter mk = do withConwayLedgerState :: Interpreter -> - (LedgerState (ShelleyBlock PraosStandard StandardConway) -> Either ForgingError a) -> + (LedgerState (ShelleyBlock PraosStandard ConwayEra) -> Either ForgingError a) -> IO a withConwayLedgerState inter mk = do st <- getCurrentLedgerState inter @@ -517,7 +519,7 @@ withConwayLedgerState inter mk = do withAlonzoLedgerState :: Interpreter -> - (LedgerState (ShelleyBlock TPraosStandard StandardAlonzo) -> Either ForgingError a) -> + (LedgerState (ShelleyBlock TPraosStandard AlonzoEra) -> Either ForgingError a) -> IO a withAlonzoLedgerState inter mk = do st <- getCurrentLedgerState inter @@ -529,7 +531,7 @@ withAlonzoLedgerState inter mk = do withShelleyLedgerState :: Interpreter -> - (LedgerState (ShelleyBlock TPraosStandard StandardShelley) -> Either ForgingError a) -> + (LedgerState (ShelleyBlock TPraosStandard ShelleyEra) -> Either ForgingError a) -> IO a withShelleyLedgerState inter mk = do st <- getCurrentLedgerState inter @@ -539,13 +541,13 @@ withShelleyLedgerState inter mk = do Left err -> throwIO err _ -> throwIO ExpectedShelleyState -mkTxId :: TxEra -> Ledger.TxId StandardCrypto +mkTxId :: TxEra -> Ledger.TxId mkTxId txe = case txe of - TxAlonzo tx -> txIdTx @StandardAlonzo tx - TxBabbage tx -> txIdTx @StandardBabbage tx - TxConway tx -> txIdTx @StandardConway tx - TxShelley tx -> txIdTx @StandardShelley tx + TxAlonzo tx -> txIdTx @AlonzoEra tx + TxBabbage tx -> txIdTx @BabbageEra tx + TxConway tx -> txIdTx @ConwayEra tx + TxShelley tx -> txIdTx @ShelleyEra tx mkValidated :: TxEra -> Validated (Consensus.GenTx CardanoBlock) mkValidated txe = diff --git a/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Alonzo.hs b/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Alonzo.hs index a1b8aa0b9..36c4b7074 100644 --- a/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Alonzo.hs +++ b/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Alonzo.hs @@ -49,7 +49,6 @@ import Cardano.Ledger.Coin import Cardano.Ledger.Core import qualified Cardano.Ledger.Core as Core import Cardano.Ledger.Credential -import Cardano.Ledger.Keys import Cardano.Ledger.Mary.Value import Cardano.Ledger.Shelley.TxCert import Cardano.Ledger.TxIn (TxIn (..)) @@ -63,24 +62,23 @@ import Data.Sequence.Strict (StrictSeq) import qualified Data.Sequence.Strict as StrictSeq import qualified Data.Set as Set import Lens.Micro -import Ouroboros.Consensus.Cardano.Block (LedgerState, StandardAlonzo) -import Ouroboros.Consensus.Shelley.Eras (StandardCrypto) +import Ouroboros.Consensus.Cardano.Block (AlonzoEra, LedgerState) import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock) import Prelude hiding (map) -type AlonzoUTxOIndex = UTxOIndex StandardAlonzo +type AlonzoUTxOIndex = UTxOIndex AlonzoEra -type AlonzoLedgerState = LedgerState (ShelleyBlock TPraosStandard StandardAlonzo) +type AlonzoLedgerState = LedgerState (ShelleyBlock TPraosStandard AlonzoEra) consTxBody :: - Set (TxIn StandardCrypto) -> - Set (TxIn StandardCrypto) -> - StrictSeq (AlonzoTxOut StandardAlonzo) -> + Set TxIn -> + Set TxIn -> + StrictSeq (AlonzoTxOut AlonzoEra) -> Coin -> - MultiAsset StandardCrypto -> - [ShelleyTxCert StandardAlonzo] -> - Withdrawals StandardCrypto -> - AlonzoTxBody StandardAlonzo + MultiAsset -> + [ShelleyTxCert AlonzoEra] -> + Withdrawals -> + AlonzoTxBody AlonzoEra consTxBody ins cols outs fees minted certs wdrl = AlonzoTxBody ins @@ -109,15 +107,15 @@ addValidityInterval slotNo tx = txBody' = set vldtTxBodyL interval (body tx) consPaymentTxBody :: - Set (TxIn StandardCrypto) -> - Set (TxIn StandardCrypto) -> - StrictSeq (AlonzoTxOut StandardAlonzo) -> + Set TxIn -> + Set TxIn -> + StrictSeq (AlonzoTxOut AlonzoEra) -> Coin -> - MultiAsset StandardCrypto -> - AlonzoTxBody StandardAlonzo + MultiAsset -> + AlonzoTxBody AlonzoEra consPaymentTxBody ins cols outs fees minted = consTxBody ins cols outs fees minted mempty (Withdrawals mempty) -consCertTxBody :: [ShelleyTxCert StandardAlonzo] -> Withdrawals StandardCrypto -> AlonzoTxBody StandardAlonzo +consCertTxBody :: [ShelleyTxCert AlonzoEra] -> Withdrawals -> AlonzoTxBody AlonzoEra consCertTxBody = consTxBody mempty mempty mempty (Coin 0) mempty mkPaymentTx :: @@ -126,7 +124,7 @@ mkPaymentTx :: Integer -> Integer -> AlonzoLedgerState -> - Either ForgingError (AlonzoTx StandardAlonzo) + Either ForgingError (AlonzoTx AlonzoEra) mkPaymentTx inputIndex outputIndex amount fees sta = do (inputPair, _) <- resolveUTxOIndex inputIndex sta addr <- resolveAddress outputIndex sta @@ -139,9 +137,9 @@ mkPaymentTx inputIndex outputIndex amount fees sta = do mkPaymentTx' :: AlonzoUTxOIndex -> - [(AlonzoUTxOIndex, MaryValue StandardCrypto)] -> + [(AlonzoUTxOIndex, MaryValue)] -> AlonzoLedgerState -> - Either ForgingError (AlonzoTx StandardAlonzo) + Either ForgingError (AlonzoTx AlonzoEra) mkPaymentTx' inputIndex outputIndex sta = do inputPair <- fst <$> resolveUTxOIndex inputIndex sta outps <- mapM mkOuts outputIndex @@ -162,7 +160,7 @@ mkLockByScriptTx :: Integer -> Integer -> AlonzoLedgerState -> - Either ForgingError (AlonzoTx StandardAlonzo) + Either ForgingError (AlonzoTx AlonzoEra) mkLockByScriptTx inputIndex spendable amount fees sta = do (inputPair, _) <- resolveUTxOIndex inputIndex sta @@ -173,7 +171,7 @@ mkLockByScriptTx inputIndex spendable amount fees sta = do -- No witnesses are necessary when the outputs is a script address. Only when it's consumed. Right $ mkSimpleTx True $ consPaymentTxBody input mempty (StrictSeq.fromList $ outs <> [change]) (Coin fees) mempty where - datahash = hashData @StandardAlonzo plutusDataList + datahash = hashData @AlonzoEra plutusDataList mkOut sp = let outAddress = if sp then alwaysSucceedsScriptAddr else alwaysFailsScriptAddr in AlonzoTxOut outAddress (valueFromList (Coin amount) []) (Strict.SJust datahash) @@ -186,7 +184,7 @@ mkUnlockScriptTx :: Integer -> Integer -> AlonzoLedgerState -> - Either ForgingError (AlonzoTx StandardAlonzo) + Either ForgingError (AlonzoTx AlonzoEra) mkUnlockScriptTx inputIndex colInputIndex outputIndex succeeds amount fees sta = do inputPairs <- fmap fst <$> mapM (`resolveUTxOIndex` sta) inputIndex (colInputPair, _) <- resolveUTxOIndex colInputIndex sta @@ -202,13 +200,13 @@ mkUnlockScriptTx inputIndex colInputIndex outputIndex succeeds amount fees sta = $ consPaymentTxBody inpts colInput (StrictSeq.fromList [output]) (Coin fees) mempty mkScriptInp' :: - (Word64, (TxIn StandardCrypto, Core.TxOut StandardAlonzo)) -> - Maybe (AlonzoPlutusPurpose AsIx era, Maybe (ScriptHash StandardCrypto, Core.Script StandardAlonzo)) + (Word64, (TxIn, Core.TxOut AlonzoEra)) -> + Maybe (AlonzoPlutusPurpose AsIx era, Maybe (ScriptHash, Core.Script AlonzoEra)) mkScriptInp' = map (second Just) . mkScriptInp mkScriptInp :: - (Word64, (TxIn StandardCrypto, Core.TxOut StandardAlonzo)) -> - Maybe (AlonzoPlutusPurpose AsIx era, (ScriptHash StandardCrypto, Core.Script StandardAlonzo)) + (Word64, (TxIn, Core.TxOut AlonzoEra)) -> + Maybe (AlonzoPlutusPurpose AsIx era, (ScriptHash, Core.Script AlonzoEra)) mkScriptInp (n, (_txIn, txOut)) | addr == alwaysFailsScriptAddr = Just @@ -224,14 +222,14 @@ mkScriptInp (n, (_txIn, txOut)) mkScriptMint' :: AlonzoEraScript era => - MultiAsset StandardCrypto -> - [(AlonzoPlutusPurpose AsIx era, Maybe (ScriptHash StandardCrypto, AlonzoScript era))] + MultiAsset -> + [(AlonzoPlutusPurpose AsIx era, Maybe (ScriptHash, Script era))] mkScriptMint' = fmap (first $ AlonzoMinting . AsIx) . mkScriptMint mkScriptMint :: AlonzoEraScript era => - MultiAsset StandardCrypto -> - [(Word32, Maybe (ScriptHash StandardCrypto, AlonzoScript era))] + MultiAsset -> + [(Word32, Maybe (ScriptHash, Script era))] mkScriptMint (MultiAsset mp) = mapMaybe f $ zip [0 ..] (Map.keys mp) where f (n, policyId) @@ -247,12 +245,12 @@ mkScriptMint (MultiAsset mp) = mapMaybe f $ zip [0 ..] (Map.keys mp) mkMAssetsScriptTx :: [AlonzoUTxOIndex] -> AlonzoUTxOIndex -> - [(AlonzoUTxOIndex, MaryValue StandardCrypto)] -> - MultiAsset StandardCrypto -> + [(AlonzoUTxOIndex, MaryValue)] -> + MultiAsset -> Bool -> Integer -> AlonzoLedgerState -> - Either ForgingError (AlonzoTx StandardAlonzo) + Either ForgingError (AlonzoTx AlonzoEra) mkMAssetsScriptTx inputIndex colInputIndex outputIndex minted succeeds fees sta = do inputPairs <- fmap fst <$> mapM (`resolveUTxOIndex` sta) inputIndex colInput <- Set.singleton . fst . fst <$> resolveUTxOIndex colInputIndex sta @@ -269,18 +267,18 @@ mkMAssetsScriptTx inputIndex colInputIndex outputIndex minted succeeds fees sta where mkOuts (outIx, vl) = do addr <- resolveAddress outIx sta - Right $ AlonzoTxOut addr vl (Strict.SJust (hashData @StandardAlonzo plutusDataList)) + Right $ AlonzoTxOut addr vl (Strict.SJust (hashData @AlonzoEra plutusDataList)) mkDCertTx :: - [ShelleyTxCert StandardAlonzo] -> - Withdrawals StandardCrypto -> - Either ForgingError (AlonzoTx StandardAlonzo) + [ShelleyTxCert AlonzoEra] -> + Withdrawals -> + Either ForgingError (AlonzoTx AlonzoEra) mkDCertTx certs wdrl = Right $ mkSimpleTx True $ consCertTxBody certs wdrl mkSimpleDCertTx :: - [(StakeIndex, StakeCredential StandardCrypto -> ShelleyTxCert StandardAlonzo)] -> + [(StakeIndex, StakeCredential -> ShelleyTxCert AlonzoEra)] -> AlonzoLedgerState -> - Either ForgingError (AlonzoTx StandardAlonzo) + Either ForgingError (AlonzoTx AlonzoEra) mkSimpleDCertTx consDert st = do dcerts <- forM consDert $ \(stakeIndex, mkDCert) -> do cred <- resolveStakeCreds stakeIndex st @@ -290,11 +288,11 @@ mkSimpleDCertTx consDert st = do mkDCertPoolTx :: [ ( [StakeIndex] , PoolIndex - , [StakeCredential StandardCrypto] -> KeyHash 'StakePool StandardCrypto -> ShelleyTxCert StandardAlonzo + , [StakeCredential] -> KeyHash 'StakePool -> ShelleyTxCert AlonzoEra ) ] -> AlonzoLedgerState -> - Either ForgingError (AlonzoTx StandardAlonzo) + Either ForgingError (AlonzoTx AlonzoEra) mkDCertPoolTx consDert st = do dcerts <- forM consDert $ \(stakeIxs, poolIx, mkDCert) -> do stakeCreds <- forM stakeIxs $ \stix -> resolveStakeCreds stix st @@ -303,10 +301,10 @@ mkDCertPoolTx consDert st = do mkDCertTx dcerts (Withdrawals mempty) mkScriptDCertTx :: - [(StakeIndex, Bool, StakeCredential StandardCrypto -> ShelleyTxCert StandardAlonzo)] -> + [(StakeIndex, Bool, StakeCredential -> ShelleyTxCert AlonzoEra)] -> Bool -> AlonzoLedgerState -> - Either ForgingError (AlonzoTx StandardAlonzo) + Either ForgingError (AlonzoTx AlonzoEra) mkScriptDCertTx consDert valid st = do dcerts <- forM consDert $ \(stakeIndex, _, mkDCert) -> do cred <- resolveStakeCreds stakeIndex st @@ -329,7 +327,7 @@ mkDepositTxPools :: AlonzoUTxOIndex -> Integer -> AlonzoLedgerState -> - Either ForgingError (AlonzoTx StandardAlonzo) + Either ForgingError (AlonzoTx AlonzoEra) mkDepositTxPools inputIndex deposit sta = do (inputPair, _) <- resolveUTxOIndex inputIndex sta @@ -340,10 +338,10 @@ mkDepositTxPools inputIndex deposit sta = do mkDCertTxPools :: AlonzoLedgerState -> - Either ForgingError (AlonzoTx StandardAlonzo) + Either ForgingError (AlonzoTx AlonzoEra) mkDCertTxPools sta = Right $ mkSimpleTx True $ consCertTxBody (allPoolStakeCert sta) (Withdrawals mempty) -mkSimpleTx :: Bool -> AlonzoTxBody StandardAlonzo -> AlonzoTx StandardAlonzo +mkSimpleTx :: Bool -> AlonzoTxBody AlonzoEra -> AlonzoTx AlonzoEra mkSimpleTx valid txBody = AlonzoTx { body = txBody @@ -353,22 +351,21 @@ mkSimpleTx valid txBody = } consPoolParamsTwoOwners :: - [StakeCredential StandardCrypto] -> - KeyHash 'StakePool StandardCrypto -> - ShelleyTxCert StandardAlonzo + [StakeCredential] -> + KeyHash 'StakePool -> + ShelleyTxCert AlonzoEra consPoolParamsTwoOwners [rwCred, KeyHashObj owner0, KeyHashObj owner1] poolId = ShelleyTxCertPool $ RegPool $ consPoolParams poolId rwCred [owner0, owner1] consPoolParamsTwoOwners _ _ = panic "expected 2 pool owners" mkScriptTx :: forall era. - ( Core.EraCrypto era ~ StandardCrypto - , Core.Script era ~ AlonzoScript era + ( Core.Script era ~ AlonzoScript era , Core.TxWits era ~ AlonzoTxWits era , AlonzoEraScript era ) => Bool -> - [(PlutusPurpose AsIx era, Maybe (ScriptHash StandardCrypto, Core.Script era))] -> + [(PlutusPurpose AsIx era, Maybe (ScriptHash, Core.Script era))] -> Core.TxBody era -> AlonzoTx era mkScriptTx valid rdmrs txBody = @@ -385,12 +382,11 @@ mkScriptTx valid rdmrs txBody = [(hashData @era plutusDataList, plutusDataList)] mkWitnesses :: - ( Core.EraCrypto era ~ StandardCrypto - , Script era ~ AlonzoScript era + ( Script era ~ AlonzoScript era , AlonzoEraScript era ) => - [(PlutusPurpose AsIx era, Maybe (ScriptHash StandardCrypto, Core.Script era))] -> - [(DataHash StandardCrypto, Data era)] -> + [(PlutusPurpose AsIx era, Maybe (ScriptHash, Core.Script era))] -> + [(DataHash, Data era)] -> AlonzoTxWits era mkWitnesses rdmrs datas = AlonzoTxWits @@ -406,9 +402,9 @@ mkWitnesses rdmrs datas = (fst <$> rdmrs) mkUTxOAlonzo :: - (Core.EraTx era, Core.EraCrypto era ~ StandardCrypto, Core.Tx era ~ AlonzoTx era) => + (Core.EraTx era, Core.Tx era ~ AlonzoTx era) => AlonzoTx era -> - [(TxIn StandardCrypto, Core.TxOut era)] + [(TxIn, Core.TxOut era)] mkUTxOAlonzo tx = [ (TxIn transId idx, out) | (out, idx) <- zip (toList (tx ^. outputsL)) (TxIx <$> [0 ..]) @@ -417,7 +413,7 @@ mkUTxOAlonzo tx = transId = txIdTx tx outputsL = Core.bodyTxL . Core.outputsTxBodyL -emptyTxBody :: AlonzoTxBody StandardAlonzo +emptyTxBody :: AlonzoTxBody AlonzoEra emptyTxBody = AlonzoTxBody mempty @@ -434,7 +430,7 @@ emptyTxBody = Strict.SNothing (Strict.SJust Testnet) -emptyTx :: AlonzoTx StandardAlonzo +emptyTx :: AlonzoTx AlonzoEra emptyTx = AlonzoTx { body = emptyTxBody diff --git a/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Alonzo/ScriptsExamples.hs b/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Alonzo/ScriptsExamples.hs index d69eccde0..74c180d23 100644 --- a/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Alonzo/ScriptsExamples.hs +++ b/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Alonzo/ScriptsExamples.hs @@ -4,7 +4,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} module Cardano.Mock.Forging.Tx.Alonzo.ScriptsExamples ( alwaysSucceedsPlutusBinary, @@ -30,56 +29,54 @@ module Cardano.Mock.Forging.Tx.Alonzo.ScriptsExamples ( plutusDataEncIndef, ) where -import Cardano.Ledger.Address -import Cardano.Ledger.Alonzo -import Cardano.Ledger.Alonzo.Scripts -import Cardano.Ledger.BaseTypes +import Cardano.Ledger.Address (Addr (..)) +import Cardano.Ledger.Alonzo.Scripts (AlonzoEraScript (..), mkBinaryPlutusScript) +import Cardano.Ledger.BaseTypes (Network (..)) +import Cardano.Ledger.Core (Era, Script) import qualified Cardano.Ledger.Core as Core -import Cardano.Ledger.Credential -import Cardano.Ledger.Crypto (StandardCrypto) -import Cardano.Ledger.Era -import Cardano.Ledger.Hashes -import Cardano.Ledger.Mary.Value -import Cardano.Ledger.Plutus.Data -import Cardano.Ledger.Plutus.Language +import Cardano.Ledger.Credential (Credential (..), StakeCredential, StakeReference (..)) +import Cardano.Ledger.Hashes (ScriptHash (..)) +import Cardano.Ledger.Mary.Value (AssetName (..)) +import Cardano.Ledger.Plutus.Data (Data (..)) +import Cardano.Ledger.Plutus.Language (Language (..), PlutusBinary (..)) import Codec.CBOR.Write (toStrictByteString) -import Codec.Serialise -import Codec.Serialise.Encoding -import Data.ByteString.Short -import Data.Maybe -import Ouroboros.Consensus.Cardano.Block (StandardAlonzo) +import Codec.Serialise (encode, encodeList) +import Codec.Serialise.Encoding (encodeListLen) +import Data.ByteString.Short (ShortByteString, toShort) +import Data.Maybe (fromJust) +import Ouroboros.Consensus.Cardano.Block (AlonzoEra) import qualified PlutusCore.Data as Plutus import qualified PlutusLedgerApi.Test.Examples as Plutus alwaysSucceedsPlutusBinary :: PlutusBinary alwaysSucceedsPlutusBinary = PlutusBinary $ Plutus.alwaysSucceedingNAryFunction 0 -alwaysSucceedsScript :: AlonzoEraScript era => AlonzoScript era -alwaysSucceedsScript = mkPlutusScriptEra alwaysSucceedsPlutusBinary +alwaysSucceedsScript :: AlonzoEraScript era => Script era +alwaysSucceedsScript = mkPlutusV1ScriptEra alwaysSucceedsPlutusBinary -alwaysSucceedsScriptHash :: ScriptHash StandardCrypto -alwaysSucceedsScriptHash = scriptHash @StandardAlonzo alwaysSucceedsScript +alwaysSucceedsScriptHash :: ScriptHash +alwaysSucceedsScriptHash = scriptHash @AlonzoEra alwaysSucceedsScript -alwaysSucceedsScriptAddr :: Addr StandardCrypto +alwaysSucceedsScriptAddr :: Addr alwaysSucceedsScriptAddr = Addr Testnet (ScriptHashObj alwaysSucceedsScriptHash) StakeRefNull -alwaysSucceedsScriptStake :: StakeCredential StandardCrypto +alwaysSucceedsScriptStake :: StakeCredential alwaysSucceedsScriptStake = ScriptHashObj alwaysSucceedsScriptHash alwaysFailsPlutusBinary :: PlutusBinary alwaysFailsPlutusBinary = PlutusBinary $ Plutus.alwaysFailingNAryFunction 0 -alwaysFailsScript :: AlonzoEraScript era => AlonzoScript era -alwaysFailsScript = mkPlutusScriptEra alwaysFailsPlutusBinary +alwaysFailsScript :: AlonzoEraScript era => Script era +alwaysFailsScript = mkPlutusV1ScriptEra alwaysFailsPlutusBinary -alwaysFailsScriptHash :: ScriptHash StandardCrypto -alwaysFailsScriptHash = scriptHash @StandardAlonzo alwaysFailsScript +alwaysFailsScriptHash :: ScriptHash +alwaysFailsScriptHash = scriptHash @AlonzoEra alwaysFailsScript -- addr_test1wrqvvu0m5jpkgxn3hwfd829hc5kfp0cuq83tsvgk44752dsz4mvrk -alwaysFailsScriptAddr :: Addr StandardCrypto +alwaysFailsScriptAddr :: Addr alwaysFailsScriptAddr = Addr Testnet (ScriptHashObj alwaysFailsScriptHash) StakeRefNull -alwaysFailsScriptStake :: StakeCredential StandardCrypto +alwaysFailsScriptStake :: StakeCredential alwaysFailsScriptStake = ScriptHashObj alwaysFailsScriptHash plutusDataList :: forall era. Era era => Data era @@ -88,29 +85,26 @@ plutusDataList = Data $ Plutus.List [] alwaysMintPlutusBinary :: PlutusBinary alwaysMintPlutusBinary = PlutusBinary $ Plutus.alwaysFailingNAryFunction 1 -alwaysMintScript :: AlonzoEraScript era => AlonzoScript era -alwaysMintScript = mkPlutusScriptEra alwaysMintPlutusBinary +alwaysMintScript :: AlonzoEraScript era => Script era +alwaysMintScript = mkPlutusV1ScriptEra alwaysMintPlutusBinary -alwaysMintScriptHash :: ScriptHash StandardCrypto -alwaysMintScriptHash = scriptHash @StandardAlonzo alwaysMintScript +alwaysMintScriptHash :: ScriptHash +alwaysMintScriptHash = scriptHash @AlonzoEra alwaysMintScript -alwaysMintScriptAddr :: Addr StandardCrypto +alwaysMintScriptAddr :: Addr alwaysMintScriptAddr = Addr Testnet (ScriptHashObj alwaysMintScriptHash) StakeRefNull -alwaysMintScriptStake :: StakeCredential StandardCrypto +alwaysMintScriptStake :: StakeCredential alwaysMintScriptStake = ScriptHashObj alwaysMintScriptHash -mkPlutusScriptEra :: AlonzoEraScript era => PlutusBinary -> AlonzoScript era -mkPlutusScriptEra sh = PlutusScript $ fromJust $ mkBinaryPlutusScript PlutusV1 sh +mkPlutusV1ScriptEra :: AlonzoEraScript era => PlutusBinary -> Script era +mkPlutusV1ScriptEra sh = fromPlutusScript $ fromJust $ mkBinaryPlutusScript PlutusV1 sh scriptHash :: forall era. - ( EraCrypto era ~ StandardCrypto - , Core.Script era ~ AlonzoScript era - , Core.EraScript era - ) => - AlonzoScript era -> - ScriptHash StandardCrypto + Core.EraScript era => + Script era -> + ScriptHash scriptHash = Core.hashScript @era assetNames :: [AssetName] diff --git a/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Babbage.hs b/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Babbage.hs index af2a8d068..5f84c72b3 100644 --- a/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Babbage.hs +++ b/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Babbage.hs @@ -6,7 +6,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} #if __GLASGOW_HASKELL__ >= 908 {-# OPTIONS_GHC -Wno-x-partial #-} #endif @@ -67,10 +66,10 @@ import Cardano.Ledger.Binary import Cardano.Ledger.Coin import qualified Cardano.Ledger.Core as Core import Cardano.Ledger.Credential -import Cardano.Ledger.Crypto (ADDRHASH) -import Cardano.Ledger.Keys import Cardano.Ledger.Mary.Value import qualified Cardano.Ledger.Plutus.Data as Alonzo + +-- import Cardano.Ledger.Hashes (ADDRHASH) import Cardano.Ledger.Plutus.Language import Cardano.Ledger.Shelley.PParams import Cardano.Ledger.Shelley.TxAuxData @@ -92,13 +91,13 @@ import qualified Data.Sequence.Strict as StrictSeq import qualified Data.Set as Set import Lens.Micro import Ouroboros.Consensus.Cardano.Block (LedgerState) -import Ouroboros.Consensus.Shelley.Eras (StandardBabbage, StandardCrypto) +import Ouroboros.Consensus.Shelley.Eras (BabbageEra) import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock) import Prelude hiding (map) -type BabbageUTxOIndex = UTxOIndex StandardBabbage +type BabbageUTxOIndex = UTxOIndex BabbageEra -type BabbageLedgerState = LedgerState (ShelleyBlock PraosStandard StandardBabbage) +type BabbageLedgerState = LedgerState (ShelleyBlock PraosStandard BabbageEra) data TxOutScriptType = TxOutNoInline Bool -- nothing is inlined, like in Alonzo @@ -114,16 +113,16 @@ data ReferenceScript | ReferenceScript Bool consTxBody :: - Set (TxIn StandardCrypto) -> - Set (TxIn StandardCrypto) -> - Set (TxIn StandardCrypto) -> - StrictSeq (BabbageTxOut StandardBabbage) -> - StrictMaybe (BabbageTxOut StandardBabbage) -> + Set TxIn -> + Set TxIn -> + Set TxIn -> + StrictSeq (BabbageTxOut BabbageEra) -> + StrictMaybe (BabbageTxOut BabbageEra) -> Coin -> - MultiAsset StandardCrypto -> - [ShelleyTxCert StandardBabbage] -> - Withdrawals StandardCrypto -> - BabbageTxBody StandardBabbage + MultiAsset -> + [ShelleyTxCert BabbageEra] -> + Withdrawals -> + BabbageTxBody BabbageEra consTxBody ins cols ref outs collOut fees minted certs wdrl = BabbageTxBody ins @@ -144,17 +143,17 @@ consTxBody ins cols ref outs collOut fees minted certs wdrl = (Strict.SJust Testnet) consPaymentTxBody :: - Set (TxIn StandardCrypto) -> - Set (TxIn StandardCrypto) -> - Set (TxIn StandardCrypto) -> - StrictSeq (BabbageTxOut StandardBabbage) -> - StrictMaybe (BabbageTxOut StandardBabbage) -> + Set TxIn -> + Set TxIn -> + Set TxIn -> + StrictSeq (BabbageTxOut BabbageEra) -> + StrictMaybe (BabbageTxOut BabbageEra) -> Coin -> - MultiAsset StandardCrypto -> - BabbageTxBody StandardBabbage + MultiAsset -> + BabbageTxBody BabbageEra consPaymentTxBody ins cols ref outs colOut fees minted = consTxBody ins cols ref outs colOut fees minted mempty (Withdrawals mempty) -consCertTxBody :: Maybe (TxIn StandardCrypto) -> [ShelleyTxCert StandardBabbage] -> Withdrawals StandardCrypto -> BabbageTxBody StandardBabbage +consCertTxBody :: Maybe TxIn -> [ShelleyTxCert BabbageEra] -> Withdrawals -> BabbageTxBody BabbageEra consCertTxBody ref = consTxBody mempty mempty (toSet ref) mempty SNothing (Coin 0) mempty where toSet Nothing = mempty @@ -166,7 +165,7 @@ mkPaymentTx :: Integer -> Integer -> BabbageLedgerState -> - Either ForgingError (AlonzoTx StandardBabbage) + Either ForgingError (AlonzoTx BabbageEra) mkPaymentTx inputIndex outputIndex amount fees sta = do (inputPair, _) <- resolveUTxOIndex inputIndex sta addr <- resolveAddress outputIndex sta @@ -179,9 +178,9 @@ mkPaymentTx inputIndex outputIndex amount fees sta = do mkPaymentTx' :: BabbageUTxOIndex -> - [(BabbageUTxOIndex, MaryValue StandardCrypto)] -> + [(BabbageUTxOIndex, MaryValue)] -> BabbageLedgerState -> - Either ForgingError (AlonzoTx StandardBabbage) + Either ForgingError (AlonzoTx BabbageEra) mkPaymentTx' inputIndex outputIndex sta = do inputPair <- fst <$> resolveUTxOIndex inputIndex sta outps <- mapM mkOuts outputIndex @@ -223,7 +222,7 @@ mkLockByScriptTx :: Integer -> Integer -> BabbageLedgerState -> - Either ForgingError (AlonzoTx StandardBabbage) + Either ForgingError (AlonzoTx BabbageEra) mkLockByScriptTx inputIndex txOutTypes amount fees sta = do (inputPair, _) <- resolveUTxOIndex inputIndex sta @@ -234,15 +233,15 @@ mkLockByScriptTx inputIndex txOutTypes amount fees sta = do -- No witnesses are necessary when the outputs is a script address. Only when it's consumed. Right $ mkSimpleTx True $ consPaymentTxBody input mempty mempty (StrictSeq.fromList $ outs <> [change]) SNothing (Coin fees) mempty -mkOutFromType :: Integer -> TxOutScriptType -> BabbageTxOut StandardBabbage +mkOutFromType :: Integer -> TxOutScriptType -> BabbageTxOut BabbageEra mkOutFromType amount txOutType = let outAddress = if scriptSucceeds txOutType then alwaysSucceedsScriptAddr else alwaysFailsScriptAddr - datahash = hashData @StandardBabbage plutusDataList + datahash = hashData @BabbageEra plutusDataList dt = case getDatum txOutType of NotInlineDatum -> Alonzo.DatumHash datahash InlineDatum -> Alonzo.Datum (Alonzo.dataToBinaryData plutusDataList) InlineDatumCBOR sbs -> Alonzo.Datum $ either error id $ Alonzo.makeBinaryData sbs - scpt :: StrictMaybe (AlonzoScript StandardBabbage) = case getInlineScript txOutType of + scpt :: StrictMaybe (AlonzoScript BabbageEra) = case getInlineScript txOutType of SNothing -> SNothing SJust True -> SJust alwaysSucceedsScript SJust False -> SJust alwaysFailsScript @@ -256,7 +255,7 @@ mkUnlockScriptTx :: Integer -> Integer -> BabbageLedgerState -> - Either ForgingError (AlonzoTx StandardBabbage) + Either ForgingError (AlonzoTx BabbageEra) mkUnlockScriptTx inputIndex colInputIndex outputIndex succeeds amount fees sta = do inputPairs <- fmap fst <$> mapM (`resolveUTxOIndex` sta) inputIndex (colInputPair, _) <- resolveUTxOIndex colInputIndex sta @@ -281,7 +280,7 @@ mkUnlockScriptTxBabbage :: Integer -> Integer -> BabbageLedgerState -> - Either ForgingError (AlonzoTx StandardBabbage) + Either ForgingError (AlonzoTx BabbageEra) mkUnlockScriptTxBabbage inputIndex colInputIndex outputIndex refInput compl succeeds amount fees sta = do inputPairs <- fmap fst <$> mapM (`resolveUTxOIndex` sta) inputIndex refInputPairs <- fmap fst <$> mapM (`resolveUTxOIndex` sta) refInput @@ -305,15 +304,15 @@ mkUnlockScriptTxBabbage inputIndex colInputIndex outputIndex refInput compl succ else Just $ TxOutNoInline True mkScriptInp' :: - (BabbageEraTxOut era, EraCrypto era ~ StandardCrypto) => - (Word64, (TxIn StandardCrypto, Core.TxOut era)) -> - Maybe (AlonzoPlutusPurpose AsIx era, Maybe (ScriptHash StandardCrypto, AlonzoScript era)) + BabbageEraTxOut era => + (Word64, (TxIn, Core.TxOut era)) -> + Maybe (AlonzoPlutusPurpose AsIx era, Maybe (ScriptHash, Script era)) mkScriptInp' = fmap (first $ AlonzoSpending . AsIx) . mkScriptInp mkScriptInp :: - (BabbageEraTxOut era, EraCrypto era ~ StandardCrypto) => - (Word64, (TxIn StandardCrypto, Core.TxOut era)) -> - Maybe (Word32, Maybe (ScriptHash StandardCrypto, AlonzoScript era)) + BabbageEraTxOut era => + (Word64, (TxIn, Core.TxOut era)) -> + Maybe (Word32, Maybe (ScriptHash, Script era)) mkScriptInp (n, (_txIn, txOut)) = case mscr of SNothing @@ -335,13 +334,13 @@ mkScriptInp (n, (_txIn, txOut)) = mkMAssetsScriptTx :: [BabbageUTxOIndex] -> BabbageUTxOIndex -> - [(BabbageUTxOIndex, MaryValue StandardCrypto)] -> + [(BabbageUTxOIndex, MaryValue)] -> [BabbageUTxOIndex] -> - MultiAsset StandardCrypto -> + MultiAsset -> Bool -> Integer -> BabbageLedgerState -> - Either ForgingError (AlonzoTx StandardBabbage) + Either ForgingError (AlonzoTx BabbageEra) mkMAssetsScriptTx inputIndex colInputIndex outputIndex refInput minted succeeds fees sta = do inputPairs <- fmap fst <$> mapM (`resolveUTxOIndex` sta) inputIndex refInputPairs <- fmap fst <$> mapM (`resolveUTxOIndex` sta) refInput @@ -359,40 +358,40 @@ mkMAssetsScriptTx inputIndex colInputIndex outputIndex refInput minted succeeds where mkOuts (outIx, vl) = do addr <- resolveAddress outIx sta - Right $ BabbageTxOut addr vl (Alonzo.DatumHash (hashData @StandardBabbage plutusDataList)) SNothing + Right $ BabbageTxOut addr vl (Alonzo.DatumHash (hashData @BabbageEra plutusDataList)) SNothing mkDCertTx :: - [ShelleyTxCert StandardBabbage] -> - Withdrawals StandardCrypto -> - Maybe (TxIn StandardCrypto) -> - Either ForgingError (AlonzoTx StandardBabbage) + [ShelleyTxCert BabbageEra] -> + Withdrawals -> + Maybe TxIn -> + Either ForgingError (AlonzoTx BabbageEra) mkDCertTx certs wdrl ref = Right $ mkSimpleTx True $ consCertTxBody ref certs wdrl mkSimpleDCertTx :: - [(StakeIndex, StakeCredential StandardCrypto -> ShelleyTxCert StandardBabbage)] -> + [(StakeIndex, StakeCredential -> ShelleyTxCert BabbageEra)] -> BabbageLedgerState -> - Either ForgingError (AlonzoTx StandardBabbage) + Either ForgingError (AlonzoTx BabbageEra) mkSimpleDCertTx consDert st = do dcerts <- forM consDert $ \(stakeIndex, mkDCert) -> do cred <- resolveStakeCreds stakeIndex st pure $ mkDCert cred mkDCertTx dcerts (Withdrawals mempty) Nothing -mkDummyRegisterTx :: Int -> Int -> Either ForgingError (AlonzoTx StandardBabbage) +mkDummyRegisterTx :: Int -> Int -> Either ForgingError (AlonzoTx BabbageEra) mkDummyRegisterTx n m = mkDCertTx - (ShelleyTxCertDelegCert . ShelleyRegCert . KeyHashObj . KeyHash . mkDummyHash (Proxy @(ADDRHASH StandardCrypto)) . fromIntegral <$> [n, m]) + (ShelleyTxCertDelegCert . ShelleyRegCert . KeyHashObj . KeyHash . mkDummyHash (Proxy @ADDRHASH) . fromIntegral <$> [n, m]) (Withdrawals mempty) Nothing mkDCertPoolTx :: [ ( [StakeIndex] , PoolIndex - , [StakeCredential StandardCrypto] -> KeyHash 'StakePool StandardCrypto -> ShelleyTxCert StandardBabbage + , [StakeCredential] -> KeyHash 'StakePool -> ShelleyTxCert BabbageEra ) ] -> BabbageLedgerState -> - Either ForgingError (AlonzoTx StandardBabbage) + Either ForgingError (AlonzoTx BabbageEra) mkDCertPoolTx consDert st = do dcerts <- forM consDert $ \(stakeIxs, poolIx, mkDCert) -> do stakeCreds <- forM stakeIxs $ \stix -> resolveStakeCreds stix st @@ -401,10 +400,10 @@ mkDCertPoolTx consDert st = do mkDCertTx dcerts (Withdrawals mempty) Nothing mkScriptDCertTx :: - [(StakeIndex, Bool, StakeCredential StandardCrypto -> ShelleyTxCert StandardBabbage)] -> + [(StakeIndex, Bool, StakeCredential -> ShelleyTxCert BabbageEra)] -> Bool -> BabbageLedgerState -> - Either ForgingError (AlonzoTx StandardBabbage) + Either ForgingError (AlonzoTx BabbageEra) mkScriptDCertTx consDert valid st = do dcerts <- forM consDert $ \(stakeIndex, _, mkDCert) -> do cred <- resolveStakeCreds stakeIndex st @@ -427,7 +426,7 @@ mkDepositTxPools :: BabbageUTxOIndex -> Integer -> BabbageLedgerState -> - Either ForgingError (AlonzoTx StandardBabbage) + Either ForgingError (AlonzoTx BabbageEra) mkDepositTxPools inputIndex deposit sta = do (inputPair, _) <- resolveUTxOIndex inputIndex sta @@ -438,10 +437,10 @@ mkDepositTxPools inputIndex deposit sta = do mkDCertTxPools :: BabbageLedgerState -> - Either ForgingError (AlonzoTx StandardBabbage) + Either ForgingError (AlonzoTx BabbageEra) mkDCertTxPools sta = Right $ mkSimpleTx True $ consCertTxBody Nothing (allPoolStakeCert sta) (Withdrawals mempty) -mkSimpleTx :: Bool -> BabbageTxBody StandardBabbage -> AlonzoTx StandardBabbage +mkSimpleTx :: Bool -> BabbageTxBody BabbageEra -> AlonzoTx BabbageEra mkSimpleTx valid txBody = AlonzoTx { body = txBody @@ -451,23 +450,23 @@ mkSimpleTx valid txBody = } consPoolParamsTwoOwners :: - [StakeCredential StandardCrypto] -> - KeyHash 'StakePool StandardCrypto -> - ShelleyTxCert StandardBabbage + [StakeCredential] -> + KeyHash 'StakePool -> + ShelleyTxCert BabbageEra consPoolParamsTwoOwners [rwCred, KeyHashObj owner0, KeyHashObj owner1] poolId = ShelleyTxCertPool $ RegPool $ consPoolParams poolId rwCred [owner0, owner1] consPoolParamsTwoOwners _ _ = panic "expected 2 pool owners" -mkUTxOBabbage :: AlonzoTx StandardBabbage -> [(TxIn StandardCrypto, BabbageTxOut StandardBabbage)] +mkUTxOBabbage :: AlonzoTx BabbageEra -> [(TxIn, BabbageTxOut BabbageEra)] mkUTxOBabbage = mkUTxOAlonzo mkUTxOCollBabbage :: BabbageEraTxBody era => AlonzoTx era -> - [(TxIn (EraCrypto era), TxOut era)] + [(TxIn, TxOut era)] mkUTxOCollBabbage tx = Map.toList $ unUTxO $ collOuts $ getField @"body" tx -emptyTxBody :: BabbageTxBody StandardBabbage +emptyTxBody :: BabbageTxBody BabbageEra emptyTxBody = BabbageTxBody mempty @@ -487,7 +486,7 @@ emptyTxBody = Strict.SNothing (Strict.SJust Testnet) -emptyTx :: AlonzoTx StandardBabbage +emptyTx :: AlonzoTx BabbageEra emptyTx = AlonzoTx { body = emptyTxBody @@ -496,7 +495,7 @@ emptyTx = , auxiliaryData = maybeToStrictMaybe Nothing } -mkParamUpdateTx :: Either ForgingError (AlonzoTx StandardBabbage) +mkParamUpdateTx :: Either ForgingError (AlonzoTx BabbageEra) mkParamUpdateTx = Right (mkSimpleTx True txBody) where txBody = @@ -531,11 +530,11 @@ mkFullTx :: Int -> Integer -> BabbageLedgerState -> - Either ForgingError (AlonzoTx StandardBabbage) + Either ForgingError (AlonzoTx BabbageEra) mkFullTx n m sta = do inputPairs <- fmap fst <$> mapM (`resolveUTxOIndex` sta) inps let rdmrs = mapMaybe mkScriptInp' $ zip [0 ..] inputPairs - let witnesses = mkWitnesses rdmrs [(hashData @StandardBabbage plutusDataList, plutusDataList)] + let witnesses = mkWitnesses rdmrs [(hashData @BabbageEra plutusDataList, plutusDataList)] refInputPairs <- fmap fst <$> mapM (`resolveUTxOIndex` sta) refInps colInput <- Set.singleton . fst . fst <$> resolveUTxOIndex colInps sta Right $ @@ -574,10 +573,10 @@ mkFullTx n m sta = do outValue0 = MaryValue (Coin 20) $ MultiAsset $ Map.fromList [(policy0, assets0), (policy1, assets0)] addr0 = Addr Testnet (Prelude.head unregisteredAddresses) (StakeRefBase $ Prelude.head unregisteredStakeCredentials) addr2 = Addr Testnet (ScriptHashObj alwaysFailsScriptHash) (StakeRefBase $ unregisteredStakeCredentials !! 2) - out0, out1, out2 :: BabbageTxOut StandardBabbage - out0 = BabbageTxOut addr0 outValue0 (Alonzo.DatumHash (hashData @StandardBabbage plutusDataList)) (Strict.SJust alwaysFailsScript) - out1 = BabbageTxOut alwaysSucceedsScriptAddr outValue0 (Alonzo.DatumHash (hashData @StandardBabbage plutusDataList)) Strict.SNothing - out2 = BabbageTxOut addr2 outValue0 (Alonzo.DatumHash (hashData @StandardBabbage plutusDataList)) (Strict.SJust alwaysFailsScript) + out0, out1, out2 :: BabbageTxOut BabbageEra + out0 = BabbageTxOut addr0 outValue0 (Alonzo.DatumHash (hashData @BabbageEra plutusDataList)) (Strict.SJust alwaysFailsScript) + out1 = BabbageTxOut alwaysSucceedsScriptAddr outValue0 (Alonzo.DatumHash (hashData @BabbageEra plutusDataList)) Strict.SNothing + out2 = BabbageTxOut addr2 outValue0 (Alonzo.DatumHash (hashData @BabbageEra plutusDataList)) (Strict.SJust alwaysFailsScript) outs = StrictSeq.fromList [out0, out1] collOut = Strict.SJust out2 assetsMinted0 = Map.fromList [(Prelude.head assetNames, 10), (assetNames !! 1, 4)] @@ -640,14 +639,14 @@ mkFullTx n m sta = do costModels = mkCostModels (Map.fromList [(PlutusV2, testingCostModelV2)]) paramsUpdate = Core.emptyPParamsUpdate & ppuCostModelsL .~ Strict.SJust costModels -- {_costmdls = Strict.SJust costModels} - proposed :: ProposedPPUpdates StandardBabbage + proposed :: ProposedPPUpdates BabbageEra proposed = ProposedPPUpdates $ Map.fromList [ (unregisteredGenesisKeys !! 1, paramsUpdate) , (unregisteredGenesisKeys !! 2, paramsUpdate) ] - updates :: Update StandardBabbage + updates :: Update BabbageEra updates = Update proposed (EpochNo 0) testingCostModelV2 :: CostModel diff --git a/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway.hs b/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway.hs index 3e08eaba0..9c231a546 100644 --- a/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway.hs +++ b/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway.hs @@ -7,7 +7,6 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} #if __GLASGOW_HASKELL__ >= 908 {-# OPTIONS_GHC -Wno-x-partial #-} @@ -80,13 +79,14 @@ import Cardano.Ledger.Conway.Scripts import Cardano.Ledger.Conway.Tx (AlonzoTx (..)) import Cardano.Ledger.Conway.TxBody (ConwayTxBody (..)) import Cardano.Ledger.Conway.TxCert hiding (mkDelegTxCert) +import Cardano.Ledger.Core (ADDRHASH) import qualified Cardano.Ledger.Core as Core import Cardano.Ledger.Credential (Credential (..), StakeCredential, StakeReference (..)) -import Cardano.Ledger.Crypto (ADDRHASH ()) import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..)) import Cardano.Ledger.Mary.Value (MaryValue (..), MultiAsset (..), PolicyID (..), valueFromList) import Cardano.Ledger.Plutus.Data import Cardano.Ledger.Plutus.Language (Language (..)) +import Cardano.Ledger.Shelley.LedgerState (certPStateL) import qualified Cardano.Ledger.Shelley.LedgerState as LedgerState import Cardano.Ledger.Shelley.TxAuxData (Metadatum (..)) import Cardano.Ledger.TxIn (TxIn (..)) @@ -112,28 +112,28 @@ import Data.Sequence.Strict (StrictSeq ()) import qualified Data.Sequence.Strict as StrictSeq import qualified Data.Set as Set import Lens.Micro -import Ouroboros.Consensus.Cardano.Block (EraCrypto, LedgerState ()) -import Ouroboros.Consensus.Shelley.Eras (StandardConway (), StandardCrypto ()) +import Ouroboros.Consensus.Cardano.Block (LedgerState) +import Ouroboros.Consensus.Shelley.Eras (ConwayEra) import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock) import qualified Ouroboros.Consensus.Shelley.Ledger.Ledger as Consensus import Prelude (error, (!!)) import qualified Prelude -type ConwayUTxOIndex = UTxOIndex StandardConway -type ConwayLedgerState = LedgerState (ShelleyBlock PraosStandard StandardConway) +type ConwayUTxOIndex = UTxOIndex ConwayEra +type ConwayLedgerState = LedgerState (ShelleyBlock PraosStandard ConwayEra) consTxBody :: - Set (TxIn StandardCrypto) -> - Set (TxIn StandardCrypto) -> - Set (TxIn StandardCrypto) -> - StrictSeq (BabbageTxOut StandardConway) -> - StrictMaybe (BabbageTxOut StandardConway) -> + Set TxIn -> + Set TxIn -> + Set TxIn -> + StrictSeq (BabbageTxOut ConwayEra) -> + StrictMaybe (BabbageTxOut ConwayEra) -> Coin -> - MultiAsset StandardCrypto -> - [ConwayTxCert StandardConway] -> - Withdrawals StandardCrypto -> + MultiAsset -> + [ConwayTxCert ConwayEra] -> + Withdrawals -> Coin -> - ConwayTxBody StandardConway + ConwayTxBody ConwayEra consTxBody ins cols ref outs colOut fees minted certs withdrawals donation = ConwayTxBody { ctbSpendInputs = ins @@ -158,10 +158,10 @@ consTxBody ins cols ref outs colOut fees minted certs withdrawals donation = } consCertTxBody :: - Maybe (TxIn StandardCrypto) -> - [ConwayTxCert StandardConway] -> - Withdrawals StandardCrypto -> - ConwayTxBody StandardConway + Maybe TxIn -> + [ConwayTxCert ConwayEra] -> + Withdrawals -> + ConwayTxBody ConwayEra consCertTxBody ref certs withdrawals = consTxBody mempty @@ -179,9 +179,9 @@ consCertTxBody ref certs withdrawals = toSet (Just a) = Set.singleton a consTxCertPool :: - [StakeCredential StandardCrypto] -> - KeyHash 'StakePool StandardCrypto -> - ConwayTxCert StandardConway + [StakeCredential] -> + KeyHash 'StakePool -> + ConwayTxCert ConwayEra consTxCertPool [] _ = panic "Expected at least 1 pool owner" consTxCertPool (rwCred : poolOwners) poolId = ConwayTxCertPool @@ -200,7 +200,7 @@ mkPaymentTx :: Integer -> Integer -> ConwayLedgerState -> - Either ForgingError (AlonzoTx StandardConway) + Either ForgingError (AlonzoTx ConwayEra) mkPaymentTx inputIndex outputIndex amount = mkPaymentTx' inputIndex outputIndices where @@ -208,11 +208,11 @@ mkPaymentTx inputIndex outputIndex amount = mkPaymentTx' :: ConwayUTxOIndex -> - [(ConwayUTxOIndex, MaryValue StandardCrypto)] -> + [(ConwayUTxOIndex, MaryValue)] -> Integer -> Integer -> ConwayLedgerState -> - Either ForgingError (AlonzoTx StandardConway) + Either ForgingError (AlonzoTx ConwayEra) mkPaymentTx' inputIndex outputIndices fees donation state' = do (inputPair, _) <- resolveUTxOIndex inputIndex state' outputs <- mapM mkOutputs outputIndices @@ -243,7 +243,7 @@ mkPaymentTx' inputIndex outputIndices fees donation state' = do addr <- resolveAddress outIx state' pure (BabbageTxOut addr val NoDatum SNothing) -mkDonationTx :: Coin -> AlonzoTx StandardConway +mkDonationTx :: Coin -> AlonzoTx ConwayEra mkDonationTx amount = mkSimpleTx True txBody where txBody = mkDummyTxBody {ctbTreasuryDonation = amount} @@ -254,7 +254,7 @@ mkLockByScriptTx :: Integer -> Integer -> ConwayLedgerState -> - Either ForgingError (AlonzoTx StandardConway) + Either ForgingError (AlonzoTx ConwayEra) mkLockByScriptTx inputIndex txOutTypes amount fees state' = do (inputPair, _) <- resolveUTxOIndex inputIndex state' @@ -288,7 +288,7 @@ mkUnlockScriptTx :: Integer -> Integer -> ConwayLedgerState -> - Either ForgingError (AlonzoTx StandardConway) + Either ForgingError (AlonzoTx ConwayEra) mkUnlockScriptTx inputIndex colInputIndex outputIndex = mkUnlockScriptTx' inputIndex colInputIndex outputIndex mempty Nothing @@ -302,7 +302,7 @@ mkUnlockScriptTxBabbage :: Integer -> Integer -> ConwayLedgerState -> - Either ForgingError (AlonzoTx StandardConway) + Either ForgingError (AlonzoTx ConwayEra) mkUnlockScriptTxBabbage inputIndex colInputIndex outputIndex refInput compl succeeds amount fees state' = do let colTxOutType = if compl @@ -322,22 +322,22 @@ mkUnlockScriptTxBabbage inputIndex colInputIndex outputIndex refInput compl succ state' mkDCertTx :: - [ConwayTxCert StandardConway] -> - Withdrawals StandardCrypto -> - Maybe (TxIn StandardCrypto) -> - Either ForgingError (AlonzoTx StandardConway) + [ConwayTxCert ConwayEra] -> + Withdrawals -> + Maybe TxIn -> + Either ForgingError (AlonzoTx ConwayEra) mkDCertTx certs wdrl ref = Right (mkSimpleTx True $ consCertTxBody ref certs wdrl) mkDCertPoolTx :: [ ( [StakeIndex] , PoolIndex - , [StakeCredential StandardCrypto] -> - KeyHash 'StakePool StandardCrypto -> - ConwayTxCert StandardConway + , [StakeCredential] -> + KeyHash 'StakePool -> + ConwayTxCert ConwayEra ) ] -> ConwayLedgerState -> - Either ForgingError (AlonzoTx StandardConway) + Either ForgingError (AlonzoTx ConwayEra) mkDCertPoolTx consDCert state' = do dcerts <- forM consDCert $ \(stakeIxs, poolIx, mkDCert) -> do stakeCreds <- forM stakeIxs $ \stakeIx -> resolveStakeCreds stakeIx state' @@ -346,13 +346,13 @@ mkDCertPoolTx consDCert state' = do mkDCertTx dcerts (Withdrawals mempty) Nothing -mkDCertTxPools :: ConwayLedgerState -> Either ForgingError (AlonzoTx StandardConway) +mkDCertTxPools :: ConwayLedgerState -> Either ForgingError (AlonzoTx ConwayEra) mkDCertTxPools state' = Right $ mkSimpleTx True $ consCertTxBody Nothing (allPoolStakeCert' state') (Withdrawals mempty) -mkSimpleTx :: Bool -> ConwayTxBody StandardConway -> AlonzoTx StandardConway +mkSimpleTx :: Bool -> ConwayTxBody ConwayEra -> AlonzoTx ConwayEra mkSimpleTx isValid' txBody = AlonzoTx { body = txBody @@ -363,9 +363,9 @@ mkSimpleTx isValid' txBody = mkAuxDataTx :: Bool -> - ConwayTxBody StandardConway -> + ConwayTxBody ConwayEra -> Map Word64 Metadatum -> - AlonzoTx StandardConway + AlonzoTx ConwayEra mkAuxDataTx isValid' txBody auxData = AlonzoTx { body = txBody @@ -375,9 +375,9 @@ mkAuxDataTx isValid' txBody auxData = } mkSimpleDCertTx :: - [(StakeIndex, StakeCredential StandardCrypto -> ConwayTxCert StandardConway)] -> + [(StakeIndex, StakeCredential -> ConwayTxCert ConwayEra)] -> ConwayLedgerState -> - Either ForgingError (AlonzoTx StandardConway) + Either ForgingError (AlonzoTx ConwayEra) mkSimpleDCertTx consDCert st = do dcerts <- forM consDCert $ \(stakeIndex, mkDCert) -> do cred <- resolveStakeCreds stakeIndex st @@ -385,10 +385,10 @@ mkSimpleDCertTx consDCert st = do mkDCertTx dcerts (Withdrawals mempty) Nothing mkScriptDCertTx :: - [(StakeIndex, Bool, StakeCredential StandardCrypto -> ConwayTxCert StandardConway)] -> + [(StakeIndex, Bool, StakeCredential -> ConwayTxCert ConwayEra)] -> Bool -> ConwayLedgerState -> - Either ForgingError (AlonzoTx StandardConway) + Either ForgingError (AlonzoTx ConwayEra) mkScriptDCertTx consCert isValid' state' = do dcerts <- forM consCert $ \(stakeIndex, _, mkDCert) -> do cred <- resolveStakeCreds stakeIndex state' @@ -411,13 +411,13 @@ mkScriptDCertTx consCert isValid' state' = do mkMultiAssetsScriptTx :: [ConwayUTxOIndex] -> ConwayUTxOIndex -> - [(ConwayUTxOIndex, MaryValue StandardCrypto)] -> + [(ConwayUTxOIndex, MaryValue)] -> [ConwayUTxOIndex] -> - MultiAsset StandardCrypto -> + MultiAsset -> Bool -> Integer -> ConwayLedgerState -> - Either ForgingError (AlonzoTx StandardConway) + Either ForgingError (AlonzoTx ConwayEra) mkMultiAssetsScriptTx inputIx colInputIx outputIx refInput minted succeeds fees state' = do inputs <- mapM (`resolveUTxOIndex` state') inputIx refs <- mapM (`resolveUTxOIndex` state') refInput @@ -448,14 +448,14 @@ mkMultiAssetsScriptTx inputIx colInputIx outputIx refInput minted succeeds fees BabbageTxOut addr val - (DatumHash $ hashData @StandardConway plutusDataList) + (DatumHash $ hashData @ConwayEra plutusDataList) SNothing mkDepositTxPools :: ConwayUTxOIndex -> Integer -> ConwayLedgerState -> - Either ForgingError (AlonzoTx StandardConway) + Either ForgingError (AlonzoTx ConwayEra) mkDepositTxPools inputIndex deposit state' = do (inputPair, _) <- resolveUTxOIndex inputIndex state' @@ -483,68 +483,68 @@ mkDepositTxPools inputIndex deposit state' = do (Coin 0) mkRegisterDRepTx :: - Credential 'DRepRole StandardCrypto -> - Either ForgingError (AlonzoTx StandardConway) + Credential 'DRepRole -> + Either ForgingError (AlonzoTx ConwayEra) mkRegisterDRepTx cred = mkDCertTx [cert] (Withdrawals mempty) Nothing where cert = ConwayTxCertGov (ConwayRegDRep cred deposit SNothing) deposit = Coin 500_000_000 mkCommitteeAuthTx :: - Credential 'ColdCommitteeRole StandardCrypto -> - Credential 'HotCommitteeRole StandardCrypto -> - Either ForgingError (AlonzoTx StandardConway) + Credential 'ColdCommitteeRole -> + Credential 'HotCommitteeRole -> + Either ForgingError (AlonzoTx ConwayEra) mkCommitteeAuthTx cold hot = mkDCertTx [cert] (Withdrawals mempty) Nothing where cert = ConwayTxCertGov (ConwayAuthCommitteeHotKey cold hot) -mkDummyRegisterTx :: Int -> Int -> Either ForgingError (AlonzoTx StandardConway) +mkDummyRegisterTx :: Int -> Int -> Either ForgingError (AlonzoTx ConwayEra) mkDummyRegisterTx n m = mkDCertTx consDelegCert (Withdrawals mempty) Nothing where consDelegCert = mkRegTxCert SNothing . KeyHashObj . KeyHash - . mkDummyHash (Proxy @(ADDRHASH StandardCrypto)) + . mkDummyHash (Proxy @ADDRHASH) . fromIntegral <$> [n, m] mkRegTxCert :: StrictMaybe Coin -> - StakeCredential StandardCrypto -> - ConwayTxCert StandardConway + StakeCredential -> + ConwayTxCert ConwayEra mkRegTxCert coin' = mkTxDelegCert $ \cred -> ConwayRegCert cred coin' mkUnRegTxCert :: StrictMaybe Coin -> - StakeCredential StandardCrypto -> - ConwayTxCert StandardConway + StakeCredential -> + ConwayTxCert ConwayEra mkUnRegTxCert coin' = mkTxDelegCert $ \cred -> ConwayUnRegCert cred coin' mkRegDelegTxCert :: Coin -> - Delegatee StandardCrypto -> - StakeCredential StandardCrypto -> - ConwayTxCert StandardConway + Delegatee -> + StakeCredential -> + ConwayTxCert ConwayEra mkRegDelegTxCert deposit delegatee = mkTxDelegCert $ \cred -> ConwayRegDelegCert cred delegatee deposit mkDelegTxCert :: - Delegatee StandardCrypto -> - StakeCredential StandardCrypto -> - ConwayTxCert StandardConway + Delegatee -> + StakeCredential -> + ConwayTxCert ConwayEra mkDelegTxCert delegatee = mkTxDelegCert $ \cred -> ConwayDelegCert cred delegatee mkTxDelegCert :: - (StakeCredential StandardCrypto -> ConwayDelegCert StandardCrypto) -> - StakeCredential StandardCrypto -> - ConwayTxCert StandardConway + (StakeCredential -> ConwayDelegCert) -> + StakeCredential -> + ConwayTxCert ConwayEra mkTxDelegCert f = ConwayTxCertDeleg . f mkAddCommitteeTx :: - Maybe (Governance.GovPurposeId 'Governance.CommitteePurpose StandardConway) -> - Credential 'ColdCommitteeRole StandardCrypto -> - AlonzoTx StandardConway + Maybe (Governance.GovPurposeId 'Governance.CommitteePurpose ConwayEra) -> + Credential 'ColdCommitteeRole -> + AlonzoTx ConwayEra mkAddCommitteeTx prevGovAction cred = mkGovActionProposalTx govAction where govAction = Governance.UpdateCommittee prevGovAction' mempty newMembers threshold @@ -553,44 +553,44 @@ mkAddCommitteeTx prevGovAction cred = mkGovActionProposalTx govAction threshold = fromJust $ boundRational (1 % 1) mkNewConstitutionTx :: - Anchor StandardCrypto -> - AlonzoTx StandardConway + Anchor -> + AlonzoTx ConwayEra mkNewConstitutionTx anchor = mkGovActionProposalTx govAction where govAction = Governance.NewConstitution SNothing constitution constitution = Governance.Constitution anchor SNothing mkTreasuryWithdrawalTx :: - RewardAccount StandardCrypto -> + RewardAccount -> Coin -> - AlonzoTx StandardConway + AlonzoTx ConwayEra mkTreasuryWithdrawalTx rewardAccount amount = mkGovActionProposalTx govAction where govAction = Governance.TreasuryWithdrawals withdrawals hashProtection withdrawals = Map.singleton rewardAccount amount hashProtection = SNothing -mkParamChangeTx :: AlonzoTx StandardConway +mkParamChangeTx :: AlonzoTx ConwayEra mkParamChangeTx = mkGovActionProposalTx govAction where govAction = Governance.ParameterChange SNothing paramUpdate hasProtection paramUpdate = Core.emptyPParamsUpdate & Core.ppuMaxTxSizeL .~ SJust 32_000 hasProtection = SNothing -mkHardForkInitTx :: AlonzoTx StandardConway +mkHardForkInitTx :: AlonzoTx ConwayEra mkHardForkInitTx = mkGovActionProposalTx govAction where govAction = Governance.HardForkInitiation SNothing protoVersion protoVersion = ProtVer (natVersion @11) 0 -mkInfoTx :: AlonzoTx StandardConway +mkInfoTx :: AlonzoTx ConwayEra mkInfoTx = mkGovActionProposalTx govAction where govAction = Governance.InfoAction mkGovActionProposalTx :: - Governance.GovAction StandardConway -> - AlonzoTx StandardConway + Governance.GovAction ConwayEra -> + AlonzoTx ConwayEra mkGovActionProposalTx govAction = mkSimpleTx True txBody where txBody = mkDummyTxBody {ctbProposalProcedures = OSet.singleton proposal} @@ -607,20 +607,20 @@ mkGovActionProposalTx govAction = mkSimpleTx True txBody anchor = Governance.Anchor { Governance.anchorUrl = fromJust (textToUrl 64 "best.cc") - , Governance.anchorDataHash = hashAnchorData (Governance.AnchorData mempty) + , Governance.anchorDataHash = Core.hashAnnotated (Governance.AnchorData mempty) } mkGovVoteYesTx :: - Governance.GovActionId StandardCrypto -> - [Governance.Voter StandardCrypto] -> - AlonzoTx StandardConway + Governance.GovActionId -> + [Governance.Voter] -> + AlonzoTx ConwayEra mkGovVoteYesTx govAction = mkGovVoteTx govAction . Map.fromList . map (,Governance.VoteYes) mkGovVoteTx :: - Governance.GovActionId StandardCrypto -> - Map (Governance.Voter StandardCrypto) Governance.Vote -> - AlonzoTx StandardConway + Governance.GovActionId -> + Map Governance.Voter Governance.Vote -> + AlonzoTx ConwayEra mkGovVoteTx govAction votes = mkSimpleTx True txBody where txBody = mkDummyTxBody {ctbVotingProcedures = Governance.VotingProcedures votes'} @@ -632,7 +632,7 @@ mkGovVoteTx govAction votes = mkSimpleTx True txBody , Governance.vProcAnchor = SNothing } -mkDummyTxBody :: ConwayTxBody StandardConway +mkDummyTxBody :: ConwayTxBody ConwayEra mkDummyTxBody = consTxBody mempty @@ -650,7 +650,7 @@ mkFullTx :: Int -> Integer -> ConwayLedgerState -> - Either ForgingError (AlonzoTx StandardConway) + Either ForgingError (AlonzoTx ConwayEra) mkFullTx n m state' = do inputPairs <- fmap fst <$> mapM (`resolveUTxOIndex` state') inputs let redeemers = mkScriptInps inputPairs @@ -658,8 +658,8 @@ mkFullTx n m state' = do mkWitnesses redeemers [ - ( hashData @StandardConway plutusDataList - , plutusDataList @StandardConway + ( hashData @ConwayEra plutusDataList + , plutusDataList @ConwayEra ) ] refInputPairs <- fmap fst <$> mapM (`resolveUTxOIndex` state') refInputs @@ -704,24 +704,24 @@ mkFullTx n m state' = do } -- Outputs outputs = StrictSeq.fromList [out0, out1] - out0, out1, out2 :: BabbageTxOut StandardConway + out0, out1, out2 :: BabbageTxOut ConwayEra out0 = BabbageTxOut addr0 outValue0 - (DatumHash (hashData @StandardConway plutusDataList)) + (DatumHash (hashData @ConwayEra plutusDataList)) (SJust alwaysFailsScript) out1 = BabbageTxOut alwaysSucceedsScriptAddr outValue0 - (DatumHash (hashData @StandardConway plutusDataList)) + (DatumHash (hashData @ConwayEra plutusDataList)) SNothing out2 = BabbageTxOut addr2 outValue0 - (DatumHash (hashData @StandardConway plutusDataList)) + (DatumHash (hashData @ConwayEra plutusDataList)) (SJust alwaysFailsScript) addr0 = Addr @@ -743,7 +743,7 @@ mkFullTx n m state' = do mkInputs inputs' = Set.fromList $ fst <$> inputs' -- Certificates - certs :: [ConwayTxCert StandardConway] + certs :: [ConwayTxCert ConwayEra] certs = [ ConwayTxCertDeleg $ ConwayRegCert (Prelude.head unregisteredStakeCredentials) SNothing , ConwayTxCertPool $ Core.RegPool poolParams0 @@ -794,14 +794,14 @@ mkFullTx n m state' = do NonEmpty.fromList [alwaysFailsPlutusBinary] mkScriptMint' :: - MultiAsset StandardCrypto -> - [(ConwayPlutusPurpose AsIx era, Maybe (Core.ScriptHash StandardCrypto, Core.Script StandardConway))] + MultiAsset -> + [(ConwayPlutusPurpose AsIx era, Maybe (Core.ScriptHash, Core.Script ConwayEra))] mkScriptMint' = fmap (first (ConwayMinting . AsIx)) . mkScriptMint {-} mkScriptMint :: - MultiAsset StandardCrypto -> - [(AlonzoPlutusPurpose AsIx era, Maybe (Core.ScriptHash StandardCrypto, Core.Script StandardConway))] + MultiAsset -> + [(AlonzoPlutusPurpose AsIx era, Maybe (Core.ScriptHash, Core.Script ConwayEra))] mkScriptMint (MultiAsset m) = mapMaybe mkMint . zip [0 ..] . map policyID $ Map.keys m where @@ -819,32 +819,32 @@ mkScriptMint (MultiAsset m) = alwaysMint = (alwaysMintScriptHash, alwaysMintScript) -} consPaymentTxBody :: - Set (TxIn StandardCrypto) -> - Set (TxIn StandardCrypto) -> - Set (TxIn StandardCrypto) -> - StrictSeq (BabbageTxOut StandardConway) -> - StrictMaybe (BabbageTxOut StandardConway) -> + Set TxIn -> + Set TxIn -> + Set TxIn -> + StrictSeq (BabbageTxOut ConwayEra) -> + StrictMaybe (BabbageTxOut ConwayEra) -> Coin -> - MultiAsset StandardCrypto -> + MultiAsset -> Coin -> - ConwayTxBody StandardConway + ConwayTxBody ConwayEra consPaymentTxBody ins cols ref outs colOut fees minted = consTxBody ins cols ref outs colOut fees minted mempty (Withdrawals mempty) mkUTxOConway :: - AlonzoTx StandardConway -> - [(TxIn StandardCrypto, BabbageTxOut StandardConway)] + AlonzoTx ConwayEra -> + [(TxIn, BabbageTxOut ConwayEra)] mkUTxOConway = mkUTxOAlonzo mkUTxOCollConway :: - AlonzoTx StandardConway -> - [(TxIn StandardCrypto, BabbageTxOut StandardConway)] + AlonzoTx ConwayEra -> + [(TxIn, BabbageTxOut ConwayEra)] mkUTxOCollConway = Babbage.mkUTxOCollBabbage mkOutFromType :: Integer -> Babbage.TxOutScriptType -> - BabbageTxOut StandardConway + BabbageTxOut ConwayEra mkOutFromType amount txOutType = BabbageTxOut outAddress (valueFromList (Coin amount) []) datum script where @@ -857,21 +857,21 @@ mkOutFromType amount txOutType = Datum (dataToBinaryData plutusDataList) Babbage.InlineDatumCBOR sbs -> Datum $ either error identity (makeBinaryData sbs) - dataHash = hashData @StandardConway plutusDataList + dataHash = hashData @ConwayEra plutusDataList script = case Babbage.getInlineScript txOutType of SNothing -> SNothing SJust True -> SJust alwaysSucceedsScript SJust False -> SJust alwaysFailsScript mkScriptInps :: - [(TxIn StandardCrypto, Core.TxOut StandardConway)] -> - [(ConwayPlutusPurpose AsIx StandardConway, Maybe (Core.ScriptHash StandardCrypto, AlonzoScript StandardConway))] + [(TxIn, Core.TxOut ConwayEra)] -> + [(ConwayPlutusPurpose AsIx ConwayEra, Maybe (Core.ScriptHash, Script ConwayEra))] mkScriptInps = mapMaybe mkScriptInp . zip [0 ..] mkScriptInp :: - (BabbageEraTxOut era, EraCrypto era ~ StandardCrypto) => - (Word64, (TxIn StandardCrypto, Core.TxOut era)) -> - Maybe (ConwayPlutusPurpose AsIx era, Maybe (Core.ScriptHash StandardCrypto, AlonzoScript era)) + BabbageEraTxOut era => + (Word64, (TxIn, Core.TxOut era)) -> + Maybe (ConwayPlutusPurpose AsIx era, Maybe (Core.ScriptHash, Script era)) mkScriptInp = fmap (first $ ConwaySpending . AsIx) . Babbage.mkScriptInp mkUnlockScriptTx' :: @@ -879,12 +879,12 @@ mkUnlockScriptTx' :: ConwayUTxOIndex -> ConwayUTxOIndex -> [ConwayUTxOIndex] -> - Maybe (BabbageTxOut StandardConway) -> + Maybe (BabbageTxOut ConwayEra) -> Bool -> Integer -> Integer -> ConwayLedgerState -> - Either ForgingError (AlonzoTx StandardConway) + Either ForgingError (AlonzoTx ConwayEra) mkUnlockScriptTx' inputIndex colInputIndex outputIndex refInput colOut succeeds amount fees state' = do inputPairs <- map fst <$> mapM (`resolveUTxOIndex` state') inputIndex refInputPairs <- map fst <$> mapM (`resolveUTxOIndex` state') refInput @@ -913,13 +913,14 @@ mkUnlockScriptTx' inputIndex colInputIndex outputIndex refInput colOut succeeds mempty (Coin 0) -allPoolStakeCert' :: ConwayLedgerState -> [ConwayTxCert StandardConway] +allPoolStakeCert' :: ConwayLedgerState -> [ConwayTxCert ConwayEra] allPoolStakeCert' st = map (mkRegTxCert SNothing) (getCreds st) where getCreds = nub . concatMap getPoolStakeCreds . Map.elems . stakePoolParams + stakePoolParams = LedgerState.psStakePoolParams - . LedgerState.certPState + . (^. certPStateL) . LedgerState.lsCertState . LedgerState.esLState . LedgerState.nesEs diff --git a/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway/Scenarios.hs b/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway/Scenarios.hs index f3a3c4fba..782765a81 100644 --- a/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway/Scenarios.hs +++ b/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway/Scenarios.hs @@ -20,7 +20,6 @@ import Cardano.Ledger.Coin import Cardano.Ledger.Conway.TxCert (Delegatee (..)) import Cardano.Ledger.Core (Tx ()) import Cardano.Ledger.Credential (Credential (..), StakeCredential (), StakeReference (..)) -import Cardano.Ledger.Crypto (StandardCrypto ()) import Cardano.Ledger.DRep (DRep (..)) import Cardano.Ledger.Keys (KeyRole (..)) import Cardano.Ledger.Mary.Value (MaryValue (..)) @@ -32,7 +31,7 @@ import Cardano.Prelude import Data.List.Extra (chunksOf) import Data.Maybe.Strict (StrictMaybe (..)) import Ouroboros.Consensus.Cardano.Block (LedgerState (..)) -import Ouroboros.Consensus.Shelley.Eras (StandardConway ()) +import Ouroboros.Consensus.Shelley.Eras (ConwayEra ()) import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock ()) import qualified Prelude @@ -56,14 +55,14 @@ delegateAndSendBlocks n interpreter = do (\(payCred, stakeCred) -> Addr Testnet payCred (StakeRefBase stakeCred)) (zip payCreds stakeCreds) -mkRegisterBlocks :: [StakeCredential StandardCrypto] -> Interpreter -> IO [CardanoBlock] +mkRegisterBlocks :: [StakeCredential] -> Interpreter -> IO [CardanoBlock] mkRegisterBlocks creds interpreter = forgeBlocksChunked interpreter creds $ \txCreds _ -> Conway.mkDCertTx (Conway.mkRegTxCert SNothing <$> txCreds) (Withdrawals mempty) Nothing -mkDelegateBlocks :: [StakeCredential StandardCrypto] -> Interpreter -> IO [CardanoBlock] +mkDelegateBlocks :: [StakeCredential] -> Interpreter -> IO [CardanoBlock] mkDelegateBlocks creds interpreter = forgeBlocksChunked interpreter creds $ \txCreds state' -> Conway.mkDCertTx (map (mkDelegCert state') $ zip (cycle [0, 1, 2]) txCreds) @@ -75,7 +74,7 @@ mkDelegateBlocks creds interpreter = forgeBlocksChunked interpreter creds $ \txC (DelegStake $ resolvePool (PoolIndex poolIx) (unState state')) cred -mkPaymentBlocks :: UTxOIndex StandardConway -> [Addr StandardCrypto] -> Interpreter -> IO [CardanoBlock] +mkPaymentBlocks :: UTxOIndex ConwayEra -> [Addr] -> Interpreter -> IO [CardanoBlock] mkPaymentBlocks utxoIx addresses interpreter = forgeBlocksChunked interpreter addresses $ \txAddrs -> Conway.mkPaymentTx' utxoIx (map mkUTxOAddress txAddrs) 0 0 . unState @@ -86,7 +85,7 @@ mkPaymentBlocks utxoIx addresses interpreter = forgeBlocksChunked :: Interpreter -> [a] -> - ([a] -> ShelleyLedgerState StandardConway -> Either ForgingError (Tx StandardConway)) -> + ([a] -> ShelleyLedgerState ConwayEra -> Either ForgingError (Tx ConwayEra)) -> IO [CardanoBlock] forgeBlocksChunked interpreter vs f = forM (chunksOf 500 vs) $ \blockCreds -> do blockTxs <- withConwayLedgerState interpreter $ \state' -> @@ -105,10 +104,10 @@ registerDRepsAndDelegateVotes interpreter = do forgeNextFindLeader interpreter (map TxConway blockTxs) registerDRepAndDelegateVotes' :: - Credential 'DRepRole StandardCrypto -> + Credential 'DRepRole -> StakeIndex -> Conway.ConwayLedgerState -> - Either ForgingError [AlonzoTx StandardConway] + Either ForgingError [AlonzoTx ConwayEra] registerDRepAndDelegateVotes' drepId stakeIx ledger = do stakeCreds <- resolveStakeCreds stakeIx ledger diff --git a/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway/ScriptsExamples.hs b/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway/ScriptsExamples.hs index 9ed71d838..cd760a60b 100644 --- a/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway/ScriptsExamples.hs +++ b/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway/ScriptsExamples.hs @@ -44,7 +44,7 @@ import Codec.CBOR.Write (toStrictByteString) import Codec.Serialise import Codec.Serialise.Encoding import Data.ByteString.Short -import Ouroboros.Consensus.Cardano.Block (StandardAlonzo) +import Ouroboros.Consensus.Cardano.Block (AlonzoEra) import qualified PlutusCore.Data as Plutus import qualified PlutusLedgerApi.Test.Examples as Plutus @@ -52,25 +52,25 @@ alwaysSucceedsScript :: forall era. AlonzoScript era alwaysSucceedsScript = PlutusScript $ Plutus PlutusV1 (BinaryPlutus $ Plutus.alwaysSucceedingNAryFunction 0) alwaysSucceedsScriptHash :: ScriptHash StandardCrypto -alwaysSucceedsScriptHash = scriptHash @StandardAlonzo alwaysSucceedsScript +alwaysSucceedsScriptHash = scriptHash @AlonzoEra alwaysSucceedsScript alwaysSucceedsScriptAddr :: Addr StandardCrypto alwaysSucceedsScriptAddr = Addr Testnet (ScriptHashObj alwaysSucceedsScriptHash) StakeRefNull -alwaysSucceedsScriptStake :: StakeCredential StandardCrypto +alwaysSucceedsScriptStake :: StakeCredential alwaysSucceedsScriptStake = ScriptHashObj alwaysSucceedsScriptHash alwaysFailsScript :: forall era. AlonzoScript era alwaysFailsScript = PlutusScript $ Plutus PlutusV1 (BinaryPlutus $ Plutus.alwaysFailingNAryFunction 0) alwaysFailsScriptHash :: ScriptHash StandardCrypto -alwaysFailsScriptHash = scriptHash @StandardAlonzo alwaysFailsScript +alwaysFailsScriptHash = scriptHash @AlonzoEra alwaysFailsScript -- addr_test1wrqvvu0m5jpkgxn3hwfd829hc5kfp0cuq83tsvgk44752dsz4mvrk alwaysFailsScriptAddr :: Addr StandardCrypto alwaysFailsScriptAddr = Addr Testnet (ScriptHashObj alwaysFailsScriptHash) StakeRefNull -alwaysFailsScriptStake :: StakeCredential StandardCrypto +alwaysFailsScriptStake :: StakeCredential alwaysFailsScriptStake = ScriptHashObj alwaysFailsScriptHash plutusDataList :: forall era. Era era => Data era @@ -80,12 +80,12 @@ alwaysMintScript :: forall era. AlonzoScript era alwaysMintScript = PlutusScript $ Plutus PlutusV1 (BinaryPlutus $ Plutus.alwaysFailingNAryFunction 1) alwaysMintScriptHash :: ScriptHash StandardCrypto -alwaysMintScriptHash = scriptHash @StandardAlonzo alwaysMintScript +alwaysMintScriptHash = scriptHash @AlonzoEra alwaysMintScript alwaysMintScriptAddr :: Addr StandardCrypto alwaysMintScriptAddr = Addr Testnet (ScriptHashObj alwaysMintScriptHash) StakeRefNull -alwaysMintScriptStake :: StakeCredential StandardCrypto +alwaysMintScriptStake :: StakeCredential alwaysMintScriptStake = ScriptHashObj alwaysMintScriptHash scriptHash :: diff --git a/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Generic.hs b/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Generic.hs index ffab4b4ea..1c0c9586c 100644 --- a/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Generic.hs +++ b/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Generic.hs @@ -4,7 +4,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} module Cardano.Mock.Forging.Tx.Generic ( allPoolStakeCert, @@ -43,20 +42,18 @@ import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Conway.Governance (Voter (..)) import qualified Cardano.Ledger.Core as Core import Cardano.Ledger.Credential -import Cardano.Ledger.Crypto (ADDRHASH) -import Cardano.Ledger.Era (Era (..), EraCrypto) -import Cardano.Ledger.Hashes (ScriptHash (ScriptHash)) -import Cardano.Ledger.Keys +import Cardano.Ledger.Hashes (ADDRHASH, ScriptHash (ScriptHash)) +import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..), hashWithSerialiser) import Cardano.Ledger.PoolParams import Cardano.Ledger.Shelley.LedgerState hiding (LedgerState) import Cardano.Ledger.Shelley.TxCert -import Cardano.Ledger.Shelley.UTxO import Cardano.Ledger.TxIn (TxIn (..)) import qualified Cardano.Ledger.UMap as UMap import Cardano.Mock.Forging.Crypto import Cardano.Mock.Forging.Tx.Alonzo.ScriptsExamples import Cardano.Mock.Forging.Types import Cardano.Prelude hiding (length, map, (.)) +import Cardano.Protocol.Crypto (hashVerKeyVRF) import Data.Coerce (coerce) import Data.List (nub) import Data.List.Extra ((!?)) @@ -72,10 +69,10 @@ import qualified Ouroboros.Consensus.Shelley.Ledger.Ledger as Consensus resolveAddress :: forall era p. - (EraCrypto era ~ StandardCrypto, Core.EraTxOut era) => + (Core.EraTxOut era, EraCertState era) => UTxOIndex era -> LedgerState (ShelleyBlock p era) -> - Either ForgingError (Addr (EraCrypto era)) + Either ForgingError Addr resolveAddress index st = case index of UTxOAddressNew n -> Right $ Addr Testnet (unregisteredAddresses !! n) StakeRefNull UTxOAddressNewWithStake n stakeIndex -> do @@ -88,10 +85,10 @@ resolveAddress index st = case index of resolveUTxOIndex :: forall era p. - (EraCrypto era ~ StandardCrypto, Core.EraTxOut era) => + (Core.EraTxOut era, EraCertState era) => UTxOIndex era -> LedgerState (ShelleyBlock p era) -> - Either ForgingError ((TxIn (EraCrypto era), Core.TxOut era), UTxOIndex era) + Either ForgingError ((TxIn, Core.TxOut era), UTxOIndex era) resolveUTxOIndex index st = toLeft $ case index of UTxOIndex n -> utxoPairs !? n UTxOAddress addr -> find (hasAddr addr) utxoPairs @@ -107,7 +104,7 @@ resolveUTxOIndex index st = toLeft $ case index of addr <- rightToMaybe $ resolveAddress index st find (hasAddr addr) utxoPairs where - utxoPairs :: [(TxIn (EraCrypto era), Core.TxOut era)] + utxoPairs :: [(TxIn, Core.TxOut era)] utxoPairs = Map.toList $ unUTxO $ @@ -120,15 +117,16 @@ resolveUTxOIndex index st = toLeft $ case index of hasAddr addr (_, txOut) = addr == txOut ^. Core.addrTxOutL hasInput inp (inp', _) = inp == inp' - toLeft :: Maybe (TxIn (EraCrypto era), Core.TxOut era) -> Either ForgingError ((TxIn (EraCrypto era), Core.TxOut era), UTxOIndex era) + toLeft :: Maybe (TxIn, Core.TxOut era) -> Either ForgingError ((TxIn, Core.TxOut era), UTxOIndex era) toLeft Nothing = Left CantFindUTxO toLeft (Just (txIn, txOut)) = Right ((txIn, txOut), UTxOInput txIn) resolveStakeCreds :: - EraCrypto era ~ StandardCrypto => + forall era p. + EraCertState era => StakeIndex -> LedgerState (ShelleyBlock p era) -> - Either ForgingError (StakeCredential StandardCrypto) + Either ForgingError StakeCredential resolveStakeCreds indx st = case indx of StakeIndex n -> toEither $ fst <$> (rewardAccs !? n) StakeAddress addr -> Right addr @@ -140,36 +138,34 @@ resolveStakeCreds indx st = case indx of rewardAccs = Map.toList $ UMap.rewardMap $ - dsUnified $ - certDState $ + dsUnified dstate + + poolParams :: Map (KeyHash 'StakePool) PoolParams + poolParams = + psStakePoolParams $ + let certState = lsCertState $ esLState $ nesEs $ Consensus.shelleyLedgerState st - - poolParams = - psStakePoolParams $ - certPState $ - lsCertState $ - esLState $ - nesEs $ - Consensus.shelleyLedgerState st + in certState ^. certPStateL delegs = UMap.sPoolMap $ dsUnified dstate dstate = - certDState $ - lsCertState $ - esLState $ - nesEs $ - Consensus.shelleyLedgerState st + let certState = + lsCertState $ + esLState $ + nesEs $ + Consensus.shelleyLedgerState st + in certState ^. certDStateL resolvePoolMember n poolIndex = let poolId = ppId (findPoolParams poolIndex) poolMembers = Map.keys $ Map.filter (== poolId) delegs in poolMembers !! n - findPoolParams :: PoolIndex -> PoolParams StandardCrypto + findPoolParams :: PoolIndex -> PoolParams findPoolParams (PoolIndex n) = Map.elems poolParams !! n findPoolParams (PoolIndexId pid) = poolParams Map.! pid findPoolParams pix@(PoolIndexNew _) = poolParams Map.! resolvePool pix st @@ -179,10 +175,10 @@ resolveStakeCreds indx st = case indx of toEither (Just a) = Right a resolvePool :: - EraCrypto era ~ StandardCrypto => + EraCertState era => PoolIndex -> LedgerState (ShelleyBlock p era) -> - KeyHash 'StakePool StandardCrypto + KeyHash 'StakePool resolvePool pix st = case pix of PoolIndexId key -> key PoolIndex n -> ppId $ poolParams !! n @@ -191,87 +187,89 @@ resolvePool pix st = case pix of poolParams = Map.elems $ psStakePoolParams $ - certPState $ - lsCertState $ - esLState $ - nesEs $ - Consensus.shelleyLedgerState st - -allPoolStakeCert :: LedgerState (ShelleyBlock p era) -> [ShelleyTxCert era] + let certState = + lsCertState $ + esLState $ + nesEs $ + Consensus.shelleyLedgerState st + in certState ^. certPStateL + +allPoolStakeCert :: EraCertState era => LedgerState (ShelleyBlock p era) -> [ShelleyTxCert era] allPoolStakeCert st = ShelleyTxCertDelegCert . ShelleyRegCert <$> nub creds where poolParms = Map.elems $ psStakePoolParams $ - certPState $ - lsCertState $ - esLState $ - nesEs $ - Consensus.shelleyLedgerState st + let certState = + lsCertState $ + esLState $ + nesEs $ + Consensus.shelleyLedgerState st + in certState ^. certPStateL creds = concatMap getPoolStakeCreds poolParms -getPoolStakeCreds :: PoolParams c -> [StakeCredential c] +getPoolStakeCreds :: PoolParams -> [StakeCredential] getPoolStakeCreds pparams = raCredential (ppRewardAccount pparams) : (KeyHashObj <$> Set.toList (ppOwners pparams)) -unregisteredStakeCredentials :: [StakeCredential StandardCrypto] +unregisteredStakeCredentials :: [StakeCredential] unregisteredStakeCredentials = [ KeyHashObj $ KeyHash "000131350ac206583290486460934394208654903261221230945870" , KeyHashObj $ KeyHash "11130293748658946834096854968435096854309685490386453861" , KeyHashObj $ KeyHash "22236827154873624578632414768234573268457923654973246472" ] -unregisteredKeyHash :: [KeyHash 'Staking StandardCrypto] +unregisteredKeyHash :: [KeyHash 'Staking] unregisteredKeyHash = [ KeyHash "000131350ac206583290486460934394208654903261221230945870" , KeyHash "11130293748658946834096854968435096854309685490386453861" , KeyHash "22236827154873624578632414768234573268457923654973246472" ] -unregisteredWitnessKey :: [KeyHash 'Witness StandardCrypto] +unregisteredWitnessKey :: [KeyHash 'Witness] unregisteredWitnessKey = [ KeyHash "000131350ac206583290486460934394208654903261221230945870" , KeyHash "11130293748658946834096854968435096854309685490386453861" , KeyHash "22236827154873624578632414768234573268457923654973246472" ] -unregisteredAddresses :: [PaymentCredential StandardCrypto] +unregisteredAddresses :: [PaymentCredential] unregisteredAddresses = [ KeyHashObj $ KeyHash "11121865734872361547862358673245672834567832456783245312" , KeyHashObj $ KeyHash "22221865734872361547862358673245672834567832456783245312" , KeyHashObj $ KeyHash "22221865734872361547862358673245672834567832456783245312" ] -unregisteredPools :: [KeyHash 'StakePool StandardCrypto] +unregisteredPools :: [KeyHash 'StakePool] unregisteredPools = [ KeyHash "11138475621387465239786593240875634298756324987562352435" , KeyHash "22246254326479503298745680239746523897456238974563298348" , KeyHash "33323876542397465497834256329487563428975634827956348975" ] -unregisteredGenesisKeys :: [KeyHash 'Genesis StandardCrypto] +unregisteredGenesisKeys :: [KeyHash 'Genesis] unregisteredGenesisKeys = [ KeyHash "11138475621387465239786593240875634298756324987562352435" , KeyHash "22246254326479503298745680239746523897456238974563298348" , KeyHash "33323876542397465497834256329487563428975634827956348975" ] -registeredByronGenesisKeys :: [KeyHash 'Genesis StandardCrypto] +registeredByronGenesisKeys :: [KeyHash 'Genesis] registeredByronGenesisKeys = [ KeyHash "1a3e49767796fd99b057ad54db3310fd640806fcb0927399bbca7b43" ] -registeredShelleyGenesisKeys :: [KeyHash 'Genesis StandardCrypto] +registeredShelleyGenesisKeys :: [KeyHash 'Genesis] registeredShelleyGenesisKeys = [ KeyHash "30c3083efd794227fde2351a04500349d1b467556c30e35d6794a501" , KeyHash "471cc34983f6a2fd7b4018e3147532185d69a448d6570d46019e58e6" ] bootstrapCommitteeCreds :: - [ ( Credential 'ColdCommitteeRole StandardCrypto - , Credential 'HotCommitteeRole StandardCrypto + [ ( Credential 'ColdCommitteeRole + , Credential 'HotCommitteeRole ) ] bootstrapCommitteeCreds = @@ -293,26 +291,26 @@ bootstrapCommitteeCreds = ) ] -unregisteredCommitteeCreds :: [Credential 'ColdCommitteeRole StandardCrypto] +unregisteredCommitteeCreds :: [Credential 'ColdCommitteeRole] unregisteredCommitteeCreds = [ KeyHashObj $ KeyHash "e0a714319812c3f773ba04ec5d6b3ffcd5aad85006805b047b082541" , KeyHashObj $ KeyHash "f15d3cfda3ac52c86d2d98925419795588e74f4e270a3c17beabeaff" ] -unregisteredDRepIds :: [Credential 'DRepRole StandardCrypto] +unregisteredDRepIds :: [Credential 'DRepRole] unregisteredDRepIds = [KeyHashObj $ KeyHash "0d94e174732ef9aae73f395ab44507bfa983d65023c11a951f0c32e4"] -createStakeCredentials :: Int -> [StakeCredential StandardCrypto] +createStakeCredentials :: Int -> [StakeCredential] createStakeCredentials n = - fmap (KeyHashObj . KeyHash . mkDummyHash (Proxy @(ADDRHASH StandardCrypto))) [1 .. n] + fmap (KeyHashObj . KeyHash . mkDummyHash (Proxy @ADDRHASH)) [1 .. n] -createPaymentCredentials :: Int -> [PaymentCredential StandardCrypto] +createPaymentCredentials :: Int -> [PaymentCredential] createPaymentCredentials n = - fmap (KeyHashObj . KeyHash . mkDummyHash (Proxy @(ADDRHASH StandardCrypto))) [1 .. n] + fmap (KeyHashObj . KeyHash . mkDummyHash (Proxy @ADDRHASH)) [1 .. n] -mkDummyScriptHash :: Int -> ScriptHash StandardCrypto -mkDummyScriptHash n = ScriptHash $ mkDummyHash (Proxy @(ADDRHASH StandardCrypto)) n +mkDummyScriptHash :: Int -> ScriptHash +mkDummyScriptHash n = ScriptHash $ mkDummyHash (Proxy @ADDRHASH) n {-# ANN module ("HLint: ignore Avoid restricted function" :: Text) #-} @@ -320,14 +318,14 @@ mkDummyHash :: forall h a. HashAlgorithm h => Proxy h -> Int -> Hash.Hash h a mkDummyHash _ = coerce . hashWithSerialiser @h toCBOR consPoolParams :: - KeyHash 'StakePool StandardCrypto -> - StakeCredential StandardCrypto -> - [KeyHash 'Staking StandardCrypto] -> - PoolParams StandardCrypto + KeyHash 'StakePool -> + StakeCredential -> + [KeyHash 'Staking] -> + PoolParams consPoolParams poolId rwCred owners = PoolParams { ppId = poolId - , ppVrf = hashVerKeyVRF . snd . mkVRFKeyPair $ RawSeed 0 0 0 0 0 -- undefined + , ppVrf = hashVerKeyVRF @StandardCrypto . snd . mkVRFKeyPair $ RawSeed 0 0 0 0 0 -- undefined , ppPledge = Coin 1000 , ppCost = Coin 10000 , ppMargin = minBound @@ -338,17 +336,17 @@ consPoolParams poolId rwCred owners = } resolveStakePoolVoters :: - EraCrypto era ~ StandardCrypto => + EraCertState era => LedgerState (ShelleyBlock proto era) -> - [Voter StandardCrypto] + [Voter] resolveStakePoolVoters ledger = [ StakePoolVoter (resolvePool (PoolIndex 0) ledger) , StakePoolVoter (resolvePool (PoolIndex 1) ledger) , StakePoolVoter (resolvePool (PoolIndex 2) ledger) ] -drepVoters :: [Voter StandardCrypto] +drepVoters :: [Voter] drepVoters = map DRepVoter unregisteredDRepIds -committeeVoters :: [Voter StandardCrypto] +committeeVoters :: [Voter] committeeVoters = map (CommitteeVoter . snd) bootstrapCommitteeCreds diff --git a/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Shelley.hs b/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Shelley.hs index 3663c035c..b914ae221 100644 --- a/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Shelley.hs +++ b/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Shelley.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -32,18 +31,14 @@ import Data.Sequence.Strict (StrictSeq) import qualified Data.Sequence.Strict as StrictSeq import qualified Data.Set as Set import Lens.Micro -import Ouroboros.Consensus.Cardano.Block (LedgerState, StandardShelley) -import Ouroboros.Consensus.Shelley.Eras (ShelleyEra, StandardCrypto) +import Ouroboros.Consensus.Cardano.Block (LedgerState, ShelleyEra) import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock) -type ShelleyUTxOIndex = UTxOIndex (ShelleyEra StandardCrypto) +type ShelleyUTxOIndex = UTxOIndex ShelleyEra -type ShelleyLedgerState = LedgerState (ShelleyBlock TPraosStandard (ShelleyEra StandardCrypto)) +type ShelleyLedgerState = LedgerState (ShelleyBlock TPraosStandard ShelleyEra) -type ShelleyTx = ShelleyTx.ShelleyTx (ShelleyEra StandardCrypto) - --- instance HasField "address" (TxOut (ShelleyEra StandardCrypto)) (Addr StandardCrypto) where --- getField (TxOut addr _) = addr +type ShelleyTx = ShelleyTx.ShelleyTx ShelleyEra mkPaymentTx :: ShelleyUTxOIndex -> @@ -67,18 +62,18 @@ mkPaymentTx inputIndex outputIndex amount fees st = do mkDCertTxPools :: ShelleyLedgerState -> Either ForgingError ShelleyTx mkDCertTxPools sta = Right $ mkSimpleTx $ consCertTxBody (allPoolStakeCert sta) (Withdrawals mempty) -mkSimpleTx :: ShelleyTxBody (ShelleyEra StandardCrypto) -> ShelleyTx +mkSimpleTx :: ShelleyTxBody ShelleyEra -> ShelleyTx mkSimpleTx txBody = ShelleyTx.ShelleyTx txBody mempty (maybeToStrictMaybe Nothing) -mkDCertTx :: [ShelleyTxCert StandardShelley] -> Withdrawals StandardCrypto -> Either ForgingError ShelleyTx +mkDCertTx :: [ShelleyTxCert ShelleyEra] -> Withdrawals -> Either ForgingError ShelleyTx mkDCertTx certs wdrl = Right $ mkSimpleTx $ consCertTxBody certs wdrl mkSimpleDCertTx :: - [(StakeIndex, StakeCredential StandardCrypto -> ShelleyTxCert StandardShelley)] -> + [(StakeIndex, StakeCredential -> ShelleyTxCert ShelleyEra)] -> ShelleyLedgerState -> Either ForgingError ShelleyTx mkSimpleDCertTx consDert st = do @@ -88,22 +83,22 @@ mkSimpleDCertTx consDert st = do mkDCertTx dcerts (Withdrawals mempty) consPaymentTxBody :: - Set (TxIn StandardCrypto) -> - StrictSeq (ShelleyTxOut (ShelleyEra StandardCrypto)) -> + Set TxIn -> + StrictSeq (ShelleyTxOut ShelleyEra) -> Coin -> - ShelleyTxBody (ShelleyEra StandardCrypto) + ShelleyTxBody ShelleyEra consPaymentTxBody ins outs fees = consTxBody ins outs fees mempty (Withdrawals mempty) -consCertTxBody :: [ShelleyTxCert StandardShelley] -> Withdrawals StandardCrypto -> ShelleyTxBody (ShelleyEra StandardCrypto) +consCertTxBody :: [ShelleyTxCert ShelleyEra] -> Withdrawals -> ShelleyTxBody ShelleyEra consCertTxBody = consTxBody mempty mempty (Coin 0) consTxBody :: - Set (TxIn StandardCrypto) -> - StrictSeq (ShelleyTxOut (ShelleyEra StandardCrypto)) -> + Set TxIn -> + StrictSeq (ShelleyTxOut ShelleyEra) -> Coin -> - [ShelleyTxCert StandardShelley] -> - Withdrawals StandardCrypto -> - ShelleyTxBody (ShelleyEra StandardCrypto) + [ShelleyTxCert ShelleyEra] -> + Withdrawals -> + ShelleyTxBody ShelleyEra consTxBody ins outs fees certs wdrl = ShelleyTxBody ins diff --git a/cardano-chain-gen/src/Cardano/Mock/Forging/Types.hs b/cardano-chain-gen/src/Cardano/Mock/Forging/Types.hs index b9f88f40b..8c3a11b92 100644 --- a/cardano-chain-gen/src/Cardano/Mock/Forging/Types.hs +++ b/cardano-chain-gen/src/Cardano/Mock/Forging/Types.hs @@ -27,11 +27,11 @@ import Ouroboros.Consensus.Forecast import Ouroboros.Consensus.Protocol.Praos (Praos) import Ouroboros.Consensus.Protocol.TPraos (TPraos) import Ouroboros.Consensus.Shelley.Eras ( - StandardAlonzo, - StandardBabbage, - StandardConway, + AlonzoEra, + BabbageEra, + ConwayEra, + ShelleyEra, StandardCrypto, - StandardShelley, ) import Ouroboros.Network.Block (Point) @@ -49,10 +49,10 @@ data MockBlock = MockBlock } data TxEra - = TxAlonzo !(Core.Tx StandardAlonzo) - | TxBabbage !(Core.Tx StandardBabbage) - | TxConway !(Core.Tx StandardConway) - | TxShelley !(Core.Tx StandardShelley) + = TxAlonzo !(Core.Tx AlonzoEra) + | TxBabbage !(Core.Tx BabbageEra) + | TxConway !(Core.Tx ConwayEra) + | TxShelley !(Core.Tx ShelleyEra) newtype NodeId = NodeId {unNodeId :: Int} deriving (Show) @@ -77,16 +77,16 @@ data ForgingError data UTxOIndex era = UTxOIndex Int - | UTxOAddress !(Addr StandardCrypto) - | UTxOInput !(TxIn StandardCrypto) - | UTxOPair !(TxIn StandardCrypto, Core.TxOut era) + | UTxOAddress !Addr + | UTxOInput !TxIn + | UTxOPair !(TxIn, Core.TxOut era) | UTxOAddressNew !Int | UTxOAddressNewWithStake !Int !StakeIndex | UTxOAddressNewWithPtr !Int !Ptr data StakeIndex = StakeIndex !Int - | StakeAddress !(StakeCredential StandardCrypto) + | StakeAddress !StakeCredential | StakeIndexNew !Int | StakeIndexScript !Bool | StakeIndexPoolLeader !PoolIndex @@ -94,5 +94,5 @@ data StakeIndex data PoolIndex = PoolIndex !Int - | PoolIndexId !(KeyHash 'StakePool StandardCrypto) + | PoolIndexId !(KeyHash 'StakePool) | PoolIndexNew !Int diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs index 759a7c5fc..2dbd2ec70 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs @@ -94,9 +94,12 @@ import Data.Text (Text) import Database.Persist.Postgresql (createPostgresqlPool) import Database.Persist.Sql (SqlBackend) import Ouroboros.Consensus.Block.Forging +import Ouroboros.Consensus.Byron.Ledger.Mempool () import Ouroboros.Consensus.Config (TopLevelConfig) +import Ouroboros.Consensus.HardFork.Combinator.Mempool () import qualified Ouroboros.Consensus.Node.ProtocolInfo as Consensus import Ouroboros.Consensus.Shelley.Eras (StandardCrypto) +import Ouroboros.Consensus.Shelley.Ledger.Mempool () import Ouroboros.Consensus.Shelley.Node (ShelleyLeaderCredentials) import System.Directory (createDirectoryIfMissing, removePathForcibly) import System.FilePath.Posix (takeDirectory, ()) diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/UnifiedApi.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/UnifiedApi.hs index 1d0b8943f..08dd5481d 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/UnifiedApi.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/UnifiedApi.hs @@ -36,12 +36,9 @@ import Control.Concurrent.Class.MonadSTM.Strict (atomically) import Control.Monad (forM, replicateM) import Data.Word (Word64) import Ouroboros.Consensus.Cardano.Block ( + BabbageEra, + ConwayEra, ShelleyEra, - StandardAlonzo, - StandardBabbage, - StandardConway, - StandardCrypto, - StandardShelley, ) import Ouroboros.Consensus.Ledger.Basics (LedgerState) import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock) @@ -71,8 +68,8 @@ forgeAndSubmitBlocks interpreter mockServer blocksToCreate = withAlonzoFindLeaderAndSubmit :: Interpreter -> ServerHandle IO CardanoBlock -> - ( LedgerState (ShelleyBlock TPraosStandard StandardAlonzo) -> - Either ForgingError [Core.Tx (AlonzoEra StandardCrypto)] + ( LedgerState (ShelleyBlock TPraosStandard AlonzoEra) -> + Either ForgingError [Core.Tx AlonzoEra] ) -> IO CardanoBlock withAlonzoFindLeaderAndSubmit interpreter mockServer mkTxs = do @@ -82,7 +79,7 @@ withAlonzoFindLeaderAndSubmit interpreter mockServer mkTxs = do withBabbageFindLeaderAndSubmit :: Interpreter -> ServerHandle IO CardanoBlock -> - (LedgerState (ShelleyBlock PraosStandard StandardBabbage) -> Either ForgingError [Core.Tx StandardBabbage]) -> + (LedgerState (ShelleyBlock PraosStandard BabbageEra) -> Either ForgingError [Core.Tx BabbageEra]) -> IO CardanoBlock withBabbageFindLeaderAndSubmit interpreter mockServer mkTxs = do alTxs <- withBabbageLedgerState interpreter mkTxs @@ -91,7 +88,7 @@ withBabbageFindLeaderAndSubmit interpreter mockServer mkTxs = do withConwayFindLeaderAndSubmit :: Interpreter -> ServerHandle IO CardanoBlock -> - (LedgerState (ShelleyBlock PraosStandard StandardConway) -> Either ForgingError [Core.Tx StandardConway]) -> + (LedgerState (ShelleyBlock PraosStandard ConwayEra) -> Either ForgingError [Core.Tx ConwayEra]) -> IO CardanoBlock withConwayFindLeaderAndSubmit interpreter mockServer mkTxs = do txs' <- withConwayLedgerState interpreter mkTxs @@ -100,8 +97,8 @@ withConwayFindLeaderAndSubmit interpreter mockServer mkTxs = do withAlonzoFindLeaderAndSubmitTx :: Interpreter -> ServerHandle IO CardanoBlock -> - ( LedgerState (ShelleyBlock TPraosStandard StandardAlonzo) -> - Either ForgingError (Core.Tx (AlonzoEra StandardCrypto)) + ( LedgerState (ShelleyBlock TPraosStandard AlonzoEra) -> + Either ForgingError (Core.Tx AlonzoEra) ) -> IO CardanoBlock withAlonzoFindLeaderAndSubmitTx interpreter mockServer mkTxs = do @@ -112,7 +109,7 @@ withAlonzoFindLeaderAndSubmitTx interpreter mockServer mkTxs = do withBabbageFindLeaderAndSubmitTx :: Interpreter -> ServerHandle IO CardanoBlock -> - (LedgerState (ShelleyBlock PraosStandard StandardBabbage) -> Either ForgingError (Core.Tx StandardBabbage)) -> + (LedgerState (ShelleyBlock PraosStandard BabbageEra) -> Either ForgingError (Core.Tx BabbageEra)) -> IO CardanoBlock withBabbageFindLeaderAndSubmitTx interpreter mockServer mkTxs = do withBabbageFindLeaderAndSubmit interpreter mockServer $ \st -> do @@ -122,7 +119,7 @@ withBabbageFindLeaderAndSubmitTx interpreter mockServer mkTxs = do withConwayFindLeaderAndSubmitTx :: Interpreter -> ServerHandle IO CardanoBlock -> - (LedgerState (ShelleyBlock PraosStandard StandardConway) -> Either ForgingError (Core.Tx StandardConway)) -> + (LedgerState (ShelleyBlock PraosStandard ConwayEra) -> Either ForgingError (Core.Tx ConwayEra)) -> IO CardanoBlock withConwayFindLeaderAndSubmitTx interpreter mockServer mkTx = withConwayFindLeaderAndSubmit interpreter mockServer $ \st -> do @@ -132,8 +129,8 @@ withConwayFindLeaderAndSubmitTx interpreter mockServer mkTx = withShelleyFindLeaderAndSubmit :: Interpreter -> ServerHandle IO CardanoBlock -> - ( LedgerState (ShelleyBlock TPraosStandard (ShelleyEra StandardCrypto)) -> - Either ForgingError [Core.Tx (ShelleyEra StandardCrypto)] + ( LedgerState (ShelleyBlock TPraosStandard ShelleyEra) -> + Either ForgingError [Core.Tx ShelleyEra] ) -> IO CardanoBlock withShelleyFindLeaderAndSubmit interpreter mockServer mkTxs = do @@ -143,8 +140,8 @@ withShelleyFindLeaderAndSubmit interpreter mockServer mkTxs = do withShelleyFindLeaderAndSubmitTx :: Interpreter -> ServerHandle IO CardanoBlock -> - ( LedgerState (ShelleyBlock TPraosStandard (ShelleyEra StandardCrypto)) -> - Either ForgingError (Core.Tx (ShelleyEra StandardCrypto)) + ( LedgerState (ShelleyBlock TPraosStandard ShelleyEra) -> + Either ForgingError (Core.Tx ShelleyEra) ) -> IO CardanoBlock withShelleyFindLeaderAndSubmitTx interpreter mockServer mkTxs = @@ -152,16 +149,16 @@ withShelleyFindLeaderAndSubmitTx interpreter mockServer mkTxs = tx <- mkTxs st pure [tx] -getShelleyLedgerState :: Interpreter -> IO (LedgerState (ShelleyBlock TPraosStandard StandardShelley)) +getShelleyLedgerState :: Interpreter -> IO (LedgerState (ShelleyBlock TPraosStandard ShelleyEra)) getShelleyLedgerState interpreter = withShelleyLedgerState interpreter Right -getAlonzoLedgerState :: Interpreter -> IO (LedgerState (ShelleyBlock TPraosStandard StandardAlonzo)) +getAlonzoLedgerState :: Interpreter -> IO (LedgerState (ShelleyBlock TPraosStandard AlonzoEra)) getAlonzoLedgerState interpreter = withAlonzoLedgerState interpreter Right -getBabbageLedgerState :: Interpreter -> IO (LedgerState (ShelleyBlock PraosStandard StandardBabbage)) +getBabbageLedgerState :: Interpreter -> IO (LedgerState (ShelleyBlock PraosStandard BabbageEra)) getBabbageLedgerState interpreter = withBabbageLedgerState interpreter Right -getConwayLedgerState :: Interpreter -> IO (LedgerState (ShelleyBlock PraosStandard StandardConway)) +getConwayLedgerState :: Interpreter -> IO (LedgerState (ShelleyBlock PraosStandard ConwayEra)) getConwayLedgerState interpreter = withConwayLedgerState interpreter Right skipUntilNextEpoch :: Interpreter -> ServerHandle IO CardanoBlock -> [TxEra] -> IO CardanoBlock diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Governance.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Governance.hs index f813c6727..e618f9640 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Governance.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Governance.hs @@ -2,7 +2,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} #if __GLASGOW_HASKELL__ >= 908 {-# OPTIONS_GHC -Wno-x-partial #-} @@ -26,12 +25,12 @@ import qualified Cardano.Db as Db import Cardano.DbSync.Era.Shelley.Generic.Util (unCredentialHash, unTxHash) import Cardano.Ledger.Address (RewardAccount (..)) import Cardano.Ledger.Alonzo.Tx (AlonzoTx) -import Cardano.Ledger.BaseTypes (AnchorData (..), Network (..), hashAnchorData, textToUrl) +import Cardano.Ledger.BaseTypes (AnchorData (..), Network (..), textToUrl) import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Conway.Governance (GovActionId (..), GovActionIx (..)) import qualified Cardano.Ledger.Conway.Governance as Governance -import Cardano.Ledger.Core (txIdTx) -import Cardano.Ledger.SafeHash (SafeToHash (..)) +import Cardano.Ledger.Core (hashAnnotated, txIdTx) +import Cardano.Ledger.Hashes (SafeToHash (..)) import Cardano.Mock.ChainSync.Server (IOManager, ServerHandle) import Cardano.Mock.Forging.Interpreter (Interpreter, getCurrentEpoch) import qualified Cardano.Mock.Forging.Tx.Conway as Conway @@ -260,7 +259,7 @@ enactNewCommittee interpreter server = do epochs <- Api.fillEpochs interpreter server 2 pure (blk : epochs) -proposeNewCommittee :: AlonzoTx Consensus.StandardConway +proposeNewCommittee :: AlonzoTx Consensus.ConwayEra proposeNewCommittee = Conway.mkAddCommitteeTx Nothing committeeCred where @@ -296,7 +295,7 @@ updateConstitution = epoch1 <- initGovernance interpreter server let newUrl = fromJust (textToUrl 64 "constitution.new") - dataHash = hashAnchorData @Consensus.StandardCrypto (AnchorData "constitution content") + dataHash = hashAnnotated (AnchorData "constitution content") anchor = Governance.Anchor newUrl dataHash -- Create and vote for a governance proposal diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Other.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Other.hs index 08d24d37c..e1ac31a84 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Other.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Other.hs @@ -28,9 +28,8 @@ import Cardano.DbSync.Era.Shelley.Generic.Util (unKeyHashRaw) import Cardano.Ledger.BaseTypes (EpochNo (..)) import Cardano.Ledger.Conway.TxCert (ConwayTxCert (..)) import Cardano.Ledger.Core (PoolCert (..)) -import Cardano.Ledger.Credential (StakeCredential ()) -import Cardano.Ledger.Crypto (StandardCrypto ()) -import Cardano.Ledger.Keys (KeyHash (), KeyRole (..)) +import Cardano.Ledger.Credential (StakeCredential) +import Cardano.Ledger.Keys (KeyHash, KeyRole (..)) import Cardano.Mock.ChainSync.Server (IOManager (), addBlock, rollback) import Cardano.Mock.Forging.Interpreter (forgeNext, getCurrentEpoch) import qualified Cardano.Mock.Forging.Tx.Babbage as Babbage @@ -42,7 +41,7 @@ import Cardano.Prelude hiding (from) import Cardano.SMASH.Server.PoolDataLayer (PoolDataLayer (..), dbToServantPoolId) import Cardano.SMASH.Server.Types (DBFail (..)) import Data.List (last) -import Ouroboros.Consensus.Shelley.Eras (StandardConway ()) +import Ouroboros.Consensus.Shelley.Eras (ConwayEra ()) import Ouroboros.Network.Block (blockPoint) import Test.Cardano.Db.Mock.Config import Test.Cardano.Db.Mock.Examples (mockBlock0) @@ -381,9 +380,9 @@ poolDelist = mkPoolDereg :: EpochNo -> - [StakeCredential StandardCrypto] -> - KeyHash 'StakePool StandardCrypto -> - ConwayTxCert StandardConway + [StakeCredential] -> + KeyHash 'StakePool -> + ConwayTxCert ConwayEra mkPoolDereg epochNo _ keyHash = ConwayTxCertPool (RetirePool keyHash epochNo) forkFixedEpoch :: IOManager -> [(Text, Text)] -> Assertion diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Plutus.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Plutus.hs index 541786e3e..7ee0a13d4 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Plutus.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Plutus.hs @@ -41,9 +41,9 @@ import qualified Cardano.Db.Schema.Core.TxOut as C import qualified Cardano.Db.Schema.Variant.TxOut as V import Cardano.DbSync.Era.Shelley.Generic.Util (renderAddress) import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.Hashes (extractHash) import Cardano.Ledger.Mary.Value (MaryValue (..), MultiAsset (..), PolicyID (..)) import Cardano.Ledger.Plutus.Data -import Cardano.Ledger.SafeHash (extractHash) import Cardano.Mock.ChainSync.Server (IOManager ()) import Cardano.Mock.Forging.Interpreter (withConwayLedgerState) import qualified Cardano.Mock.Forging.Tx.Alonzo.ScriptsExamples as Examples @@ -54,7 +54,7 @@ import Cardano.Prelude hiding (head) import qualified Data.Map as Map import Data.Maybe.Strict (StrictMaybe (..)) import GHC.Base (error) -import Ouroboros.Consensus.Shelley.Eras (StandardConway ()) +import Ouroboros.Consensus.Shelley.Eras (ConwayEra ()) import Ouroboros.Network.Block (genesisPoint) import Test.Cardano.Db.Mock.Config ( CommandLineArgs (..), @@ -124,7 +124,7 @@ simpleScript = , True , DB.DbLovelace 20_000 , Just $ - hashToBytes (extractHash $ hashData @StandardConway Examples.plutusDataList) + hashToBytes (extractHash $ hashData @ConwayEra Examples.plutusDataList) ) unlockScriptSameBlock :: IOManager -> [(Text, Text)] -> Assertion diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Rollback.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Rollback.hs index 3bb4482f7..5f1cef9c5 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Rollback.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Rollback.hs @@ -14,7 +14,6 @@ module Test.Cardano.Db.Mock.Unit.Conway.Rollback ( import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Conway.TxCert (ConwayDelegCert (..), Delegatee (..)) -import Cardano.Ledger.Crypto () import Cardano.Mock.ChainSync.Server (IOManager (), addBlock, rollback) import Cardano.Mock.Forging.Interpreter (forgeNext) import qualified Cardano.Mock.Forging.Tx.Conway as Conway diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Stake.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Stake.hs index 778d3eb5e..d89289520 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Stake.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Stake.hs @@ -1,4 +1,6 @@ {-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} module Test.Cardano.Db.Mock.Unit.Conway.Stake ( -- * Stake Address @@ -21,14 +23,15 @@ module Test.Cardano.Db.Mock.Unit.Conway.Stake ( ) where import qualified Cardano.Db as DB -import Cardano.Ledger.BaseTypes (CertIx (..), TxIx (..)) +import Cardano.Ledger.BaseTypes (CertIx (..), SlotNo (..), TxIx (..)) import Cardano.Ledger.Coin (Coin (..)) -import Cardano.Ledger.Credential (Ptr (..)) +import Cardano.Ledger.Credential (Ptr (..), SlotNo32 (..)) import Cardano.Mock.ChainSync.Server (IOManager (), addBlock) import qualified Cardano.Mock.Forging.Tx.Conway as Conway import qualified Cardano.Mock.Forging.Tx.Conway.Scenarios as Conway import Cardano.Mock.Forging.Types (StakeIndex (..), UTxOIndex (..)) import Cardano.Prelude +import Data.IntCast (intCastMaybe) import Data.Maybe.Strict (StrictMaybe (..)) import Ouroboros.Network.Block (blockSlot) import Test.Cardano.Db.Mock.Config @@ -127,7 +130,7 @@ stakeAddressPtr = Conway.mkSimpleDCertTx [(StakeIndexNew 1, Conway.mkRegTxCert SNothing)] -- Forge a block pointing to the cert - let ptr = Ptr (blockSlot blk) (TxIx 0) (CertIx 0) + let ptr = Ptr (unsafeToSlotNo32 $ blockSlot blk) (TxIx 0) (CertIx 0) void $ Api.withConwayFindLeaderAndSubmitTx interpreter mockServer $ Conway.mkPaymentTx (UTxOIndex 0) (UTxOAddressNewWithPtr 0 ptr) 20_000 20_000 0 @@ -148,7 +151,7 @@ stakeAddressPtrDereg = Api.withConwayFindLeaderAndSubmitTx interpreter mockServer $ Conway.mkSimpleDCertTx [(StakeIndexNew 0, Conway.mkRegTxCert SNothing)] -- Forge a block with a pointer - let ptr0 = Ptr (blockSlot blk) (TxIx 0) (CertIx 0) + let ptr0 = Ptr (unsafeToSlotNo32 $ blockSlot blk) (TxIx 0) (CertIx 0) blk' <- Api.withConwayFindLeaderAndSubmit interpreter mockServer $ \state' -> sequence [ Conway.mkPaymentTx @@ -166,7 +169,7 @@ stakeAddressPtrDereg = ] -- Forge a block with a pointers to the certs - let ptr1 = Ptr (blockSlot blk') (TxIx 1) (CertIx 1) + let ptr1 = Ptr (unsafeToSlotNo32 $ blockSlot blk') (TxIx 1) (CertIx 1) void $ Api.withConwayFindLeaderAndSubmit interpreter mockServer $ \state' -> sequence [ Conway.mkPaymentTx @@ -215,7 +218,7 @@ stakeAddressPtrUseBefore = Api.withConwayFindLeaderAndSubmitTx interpreter mockServer $ Conway.mkSimpleDCertTx [(StakeIndexNew 1, Conway.mkRegTxCert SNothing)] -- Create a pointer to it - let ptr = Ptr (blockSlot blk) (TxIx 0) (CertIx 0) + let ptr = Ptr (unsafeToSlotNo32 $ blockSlot blk) (TxIx 0) (CertIx 0) void $ Api.withConwayFindLeaderAndSubmitTx interpreter mockServer $ Conway.mkPaymentTx (UTxOIndex 0) (UTxOAddressNewWithPtr 0 ptr) 20_000 20_000 0 @@ -435,3 +438,16 @@ registerStakeCredsNoShelley = do } testLabel = "conwayConfigShelleyDisabled" cfgDir = conwayConfigDir + +-- This function cargo culted from cardano-wallet. +unsafeToSlotNo32 :: SlotNo -> SlotNo32 +unsafeToSlotNo32 = + fromMaybe reportFailure . toSlotNo32 + where + reportFailure :: e + reportFailure = + panic + "Test.Cardano.Db.Mock.Unit.Conway.Stake.unsafeToSlotNo32: unable to convert SlotNo to SlotNo32" + + toSlotNo32 :: SlotNo -> Maybe SlotNo32 + toSlotNo32 (SlotNo n) = SlotNo32 <$> intCastMaybe @Word64 @Word32 n diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Validate.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Validate.hs index 0cf96ff0a..a7647cbea 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Validate.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Validate.hs @@ -4,7 +4,6 @@ {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} module Test.Cardano.Db.Mock.Validate ( assertBlocksCount, @@ -52,7 +51,7 @@ import Cardano.DbSync.Era.Shelley.Generic.Util import qualified Cardano.Ledger.Address as Ledger import Cardano.Ledger.BaseTypes import qualified Cardano.Ledger.Core as Core -import Cardano.Ledger.Era +import Cardano.Ledger.Shelley.LedgerState (EraCertState) import Cardano.Mock.Forging.Tx.Generic import Cardano.Mock.Forging.Types import Cardano.SMASH.Server.PoolDataLayer @@ -208,7 +207,7 @@ assertCurrentEpoch env expected = q = queryCurrentEpochNo assertAddrValues :: - (EraCrypto era ~ StandardCrypto, Core.EraTxOut era) => + (EraCertState era, Core.EraTxOut era) => DBSyncEnv -> UTxOIndex era -> DbLovelace -> @@ -247,7 +246,7 @@ assertCertCounts env expected = pure (registr - 5, deregistr, deleg - 5, withdrawal) assertRewardCounts :: - EraCrypto era ~ StandardCrypto => + EraCertState era => DBSyncEnv -> LedgerState (ShelleyBlock p era) -> Bool -> @@ -499,7 +498,7 @@ addPoolCounters :: Num a => (a, a, a, a, a, a) -> (a, a, a, a, a, a) -> (a, a, a addPoolCounters (a, b, c, d, e, f) (a', b', c', d', e', f') = (a + a', b + b', c + c', d + d', e + e', f + f') assertPoolLayerCounters :: - EraCrypto era ~ StandardCrypto => + EraCertState era => DBSyncEnv -> (Word64, Word64) -> [(PoolIndex, (Either DBFail Bool, Bool, Bool))] -> diff --git a/cardano-chain-gen/test/testfiles/fingerprint/CLAcheckEpochDisabledArg b/cardano-chain-gen/test/testfiles/fingerprint/CLAcheckEpochDisabledArg deleted file mode 100644 index e559dff63..000000000 --- a/cardano-chain-gen/test/testfiles/fingerprint/CLAcheckEpochDisabledArg +++ /dev/null @@ -1 +0,0 @@ -[5,11,15,21,22,23,28,33,34,36,42,43,48,52,62,82,88,92,102,106,109,111,116,133,134,143,151,153,157,161,162,171,182,183,193,195,196,197,200,206,208,216,219,222,238,245,250,262,271,272,275,282,286,296,301,310,311,314,325,340,347,354,355,365,376,379,382,384,389,390,391,392,393,398,404,407,414,418,419,422,424,446,448,450,457,465,476,478,485,486,488,499,503,506,509,512,515,518,524,526,527,530,541,542,549,556,561,570,576,578,579,583] \ No newline at end of file diff --git a/cardano-db-sync/cardano-db-sync.cabal b/cardano-db-sync/cardano-db-sync.cabal index c3010c23a..bc0f10808 100644 --- a/cardano-db-sync/cardano-db-sync.cabal +++ b/cardano-db-sync/cardano-db-sync.cabal @@ -154,6 +154,7 @@ library , cardano-client , cardano-crypto , cardano-crypto-class + , cardano-crypto-praos , cardano-crypto-wrapper , cardano-data , cardano-db @@ -164,7 +165,7 @@ library , cardano-ledger-binary , cardano-ledger-byron , cardano-ledger-core - , cardano-ledger-conway ^>= 1.17.3 + , cardano-ledger-conway >= 1.17.3 , cardano-ledger-binary , cardano-ledger-mary , cardano-ledger-shelley >= 1.12.3.0 diff --git a/cardano-db-sync/src/Cardano/DbSync.hs b/cardano-db-sync/src/Cardano/DbSync.hs index 32fe21b1b..4cb12e463 100644 --- a/cardano-db-sync/src/Cardano/DbSync.hs +++ b/cardano-db-sync/src/Cardano/DbSync.hs @@ -52,7 +52,7 @@ import qualified Data.Strict.Maybe as Strict import qualified Data.Text as Text import Data.Version (showVersion) import Database.Persist.Postgresql (ConnectionString, withPostgresqlConn) -import qualified Ouroboros.Consensus.HardFork.Simple as HardFork +import Ouroboros.Consensus.Cardano (CardanoHardForkTrigger (..)) import Ouroboros.Network.NodeToClient (IOManager, withIOManager) import Paths_cardano_db_sync (version) import System.Directory (createDirectoryIfMissing) @@ -214,8 +214,9 @@ runSyncNode metricsSetters trce iomgr dbConnString runMigrationFnc syncNodeConfi useShelleyInit :: SyncNodeConfig -> Bool useShelleyInit cfg = case dncShelleyHardFork cfg of - HardFork.TriggerHardForkAtEpoch (EpochNo 0) -> True + CardanoTriggerHardForkAtEpoch (EpochNo 0) -> True _other -> False + removeJsonbFromSchemaConfig = ioRemoveJsonbFromSchema $ soptInsertOptions syncOptions maybeLedgerDir = enpMaybeLedgerStateDir syncNodeParams diff --git a/cardano-db-sync/src/Cardano/DbSync/Api.hs b/cardano-db-sync/src/Cardano/DbSync/Api.hs index a24f1baae..4bad39673 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Api.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Api.hs @@ -176,11 +176,11 @@ getSafeBlockNoDiff syncEnv = 2 * getSecurityParam syncEnv getPruneInterval :: SyncEnv -> Word64 getPruneInterval syncEnv = 10 * getSecurityParam syncEnv -whenConsumeOrPruneTxOut :: (MonadIO m) => SyncEnv -> m () -> m () +whenConsumeOrPruneTxOut :: MonadIO m => SyncEnv -> m () -> m () whenConsumeOrPruneTxOut env = when (DB.pcmConsumedTxOut $ getPruneConsume env) -whenPruneTxOut :: (MonadIO m) => SyncEnv -> m () -> m () +whenPruneTxOut :: MonadIO m => SyncEnv -> m () -> m () whenPruneTxOut env = when (DB.pcmPruneTxOut $ getPruneConsume env) @@ -493,10 +493,10 @@ getSecurityParam syncEnv = NoLedger nle -> getMaxRollbacks $ nleProtocolInfo nle getMaxRollbacks :: - (ConsensusProtocol (BlockProtocol blk)) => + ConsensusProtocol (BlockProtocol blk) => ProtocolInfo blk -> Word64 -getMaxRollbacks = maxRollbacks . configSecurityParam . pInfoConfig +getMaxRollbacks = Ledger.unNonZero . maxRollbacks . configSecurityParam . pInfoConfig getBootstrapInProgress :: Trace IO Text -> diff --git a/cardano-db-sync/src/Cardano/DbSync/Api/Ledger.hs b/cardano-db-sync/src/Cardano/DbSync/Api/Ledger.hs index c0afff911..67893b2e6 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Api/Ledger.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Api/Ledger.hs @@ -29,7 +29,6 @@ import Cardano.Ledger.Core (Value) import Cardano.Ledger.Mary.Value import Cardano.Ledger.Shelley.LedgerState import Cardano.Ledger.TxIn -import Cardano.Ledger.UTxO (UTxO (..)) import Cardano.Prelude (lift, textShow) import Control.Concurrent.Class.MonadSTM.Strict (atomically, readTVarIO, writeTVar) import Control.Monad.Extra @@ -91,14 +90,13 @@ storeUTxOFromLedger env st = case ledgerState st of where trce = getTrace env getUTxO st' = - unUTxO $ Consensus.shelleyLedgerState st' ^. (nesEsL . esLStateL . lsUTxOStateL . utxosUtxoL) + unUTxO $ Consensus.shelleyLedgerState st' ^. (nesEsL . esLStateL . lsUTxOStateL . utxoL) pageSize :: Int pageSize = 100000 storeUTxO :: - ( EraCrypto era ~ StandardCrypto - , Cardano.Ledger.Core.Value era ~ MaryValue StandardCrypto + ( Cardano.Ledger.Core.Value era ~ MaryValue , Script era ~ AlonzoScript era , TxOut era ~ BabbageTxOut era , BabbageEraTxOut era @@ -108,7 +106,7 @@ storeUTxO :: , NativeScript era ~ Timelock era ) => SyncEnv -> - Map (TxIn StandardCrypto) (BabbageTxOut era) -> + Map TxIn (BabbageTxOut era) -> ExceptT SyncNodeError (ReaderT SqlBackend m) () storeUTxO env mp = do liftIO $ @@ -127,8 +125,7 @@ storeUTxO env mp = do size = Map.size mp storePage :: - ( EraCrypto era ~ StandardCrypto - , Cardano.Ledger.Core.Value era ~ MaryValue StandardCrypto + ( Cardano.Ledger.Core.Value era ~ MaryValue , Script era ~ AlonzoScript era , TxOut era ~ BabbageTxOut era , DBPlutusScript era @@ -139,7 +136,7 @@ storePage :: ) => SyncEnv -> Float -> - (Int, [(TxIn StandardCrypto, BabbageTxOut era)]) -> + (Int, [(TxIn, BabbageTxOut era)]) -> ExceptT SyncNodeError (ReaderT SqlBackend m) () storePage syncEnv percQuantum (n, ls) = do when (n `mod` 10 == 0) $ liftIO $ logInfo trce $ "Bootstrap in progress " <> prc <> "%" @@ -154,8 +151,7 @@ storePage syncEnv percQuantum (n, ls) = do prc = Text.pack $ showGFloat (Just 1) (max 0 $ min 100.0 (fromIntegral n * percQuantum)) "" prepareTxOut :: - ( EraCrypto era ~ StandardCrypto - , Cardano.Ledger.Core.Value era ~ MaryValue StandardCrypto + ( Cardano.Ledger.Core.Value era ~ MaryValue , Script era ~ AlonzoScript era , TxOut era ~ BabbageTxOut era , BabbageEraTxOut era @@ -165,11 +161,11 @@ prepareTxOut :: , NativeScript era ~ Timelock era ) => SyncEnv -> - (TxIn StandardCrypto, BabbageTxOut era) -> + (TxIn, BabbageTxOut era) -> ExceptT SyncNodeError (ReaderT SqlBackend m) (ExtendedTxOut, [MissingMaTxOut]) prepareTxOut syncEnv (TxIn txIntxId (TxIx index), txOut) = do let txHashByteString = Generic.safeHashToByteString $ unTxId txIntxId - let genTxOut = fromTxOut index txOut + let genTxOut = fromTxOut (fromIntegral index) txOut txId <- liftLookupFail "prepareTxOut" $ queryTxIdWithCache cache txIntxId insertTxOut trce cache iopts (txId, txHashByteString) genTxOut where diff --git a/cardano-db-sync/src/Cardano/DbSync/Cache.hs b/cardano-db-sync/src/Cardano/DbSync/Cache.hs index 36c8315fd..4457caf2c 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Cache.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Cache.hs @@ -57,7 +57,6 @@ import Control.Monad.Trans.Control (MonadBaseControl) import Data.Either.Combinators import qualified Data.Map.Strict as Map import Database.Persist.Postgresql (SqlBackend) -import Ouroboros.Consensus.Cardano.Block (StandardCrypto) -- Rollbacks make everything harder and the same applies to caching. -- After a rollback db entries are deleted, so we need to clean the same @@ -114,7 +113,7 @@ queryOrInsertRewardAccount :: Trace IO Text -> CacheStatus -> CacheAction -> - Ledger.RewardAccount StandardCrypto -> + Ledger.RewardAccount -> ReaderT SqlBackend m DB.StakeAddressId queryOrInsertRewardAccount trce cache cacheUA rewardAddr = do eiAddrId <- queryStakeAddrWithCacheRetBs trce cache cacheUA rewardAddr @@ -137,7 +136,7 @@ queryOrInsertStakeAddress trce cache cacheUA nw cred = -- the uniqueness constraint) but the function will return the 'StakeAddressId'. insertStakeAddress :: (MonadBaseControl IO m, MonadIO m) => - Ledger.RewardAccount StandardCrypto -> + Ledger.RewardAccount -> Maybe ByteString -> ReaderT SqlBackend m DB.StakeAddressId insertStakeAddress rewardAddr stakeCredBs = do @@ -168,7 +167,7 @@ queryStakeAddrWithCacheRetBs :: Trace IO Text -> CacheStatus -> CacheAction -> - Ledger.RewardAccount StandardCrypto -> + Ledger.RewardAccount -> ReaderT SqlBackend m (Either (DB.LookupFail, ByteString) DB.StakeAddressId) queryStakeAddrWithCacheRetBs _trce cache cacheUA ra@(Ledger.RewardAccount _ cred) = do let bs = Ledger.serialiseRewardAccount ra @@ -381,7 +380,7 @@ queryPoolKeyOrInsert txt trce cache cacheUA logsWarning hsh = do queryMAWithCache :: MonadIO m => CacheStatus -> - PolicyID StandardCrypto -> + PolicyID -> AssetName -> ReaderT SqlBackend m (Either (ByteString, ByteString) DB.MultiAssetId) queryMAWithCache cache policyId asset = @@ -442,7 +441,7 @@ queryPrevBlockWithCache msg cache hsh = queryTxIdWithCache :: MonadIO m => CacheStatus -> - Ledger.TxId StandardCrypto -> + Ledger.TxId -> ReaderT SqlBackend m (Either DB.LookupFail DB.TxId) queryTxIdWithCache cache txIdLedger = do case cache of @@ -477,7 +476,7 @@ queryTxIdWithCache cache txIdLedger = do tryUpdateCacheTx :: MonadIO m => CacheStatus -> - Ledger.TxId StandardCrypto -> + Ledger.TxId -> DB.TxId -> m () tryUpdateCacheTx (ActiveCache ci) ledgerTxId txId = diff --git a/cardano-db-sync/src/Cardano/DbSync/Cache/Epoch.hs b/cardano-db-sync/src/Cardano/DbSync/Cache/Epoch.hs index a7877cdcd..a0db062ad 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Cache/Epoch.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Cache/Epoch.hs @@ -17,6 +17,7 @@ import Cardano.DbSync.Era.Shelley.Generic.StakeDist (getSecurityParameter) import Cardano.DbSync.Error (SyncNodeError (..)) import Cardano.DbSync.Ledger.Types (HasLedgerEnv (..)) import Cardano.DbSync.LocalStateQuery (NoLedgerEnv (..)) +import Cardano.Ledger.BaseTypes.NonZero (NonZero (..)) import Cardano.Prelude import Control.Concurrent.Class.MonadSTM.Strict (readTVarIO, writeTVar) import Data.Map.Strict (deleteMin, insert, lookupMax, size, split) @@ -106,7 +107,7 @@ writeToMapEpochCache syncEnv cache latestEpoch = do -- To make sure our Map Epoch doesn't get too large so we use something slightly bigger than K value "securityParam" -- and once the map gets larger than that number we delete the first inserted item making room for another Epoch. scaledMapEpoch = - if size mapEpoch > fromEnum securityParam + if size mapEpoch > fromEnum (unNonZero securityParam) then deleteMin mapEpoch else mapEpoch diff --git a/cardano-db-sync/src/Cardano/DbSync/Cache/Types.hs b/cardano-db-sync/src/Cardano/DbSync/Cache/Types.hs index 9c060f907..96307d8a3 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Cache/Types.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Cache/Types.hs @@ -48,7 +48,6 @@ import Control.Concurrent.Class.MonadSTM.Strict ( import qualified Data.Map.Strict as Map import Data.Time.Clock (UTCTime) import Data.WideWord.Word128 (Word128) -import Ouroboros.Consensus.Cardano.Block (StandardCrypto) type StakePoolCache = Map PoolKeyHash DB.PoolHashId @@ -79,12 +78,12 @@ data CacheInternal = CacheInternal , cStake :: !(StrictTVar IO StakeCache) , cPools :: !(StrictTVar IO StakePoolCache) , cDatum :: !(StrictTVar IO (LRUCache DataHash DB.DatumId)) - , cMultiAssets :: !(StrictTVar IO (LRUCache (PolicyID StandardCrypto, AssetName) DB.MultiAssetId)) + , cMultiAssets :: !(StrictTVar IO (LRUCache (PolicyID, AssetName) DB.MultiAssetId)) , cPrevBlock :: !(StrictTVar IO (Maybe (DB.BlockId, ByteString))) , cStats :: !(StrictTVar IO CacheStatistics) , cEpoch :: !(StrictTVar IO CacheEpoch) , cAddress :: !(StrictTVar IO (LRUCache ByteString V.AddressId)) - , cTxIds :: !(StrictTVar IO (FIFOCache (Ledger.TxId StandardCrypto) DB.TxId)) + , cTxIds :: !(StrictTVar IO (FIFOCache Ledger.TxId DB.TxId)) } data CacheStatistics = CacheStatistics diff --git a/cardano-db-sync/src/Cardano/DbSync/Config/Cardano.hs b/cardano-db-sync/src/Cardano/DbSync/Config/Cardano.hs index 060a095dd..59a74054c 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Config/Cardano.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Config/Cardano.hs @@ -33,12 +33,12 @@ import Control.Monad.Trans.Except (ExceptT) import Ouroboros.Consensus.Block.Forging import Ouroboros.Consensus.Cardano (Nonce (..), ProtVer (ProtVer)) import qualified Ouroboros.Consensus.Cardano as Consensus +import Ouroboros.Consensus.Cardano.Block (StandardCrypto) import Ouroboros.Consensus.Cardano.Node import Ouroboros.Consensus.Config (TopLevelConfig (..), emptyCheckpointsMap) import Ouroboros.Consensus.Ledger.Basics (LedgerConfig) import Ouroboros.Consensus.Node.ProtocolInfo (ProtocolInfo) import qualified Ouroboros.Consensus.Node.ProtocolInfo as Consensus -import Ouroboros.Consensus.Shelley.Eras (StandardCrypto) import Ouroboros.Consensus.Shelley.Node (ShelleyGenesis (..)) -- Usually only one constructor, but may have two when we are preparing for a HFC event. @@ -48,14 +48,14 @@ data GenesisConfig !Byron.Config !ShelleyConfig !AlonzoGenesis - !(ConwayGenesis StandardCrypto) + !ConwayGenesis genesisProtocolMagicId :: GenesisConfig -> ProtocolMagicId genesisProtocolMagicId ge = case ge of GenesisCardano _cfg _bCfg sCfg _aCfg _cCfg -> shelleyProtocolMagicId (scConfig sCfg) where - shelleyProtocolMagicId :: ShelleyGenesis StandardCrypto -> ProtocolMagicId + shelleyProtocolMagicId :: ShelleyGenesis -> ProtocolMagicId shelleyProtocolMagicId sCfg = ProtocolMagicId (sgNetworkMagic sCfg) readCardanoGenesisConfig :: diff --git a/cardano-db-sync/src/Cardano/DbSync/Config/Conway.hs b/cardano-db-sync/src/Cardano/DbSync/Config/Conway.hs index f06e21c14..2419c0be9 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Config/Conway.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Config/Conway.hs @@ -15,7 +15,6 @@ import Cardano.Ledger.BaseTypes (EpochInterval (..)) import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..)) import Cardano.Ledger.Conway.PParams (UpgradeConwayPParams (..)) -import Cardano.Ledger.Crypto (StandardCrypto ()) import Cardano.Ledger.Plutus.CostModels (mkCostModel) import Cardano.Ledger.Plutus.Language (Language (..)) import Cardano.Prelude @@ -37,7 +36,7 @@ data ConwayGenesisError readConwayGenesisConfig :: SyncNodeConfig -> - ExceptIO SyncNodeError (ConwayGenesis StandardCrypto) + ExceptIO SyncNodeError ConwayGenesis readConwayGenesisConfig SyncNodeConfig {..} = case dncConwayGenesisFile of Just file -> readConwayGenesisConfig' file dncConwayGenesisHash @@ -66,7 +65,7 @@ readConwayGenesisConfig SyncNodeConfig {..} = readGenesis :: GenesisFile -> Maybe GenesisHashConway -> - ExceptIO ConwayGenesisError (ConwayGenesis StandardCrypto) + ExceptIO ConwayGenesisError ConwayGenesis readGenesis (GenesisFile file) expectedHash = do content <- readFile' file checkExpectedGenesisHash expectedHash content @@ -78,7 +77,7 @@ readFile' file = (GenesisReadError file . show) (ByteString.readFile file) -decodeGenesis :: (Text -> ConwayGenesisError) -> ByteString -> ExceptIO ConwayGenesisError (ConwayGenesis StandardCrypto) +decodeGenesis :: (Text -> ConwayGenesisError) -> ByteString -> ExceptIO ConwayGenesisError ConwayGenesis decodeGenesis f = firstExceptT (f . Text.pack) . hoistEither diff --git a/cardano-db-sync/src/Cardano/DbSync/Config/Node.hs b/cardano-db-sync/src/Cardano/DbSync/Config/Node.hs index cea318f03..79decf202 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Config/Node.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Config/Node.hs @@ -25,7 +25,11 @@ import qualified Data.Aeson as Aeson import Data.Aeson.Types (Parser) import qualified Data.ByteString.Char8 as BS import qualified Data.Yaml as Yaml -import qualified Ouroboros.Consensus.Cardano.CanHardFork as Shelley +import Ouroboros.Consensus.Cardano (CardanoHardForkTrigger (..)) +import Ouroboros.Consensus.Cardano.Block (AllegraEra, AlonzoEra, BabbageEra, ConwayEra, MaryEra, ShelleyEra, StandardCrypto) +import Ouroboros.Consensus.Protocol.Praos (Praos) +import Ouroboros.Consensus.Protocol.TPraos (TPraos) +import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock) data NodeConfig = NodeConfig { ncProtocol :: !SyncProtocol @@ -41,17 +45,17 @@ data NodeConfig = NodeConfig , ncRequiresNetworkMagic :: !RequiresNetworkMagic , ncByronProtocolVersion :: !Byron.ProtocolVersion , -- Shelley hardfok parameters - ncShelleyHardFork :: !Shelley.TriggerHardFork + ncShelleyHardFork :: !(CardanoHardForkTrigger (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)) , -- Allegra hardfok parameters - ncAllegraHardFork :: !Shelley.TriggerHardFork + ncAllegraHardFork :: !(CardanoHardForkTrigger (ShelleyBlock (TPraos StandardCrypto) AllegraEra)) , -- Mary hardfok parameters - ncMaryHardFork :: !Shelley.TriggerHardFork + ncMaryHardFork :: !(CardanoHardForkTrigger (ShelleyBlock (TPraos StandardCrypto) MaryEra)) , -- Alonzo hardfok parameters - ncAlonzoHardFork :: !Shelley.TriggerHardFork + ncAlonzoHardFork :: !(CardanoHardForkTrigger (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)) , -- Babbage hardfok parameters - ncBabbageHardFork :: !Shelley.TriggerHardFork + ncBabbageHardFork :: !(CardanoHardForkTrigger (ShelleyBlock (Praos StandardCrypto) BabbageEra)) , -- Conway hardfok parameters - ncConwayHardFork :: !Shelley.TriggerHardFork + ncConwayHardFork :: !(CardanoHardForkTrigger (ShelleyBlock (Praos StandardCrypto) ConwayEra)) } parseNodeConfig :: ByteString -> IO NodeConfig @@ -106,44 +110,44 @@ instance FromJSON NodeConfig where <*> (o .: "LastKnownBlockVersion-Minor") <*> (o .: "LastKnownBlockVersion-Alt") - parseShelleyHardForkEpoch :: Object -> Parser Shelley.TriggerHardFork + parseShelleyHardForkEpoch :: Object -> Parser (CardanoHardForkTrigger (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)) parseShelleyHardForkEpoch o = asum - [ Shelley.TriggerHardForkAtEpoch <$> o .: "TestShelleyHardForkAtEpoch" - , pure $ Shelley.TriggerHardForkAtVersion 2 -- Mainnet default + [ CardanoTriggerHardForkAtEpoch <$> o .: "TestShelleyHardForkAtEpoch" + , pure CardanoTriggerHardForkAtDefaultVersion ] - parseAllegraHardForkEpoch :: Object -> Parser Shelley.TriggerHardFork + parseAllegraHardForkEpoch :: Object -> Parser (CardanoHardForkTrigger (ShelleyBlock (TPraos StandardCrypto) AllegraEra)) parseAllegraHardForkEpoch o = asum - [ Shelley.TriggerHardForkAtEpoch <$> o .: "TestAllegraHardForkAtEpoch" - , pure $ Shelley.TriggerHardForkAtVersion 3 -- Mainnet default + [ CardanoTriggerHardForkAtEpoch <$> o .: "TestAllegraHardForkAtEpoch" + , pure CardanoTriggerHardForkAtDefaultVersion ] - parseMaryHardForkEpoch :: Object -> Parser Shelley.TriggerHardFork + parseMaryHardForkEpoch :: Object -> Parser (CardanoHardForkTrigger (ShelleyBlock (TPraos StandardCrypto) MaryEra)) parseMaryHardForkEpoch o = asum - [ Shelley.TriggerHardForkAtEpoch <$> o .: "TestMaryHardForkAtEpoch" - , pure $ Shelley.TriggerHardForkAtVersion 4 -- Mainnet default + [ CardanoTriggerHardForkAtEpoch <$> o .: "TestMaryHardForkAtEpoch" + , pure CardanoTriggerHardForkAtDefaultVersion ] - parseAlonzoHardForkEpoch :: Object -> Parser Shelley.TriggerHardFork + parseAlonzoHardForkEpoch :: Object -> Parser (CardanoHardForkTrigger (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)) parseAlonzoHardForkEpoch o = asum - [ Shelley.TriggerHardForkAtEpoch <$> o .: "TestAlonzoHardForkAtEpoch" - , pure $ Shelley.TriggerHardForkAtVersion 5 -- Mainnet default + [ CardanoTriggerHardForkAtEpoch <$> o .: "TestAlonzoHardForkAtEpoch" + , pure CardanoTriggerHardForkAtDefaultVersion ] - parseBabbageHardForkEpoch :: Object -> Parser Shelley.TriggerHardFork + parseBabbageHardForkEpoch :: Object -> Parser (CardanoHardForkTrigger (ShelleyBlock (Praos StandardCrypto) BabbageEra)) parseBabbageHardForkEpoch o = asum - [ Shelley.TriggerHardForkAtEpoch <$> o .: "TestBabbageHardForkAtEpoch" - , pure $ Shelley.TriggerHardForkAtVersion 7 -- Mainnet default + [ CardanoTriggerHardForkAtEpoch <$> o .: "TestBabbageHardForkAtEpoch" + , pure CardanoTriggerHardForkAtDefaultVersion ] - parseConwayHardForkEpoch :: Object -> Parser Shelley.TriggerHardFork + parseConwayHardForkEpoch :: Object -> Parser (CardanoHardForkTrigger (ShelleyBlock (Praos StandardCrypto) ConwayEra)) parseConwayHardForkEpoch o = asum - [ Shelley.TriggerHardForkAtEpoch <$> o .: "TestConwayHardForkAtEpoch" - , pure $ Shelley.TriggerHardForkAtVersion 9 -- Mainnet default + [ CardanoTriggerHardForkAtEpoch <$> o .: "TestConwayHardForkAtEpoch" + , pure CardanoTriggerHardForkAtDefaultVersion ] diff --git a/cardano-db-sync/src/Cardano/DbSync/Config/Shelley.hs b/cardano-db-sync/src/Cardano/DbSync/Config/Shelley.hs index 4b177116f..19001de82 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Config/Shelley.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Config/Shelley.hs @@ -21,7 +21,6 @@ import qualified Data.ByteString.Char8 as BS import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text -import Ouroboros.Consensus.Shelley.Eras (StandardCrypto) import Ouroboros.Consensus.Shelley.Ledger.Block () import Ouroboros.Consensus.Shelley.Node (ShelleyGenesis (..)) @@ -29,7 +28,7 @@ import Ouroboros.Consensus.Shelley.Node (ShelleyGenesis (..)) -- can use it. data ShelleyConfig = ShelleyConfig - { scConfig :: !(ShelleyGenesis StandardCrypto) + { scConfig :: !ShelleyGenesis , scGenesisHash :: !GenesisHashShelley } diff --git a/cardano-db-sync/src/Cardano/DbSync/Config/Types.hs b/cardano-db-sync/src/Cardano/DbSync/Config/Types.hs index 333405a7e..6156be9ae 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Config/Types.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Config/Types.hs @@ -79,7 +79,11 @@ import Data.Aeson.Key (fromText) import Data.Aeson.Types (Pair, Parser, typeMismatch) import Data.ByteString.Short (ShortByteString (), fromShort, toShort) import Data.Default.Class (Default (..)) -import Ouroboros.Consensus.Cardano.CanHardFork (TriggerHardFork (..)) +import Ouroboros.Consensus.Cardano (CardanoHardForkTrigger (..)) +import Ouroboros.Consensus.Cardano.Block (AllegraEra, AlonzoEra, BabbageEra, ConwayEra, MaryEra, ShelleyEra, StandardCrypto) +import Ouroboros.Consensus.Protocol.Praos (Praos) +import Ouroboros.Consensus.Protocol.TPraos (TPraos) +import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock) newtype LogFileDir = LogFileDir { unLogFileDir :: FilePath @@ -135,12 +139,12 @@ data SyncNodeConfig = SyncNodeConfig , dncConwayGenesisFile :: !(Maybe GenesisFile) , dncConwayGenesisHash :: !(Maybe GenesisHashConway) , dncByronProtocolVersion :: !Byron.ProtocolVersion - , dncShelleyHardFork :: !TriggerHardFork - , dncAllegraHardFork :: !TriggerHardFork - , dncMaryHardFork :: !TriggerHardFork - , dncAlonzoHardFork :: !TriggerHardFork - , dncBabbageHardFork :: !TriggerHardFork - , dncConwayHardFork :: !TriggerHardFork + , dncShelleyHardFork :: !(CardanoHardForkTrigger (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)) + , dncAllegraHardFork :: !(CardanoHardForkTrigger (ShelleyBlock (TPraos StandardCrypto) AllegraEra)) + , dncMaryHardFork :: !(CardanoHardForkTrigger (ShelleyBlock (TPraos StandardCrypto) MaryEra)) + , dncAlonzoHardFork :: !(CardanoHardForkTrigger (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)) + , dncBabbageHardFork :: !(CardanoHardForkTrigger (ShelleyBlock (Praos StandardCrypto) BabbageEra)) + , dncConwayHardFork :: !(CardanoHardForkTrigger (ShelleyBlock (Praos StandardCrypto) ConwayEra)) , dncInsertOptions :: !SyncInsertOptions , dncIpfsGateway :: [Text] } diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Block.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Block.hs index e74620297..928f635eb 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Block.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Block.hs @@ -6,7 +6,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE NoImplicitPrelude #-} module Cardano.DbSync.Era.Shelley.Generic.Block ( @@ -25,6 +24,8 @@ module Cardano.DbSync.Era.Shelley.Generic.Block ( import qualified Cardano.Crypto.Hash as Crypto import qualified Cardano.Crypto.KES.Class as KES +import Cardano.Crypto.VRF.Class (VerKeyVRF) +import Cardano.Crypto.VRF.Praos (PraosVRF) import Cardano.DbSync.Era.Shelley.Generic.Tx import Cardano.DbSync.Types import Cardano.DbSync.Util.Bech32 (serialiseVerKeyVrfToBech32) @@ -33,21 +34,21 @@ import Cardano.Ledger.Alonzo.Scripts (Prices) import qualified Cardano.Ledger.BaseTypes as Ledger import qualified Cardano.Ledger.Block as Ledger import qualified Cardano.Ledger.Core as Ledger -import Cardano.Ledger.Crypto (Crypto, StandardCrypto) -import Cardano.Ledger.Era (EraSegWits (..)) -import Cardano.Ledger.Keys (KeyHash, KeyRole (..), VerKeyVRF, hashKey) +import Cardano.Ledger.Keys (KeyHash, KeyRole (..), hashKey) import Cardano.Prelude +import Cardano.Protocol.Crypto (Crypto, StandardCrypto, VRF) import qualified Cardano.Protocol.TPraos.BHeader as TPraos import qualified Cardano.Protocol.TPraos.OCert as TPraos import Cardano.Slotting.Slot (SlotNo (..)) import Ouroboros.Consensus.Cardano.Block ( - StandardAllegra, - StandardAlonzo, - StandardBabbage, - StandardConway, - StandardMary, - StandardShelley, + AllegraEra, + AlonzoEra, + BabbageEra, + ConwayEra, + MaryEra, + ShelleyEra, ) +import Ouroboros.Consensus.Protocol.Praos (Praos) import qualified Ouroboros.Consensus.Protocol.Praos.Header as Praos import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock) import qualified Ouroboros.Consensus.Shelley.Ledger.Block as Consensus @@ -58,7 +59,7 @@ data Block = Block { blkEra :: !BlockEra , blkHash :: !ByteString , blkPreviousHash :: !(Maybe ByteString) -- Nothing is used for first block after Genesis. - , blkSlotLeader :: !(KeyHash 'BlockIssuer StandardCrypto) + , blkSlotLeader :: !(KeyHash 'BlockIssuer) , blkSlotNo :: !SlotNo , blkBlockNo :: !BlockNo , blkSize :: !Word64 @@ -69,7 +70,7 @@ data Block = Block , blkTxs :: [Tx] -- intentionally left lazy to delay the tx transformation } -fromAllegraBlock :: ShelleyBlock TPraosStandard StandardAllegra -> Block +fromAllegraBlock :: ShelleyBlock (TPraosStandard StandardCrypto) AllegraEra -> Block fromAllegraBlock blk = Block { blkEra = Allegra @@ -86,7 +87,7 @@ fromAllegraBlock blk = , blkTxs = map fromAllegraTx (getTxs blk) } -fromShelleyBlock :: ShelleyBlock TPraosStandard StandardShelley -> Block +fromShelleyBlock :: ShelleyBlock (TPraosStandard StandardCrypto) ShelleyEra -> Block fromShelleyBlock blk = Block { blkEra = Shelley @@ -103,7 +104,7 @@ fromShelleyBlock blk = , blkTxs = map fromShelleyTx (getTxs blk) } -fromMaryBlock :: ShelleyBlock TPraosStandard StandardMary -> Block +fromMaryBlock :: ShelleyBlock (TPraosStandard StandardCrypto) MaryEra -> Block fromMaryBlock blk = Block { blkEra = Mary @@ -120,7 +121,7 @@ fromMaryBlock blk = , blkTxs = map fromMaryTx (getTxs blk) } -fromAlonzoBlock :: Bool -> Maybe Prices -> ShelleyBlock TPraosStandard StandardAlonzo -> Block +fromAlonzoBlock :: Bool -> Maybe Prices -> ShelleyBlock (TPraosStandard StandardCrypto) AlonzoEra -> Block fromAlonzoBlock iope mprices blk = Block { blkEra = Alonzo @@ -137,7 +138,7 @@ fromAlonzoBlock iope mprices blk = , blkTxs = map (fromAlonzoTx iope mprices) (getTxs blk) } -fromBabbageBlock :: Bool -> Maybe Prices -> ShelleyBlock PraosStandard StandardBabbage -> Block +fromBabbageBlock :: Bool -> Maybe Prices -> ShelleyBlock (PraosStandard StandardCrypto) BabbageEra -> Block fromBabbageBlock iope mprices blk = Block { blkEra = Babbage @@ -154,7 +155,7 @@ fromBabbageBlock iope mprices blk = , blkTxs = map (fromBabbageTx iope mprices) (getTxs blk) } -fromConwayBlock :: Bool -> Maybe Prices -> ShelleyBlock PraosStandard StandardConway -> Block +fromConwayBlock :: Bool -> Maybe Prices -> ShelleyBlock (PraosStandard StandardCrypto) ConwayEra -> Block fromConwayBlock iope mprices blk = Block { blkEra = Conway @@ -173,8 +174,8 @@ fromConwayBlock iope mprices blk = -- ------------------------------------------------------------------------------------------------- -getTxs :: forall p era. EraSegWits era => ShelleyBlock p era -> [(Word64, Ledger.Tx era)] -getTxs = zip [0 ..] . toList . fromTxSeq @era . Ledger.bbody . Consensus.shelleyBlockRaw +getTxs :: forall p era. Ledger.EraSegWits era => ShelleyBlock p era -> [(Word64, Ledger.Tx era)] +getTxs = zip [0 ..] . toList . Ledger.fromTxSeq @era . Ledger.bbody . Consensus.shelleyBlockRaw blockHeader :: ShelleyBlock p era -> ShelleyProtocolHeader p blockHeader = Ledger.bheader . Consensus.shelleyBlockRaw @@ -188,55 +189,55 @@ blockHash = blockNumber :: ShelleyProtocol p => ShelleyBlock p era -> BlockNo blockNumber = pHeaderBlock . blockHeader -blockPrevHash :: (ProtoCrypto p ~ StandardCrypto, ProtocolHeaderSupportsEnvelope p) => ShelleyBlock p era -> Maybe ByteString +blockPrevHash :: ProtocolHeaderSupportsEnvelope p => ShelleyBlock p era -> Maybe ByteString blockPrevHash blk = case pHeaderPrevHash $ Ledger.bheader (Consensus.shelleyBlockRaw blk) of TPraos.GenesisHash -> Nothing TPraos.BlockHash (TPraos.HashHeader h) -> Just $ Crypto.hashToBytes h -blockOpCertKeyTPraos :: ShelleyBlock TPraosStandard era -> ByteString +blockOpCertKeyTPraos :: ShelleyBlock (TPraosStandard StandardCrypto) era -> ByteString blockOpCertKeyTPraos = KES.rawSerialiseVerKeyKES . TPraos.ocertVkHot . blockOpCertTPraos -blockOpCertKeyPraos :: ShelleyBlock PraosStandard era -> ByteString +blockOpCertKeyPraos :: ShelleyBlock (PraosStandard StandardCrypto) era -> ByteString blockOpCertKeyPraos = KES.rawSerialiseVerKeyKES . TPraos.ocertVkHot . blockOpCertPraos -blockOpCertCounterTPraos :: ShelleyBlock TPraosStandard era -> Word64 +blockOpCertCounterTPraos :: ShelleyBlock (TPraosStandard StandardCrypto) era -> Word64 blockOpCertCounterTPraos = TPraos.ocertN . blockOpCertTPraos -blockOpCertCounterPraos :: ShelleyBlock PraosStandard era -> Word64 +blockOpCertCounterPraos :: ShelleyBlock (PraosStandard StandardCrypto) era -> Word64 blockOpCertCounterPraos = TPraos.ocertN . blockOpCertPraos -blockOpCertTPraos :: ShelleyBlock TPraosStandard era -> TPraos.OCert StandardCrypto +blockOpCertTPraos :: ShelleyBlock (TPraosStandard StandardCrypto) era -> TPraos.OCert StandardCrypto blockOpCertTPraos = TPraos.bheaderOCert . TPraos.bhbody . blockHeader -blockOpCertPraos :: ShelleyBlock PraosStandard era -> TPraos.OCert StandardCrypto +blockOpCertPraos :: ShelleyBlock (PraosStandard StandardCrypto) era -> TPraos.OCert StandardCrypto blockOpCertPraos = Praos.hbOCert . getHeaderBodyPraos . blockHeader -blockProtoVersionTPraos :: ShelleyBlock TPraosStandard era -> Ledger.ProtVer +blockProtoVersionTPraos :: ShelleyBlock (TPraosStandard StandardCrypto) era -> Ledger.ProtVer blockProtoVersionTPraos = TPraos.bprotver . TPraos.bhbody . blockHeader -blockProtoVersionPraos :: ShelleyBlock PraosStandard era -> Ledger.ProtVer +blockProtoVersionPraos :: ShelleyBlock (PraosStandard StandardCrypto) era -> Ledger.ProtVer blockProtoVersionPraos = Praos.hbProtVer . getHeaderBodyPraos . blockHeader blockSize :: ProtocolHeaderSupportsEnvelope p => ShelleyBlock p era -> Word64 blockSize = fromIntegral . pHeaderBlockSize . blockHeader -blockVrfKeyView :: VerKeyVRF StandardCrypto -> Text +blockVrfKeyView :: VerKeyVRF (VRF StandardCrypto) -> Text blockVrfKeyView = serialiseVerKeyVrfToBech32 -blockVrfVkTPraos :: ShelleyBlock TPraosStandard era -> VerKeyVRF StandardCrypto +blockVrfVkTPraos :: ShelleyBlock (TPraosStandard StandardCrypto) era -> VerKeyVRF PraosVRF blockVrfVkTPraos = TPraos.bheaderVrfVk . TPraos.bhbody . blockHeader -blockVrfVkPraos :: ShelleyBlock PraosStandard era -> VerKeyVRF StandardCrypto +blockVrfVkPraos :: ShelleyBlock (Praos StandardCrypto) era -> VerKeyVRF (VRF StandardCrypto) blockVrfVkPraos = Praos.hbVrfVk . getHeaderBodyPraos . blockHeader getHeaderBodyPraos :: Crypto c => Praos.Header c -> Praos.HeaderBody c getHeaderBodyPraos (Praos.Header headerBody _) = headerBody blockIssuer :: - (ShelleyProtocol p, Crypto (ProtoCrypto p), ProtoCrypto p ~ crypto) => + ShelleyProtocol p => ShelleyBlock p era -> - KeyHash 'BlockIssuer crypto + KeyHash 'BlockIssuer blockIssuer = hashKey . pHeaderIssuer . blockHeader slotNumber :: ShelleyProtocol p => ShelleyBlock p era -> SlotNo diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/EpochUpdate.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/EpochUpdate.hs index ef7f6fb23..fea5ab42c 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/EpochUpdate.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/EpochUpdate.hs @@ -18,7 +18,7 @@ import qualified Cardano.Protocol.TPraos.API as Shelley import qualified Cardano.Protocol.TPraos.Rules.Tickn as Shelley import Cardano.Slotting.Slot (EpochNo (..)) import Data.Strict.Maybe (Maybe (..)) -import Ouroboros.Consensus.Cardano.Block (HardForkState (..), StandardConway) +import Ouroboros.Consensus.Cardano.Block (ConwayEra, HardForkState (..)) import Ouroboros.Consensus.Cardano.CanHardFork () import qualified Ouroboros.Consensus.HeaderValidation as Consensus import Ouroboros.Consensus.Ledger.Extended (ExtLedgerState (..)) @@ -30,8 +30,8 @@ data NewEpoch = NewEpoch , neIsEBB :: !Bool , neAdaPots :: !(Maybe Shelley.AdaPots) , neEpochUpdate :: !EpochUpdate - , neDRepState :: !(Maybe (DRepPulsingState StandardConway)) - , neEnacted :: !(Maybe (ConwayGovState StandardConway)) + , neDRepState :: !(Maybe (DRepPulsingState ConwayEra)) + , neEnacted :: !(Maybe (ConwayGovState ConwayEra)) , nePoolDistr :: !(Maybe (Map PoolKeyHash (Coin, Word64), Map PoolKeyHash Natural)) } @@ -60,9 +60,9 @@ extractEpochNonce extLedgerState = ChainDepStateBabbage st -> extractNoncePraos st ChainDepStateConway st -> extractNoncePraos st where - extractNonce :: Consensus.TPraosState c -> Ledger.Nonce + extractNonce :: Consensus.TPraosState -> Ledger.Nonce extractNonce = Shelley.ticknStateEpochNonce . Shelley.csTickn . Consensus.tpraosStateChainDepState - extractNoncePraos :: Consensus.PraosState c -> Ledger.Nonce + extractNoncePraos :: Consensus.PraosState -> Ledger.Nonce extractNoncePraos = praosStateEpochNonce diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Metadata.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Metadata.hs index 08041235e..c52c94805 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Metadata.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Metadata.hs @@ -35,7 +35,7 @@ import qualified Data.Text.Encoding as Text import qualified Data.Text.Lazy as Text.Lazy import Data.Tuple.Extra (both) import qualified Data.Vector as Vector -import Ouroboros.Consensus.Cardano.Block (StandardAllegra, StandardMary, StandardShelley) +import Ouroboros.Consensus.Cardano.Block (AllegraEra, MaryEra, ShelleyEra) data TxMetadataValue = TxMetaMap ![(TxMetadataValue, TxMetadataValue)] @@ -45,7 +45,7 @@ data TxMetadataValue | TxMetaText !Text deriving (Eq, Ord, Show) -fromAllegraMetadata :: Allegra.AllegraTxAuxData StandardAllegra -> Map Word64 TxMetadataValue +fromAllegraMetadata :: Allegra.AllegraTxAuxData AllegraEra -> Map Word64 TxMetadataValue fromAllegraMetadata (Allegra.AllegraTxAuxData mdMap _scripts) = Map.map fromMetadatum mdMap @@ -53,11 +53,11 @@ fromAlonzoMetadata :: AlonzoEraScript era => Alonzo.AlonzoTxAuxData era -> Map W fromAlonzoMetadata aux = Map.map fromMetadatum $ Alonzo.atadMetadata aux -fromShelleyMetadata :: Shelley.ShelleyTxAuxData StandardShelley -> Map Word64 TxMetadataValue +fromShelleyMetadata :: Shelley.ShelleyTxAuxData ShelleyEra -> Map Word64 TxMetadataValue fromShelleyMetadata (Shelley.ShelleyTxAuxData mdMap) = Map.map fromMetadatum mdMap -fromMaryMetadata :: Allegra.AllegraTxAuxData StandardMary -> Map Word64 TxMetadataValue +fromMaryMetadata :: Allegra.AllegraTxAuxData MaryEra -> Map Word64 TxMetadataValue fromMaryMetadata (Allegra.AllegraTxAuxData mdMap _scripts) = Map.map fromMetadatum mdMap diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/ParamProposal.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/ParamProposal.hs index 2a2960423..6b81f6c8b 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/ParamProposal.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/ParamProposal.hs @@ -2,7 +2,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE NoImplicitPrelude #-} module Cardano.DbSync.Era.Shelley.Generic.ParamProposal ( @@ -20,7 +19,6 @@ import qualified Cardano.Ledger.BaseTypes as Ledger import Cardano.Ledger.Coin (Coin, unCoin) import Cardano.Ledger.Conway.Core import Cardano.Ledger.Conway.PParams (ppuMinFeeRefScriptCostPerByteL) -import Cardano.Ledger.Crypto import qualified Cardano.Ledger.Keys as Ledger import Cardano.Ledger.Plutus.Language (Language) import qualified Cardano.Ledger.Shelley.PParams as Shelley @@ -28,7 +26,7 @@ import Cardano.Prelude import Cardano.Slotting.Slot (EpochNo (..)) import qualified Data.Map.Strict as Map import Lens.Micro ((^.)) -import Ouroboros.Consensus.Cardano.Block (StandardAlonzo, StandardBabbage, StandardConway) +import Ouroboros.Consensus.Cardano.Block (AlonzoEra, BabbageEra, ConwayEra) data ParamProposal = ParamProposal { pppEpochNo :: !(Maybe EpochNo) @@ -74,7 +72,7 @@ data ParamProposal = ParamProposal , pppMinFeeRefScriptCostPerByte :: !(Maybe Rational) } -convertParamProposal :: EraCrypto era ~ StandardCrypto => Witness era -> Shelley.Update era -> [ParamProposal] +convertParamProposal :: Witness era -> Shelley.Update era -> [ParamProposal] convertParamProposal witness (Shelley.Update pp epoch) = case witness of Shelley {} -> shelleyParamProposal epoch pp @@ -89,17 +87,17 @@ shelleyParamProposal :: (EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era shelleyParamProposal epochNo (Shelley.ProposedPPUpdates umap) = map (convertShelleyParamProposal epochNo) $ Map.toList umap -alonzoParamProposal :: EpochNo -> Shelley.ProposedPPUpdates StandardAlonzo -> [ParamProposal] +alonzoParamProposal :: EpochNo -> Shelley.ProposedPPUpdates AlonzoEra -> [ParamProposal] alonzoParamProposal epochNo (Shelley.ProposedPPUpdates umap) = map (convertAlonzoParamProposal epochNo) $ Map.toList umap -babbageParamProposal :: EpochNo -> Shelley.ProposedPPUpdates StandardBabbage -> [ParamProposal] +babbageParamProposal :: EpochNo -> Shelley.ProposedPPUpdates BabbageEra -> [ParamProposal] babbageParamProposal epochNo (Shelley.ProposedPPUpdates umap) = map (convertBabbageParamProposal epochNo) $ Map.toList umap -- ------------------------------------------------------------------------------------------------- -convertConwayParamProposal :: PParamsUpdate StandardConway -> ParamProposal +convertConwayParamProposal :: PParamsUpdate ConwayEra -> ParamProposal convertConwayParamProposal pmap = ParamProposal { pppEpochNo = Nothing @@ -112,7 +110,7 @@ convertConwayParamProposal pmap = , pppKeyDeposit = strictMaybeToMaybe (pmap ^. ppuKeyDepositL) , pppPoolDeposit = strictMaybeToMaybe (pmap ^. ppuPoolDepositL) , pppMaxEpoch = strictMaybeToMaybe (pmap ^. ppuEMaxL) - , pppOptimalPoolCount = strictMaybeToMaybe (pmap ^. ppuNOptL) + , pppOptimalPoolCount = fromIntegral <$> strictMaybeToMaybe (pmap ^. ppuNOptL) , pppInfluence = Ledger.unboundRational <$> strictMaybeToMaybe (pmap ^. ppuA0L) , pppMonetaryExpandRate = strictMaybeToMaybe (pmap ^. ppuRhoL) , pppTreasuryGrowthRate = strictMaybeToMaybe (pmap ^. ppuTauL) @@ -144,7 +142,7 @@ convertConwayParamProposal pmap = , pppMinFeeRefScriptCostPerByte = Ledger.unboundRational <$> strictMaybeToMaybe (pmap ^. ppuMinFeeRefScriptCostPerByteL) } -convertBabbageParamProposal :: EpochNo -> (Ledger.KeyHash genesis StandardCrypto, PParamsUpdate StandardBabbage) -> ParamProposal +convertBabbageParamProposal :: EpochNo -> (Ledger.KeyHash genesis, PParamsUpdate BabbageEra) -> ParamProposal convertBabbageParamProposal epochNo (key, pmap) = ParamProposal { pppEpochNo = Just epochNo @@ -157,7 +155,7 @@ convertBabbageParamProposal epochNo (key, pmap) = , pppKeyDeposit = strictMaybeToMaybe (pmap ^. ppuKeyDepositL) , pppPoolDeposit = strictMaybeToMaybe (pmap ^. ppuPoolDepositL) , pppMaxEpoch = strictMaybeToMaybe (pmap ^. ppuEMaxL) - , pppOptimalPoolCount = strictMaybeToMaybe (pmap ^. ppuNOptL) + , pppOptimalPoolCount = fromIntegral <$> strictMaybeToMaybe (pmap ^. ppuNOptL) , pppInfluence = Ledger.unboundRational <$> strictMaybeToMaybe (pmap ^. ppuA0L) , pppMonetaryExpandRate = strictMaybeToMaybe (pmap ^. ppuRhoL) , pppTreasuryGrowthRate = strictMaybeToMaybe (pmap ^. ppuTauL) @@ -188,7 +186,7 @@ convertBabbageParamProposal epochNo (key, pmap) = , pppMinFeeRefScriptCostPerByte = Nothing } -convertAlonzoParamProposal :: EpochNo -> (Ledger.KeyHash genesis crypto, PParamsUpdate StandardAlonzo) -> ParamProposal +convertAlonzoParamProposal :: EpochNo -> (Ledger.KeyHash genesis, PParamsUpdate AlonzoEra) -> ParamProposal convertAlonzoParamProposal epochNo (key, pmap) = ParamProposal { pppEpochNo = Just epochNo @@ -201,7 +199,7 @@ convertAlonzoParamProposal epochNo (key, pmap) = , pppKeyDeposit = strictMaybeToMaybe (pmap ^. ppuKeyDepositL) , pppPoolDeposit = strictMaybeToMaybe (pmap ^. ppuPoolDepositL) , pppMaxEpoch = strictMaybeToMaybe (pmap ^. ppuEMaxL) - , pppOptimalPoolCount = strictMaybeToMaybe (pmap ^. ppuNOptL) + , pppOptimalPoolCount = fromIntegral <$> strictMaybeToMaybe (pmap ^. ppuNOptL) , pppInfluence = Ledger.unboundRational <$> strictMaybeToMaybe (pmap ^. ppuA0L) , pppMonetaryExpandRate = strictMaybeToMaybe (pmap ^. ppuRhoL) , pppTreasuryGrowthRate = strictMaybeToMaybe (pmap ^. ppuTauL) @@ -234,7 +232,7 @@ convertAlonzoParamProposal epochNo (key, pmap) = } -- | This works fine from Shelley to Mary. Not for Alonzo since 'ppuMinUTxOValueL' was removed -convertShelleyParamProposal :: (EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6, ProtVerAtMost era 8) => EpochNo -> (Ledger.KeyHash genesis crypto, PParamsUpdate era) -> ParamProposal +convertShelleyParamProposal :: (EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6, ProtVerAtMost era 8) => EpochNo -> (Ledger.KeyHash genesis, PParamsUpdate era) -> ParamProposal convertShelleyParamProposal epochNo (key, pmap) = ParamProposal { pppEpochNo = Just epochNo @@ -247,7 +245,7 @@ convertShelleyParamProposal epochNo (key, pmap) = , pppKeyDeposit = strictMaybeToMaybe (pmap ^. ppuKeyDepositL) , pppPoolDeposit = strictMaybeToMaybe (pmap ^. ppuPoolDepositL) , pppMaxEpoch = strictMaybeToMaybe (pmap ^. ppuEMaxL) - , pppOptimalPoolCount = strictMaybeToMaybe (pmap ^. ppuNOptL) + , pppOptimalPoolCount = fromIntegral <$> strictMaybeToMaybe (pmap ^. ppuNOptL) , pppInfluence = Ledger.unboundRational <$> strictMaybeToMaybe (pmap ^. ppuA0L) , pppMonetaryExpandRate = strictMaybeToMaybe (pmap ^. ppuRhoL) , pppTreasuryGrowthRate = strictMaybeToMaybe (pmap ^. ppuTauL) diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/ProtoParams.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/ProtoParams.hs index 1b85b3b49..9476c2214 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/ProtoParams.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/ProtoParams.hs @@ -37,7 +37,7 @@ data ProtoParams = ProtoParams , ppKeyDeposit :: !Coin , ppPoolDeposit :: !Coin , ppMaxEpoch :: !EpochInterval - , ppOptialPoolCount :: !Natural + , ppOptimalPoolCount :: !Word16 , ppInfluence :: !Rational , ppMonetaryExpandRate :: !UnitInterval , ppTreasuryGrowthRate :: !UnitInterval @@ -112,7 +112,7 @@ getDeposits lstate = -- ------------------------------------------------------------------------------------------------- -fromConwayParams :: PParams StandardConway -> ProtoParams +fromConwayParams :: PParams ConwayEra -> ProtoParams fromConwayParams params = ProtoParams { ppMinfeeA = fromIntegral . unCoin $ params ^. ppMinFeeAL @@ -123,7 +123,7 @@ fromConwayParams params = , ppKeyDeposit = params ^. ppKeyDepositL , ppPoolDeposit = params ^. ppPoolDepositL , ppMaxEpoch = params ^. ppEMaxL - , ppOptialPoolCount = params ^. ppNOptL + , ppOptimalPoolCount = params ^. ppNOptL , ppInfluence = Ledger.unboundRational $ params ^. ppA0L , ppMonetaryExpandRate = params ^. ppRhoL , ppTreasuryGrowthRate = params ^. ppTauL @@ -154,7 +154,7 @@ fromConwayParams params = , ppMinFeeRefScriptCostPerByte = Just $ Ledger.unboundRational $ params ^. ppMinFeeRefScriptCostPerByteL } -fromBabbageParams :: PParams StandardBabbage -> ProtoParams +fromBabbageParams :: PParams BabbageEra -> ProtoParams fromBabbageParams params = ProtoParams { ppMinfeeA = fromIntegral . unCoin $ params ^. ppMinFeeAL @@ -165,7 +165,7 @@ fromBabbageParams params = , ppKeyDeposit = params ^. ppKeyDepositL , ppPoolDeposit = params ^. ppPoolDepositL , ppMaxEpoch = params ^. ppEMaxL - , ppOptialPoolCount = params ^. ppNOptL + , ppOptimalPoolCount = params ^. ppNOptL , ppInfluence = Ledger.unboundRational $ params ^. ppA0L , ppMonetaryExpandRate = params ^. ppRhoL , ppTreasuryGrowthRate = params ^. ppTauL @@ -196,7 +196,7 @@ fromBabbageParams params = , ppMinFeeRefScriptCostPerByte = Nothing } -fromAlonzoParams :: PParams StandardAlonzo -> ProtoParams +fromAlonzoParams :: PParams AlonzoEra -> ProtoParams fromAlonzoParams params = ProtoParams { ppMinfeeA = fromIntegral . unCoin $ params ^. ppMinFeeAL @@ -207,7 +207,7 @@ fromAlonzoParams params = , ppKeyDeposit = params ^. ppKeyDepositL , ppPoolDeposit = params ^. ppPoolDepositL , ppMaxEpoch = params ^. ppEMaxL - , ppOptialPoolCount = params ^. ppNOptL + , ppOptimalPoolCount = params ^. ppNOptL , ppInfluence = Ledger.unboundRational $ params ^. ppA0L , ppMonetaryExpandRate = params ^. ppRhoL , ppTreasuryGrowthRate = params ^. ppTauL @@ -249,7 +249,7 @@ fromShelleyParams params = , ppKeyDeposit = params ^. ppKeyDepositL , ppPoolDeposit = params ^. ppPoolDepositL , ppMaxEpoch = params ^. ppEMaxL - , ppOptialPoolCount = params ^. ppNOptL + , ppOptimalPoolCount = params ^. ppNOptL , ppInfluence = Ledger.unboundRational $ params ^. ppA0L , ppMonetaryExpandRate = params ^. ppRhoL , ppTreasuryGrowthRate = params ^. ppTauL diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Script.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Script.hs index 7337d5c58..74bd22d29 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Script.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Script.hs @@ -17,10 +17,8 @@ module Cardano.DbSync.Era.Shelley.Generic.Script ( import Cardano.Crypto.Hash.Class import qualified Cardano.Ledger.Allegra.Scripts as Allegra -import Cardano.Ledger.Core (EraCrypto ()) +import Cardano.Ledger.Core (Era (..)) import qualified Cardano.Ledger.Core as Core -import Cardano.Ledger.Crypto -import Cardano.Ledger.Era (Era ()) import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..), coerceKeyRole) import qualified Cardano.Ledger.Shelley.API.Types as Shelley import qualified Cardano.Ledger.Shelley.Scripts as Shelley @@ -78,7 +76,7 @@ instance (Era era, Shelley.ShelleyEraScript era, Core.NativeScript era ~ Shelley requireSignatureToJSON sig multiSigToJSON _ = Aeson.Null -- This can never happen -instance (Era era, Shelley.ShelleyEraScript era, Core.NativeScript era ~ Shelley.MultiSig era, EraCrypto era ~ StandardCrypto) => FromJSON (MultiSigScript era) where +instance (Era era, Shelley.ShelleyEraScript era, Core.NativeScript era ~ Shelley.MultiSig era) => FromJSON (MultiSigScript era) where parseJSON v = MultiSigScript <$> parseMultiSig v instance (Era era, Allegra.AllegraEraScript era, Core.NativeScript era ~ Allegra.Timelock era) => ToJSON (TimelockScript era) where @@ -94,10 +92,10 @@ instance (Era era, Allegra.AllegraEraScript era, Core.NativeScript era ~ Allegra timelockToJSON (Allegra.RequireTimeStart slot) = requireTimeStartToJSON slot timelockToJSON (Allegra.RequireTimeExpire slot) = requireTimeExpireToJSON slot -instance (Era era, Allegra.AllegraEraScript era, EraCrypto era ~ StandardCrypto, Core.NativeScript era ~ Allegra.Timelock era) => FromJSON (TimelockScript era) where +instance (Era era, Allegra.AllegraEraScript era, Core.NativeScript era ~ Allegra.Timelock era) => FromJSON (TimelockScript era) where parseJSON v = TimelockScript <$> parseTimelock v -requireSignatureToJSON :: KeyHash discr c -> Aeson.Value +requireSignatureToJSON :: KeyHash discr -> Aeson.Value requireSignatureToJSON (KeyHash sig) = Aeson.object [ "type" .= Aeson.String "sig" @@ -141,7 +139,7 @@ requireTimeStartToJSON slot = ] parseMultiSig :: - (Shelley.ShelleyEraScript era, Core.NativeScript era ~ Shelley.MultiSig era, EraCrypto era ~ StandardCrypto) => + (Shelley.ShelleyEraScript era, Core.NativeScript era ~ Shelley.MultiSig era) => Aeson.Value -> Parser (Shelley.MultiSig era) parseMultiSig v = @@ -156,7 +154,7 @@ parseMultiSig v = parseScriptMOf' = second (fromList . map unMultiSigScript) <$> parseScriptMOf v parseTimelock :: - (Allegra.AllegraEraScript era, Core.NativeScript era ~ Allegra.Timelock era, EraCrypto era ~ StandardCrypto) => + (Allegra.AllegraEraScript era, Core.NativeScript era ~ Allegra.Timelock era) => Aeson.Value -> Parser (Allegra.Timelock era) parseTimelock v = @@ -174,7 +172,7 @@ parseTimelock v = parseScriptSig :: Aeson.Value -> - Parser (KeyHash 'Payment StandardCrypto) + Parser (KeyHash 'Payment) parseScriptSig = Aeson.withObject "sig" $ \obj -> do v <- obj .: "type" case (v :: Text) of @@ -185,7 +183,7 @@ parseScriptSig = Aeson.withObject "sig" $ \obj -> do parseKeyHash :: Text -> - Parser (KeyHash 'Payment StandardCrypto) + Parser (KeyHash 'Payment) parseKeyHash v = do let maybeHash = hashFromBytesAsHex $ encodeUtf8 v maybeKeyHash = KeyHash <$> maybeHash @@ -214,7 +212,7 @@ parseScriptAny = Aeson.withObject "any" $ \obj -> do _ -> fail "\"any\" script value not found" parseScriptMOf :: - (FromJSON script) => + FromJSON script => Aeson.Value -> Parser (Int, [script]) parseScriptMOf = Aeson.withObject "atLeast" $ \obj -> do diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/ScriptData.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/ScriptData.hs index 1a88d5699..49313c34c 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/ScriptData.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/ScriptData.hs @@ -10,7 +10,7 @@ module Cardano.DbSync.Era.Shelley.Generic.ScriptData ( import Cardano.Ledger.Binary (Annotator (..), DecCBOR (..), ToCBOR (..), fromPlainDecoder) import Cardano.Ledger.Binary.Encoding (EncCBOR (..)) -import Cardano.Ledger.Era (Era (..)) +import Cardano.Ledger.Core (Era (..)) import Cardano.Ledger.Plutus.Data (Data (..), getPlutusData) import Cardano.Prelude hiding (show) import Codec.Serialise (Serialise (..)) diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/StakeDist.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/StakeDist.hs index d6964a7cd..bea820f9f 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/StakeDist.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/StakeDist.hs @@ -6,7 +6,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE NoImplicitPrelude #-} module Cardano.DbSync.Era.Shelley.Generic.StakeDist ( @@ -18,13 +17,13 @@ module Cardano.DbSync.Era.Shelley.Generic.StakeDist ( ) where import Cardano.DbSync.Types +import Cardano.Ledger.BaseTypes.NonZero (NonZero (..)) import Cardano.Ledger.Coin (Coin (..)) import qualified Cardano.Ledger.Compactible as Ledger import Cardano.Ledger.Credential (Credential) -import qualified Cardano.Ledger.EpochBoundary as Ledger -import Cardano.Ledger.Era (EraCrypto) import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..)) import qualified Cardano.Ledger.Shelley.LedgerState as Shelley +import qualified Cardano.Ledger.State as Ledger import Cardano.Ledger.Val ((<+>)) import Cardano.Prelude import qualified Data.Map.Strict as Map @@ -33,7 +32,7 @@ import qualified Data.VMap as VMap import qualified Data.Vector.Generic as VG import Lens.Micro import Ouroboros.Consensus.Block -import Ouroboros.Consensus.Cardano.Block (LedgerState (..), StandardCrypto) +import Ouroboros.Consensus.Cardano.Block (LedgerState (..)) import Ouroboros.Consensus.Config import Ouroboros.Consensus.HardFork.Combinator import Ouroboros.Consensus.Ledger.Extended (ExtLedgerState (..)) @@ -59,7 +58,7 @@ emptySlice epoch = StakeSlice epoch Map.empty getSecurityParameter :: ConsensusProtocol (BlockProtocol blk) => ProtocolInfo blk -> - Word64 + NonZero Word64 getSecurityParameter = maxRollbacks . configSecurityParam . pInfoConfig -- 'sliceIndex' can match the epochBlockNo for every block. @@ -88,8 +87,8 @@ getStakeSlice pInfo !epochBlockNo els isMigration = LedgerStateConway cls -> genericStakeSlice pInfo epochBlockNo cls isMigration genericStakeSlice :: - forall era c blk p. - (c ~ StandardCrypto, EraCrypto era ~ c, ConsensusProtocol (BlockProtocol blk)) => + forall era blk p. + ConsensusProtocol (BlockProtocol blk) => ProtocolInfo blk -> Word64 -> LedgerState (ShelleyBlock p era) -> @@ -109,26 +108,26 @@ genericStakeSlice pInfo epochBlockNo lstate isMigration -- On mainnet this is 2160 k :: Word64 - k = getSecurityParameter pInfo + k = unNonZero $ getSecurityParameter pInfo -- We use 'ssStakeMark' here. That means that when these values -- are added to the database, the epoch number where they become active is the current -- epoch plus one. - stakeSnapshot :: Ledger.SnapShot c + stakeSnapshot :: Ledger.SnapShot stakeSnapshot = Ledger.ssStakeMark . Shelley.esSnapshots . Shelley.nesEs $ Consensus.shelleyLedgerState lstate - delegations :: VMap.KVVector VB VB (Credential 'Staking c, KeyHash 'StakePool c) + delegations :: VMap.KVVector VB VB (Credential 'Staking, KeyHash 'StakePool) delegations = VMap.unVMap $ Ledger.ssDelegations stakeSnapshot delegationsLen :: Word64 delegationsLen = fromIntegral $ VG.length delegations - stakes :: VMap VB VP (Credential 'Staking c) (Ledger.CompactForm Coin) + stakes :: VMap VB VP (Credential 'Staking) (Ledger.CompactForm Coin) stakes = Ledger.unStake $ Ledger.ssStake stakeSnapshot - lookupStake :: Credential 'Staking c -> Maybe Coin + lookupStake :: Credential 'Staking -> Maybe Coin lookupStake cred = Ledger.fromCompact <$> VMap.lookup cred stakes -- This is deterministic for the whole epoch and is the constant size of slices @@ -167,7 +166,7 @@ genericStakeSlice pInfo epochBlockNo lstate isMigration , sliceDistr = distribution } where - delegationsSliced :: VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c) + delegationsSliced :: VMap VB VB (Credential 'Staking) (KeyHash 'StakePool) delegationsSliced = VMap $ VG.slice (fromIntegral index) (fromIntegral actualSize) delegations distribution :: Map StakeCred (Coin, PoolKeyHash) @@ -191,7 +190,6 @@ getPoolDistr els = genericPoolDistr :: forall era p. - (EraCrypto era ~ StandardCrypto) => LedgerState (ShelleyBlock p era) -> (Map PoolKeyHash (Coin, Word64), Map PoolKeyHash Natural) genericPoolDistr lstate = @@ -200,7 +198,7 @@ genericPoolDistr lstate = nes :: Shelley.NewEpochState era nes = Consensus.shelleyLedgerState lstate - stakeMark :: Ledger.SnapShot StandardCrypto + stakeMark :: Ledger.SnapShot stakeMark = Ledger.ssStakeMark $ Shelley.esSnapshots $ Shelley.nesEs nes stakePerPool = countStakePerPool (Ledger.ssDelegations stakeMark) (Ledger.ssStake stakeMark) @@ -208,7 +206,7 @@ genericPoolDistr lstate = countStakePerPool :: VMap VB VB StakeCred PoolKeyHash -> - Ledger.Stake StandardCrypto -> + Ledger.Stake -> Map PoolKeyHash (Coin, Word64) countStakePerPool delegs (Ledger.Stake stake) = VMap.foldlWithKey accum Map.empty stake where diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Allegra.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Allegra.hs index 4ed3ef002..bec004472 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Allegra.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Allegra.hs @@ -45,9 +45,9 @@ import qualified Data.Aeson as Aeson import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Data.Map.Strict as Map import Lens.Micro ((^.)) -import Ouroboros.Consensus.Cardano.Block (StandardAllegra, StandardCrypto) +import Ouroboros.Consensus.Cardano.Block (AllegraEra) -fromAllegraTx :: (Word64, Core.Tx StandardAllegra) -> Tx +fromAllegraTx :: (Word64, Core.Tx AllegraEra) -> Tx fromAllegraTx (blkIndex, tx) = Tx { txHash = txHashId tx @@ -81,7 +81,7 @@ fromAllegraTx (blkIndex, tx) = , txTreasuryDonation = mempty -- Allegra does not support treasury donations } where - txBody :: Core.TxBody StandardAllegra + txBody :: Core.TxBody AllegraEra txBody = tx ^. Core.bodyTxL outputs :: [TxOut] @@ -94,7 +94,7 @@ fromAllegraTx (blkIndex, tx) = getScripts :: forall era. - (EraCrypto era ~ StandardCrypto, NativeScript era ~ Timelock era, AllegraEraScript era, Core.Tx era ~ ShelleyTx era, TxAuxData era ~ AllegraTxAuxData era, Script era ~ Timelock era, EraTx era) => + (NativeScript era ~ Timelock era, AllegraEraScript era, Core.Tx era ~ ShelleyTx era, TxAuxData era ~ AllegraTxAuxData era, Script era ~ Timelock era, EraTx era) => ShelleyTx era -> [TxScript] getScripts tx = @@ -105,9 +105,9 @@ getScripts tx = getAuxScripts :: forall era. - (EraCrypto era ~ StandardCrypto, EraScript era, Script era ~ Timelock era) => + (EraScript era, Script era ~ Timelock era) => StrictMaybe (AllegraTxAuxData era) -> - [(ScriptHash StandardCrypto, Timelock era)] + [(ScriptHash, Timelock era)] getAuxScripts maux = case strictMaybeToMaybe maux of Nothing -> [] @@ -116,7 +116,7 @@ getAuxScripts maux = mkTxScript :: (NativeScript era ~ Timelock era, AllegraEraScript era) => - (ScriptHash StandardCrypto, Timelock era) -> + (ScriptHash, Timelock era) -> TxScript mkTxScript (hsh, script) = TxScript diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Alonzo.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Alonzo.hs index 4b551fda4..ef4647ba0 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Alonzo.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Alonzo.hs @@ -50,10 +50,9 @@ import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Conway.Governance import Cardano.Ledger.Conway.Scripts (ConwayPlutusPurpose (..)) import qualified Cardano.Ledger.Core as Core +import Cardano.Ledger.Hashes (ScriptHash) import qualified Cardano.Ledger.Keys as Ledger import Cardano.Ledger.Mary.Value (MaryValue (..), MultiAsset (..), policyID) -import qualified Cardano.Ledger.SafeHash as Ledger -import Cardano.Ledger.Shelley.Scripts (ScriptHash) import qualified Cardano.Ledger.Shelley.TxBody as Shelley import Cardano.Ledger.Shelley.TxCert as Shelley import qualified Cardano.Ledger.TxIn as Ledger @@ -65,9 +64,9 @@ import qualified Data.Map.Strict as Map import qualified Data.Maybe.Strict as Strict import qualified Data.Set as Set import Lens.Micro -import Ouroboros.Consensus.Cardano.Block (EraCrypto, StandardAlonzo, StandardCrypto) +import Ouroboros.Consensus.Cardano.Block (AlonzoEra) -fromAlonzoTx :: Bool -> Maybe Alonzo.Prices -> (Word64, Core.Tx StandardAlonzo) -> Tx +fromAlonzoTx :: Bool -> Maybe Alonzo.Prices -> (Word64, Core.Tx AlonzoEra) -> Tx fromAlonzoTx ioExtraPlutus mprices (blkIndex, tx) = Tx { txHash = txHashId tx @@ -113,13 +112,13 @@ fromAlonzoTx ioExtraPlutus mprices (blkIndex, tx) = , txTreasuryDonation = mempty -- Alonzo does not support treasury donations } where - txBody :: Alonzo.AlonzoTxBody StandardAlonzo + txBody :: Alonzo.AlonzoTxBody AlonzoEra txBody = tx ^. Core.bodyTxL outputs :: [TxOut] outputs = zipWith fromTxOut [0 ..] $ toList (Alonzo.outputs' txBody) - fromTxOut :: Word64 -> AlonzoTxOut StandardAlonzo -> TxOut + fromTxOut :: Word64 -> AlonzoTxOut AlonzoEra -> TxOut fromTxOut index txOut = TxOut { txOutIndex = index @@ -145,13 +144,12 @@ fromAlonzoTx ioExtraPlutus mprices (blkIndex, tx) = collInputs = mkCollTxIn txBody -mkCollTxIn :: (EraCrypto era ~ StandardCrypto, AlonzoEraTxBody era) => Core.TxBody era -> [TxIn] +mkCollTxIn :: AlonzoEraTxBody era => Core.TxBody era -> [TxIn] mkCollTxIn txBody = map fromTxIn . toList $ txBody ^. Alonzo.collateralInputsTxBodyL getScripts :: forall era. - ( EraCrypto era ~ StandardCrypto - , Core.Script era ~ Alonzo.AlonzoScript era + ( Core.Script era ~ Alonzo.AlonzoScript era , Core.TxAuxData era ~ AlonzoTxAuxData era , Core.EraTx era , DBPlutusScript era @@ -167,7 +165,7 @@ getScripts tx = where getAuxScripts :: StrictMaybe (AlonzoTxAuxData era) -> - [(ScriptHash StandardCrypto, Alonzo.AlonzoScript era)] + [(ScriptHash, Alonzo.AlonzoScript era)] getAuxScripts maux = case strictMaybeToMaybe maux of Nothing -> [] @@ -178,8 +176,7 @@ getScripts tx = resolveRedeemers :: forall era. - ( EraCrypto era ~ StandardCrypto - , Alonzo.AlonzoEraTxWits era + ( Alonzo.AlonzoEraTxWits era , Core.EraTx era , DBScriptPurpose era ) => @@ -199,7 +196,7 @@ resolveRedeemers ioExtraPlutus mprices tx toCert = txBody :: Core.TxBody era txBody = tx ^. Core.bodyTxL - withdrawalsNoRedeemers :: Map (Shelley.RewardAccount StandardCrypto) TxWithdrawal + withdrawalsNoRedeemers :: Map Shelley.RewardAccount TxWithdrawal withdrawalsNoRedeemers = Map.mapWithKey (curry mkTxWithdrawal) $ Shelley.unWithdrawals $ @@ -211,7 +208,7 @@ resolveRedeemers ioExtraPlutus mprices tx toCert = toList $ toCert <$> (txBody ^. Core.certsTxBodyL) - txInsMissingRedeemer :: Map (Ledger.TxIn StandardCrypto) TxIn + txInsMissingRedeemer :: Map Ledger.TxIn TxIn txInsMissingRedeemer = Map.fromList $ fmap (\inp -> (inp, fromTxIn inp)) $ toList $ txBody ^. Core.inputsTxBodyL initRedeemersMaps :: RedeemerMaps @@ -267,14 +264,14 @@ resolveRedeemers ioExtraPlutus mprices tx toCert = Strict.SNothing -> Nothing Strict.SJust a -> toAlonzoPurpose txBody $ Alonzo.hoistPlutusPurpose Alonzo.toAsItem a -handleTxInPtr :: Word64 -> Ledger.TxIn StandardCrypto -> RedeemerMaps -> (RedeemerMaps, Maybe (Either TxIn ByteString)) +handleTxInPtr :: Word64 -> Ledger.TxIn -> RedeemerMaps -> (RedeemerMaps, Maybe (Either TxIn ByteString)) handleTxInPtr rdmrIx txIn mps = case Map.lookup txIn (rmInps mps) of Nothing -> (mps, Nothing) Just gtxIn -> let gtxIn' = gtxIn {txInRedeemerIndex = Just rdmrIx} in (mps {rmInps = Map.insert txIn gtxIn' (rmInps mps)}, Just (Left gtxIn')) -handleRewardPtr :: Word64 -> Shelley.RewardAccount StandardCrypto -> RedeemerMaps -> (RedeemerMaps, Maybe (Either TxIn ByteString)) +handleRewardPtr :: Word64 -> Shelley.RewardAccount -> RedeemerMaps -> (RedeemerMaps, Maybe (Either TxIn ByteString)) handleRewardPtr rdmrIx rwdAcnt mps = case Map.lookup rwdAcnt (rmWdrl mps) of Nothing -> (mps, Nothing) Just wdrl -> @@ -289,14 +286,14 @@ handleCertPtr rdmrIx dcert mps = f x = x data RedeemerMaps = RedeemerMaps - { rmWdrl :: Map (Shelley.RewardAccount StandardCrypto) TxWithdrawal + { rmWdrl :: Map Shelley.RewardAccount TxWithdrawal , rmCerts :: [(Cert, TxCertificate)] - , rmInps :: Map (Ledger.TxIn StandardCrypto) TxIn + , rmInps :: Map Ledger.TxIn TxIn } mkTxScript :: (DBPlutusScript era, Core.NativeScript era ~ Timelock era) => - (ScriptHash StandardCrypto, Alonzo.AlonzoScript era) -> + (ScriptHash, Alonzo.AlonzoScript era) -> TxScript mkTxScript (hsh, script) = TxScript @@ -324,7 +321,7 @@ mkTxScript (hsh, script) = plutusCborScript = case script of Alonzo.TimelockScript {} -> Nothing - plScript -> Just $ Ledger.originalBytes plScript + plScript -> Just $ Core.originalBytes plScript getPlutusSizes :: forall era. @@ -349,14 +346,14 @@ getPlutusScriptSize script = Just $ fromIntegral $ SBS.length $ unPlutusBinary $ Alonzo.plutusScriptBinary ps txDataWitness :: - (Core.TxWits era ~ Alonzo.AlonzoTxWits era, Core.EraTx era, EraCrypto era ~ StandardCrypto) => + (Core.TxWits era ~ Alonzo.AlonzoTxWits era, Core.EraTx era) => Core.Tx era -> [PlutusData] txDataWitness tx = mkTxData <$> Map.toList (Alonzo.unTxDats $ Alonzo.txdats' (tx ^. Core.witsTxL)) mkTxData :: (DataHash, Alonzo.Data era) -> PlutusData -mkTxData (dataHash, dt) = PlutusData dataHash (jsonData dt) (Ledger.originalBytes dt) +mkTxData (dataHash, dt) = PlutusData dataHash (jsonData dt) (Core.originalBytes dt) where jsonData :: Alonzo.Data era -> ByteString jsonData = @@ -373,7 +370,7 @@ extraKeyWits txBody = Set.map (\(Ledger.KeyHash h) -> Crypto.hashToBytes h) $ txBody ^. Alonzo.reqSignerHashesTxBodyL -scriptHashAcnt :: Shelley.RewardAccount StandardCrypto -> Maybe ByteString +scriptHashAcnt :: Shelley.RewardAccount -> Maybe ByteString scriptHashAcnt rewardAddr = getCredentialScriptHash $ Ledger.raCredential rewardAddr scriptHashCert :: Cert -> Maybe ByteString @@ -387,13 +384,13 @@ scriptHashCertConway cert = unScriptHash <$> getScriptWitnessTxCert cert scriptHashCertShelley :: ShelleyCert -> Maybe ByteString scriptHashCertShelley cert = unScriptHash <$> getScriptWitnessTxCert cert -getConwayVotingScriptHash :: Voter StandardCrypto -> Maybe ByteString +getConwayVotingScriptHash :: Voter -> Maybe ByteString getConwayVotingScriptHash = \case CommitteeVoter cred -> getCredentialScriptHash cred DRepVoter cred -> getCredentialScriptHash cred StakePoolVoter _ -> Nothing -getConwayProposalScriptHash :: EraCrypto era ~ StandardCrypto => ProposalProcedure era -> Maybe ByteString +getConwayProposalScriptHash :: ProposalProcedure era -> Maybe ByteString getConwayProposalScriptHash pp = case pProcGovAction pp of ParameterChange _ _ p -> unScriptHash <$> strictMaybeToMaybe p TreasuryWithdrawals _ p -> unScriptHash <$> strictMaybeToMaybe p diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Babbage.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Babbage.hs index 12824f42e..a69884fb8 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Babbage.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Babbage.hs @@ -27,15 +27,14 @@ import Cardano.Ledger.Babbage.TxBody (BabbageTxOut) import qualified Cardano.Ledger.Babbage.TxBody as Babbage import Cardano.Ledger.BaseTypes import qualified Cardano.Ledger.Core as Core -import qualified Cardano.Ledger.Era as Ledger import Cardano.Ledger.Mary.Value (MaryValue (..), MultiAsset (..)) import qualified Cardano.Ledger.Plutus.Data as Alonzo import Cardano.Prelude import qualified Data.Map.Strict as Map import Lens.Micro -import Ouroboros.Consensus.Shelley.Eras (StandardBabbage, StandardCrypto) +import Ouroboros.Consensus.Shelley.Eras (BabbageEra) -fromBabbageTx :: Bool -> Maybe Alonzo.Prices -> (Word64, Core.Tx StandardBabbage) -> Tx +fromBabbageTx :: Bool -> Maybe Alonzo.Prices -> (Word64, Core.Tx BabbageEra) -> Tx fromBabbageTx ioExtraPlutus mprices (blkIndex, tx) = Tx { txHash = txHashId tx @@ -82,7 +81,7 @@ fromBabbageTx ioExtraPlutus mprices (blkIndex, tx) = , txTreasuryDonation = mempty -- Babbage does not support treasury donations } where - txBody :: Core.TxBody StandardBabbage + txBody :: Core.TxBody BabbageEra txBody = tx ^. Core.bodyTxL outputs :: [TxOut] @@ -96,7 +95,7 @@ fromBabbageTx ioExtraPlutus mprices (blkIndex, tx) = collIndex :: Word64 collIndex = case txIxFromIntegral (length outputs) of - Just (TxIx i) -> i + Just (TxIx i) -> fromIntegral i Nothing -> fromIntegral (maxBound :: Word16) -- This is true if second stage contract validation passes. @@ -113,12 +112,11 @@ fromBabbageTx ioExtraPlutus mprices (blkIndex, tx) = fromTxOut :: forall era. ( Core.BabbageEraTxOut era - , EraCrypto era ~ StandardCrypto - , Core.Value era ~ MaryValue (EraCrypto era) , Core.TxOut era ~ BabbageTxOut era , Core.Script era ~ Alonzo.AlonzoScript era , DBPlutusScript era , NativeScript era ~ Timelock era + , Value era ~ MaryValue ) => Word64 -> BabbageTxOut era -> @@ -139,8 +137,7 @@ fromTxOut index txOut = fromScript :: forall era. - ( EraCrypto era ~ StandardCrypto - , Core.Script era ~ Alonzo.AlonzoScript era + ( Core.Script era ~ Alonzo.AlonzoScript era , DBPlutusScript era , NativeScript era ~ Timelock era ) => @@ -148,7 +145,7 @@ fromScript :: TxScript fromScript scr = mkTxScript (Core.hashScript @era scr, scr) -fromDatum :: (EraCrypto era ~ StandardCrypto, Ledger.Era era) => Alonzo.Datum era -> TxOutDatum +fromDatum :: Era era => Alonzo.Datum era -> TxOutDatum fromDatum bdat = case bdat of Alonzo.NoDatum -> NoDatum diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Conway.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Conway.hs index a02e2ab46..01f5dce56 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Conway.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Conway.hs @@ -25,9 +25,9 @@ import Cardano.Ledger.TxIn import Cardano.Prelude import qualified Data.Map.Strict as Map import Lens.Micro -import Ouroboros.Consensus.Cardano.Block (StandardConway, StandardCrypto) +import Ouroboros.Consensus.Cardano.Block (ConwayEra) -fromConwayTx :: Bool -> Maybe Alonzo.Prices -> (Word64, Core.Tx StandardConway) -> Tx +fromConwayTx :: Bool -> Maybe Alonzo.Prices -> (Word64, Core.Tx ConwayEra) -> Tx fromConwayTx ioExtraPlutus mprices (blkIndex, tx) = Tx { txHash = txHashId tx @@ -74,10 +74,10 @@ fromConwayTx ioExtraPlutus mprices (blkIndex, tx) = , txTreasuryDonation = ctbTreasuryDonation txBody } where - txBody :: Core.TxBody StandardConway + txBody :: Core.TxBody ConwayEra txBody = tx ^. Core.bodyTxL - txId :: TxId StandardCrypto + txId :: TxId txId = mkTxId tx outputs :: [TxOut] @@ -91,7 +91,7 @@ fromConwayTx ioExtraPlutus mprices (blkIndex, tx) = collIndex :: Word64 collIndex = case txIxFromIntegral (length outputs) of - Just (TxIx i) -> i + Just (TxIx i) -> fromIntegral i Nothing -> fromIntegral (maxBound :: Word16) -- This is true if second stage contract validation passes. @@ -105,5 +105,5 @@ fromConwayTx ioExtraPlutus mprices (blkIndex, tx) = collInputs = mkCollTxIn txBody - mkProposalIndex :: Word16 -> a -> (GovActionId StandardCrypto, a) + mkProposalIndex :: Word16 -> a -> (GovActionId, a) mkProposalIndex gix a = (GovActionId txId (GovActionIx gix), a) diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Mary.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Mary.hs index 6d2a2a379..d290008a8 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Mary.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Mary.hs @@ -17,9 +17,9 @@ import Cardano.Ledger.Mary.Value (MaryValue (..), MultiAsset (..)) import Cardano.Ledger.Shelley.TxOut import Cardano.Prelude import Lens.Micro ((^.)) -import Ouroboros.Consensus.Cardano.Block (StandardMary) +import Ouroboros.Consensus.Cardano.Block (MaryEra) -fromMaryTx :: (Word64, Core.Tx StandardMary) -> Tx +fromMaryTx :: (Word64, Core.Tx MaryEra) -> Tx fromMaryTx (blkIndex, tx) = Tx { txHash = txHashId tx @@ -53,13 +53,13 @@ fromMaryTx (blkIndex, tx) = , txTreasuryDonation = mempty -- Mary does not support treasury donations } where - txBody :: Core.TxBody StandardMary + txBody :: Core.TxBody MaryEra txBody = tx ^. Core.bodyTxL outputs :: [TxOut] outputs = zipWith fromTxOut [0 ..] $ toList (txBody ^. Core.outputsTxBodyL) - fromTxOut :: Word64 -> ShelleyTxOut StandardMary -> TxOut + fromTxOut :: Word64 -> ShelleyTxOut MaryEra -> TxOut fromTxOut index txOut = TxOut { txOutIndex = index diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Shelley.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Shelley.hs index d0c8d5f84..a879195df 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Shelley.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Shelley.hs @@ -38,9 +38,8 @@ import Cardano.DbSync.Era.Shelley.Generic.Witness import Cardano.Ledger.BaseTypes (TxIx (..), strictMaybeToMaybe) import Cardano.Ledger.Coin (Coin (..)) import qualified Cardano.Ledger.Core as Core -import Cardano.Ledger.Era (EraCrypto) -import qualified Cardano.Ledger.SafeHash as Ledger -import Cardano.Ledger.Shelley.Scripts (MultiSig, ScriptHash) +import Cardano.Ledger.Hashes (SafeHash, ScriptHash (..)) +import Cardano.Ledger.Shelley.Scripts (MultiSig) import qualified Cardano.Ledger.Shelley.TxBody as Shelley import Cardano.Ledger.Shelley.TxCert import qualified Cardano.Ledger.TxIn as Ledger @@ -49,9 +48,9 @@ import qualified Data.Aeson as Aeson import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Data.Map.Strict as Map import Lens.Micro ((^.)) -import Ouroboros.Consensus.Cardano.Block (StandardCrypto, StandardShelley) +import Ouroboros.Consensus.Cardano.Block (ShelleyEra) -fromShelleyTx :: (Word64, Core.Tx StandardShelley) -> Tx +fromShelleyTx :: (Word64, Core.Tx ShelleyEra) -> Tx fromShelleyTx (blkIndex, tx) = Tx { txHash = txHashId tx @@ -85,7 +84,7 @@ fromShelleyTx (blkIndex, tx) = , txTreasuryDonation = mempty -- Shelley does not support treasury donations } where - txBody :: Core.TxBody StandardShelley + txBody :: Core.TxBody ShelleyEra txBody = tx ^. Core.bodyTxL outputs :: [TxOut] @@ -95,7 +94,7 @@ fromShelleyTx (blkIndex, tx) = scripts = mkTxScript <$> Map.toList (tx ^. Core.witsTxL . Core.scriptTxWitsL) - mkTxScript :: (ScriptHash (EraCrypto StandardShelley), MultiSig StandardShelley) -> TxScript + mkTxScript :: (ScriptHash, MultiSig ShelleyEra) -> TxScript mkTxScript (hsh, script) = TxScript { txScriptHash = unScriptHash hsh @@ -107,7 +106,7 @@ fromShelleyTx (blkIndex, tx) = mkTxOut :: forall era. - (Core.EraTxBody era, Core.Value era ~ Coin, EraCrypto era ~ StandardCrypto) => + (Core.EraTxBody era, Core.Value era ~ Coin) => Core.TxBody era -> [TxOut] mkTxOut txBody = zipWith fromTxOut [0 ..] $ toList (txBody ^. Core.outputsTxBodyL) @@ -122,25 +121,25 @@ mkTxOut txBody = zipWith fromTxOut [0 ..] $ toList (txBody ^. Core.outputsTxBody , txOutDatum = NoDatum -- Shelley does not support plutus data } -fromTxIn :: Ledger.TxIn StandardCrypto -> TxIn +fromTxIn :: Ledger.TxIn -> TxIn fromTxIn (Ledger.TxIn (Ledger.TxId txid) (TxIx w64)) = TxIn - { txInIndex = w64 + { txInIndex = fromIntegral w64 , txInRedeemerIndex = Nothing , txInTxId = Ledger.TxId txid } -txHashId :: (EraCrypto era ~ StandardCrypto, Core.EraTx era) => Core.Tx era -> ByteString +txHashId :: Core.EraTx era => Core.Tx era -> ByteString txHashId = safeHashToByteString . txSafeHash -txSafeHash :: (EraCrypto era ~ StandardCrypto, Core.EraTx era) => Core.Tx era -> Ledger.SafeHash StandardCrypto Core.EraIndependentTxBody -txSafeHash tx = Ledger.hashAnnotated (tx ^. Core.bodyTxL) +txSafeHash :: Core.EraTx era => Core.Tx era -> SafeHash Shelley.EraIndependentTxBody +txSafeHash tx = Core.hashAnnotated (tx ^. Core.bodyTxL) -mkTxId :: (EraCrypto era ~ StandardCrypto, Core.EraTx era) => Core.Tx era -> Ledger.TxId StandardCrypto +mkTxId :: Core.EraTx era => Core.Tx era -> Ledger.TxId mkTxId = Ledger.TxId . txSafeHash -txHashFromSafe :: Ledger.SafeHash StandardCrypto Core.EraIndependentTxBody -> ByteString -txHashFromSafe = Crypto.hashToBytes . Ledger.extractHash +txHashFromSafe :: SafeHash Core.EraIndependentTxBody -> ByteString +txHashFromSafe = Crypto.hashToBytes . Core.extractHash getTxSize :: Core.EraTx era => Core.Tx era -> Word64 getTxSize tx = fromIntegral $ tx ^. Core.sizeTxF @@ -149,13 +148,13 @@ getTxCBOR :: Core.EraTx era => Core.Tx era -> ByteString getTxCBOR = serialize' mkTxIn :: - (Core.EraTxBody era, EraCrypto era ~ StandardCrypto) => + Core.EraTxBody era => Core.TxBody era -> [TxIn] mkTxIn txBody = map fromTxIn $ toList $ txBody ^. Core.inputsTxBodyL calcWithdrawalSum :: - (Core.EraTxBody era, EraCrypto era ~ StandardCrypto) => + Core.EraTxBody era => Core.TxBody era -> Coin calcWithdrawalSum bd = @@ -165,13 +164,13 @@ getTxMetadata :: Core.EraTx era => Core.Tx era -> Maybe (Core.TxAuxData era) getTxMetadata tx = strictMaybeToMaybe (tx ^. Core.auxDataTxL) mkTxWithdrawals :: - (Shelley.ShelleyEraTxBody era, EraCrypto era ~ StandardCrypto) => + Shelley.ShelleyEraTxBody era => Core.TxBody era -> [TxWithdrawal] mkTxWithdrawals bd = map mkTxWithdrawal $ Map.toList $ Shelley.unWithdrawals $ bd ^. Core.withdrawalsTxBodyL -mkTxWithdrawal :: (Shelley.RewardAccount StandardCrypto, Coin) -> TxWithdrawal +mkTxWithdrawal :: (Shelley.RewardAccount, Coin) -> TxWithdrawal mkTxWithdrawal (ra, c) = TxWithdrawal { txwRedeemerIndex = Nothing @@ -180,7 +179,7 @@ mkTxWithdrawal (ra, c) = } mkTxParamProposal :: - (Shelley.ShelleyEraTxBody era, EraCrypto era ~ StandardCrypto) => + Shelley.ShelleyEraTxBody era => Witness era -> Core.TxBody era -> [ParamProposal] @@ -191,14 +190,13 @@ mkTxCertificates :: forall era. ( Shelley.ShelleyEraTxBody era , TxCert era ~ ShelleyTxCert era - , EraCrypto era ~ StandardCrypto ) => Core.TxBody era -> [TxCertificate] mkTxCertificates bd = zipWith mkTxCertificate [0 ..] $ toShelleyCert <$> toList (bd ^. Core.certsTxBodyL) -toShelleyCert :: EraCrypto era ~ StandardCrypto => ShelleyTxCert era -> ShelleyCert +toShelleyCert :: ShelleyTxCert era -> ShelleyCert toShelleyCert cert = case cert of ShelleyTxCertDelegCert a -> ShelleyTxCertDelegCert a ShelleyTxCertPool a -> ShelleyTxCertPool a diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Types.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Types.hs index f4001498d..1553d128b 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Types.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Types.hs @@ -48,11 +48,11 @@ import Cardano.Ledger.Shelley.TxCert import qualified Cardano.Ledger.TxIn as Ledger import Cardano.Prelude import Cardano.Slotting.Slot (SlotNo (..)) -import Ouroboros.Consensus.Cardano.Block (StandardAlonzo, StandardBabbage, StandardConway, StandardCrypto, StandardShelley) +import Ouroboros.Consensus.Cardano.Block (AlonzoEra, BabbageEra, ConwayEra, ShelleyEra) data Tx = Tx { txHash :: !ByteString - , txLedgerTxId :: !(Ledger.TxId StandardCrypto) + , txLedgerTxId :: !Ledger.TxId , txBlockIndex :: !Word64 , txCBOR :: ByteString , txSize :: !Word64 @@ -71,19 +71,19 @@ data Tx = Tx , txCertificates :: ![TxCertificate] , txWithdrawals :: ![TxWithdrawal] , txParamProposal :: ![ParamProposal] - , txMint :: !(MultiAsset StandardCrypto) + , txMint :: !MultiAsset , txRedeemer :: [(Word64, TxRedeemer)] , txData :: [PlutusData] , txScriptSizes :: [Word64] -- this contains only the sizes of plutus scripts in witnesses , txScripts :: [TxScript] , txExtraKeyWitnesses :: ![ByteString] - , txVotingProcedure :: ![(Voter StandardCrypto, [(GovActionId StandardCrypto, VotingProcedure StandardConway)])] - , txProposalProcedure :: ![(GovActionId StandardCrypto, ProposalProcedure StandardConway)] + , txVotingProcedure :: ![(Voter, [(GovActionId, VotingProcedure ConwayEra)])] + , txProposalProcedure :: ![(GovActionId, ProposalProcedure ConwayEra)] , txTreasuryDonation :: !Coin } -type ShelleyCert = ShelleyTxCert StandardShelley -type ConwayCert = ConwayTxCert StandardConway +type ShelleyCert = ShelleyTxCert ShelleyEra +type ConwayCert = ConwayTxCert ConwayEra type Cert = Either ShelleyCert ConwayCert data TxCertificate = TxCertificate @@ -94,22 +94,22 @@ data TxCertificate = TxCertificate data TxWithdrawal = TxWithdrawal { txwRedeemerIndex :: !(Maybe Word64) - , txwRewardAccount :: !(Shelley.RewardAccount StandardCrypto) + , txwRewardAccount :: !Shelley.RewardAccount , txwAmount :: !Coin } data TxIn = TxIn { txInIndex :: !Word64 - , txInTxId :: !(Ledger.TxId StandardCrypto) + , txInTxId :: !Ledger.TxId , txInRedeemerIndex :: !(Maybe Word64) -- This only has a meaning for Alonzo. } deriving (Show) data TxOut = TxOut { txOutIndex :: !Word64 - , txOutAddress :: !(Ledger.Addr StandardCrypto) + , txOutAddress :: !Ledger.Addr , txOutAdaValue :: !Coin - , txOutMaValue :: !(Map (PolicyID StandardCrypto) (Map AssetName Integer)) + , txOutMaValue :: !(Map PolicyID (Map AssetName Integer)) , txOutScript :: Maybe TxScript , txOutDatum :: !TxOutDatum } @@ -182,7 +182,7 @@ class AlonzoEraTxBody era => DBScriptPurpose era where getPurpose :: PlutusPurpose AsIx era -> (DB.ScriptPurpose, Word32) toAlonzoPurpose :: TxBody era -> PlutusPurpose AsItem era -> Maybe (Either (AlonzoPlutusPurpose AsItem era, Maybe (PlutusPurpose AsIx era)) (ConwayPlutusPurpose AsItem era)) -instance DBScriptPurpose StandardAlonzo where +instance DBScriptPurpose AlonzoEra where getPurpose = \case AlonzoSpending idx -> (DB.Spend, unAsIx idx) AlonzoMinting idx -> (DB.Mint, unAsIx idx) @@ -195,7 +195,7 @@ instance DBScriptPurpose StandardAlonzo where AlonzoRewarding a -> Just $ Left (AlonzoRewarding a, Nothing) AlonzoCertifying a -> Just $ Left (AlonzoCertifying a, strictMaybeToMaybe (alonzoRedeemerPointer txBody pp)) -instance DBScriptPurpose StandardBabbage where +instance DBScriptPurpose BabbageEra where getPurpose = \case AlonzoSpending idx -> (DB.Spend, unAsIx idx) AlonzoMinting idx -> (DB.Mint, unAsIx idx) @@ -208,7 +208,7 @@ instance DBScriptPurpose StandardBabbage where AlonzoRewarding a -> Just $ Left (AlonzoRewarding a, Nothing) AlonzoCertifying a -> Just $ Left (AlonzoCertifying a, strictMaybeToMaybe (alonzoRedeemerPointer txBody pp)) -instance DBScriptPurpose StandardConway where +instance DBScriptPurpose ConwayEra where getPurpose = \case ConwaySpending idx -> (DB.Spend, unAsIx idx) ConwayMinting idx -> (DB.Mint, unAsIx idx) @@ -225,14 +225,14 @@ instance DBScriptPurpose StandardConway where class AlonzoEraScript era => DBPlutusScript era where getPlutusScriptType :: PlutusScript era -> DB.ScriptType -instance DBPlutusScript StandardAlonzo where +instance DBPlutusScript AlonzoEra where getPlutusScriptType _ = DB.PlutusV1 -instance DBPlutusScript StandardBabbage where +instance DBPlutusScript BabbageEra where getPlutusScriptType (BabbagePlutusV1 _) = DB.PlutusV1 getPlutusScriptType (BabbagePlutusV2 _) = DB.PlutusV2 -instance DBPlutusScript StandardConway where +instance DBPlutusScript ConwayEra where getPlutusScriptType (ConwayPlutusV1 _) = DB.PlutusV1 getPlutusScriptType (ConwayPlutusV2 _) = DB.PlutusV2 getPlutusScriptType (ConwayPlutusV3 _) = DB.PlutusV3 diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Util.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Util.hs index cc12372e8..bc2ee6b71 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Util.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Util.hs @@ -44,10 +44,9 @@ import qualified Cardano.Ledger.BaseTypes as Ledger import Cardano.Ledger.Coin (Coin (..), DeltaCoin) import Cardano.Ledger.Conway.Governance import qualified Cardano.Ledger.Credential as Ledger +import Cardano.Ledger.Hashes (SafeHash, ScriptHash (..), extractHash) import qualified Cardano.Ledger.Keys as Ledger import Cardano.Ledger.Mary.Value (AssetName (..)) -import qualified Cardano.Ledger.SafeHash as Ledger -import qualified Cardano.Ledger.Shelley.Scripts as Shelley import qualified Cardano.Ledger.Shelley.TxBody as Shelley import Cardano.Ledger.Shelley.TxCert import Cardano.Ledger.TxIn @@ -59,27 +58,26 @@ import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Data.ByteString.Short as SBS import qualified Data.List as List import qualified Data.Text.Encoding as Text -import Ouroboros.Consensus.Cardano.Block (StandardConway, StandardCrypto) -annotateStakingCred :: Ledger.Network -> Ledger.StakeCredential era -> Ledger.RewardAccount era +annotateStakingCred :: Ledger.Network -> Ledger.StakeCredential -> Ledger.RewardAccount annotateStakingCred = Shelley.RewardAccount coinToDbLovelace :: Coin -> DbLovelace coinToDbLovelace = DbLovelace . fromIntegral . unCoin -getPaymentCred :: Ledger.Addr StandardCrypto -> Maybe (Ledger.PaymentCredential StandardCrypto) +getPaymentCred :: Ledger.Addr -> Maybe Ledger.PaymentCredential getPaymentCred addr = case addr of Ledger.Addr _nw pcred _sref -> Just pcred Ledger.AddrBootstrap {} -> Nothing -hasCredScript :: Ledger.Credential kr StandardCrypto -> Bool +hasCredScript :: Ledger.Credential kr -> Bool hasCredScript pc = case pc of Ledger.ScriptHashObj _ -> True Ledger.KeyHashObj {} -> False -maybePaymentCred :: Ledger.Addr era -> Maybe ByteString +maybePaymentCred :: Ledger.Addr -> Maybe ByteString maybePaymentCred addr = case addr of Ledger.Addr _nw pcred _sref -> @@ -87,7 +85,7 @@ maybePaymentCred addr = Ledger.AddrBootstrap {} -> Nothing -getCredentialScriptHash :: Ledger.Credential kr StandardCrypto -> Maybe ByteString +getCredentialScriptHash :: Ledger.Credential kr -> Maybe ByteString getCredentialScriptHash pc = case pc of Ledger.ScriptHashObj hash -> Just $ unScriptHash hash @@ -109,59 +107,59 @@ nonceToBytes nonce = Ledger.NeutralNonce -> Nothing partitionMIRTargets :: - [MIRTarget StandardCrypto] -> - ([Map (Ledger.Credential 'Ledger.Staking StandardCrypto) DeltaCoin], [Coin]) + [MIRTarget] -> + ([Map (Ledger.Credential 'Ledger.Staking) DeltaCoin], [Coin]) partitionMIRTargets = List.foldl' foldfunc ([], []) where foldfunc :: - ([Map (Ledger.Credential 'Ledger.Staking StandardCrypto) DeltaCoin], [Coin]) -> - MIRTarget StandardCrypto -> - ([Map (Ledger.Credential 'Ledger.Staking StandardCrypto) DeltaCoin], [Coin]) + ([Map (Ledger.Credential 'Ledger.Staking) DeltaCoin], [Coin]) -> + MIRTarget -> + ([Map (Ledger.Credential 'Ledger.Staking) DeltaCoin], [Coin]) foldfunc (xs, ys) mt = case mt of StakeAddressesMIR x -> (x : xs, ys) SendToOppositePotMIR y -> (xs, y : ys) -renderAddress :: Ledger.Addr StandardCrypto -> Text +renderAddress :: Ledger.Addr -> Text renderAddress = serialiseAddress -renderRewardAccount :: Ledger.RewardAccount StandardCrypto -> Text +renderRewardAccount :: Ledger.RewardAccount -> Text renderRewardAccount = serialiseRewardAccount -stakingCredHash :: Ledger.Network -> Ledger.StakeCredential era -> ByteString +stakingCredHash :: Ledger.Network -> Ledger.StakeCredential -> ByteString stakingCredHash network = Ledger.serialiseRewardAccount . annotateStakingCred network unitIntervalToDouble :: Ledger.UnitInterval -> Double unitIntervalToDouble = fromRational . Ledger.unboundRational -unCredentialHash :: Ledger.Credential kr StandardCrypto -> ByteString +unCredentialHash :: Ledger.Credential kr -> ByteString unCredentialHash = \case Ledger.ScriptHashObj scriptHash -> unScriptHash scriptHash Ledger.KeyHashObj keyHash -> unKeyHashRaw keyHash -unKeyHashRaw :: Ledger.KeyHash d era -> ByteString +unKeyHashRaw :: Ledger.KeyHash d -> ByteString unKeyHashRaw (Ledger.KeyHash kh) = Crypto.hashToBytes kh -unKeyHashView :: Ledger.KeyHash 'Ledger.StakePool StandardCrypto -> Text +unKeyHashView :: Ledger.KeyHash 'Ledger.StakePool -> Text unKeyHashView = serialiseStakePoolKeyHashToBech32 -unScriptHash :: Shelley.ScriptHash StandardCrypto -> ByteString -unScriptHash (Shelley.ScriptHash h) = Crypto.hashToBytes h +unScriptHash :: ScriptHash -> ByteString +unScriptHash (ScriptHash h) = Crypto.hashToBytes h -unTxHash :: TxId c -> ByteString -unTxHash (TxId txid) = Crypto.hashToBytes $ Ledger.extractHash txid +unTxHash :: TxId -> ByteString +unTxHash (TxId txid) = Crypto.hashToBytes $ extractHash txid unAssetName :: AssetName -> ByteString unAssetName = SBS.fromShort . assetNameBytes dataHashToBytes :: DataHash -> ByteString -dataHashToBytes = Crypto.hashToBytes . Ledger.extractHash +dataHashToBytes = Crypto.hashToBytes . extractHash -safeHashToByteString :: Ledger.SafeHash StandardCrypto c -> ByteString -safeHashToByteString = Crypto.hashToBytes . Ledger.extractHash +safeHashToByteString :: SafeHash a -> ByteString +safeHashToByteString = Crypto.hashToBytes . extractHash -toGovAction :: GovAction StandardConway -> Db.GovActionType +toGovAction :: GovAction a -> Db.GovActionType toGovAction = \case ParameterChange {} -> Db.ParameterChange HardForkInitiation {} -> Db.HardForkInitiation @@ -177,7 +175,7 @@ toVote = \case VoteYes -> Db.VoteYes Abstain -> Db.VoteAbstain -toVoterRole :: Voter StandardCrypto -> Db.VoterRole +toVoterRole :: Voter -> Db.VoterRole toVoterRole = \case CommitteeVoter {} -> Db.ConstitutionalCommittee DRepVoter {} -> Db.DRep diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Witness.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Witness.hs index 925c1f71e..920ea9407 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Witness.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Witness.hs @@ -30,11 +30,11 @@ instance Show (Evidence c) where -- show Test = "Test"-- | Witness of a valid (predefined) era data Witness era where - Shelley :: Evidence c -> Witness (ShelleyEra c) - Allegra :: Evidence c -> Witness (AllegraEra c) - Mary :: Evidence c -> Witness (MaryEra c) - Alonzo :: Evidence c -> Witness (AlonzoEra c) - Babbage :: Evidence c -> Witness (BabbageEra c) + Shelley :: Evidence c -> Witness ShelleyEra + Allegra :: Evidence c -> Witness AllegraEra + Mary :: Evidence c -> Witness MaryEra + Alonzo :: Evidence c -> Witness AlonzoEra + Babbage :: Evidence c -> Witness BabbageEra -- Conway :: Evidence c -> Witness (ConwayEra c) diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Genesis.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Genesis.hs index 0cc49a38e..e4a746c44 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Genesis.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Genesis.hs @@ -47,7 +47,7 @@ import Data.Time.Clock (UTCTime (..)) import qualified Data.Time.Clock as Time import Database.Persist.Sql (SqlBackend) import Lens.Micro -import Ouroboros.Consensus.Cardano.Block (StandardCrypto, StandardShelley) +import Ouroboros.Consensus.Cardano.Block (ShelleyEra) import Ouroboros.Consensus.Shelley.Node ( ShelleyGenesis (..), ShelleyGenesisStaking (..), @@ -61,7 +61,7 @@ import Paths_cardano_db_sync (version) insertValidateGenesisDist :: SyncEnv -> Text -> - ShelleyGenesis StandardCrypto -> + ShelleyGenesis -> Bool -> ExceptT SyncNodeError IO () insertValidateGenesisDist syncEnv networkName cfg shelleyInitiation = do @@ -166,7 +166,7 @@ validateGenesisDistribution :: SyncEnv -> Bool -> Text -> - ShelleyGenesis StandardCrypto -> + ShelleyGenesis -> DB.BlockId -> Word64 -> ReaderT SqlBackend m (Either SyncNodeError ()) @@ -225,7 +225,7 @@ insertTxOuts :: SyncEnv -> Trace IO Text -> DB.BlockId -> - (TxIn StandardCrypto, ShelleyTxOut StandardShelley) -> + (TxIn, ShelleyTxOut ShelleyEra) -> ReaderT SqlBackend m () insertTxOuts syncEnv trce blkId (TxIn txInId _, txOut) = do -- Each address/value pair of the initial coin distribution comes from an artifical transaction @@ -305,7 +305,7 @@ insertStaking :: Trace IO Text -> CacheStatus -> DB.BlockId -> - ShelleyGenesis StandardCrypto -> + ShelleyGenesis -> ExceptT SyncNodeError (ReaderT SqlBackend m) () insertStaking tracer cache blkId genesis = do -- All Genesis staking comes from an artifical transaction @@ -339,34 +339,34 @@ insertStaking tracer cache blkId genesis = do -- ----------------------------------------------------------------------------- -configGenesisHash :: ShelleyGenesis StandardCrypto -> ByteString +configGenesisHash :: ShelleyGenesis -> ByteString configGenesisHash _ = BS.take 32 ("Shelley Genesis Block Hash " <> BS.replicate 32 '\0') -genesisHashSlotLeader :: ShelleyGenesis StandardCrypto -> ByteString +genesisHashSlotLeader :: ShelleyGenesis -> ByteString genesisHashSlotLeader _ = BS.take 28 ("Shelley Genesis SlotLeader Hash" <> BS.replicate 28 '\0') configGenesisStakingHash :: ByteString configGenesisStakingHash = BS.take 32 ("Shelley Genesis Staking Tx Hash " <> BS.replicate 32 '\0') -configGenesisSupply :: ShelleyGenesis StandardCrypto -> DB.Ada +configGenesisSupply :: ShelleyGenesis -> DB.Ada configGenesisSupply = DB.word64ToAda . fromIntegral . sum . map Ledger.unCoin . genesisTxoAssocList -genesisUTxOSize :: ShelleyGenesis StandardCrypto -> Int +genesisUTxOSize :: ShelleyGenesis -> Int genesisUTxOSize = length . genesisUtxOs -genesisTxoAssocList :: ShelleyGenesis StandardCrypto -> [Ledger.Coin] +genesisTxoAssocList :: ShelleyGenesis -> [Ledger.Coin] genesisTxoAssocList = map (unTxOut . snd) . genesisUtxOs where - unTxOut :: ShelleyTxOut StandardShelley -> Ledger.Coin + unTxOut :: ShelleyTxOut ShelleyEra -> Ledger.Coin unTxOut txOut = txOut ^. Core.valueTxOutL -genesisUtxOs :: ShelleyGenesis StandardCrypto -> [(TxIn StandardCrypto, ShelleyTxOut StandardShelley)] +genesisUtxOs :: ShelleyGenesis -> [(TxIn, ShelleyTxOut ShelleyEra)] genesisUtxOs = Map.toList . Shelley.unUTxO . Shelley.genesisUTxO -configStartTime :: ShelleyGenesis StandardCrypto -> UTCTime +configStartTime :: ShelleyGenesis -> UTCTime configStartTime = roundToMillseconds . Shelley.sgSystemStart roundToMillseconds :: UTCTime -> UTCTime diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Epoch.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Epoch.hs index cc1f86205..ba49786ab 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Epoch.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Epoch.hs @@ -127,7 +127,7 @@ insertEpochParam _tracer blkId (EpochNo epoch) params nonce = do , DB.epochParamKeyDeposit = Generic.coinToDbLovelace (Generic.ppKeyDeposit params) , DB.epochParamPoolDeposit = Generic.coinToDbLovelace (Generic.ppPoolDeposit params) , DB.epochParamMaxEpoch = fromIntegral $ unEpochInterval (Generic.ppMaxEpoch params) - , DB.epochParamOptimalPoolCount = fromIntegral (Generic.ppOptialPoolCount params) + , DB.epochParamOptimalPoolCount = fromIntegral (Generic.ppOptimalPoolCount params) , DB.epochParamInfluence = fromRational (Generic.ppInfluence params) , DB.epochParamMonetaryExpandRate = toDouble (Generic.ppMonetaryExpandRate params) , DB.epochParamTreasuryGrowthRate = toDouble (Generic.ppTreasuryGrowthRate params) diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Certificate.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Certificate.hs index 46aac293a..128f18bcd 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Certificate.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Certificate.hs @@ -55,7 +55,6 @@ import Control.Monad.Trans.Control (MonadBaseControl) import Data.Group (invert) import qualified Data.Map.Strict as Map import Database.Persist.Sql (SqlBackend) -import Ouroboros.Consensus.Cardano.Block (StandardCrypto) insertCertificate :: (MonadBaseControl IO m, MonadIO m) => @@ -115,7 +114,7 @@ insertDelegCert :: Maybe DB.RedeemerId -> EpochNo -> SlotNo -> - ShelleyDelegCert StandardCrypto -> + ShelleyDelegCert -> ExceptT SyncNodeError (ReaderT SqlBackend m) () insertDelegCert tracer cache mDeposits network txId idx mRedeemerId epochNo slotNo dCert = case dCert of @@ -132,7 +131,7 @@ insertConwayDelegCert :: Maybe DB.RedeemerId -> EpochNo -> SlotNo -> - ConwayDelegCert StandardCrypto -> + ConwayDelegCert -> ExceptT SyncNodeError (ReaderT SqlBackend m) () insertConwayDelegCert syncEnv mDeposits txId idx mRedeemerId epochNo slotNo dCert = case dCert of @@ -175,7 +174,7 @@ insertMirCert :: Ledger.Network -> DB.TxId -> Word16 -> - MIRCert StandardCrypto -> + MIRCert -> ExceptT SyncNodeError (ReaderT SqlBackend m) () insertMirCert tracer cache network txId idx mcert = do case mirPot mcert of @@ -239,9 +238,9 @@ insertDrepRegistration :: DB.BlockId -> DB.TxId -> Word16 -> - Ledger.Credential 'DRepRole StandardCrypto -> + Ledger.Credential 'DRepRole -> Maybe Coin -> - Maybe (Anchor StandardCrypto) -> + Maybe Anchor -> ReaderT SqlBackend m () insertDrepRegistration blkId txId idx cred mcoin mAnchor = do drepId <- insertCredDrepHash cred @@ -260,7 +259,7 @@ insertDrepDeRegistration :: (MonadBaseControl IO m, MonadIO m) => DB.TxId -> Word16 -> - Ledger.Credential 'DRepRole StandardCrypto -> + Ledger.Credential 'DRepRole -> Coin -> ReaderT SqlBackend m () insertDrepDeRegistration txId idx cred coin = do @@ -279,8 +278,8 @@ insertCommitteeRegistration :: (MonadBaseControl IO m, MonadIO m) => DB.TxId -> Word16 -> - Ledger.Credential 'ColdCommitteeRole StandardCrypto -> - Ledger.Credential 'HotCommitteeRole StandardCrypto -> + Ledger.Credential 'ColdCommitteeRole -> + Ledger.Credential 'HotCommitteeRole -> ReaderT SqlBackend m () insertCommitteeRegistration txId idx khCold cred = do khHotId <- insertCommitteeHash cred @@ -299,8 +298,8 @@ insertCommitteeDeRegistration :: DB.BlockId -> DB.TxId -> Word16 -> - Ledger.Credential 'ColdCommitteeRole StandardCrypto -> - Maybe (Anchor StandardCrypto) -> + Ledger.Credential 'ColdCommitteeRole -> + Maybe Anchor -> ReaderT SqlBackend m () insertCommitteeDeRegistration blockId txId idx khCold mAnchor = do votingAnchorId <- whenMaybe mAnchor $ insertVotingAnchor blockId DB.CommitteeDeRegAnchor @@ -344,7 +343,7 @@ insertStakeRegistration :: Maybe Generic.Deposits -> DB.TxId -> Word16 -> - Shelley.RewardAccount StandardCrypto -> + Shelley.RewardAccount -> ExceptT SyncNodeError (ReaderT SqlBackend m) () insertStakeRegistration tracer cache epochNo mDeposits txId idx rewardAccount = do saId <- lift $ queryOrInsertRewardAccount tracer cache UpdateCache rewardAccount @@ -410,7 +409,7 @@ insertDelegation :: Word16 -> Maybe DB.RedeemerId -> StakeCred -> - Ledger.KeyHash 'Ledger.StakePool StandardCrypto -> + Ledger.KeyHash 'Ledger.StakePool -> ExceptT SyncNodeError (ReaderT SqlBackend m) () insertDelegation trce cache network (EpochNo epoch) slotNo txId idx mRedeemerId cred poolkh = do addrId <- lift $ queryOrInsertStakeAddress trce cache UpdateCacheStrong network cred @@ -434,7 +433,7 @@ insertDelegationVote :: DB.TxId -> Word16 -> StakeCred -> - DRep StandardCrypto -> + DRep -> ExceptT SyncNodeError (ReaderT SqlBackend m) () insertDelegationVote trce cache network txId idx cred drep = do addrId <- lift $ queryOrInsertStakeAddress trce cache UpdateCacheStrong network cred diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/GovAction.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/GovAction.hs index 6de4a5362..365dad7f9 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/GovAction.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/GovAction.hs @@ -64,7 +64,7 @@ import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Data.Map.Strict as Map import qualified Data.Text.Encoding as Text import Database.Persist.Sql (SqlBackend) -import Ouroboros.Consensus.Cardano.Block (StandardConway, StandardCrypto) +import Ouroboros.Consensus.Cardano.Block (ConwayEra) insertGovActionProposal :: forall m. @@ -74,8 +74,8 @@ insertGovActionProposal :: DB.BlockId -> DB.TxId -> Maybe EpochNo -> - Maybe (ConwayGovState StandardConway) -> - (Word64, (GovActionId StandardCrypto, ProposalProcedure StandardConway)) -> + Maybe (ConwayGovState ConwayEra) -> + (Word64, (GovActionId, ProposalProcedure ConwayEra)) -> ExceptT SyncNodeError (ReaderT SqlBackend m) () insertGovActionProposal trce cache blkId txId govExpiresAt mcgs (index, (govId, pp)) = do addrId <- @@ -114,7 +114,7 @@ insertGovActionProposal trce cache blkId txId govExpiresAt mcgs (index, (govId, NewConstitution _ constitution -> lift $ void $ insertConstitution blkId (Just govActionProposalId) constitution _ -> pure () where - mprevGovAction :: Maybe (GovActionId StandardCrypto) = case pProcGovAction pp of + mprevGovAction :: Maybe GovActionId = case pProcGovAction pp of ParameterChange prv _ _ -> unGovPurposeId <$> strictMaybeToMaybe prv HardForkInitiation prv _ -> unGovPurposeId <$> strictMaybeToMaybe prv NoConfidence prv -> unGovPurposeId <$> strictMaybeToMaybe prv @@ -142,7 +142,7 @@ insertGovActionProposal trce cache blkId txId govExpiresAt mcgs (index, (govId, other -> liftIO $ logWarning trce $ textShow other <> ": Failed to find committee for " <> textShow pp -insertCommittee :: (MonadIO m, MonadBaseControl IO m) => Maybe DB.GovActionProposalId -> Committee StandardConway -> ReaderT SqlBackend m DB.CommitteeId +insertCommittee :: (MonadIO m, MonadBaseControl IO m) => Maybe DB.GovActionProposalId -> Committee ConwayEra -> ReaderT SqlBackend m DB.CommitteeId insertCommittee mgapId committee = do committeeId <- insertCommitteeDB mapM_ (insertNewMember committeeId) (Map.toList $ committeeMembers committee) @@ -172,7 +172,7 @@ insertCommittee mgapId committee = do resolveGovActionProposal :: MonadIO m => CacheStatus -> - GovActionId StandardCrypto -> + GovActionId -> ExceptT SyncNodeError (ReaderT SqlBackend m) DB.GovActionProposalId resolveGovActionProposal cache gaId = do let txId = gaidTxId gaId @@ -249,7 +249,7 @@ insertParamProposal blkId txId pp = do , DB.paramProposalMinFeeRefScriptCostPerByte = fromRational <$> pppMinFeeRefScriptCostPerByte pp } -insertConstitution :: (MonadIO m, MonadBaseControl IO m) => DB.BlockId -> Maybe DB.GovActionProposalId -> Constitution StandardConway -> ReaderT SqlBackend m DB.ConstitutionId +insertConstitution :: (MonadIO m, MonadBaseControl IO m) => DB.BlockId -> Maybe DB.GovActionProposalId -> Constitution ConwayEra -> ReaderT SqlBackend m DB.ConstitutionId insertConstitution blockId mgapId constitution = do votingAnchorId <- insertVotingAnchor blockId DB.ConstitutionAnchor $ constitutionAnchor constitution DB.insertConstitution $ @@ -268,7 +268,7 @@ insertVotingProcedures :: CacheStatus -> DB.BlockId -> DB.TxId -> - (Voter StandardCrypto, [(GovActionId StandardCrypto, VotingProcedure StandardConway)]) -> + (Voter, [(GovActionId, VotingProcedure ConwayEra)]) -> ExceptT SyncNodeError (ReaderT SqlBackend m) () insertVotingProcedures trce cache blkId txId (voter, actions) = mapM_ (insertVotingProcedure trce cache blkId txId voter) (zip [0 ..] actions) @@ -279,8 +279,8 @@ insertVotingProcedure :: CacheStatus -> DB.BlockId -> DB.TxId -> - Voter StandardCrypto -> - (Word16, (GovActionId StandardCrypto, VotingProcedure StandardConway)) -> + Voter -> + (Word16, (GovActionId, VotingProcedure ConwayEra)) -> ExceptT SyncNodeError (ReaderT SqlBackend m) () insertVotingProcedure trce cache blkId txId voter (index, (gaId, vp)) = do govActionId <- resolveGovActionProposal cache gaId @@ -311,7 +311,7 @@ insertVotingProcedure trce cache blkId txId voter (index, (gaId, vp)) = do , DB.votingProcedureInvalid = Nothing } -insertVotingAnchor :: (MonadIO m, MonadBaseControl IO m) => DB.BlockId -> DB.AnchorType -> Anchor StandardCrypto -> ReaderT SqlBackend m DB.VotingAnchorId +insertVotingAnchor :: (MonadIO m, MonadBaseControl IO m) => DB.BlockId -> DB.AnchorType -> Anchor -> ReaderT SqlBackend m DB.VotingAnchorId insertVotingAnchor blockId anchorType anchor = DB.insertAnchor $ DB.VotingAnchor @@ -321,7 +321,7 @@ insertVotingAnchor blockId anchorType anchor = , DB.votingAnchorType = anchorType } -insertCommitteeHash :: (MonadBaseControl IO m, MonadIO m) => Ledger.Credential kr StandardCrypto -> ReaderT SqlBackend m DB.CommitteeHashId +insertCommitteeHash :: (MonadBaseControl IO m, MonadIO m) => Ledger.Credential kr -> ReaderT SqlBackend m DB.CommitteeHashId insertCommitteeHash cred = do DB.insertCommitteeHash DB.CommitteeHash @@ -332,13 +332,13 @@ insertCommitteeHash cred = do -------------------------------------------------------------------------------------- -- DREP -------------------------------------------------------------------------------------- -insertDrep :: (MonadBaseControl IO m, MonadIO m) => DRep StandardCrypto -> ReaderT SqlBackend m DB.DrepHashId +insertDrep :: (MonadBaseControl IO m, MonadIO m) => DRep -> ReaderT SqlBackend m DB.DrepHashId insertDrep = \case DRepCredential cred -> insertCredDrepHash cred DRepAlwaysAbstain -> DB.insertAlwaysAbstainDrep DRepAlwaysNoConfidence -> DB.insertAlwaysNoConfidence -insertCredDrepHash :: (MonadBaseControl IO m, MonadIO m) => Ledger.Credential 'DRepRole StandardCrypto -> ReaderT SqlBackend m DB.DrepHashId +insertCredDrepHash :: (MonadBaseControl IO m, MonadIO m) => Ledger.Credential 'DRepRole -> ReaderT SqlBackend m DB.DrepHashId insertCredDrepHash cred = do DB.insertDrepHash DB.DrepHash @@ -349,12 +349,12 @@ insertCredDrepHash cred = do where bs = Generic.unCredentialHash cred -insertDrepDistr :: forall m. (MonadBaseControl IO m, MonadIO m) => EpochNo -> PulsingSnapshot StandardConway -> ReaderT SqlBackend m () +insertDrepDistr :: forall m. (MonadBaseControl IO m, MonadIO m) => EpochNo -> PulsingSnapshot ConwayEra -> ReaderT SqlBackend m () insertDrepDistr e pSnapshot = do drepsDB <- mapM mkEntry (Map.toList $ psDRepDistr pSnapshot) DB.insertManyDrepDistr drepsDB where - mkEntry :: (DRep StandardCrypto, Ledger.CompactForm Coin) -> ReaderT SqlBackend m DB.DrepDistr + mkEntry :: (DRep, Ledger.CompactForm Coin) -> ReaderT SqlBackend m DB.DrepDistr mkEntry (drep, coin) = do drepId <- insertDrep drep pure $ @@ -365,7 +365,7 @@ insertDrepDistr e pSnapshot = do , DB.drepDistrActiveUntil = unEpochNo <$> isActiveEpochNo drep } - isActiveEpochNo :: DRep StandardCrypto -> Maybe EpochNo + isActiveEpochNo :: DRep -> Maybe EpochNo isActiveEpochNo = \case DRepAlwaysAbstain -> Nothing DRepAlwaysNoConfidence -> Nothing @@ -388,7 +388,7 @@ updateRatified :: MonadIO m => CacheStatus -> EpochNo -> - [GovActionState StandardConway] -> + [GovActionState ConwayEra] -> ExceptT SyncNodeError (ReaderT SqlBackend m) () updateRatified cache epochNo ratifiedActions = do forM_ ratifiedActions $ \action -> do @@ -400,7 +400,7 @@ updateExpired :: MonadIO m => CacheStatus -> EpochNo -> - [GovActionId StandardCrypto] -> + [GovActionId] -> ExceptT SyncNodeError (ReaderT SqlBackend m) () updateExpired cache epochNo ratifiedActions = do forM_ ratifiedActions $ \action -> do @@ -412,7 +412,7 @@ updateDropped :: MonadIO m => CacheStatus -> EpochNo -> - [GovActionId StandardCrypto] -> + [GovActionId] -> ExceptT SyncNodeError (ReaderT SqlBackend m) () updateDropped cache epochNo ratifiedActions = do forM_ ratifiedActions $ \action -> do @@ -426,7 +426,7 @@ insertUpdateEnacted :: CacheStatus -> DB.BlockId -> EpochNo -> - ConwayGovState StandardConway -> + ConwayGovState ConwayEra -> ExceptT SyncNodeError (ReaderT SqlBackend m) () insertUpdateEnacted trce cache blkId epochNo enactedState = do (mcommitteeId, mnoConfidenceGaId) <- handleCommittee diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Other.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Other.hs index 4099e8427..7eee027e0 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Other.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Other.hs @@ -37,7 +37,6 @@ import Cardano.Ledger.Mary.Value (AssetName (..), PolicyID (..)) import Cardano.Prelude import Control.Monad.Trans.Control (MonadBaseControl) import Database.Persist.Sql (SqlBackend) -import Ouroboros.Consensus.Cardano.Block (StandardCrypto) -------------------------------------------------------------------------------------------- -- Insert Redeemer @@ -150,7 +149,7 @@ insertStakeAddressRefIfMissing :: (MonadBaseControl IO m, MonadIO m) => Trace IO Text -> CacheStatus -> - Ledger.Addr StandardCrypto -> + Ledger.Addr -> ReaderT SqlBackend m (Maybe DB.StakeAddressId) insertStakeAddressRefIfMissing trce cache addr = case addr of @@ -166,7 +165,7 @@ insertStakeAddressRefIfMissing trce cache addr = insertMultiAsset :: (MonadBaseControl IO m, MonadIO m) => CacheStatus -> - PolicyID StandardCrypto -> + PolicyID -> AssetName -> ReaderT SqlBackend m DB.MultiAssetId insertMultiAsset cache policy aName = do diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Pool.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Pool.hs index 2631c8a6c..cdcd0e609 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Pool.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Pool.hs @@ -42,7 +42,6 @@ import qualified Cardano.Ledger.Shelley.TxBody as Shelley import Cardano.Prelude import Control.Monad.Trans.Control (MonadBaseControl) import Database.Persist.Sql (SqlBackend) -import Ouroboros.Consensus.Cardano.Block (StandardCrypto) type IsPoolMember = PoolKeyHash -> Bool @@ -57,7 +56,7 @@ insertPoolRegister :: DB.BlockId -> DB.TxId -> Word16 -> - PoolP.PoolParams StandardCrypto -> + PoolP.PoolParams -> ExceptT SyncNodeError (ReaderT SqlBackend m) () insertPoolRegister trce cache isMember mdeposits network (EpochNo epoch) blkId txId idx params = do poolHashId <- lift $ insertPoolKeyWithCache cache UpdateCache (PoolP.ppId params) @@ -76,7 +75,7 @@ insertPoolRegister trce cache isMember mdeposits network (EpochNo epoch) blkId t $ DB.PoolUpdate { DB.poolUpdateHashId = poolHashId , DB.poolUpdateCertIndex = idx - , DB.poolUpdateVrfKeyHash = hashToBytes (PoolP.ppVrf params) + , DB.poolUpdateVrfKeyHash = hashToBytes $ Ledger.fromVRFVerKeyHash (PoolP.ppVrf params) , DB.poolUpdatePledge = Generic.coinToDbLovelace (PoolP.ppPledge params) , DB.poolUpdateRewardAddrId = saId , DB.poolUpdateActiveEpochNo = epoch + epochActivationDelay @@ -103,7 +102,7 @@ insertPoolRegister trce cache isMember mdeposits network (EpochNo epoch) blkId t -- Ignore the network in the `RewardAccount` and use the provided one instead. -- This is a workaround for https://github.com/IntersectMBO/cardano-db-sync/issues/546 - adjustNetworkTag :: Ledger.RewardAccount StandardCrypto -> Ledger.RewardAccount StandardCrypto + adjustNetworkTag :: Ledger.RewardAccount -> Ledger.RewardAccount adjustNetworkTag (Shelley.RewardAccount _ cred) = Shelley.RewardAccount network cred insertPoolRetire :: @@ -113,7 +112,7 @@ insertPoolRetire :: CacheStatus -> EpochNo -> Word16 -> - Ledger.KeyHash 'Ledger.StakePool StandardCrypto -> + Ledger.KeyHash 'Ledger.StakePool -> ExceptT SyncNodeError (ReaderT SqlBackend m) () insertPoolRetire trce txId cache epochNum idx keyHash = do poolId <- lift $ queryPoolKeyOrInsert "insertPoolRetire" trce cache UpdateCache True keyHash @@ -147,7 +146,7 @@ insertPoolOwner :: CacheStatus -> Ledger.Network -> DB.PoolUpdateId -> - Ledger.KeyHash 'Ledger.Staking StandardCrypto -> + Ledger.KeyHash 'Ledger.Staking -> ExceptT SyncNodeError (ReaderT SqlBackend m) () insertPoolOwner trce cache network poolUpdateId skh = do saId <- lift $ queryOrInsertStakeAddress trce cache UpdateCacheStrong network (Ledger.KeyHashObj skh) @@ -206,7 +205,7 @@ insertPoolCert :: DB.BlockId -> DB.TxId -> Word16 -> - PoolCert StandardCrypto -> + PoolCert -> ExceptT SyncNodeError (ReaderT SqlBackend m) () insertPoolCert tracer cache isMember mdeposits network epoch blkId txId idx pCert = case pCert of diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Tx.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Tx.hs index 4f12d03a9..48c5b7961 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Tx.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Tx.hs @@ -59,7 +59,6 @@ import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Data.Map.Strict as Map import qualified Data.Strict.Maybe as Strict import Database.Persist.Sql (SqlBackend) -import Ouroboros.Consensus.Cardano.Block (StandardCrypto) -------------------------------------------------------------------------------------- -- INSERT TX @@ -335,21 +334,21 @@ insertMaTxMint :: Trace IO Text -> CacheStatus -> DB.TxId -> - MultiAsset StandardCrypto -> + MultiAsset -> ExceptT SyncNodeError (ReaderT SqlBackend m) [DB.MaTxMint] insertMaTxMint _tracer cache txId (MultiAsset mintMap) = concatMapM (lift . prepareOuter) $ Map.toList mintMap where prepareOuter :: (MonadBaseControl IO m, MonadIO m) => - (PolicyID StandardCrypto, Map AssetName Integer) -> + (PolicyID, Map AssetName Integer) -> ReaderT SqlBackend m [DB.MaTxMint] prepareOuter (policy, aMap) = mapM (prepareInner policy) $ Map.toList aMap prepareInner :: (MonadBaseControl IO m, MonadIO m) => - PolicyID StandardCrypto -> + PolicyID -> (AssetName, Integer) -> ReaderT SqlBackend m DB.MaTxMint prepareInner policy (aname, amount) = do @@ -365,21 +364,21 @@ insertMaTxOuts :: (MonadBaseControl IO m, MonadIO m) => Trace IO Text -> CacheStatus -> - Map (PolicyID StandardCrypto) (Map AssetName Integer) -> + Map PolicyID (Map AssetName Integer) -> ExceptT SyncNodeError (ReaderT SqlBackend m) [MissingMaTxOut] insertMaTxOuts _tracer cache maMap = concatMapM (lift . prepareOuter) $ Map.toList maMap where prepareOuter :: (MonadBaseControl IO m, MonadIO m) => - (PolicyID StandardCrypto, Map AssetName Integer) -> + (PolicyID, Map AssetName Integer) -> ReaderT SqlBackend m [MissingMaTxOut] prepareOuter (policy, aMap) = mapM (prepareInner policy) $ Map.toList aMap prepareInner :: (MonadBaseControl IO m, MonadIO m) => - PolicyID StandardCrypto -> + PolicyID -> (AssetName, Integer) -> ReaderT SqlBackend m MissingMaTxOut prepareInner policy (aname, amount) = do diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Validate.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Validate.hs index d155df128..0a5685185 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Validate.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Validate.hs @@ -16,7 +16,6 @@ import qualified Cardano.DbSync.Era.Shelley.Generic as Generic import Cardano.DbSync.Ledger.Event import Cardano.DbSync.Types import Cardano.Ledger.Coin (Coin (..)) -import Cardano.Ledger.Crypto (StandardCrypto) import Cardano.Ledger.Shelley.API (Network) import qualified Cardano.Ledger.Shelley.Rewards as Ledger import Cardano.Prelude hiding (from, on) @@ -54,7 +53,7 @@ validateEpochRewards :: Network -> EpochNo -> EpochNo -> - Map StakeCred (Set (Ledger.Reward StandardCrypto)) -> + Map StakeCred (Set Ledger.Reward) -> ReaderT SqlBackend m () validateEpochRewards tracer network _earnedEpochNo spendableEpochNo rmap = do actualCount <- Db.queryNormalEpochRewardCount (unEpochNo spendableEpochNo) diff --git a/cardano-db-sync/src/Cardano/DbSync/Error.hs b/cardano-db-sync/src/Cardano/DbSync/Error.hs index e01a3d3ba..0a817f061 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Error.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Error.hs @@ -151,10 +151,10 @@ annotateInvariantTx tx ei = EInvInOut inval outval -> EInvTxInOut tx inval outval _other -> ei -dbSyncNodeError :: (Monad m) => Text -> ExceptT SyncNodeError m a +dbSyncNodeError :: Monad m => Text -> ExceptT SyncNodeError m a dbSyncNodeError = left . SNErrDefault -dbSyncInvariant :: (Monad m) => Text -> SyncInvariant -> ExceptT SyncNodeError m a +dbSyncInvariant :: Monad m => Text -> SyncInvariant -> ExceptT SyncNodeError m a dbSyncInvariant loc = left . SNErrInvariant loc renderSyncInvariant :: SyncInvariant -> Text @@ -174,7 +174,7 @@ renderSyncInvariant ei = , textShow tx ] -fromEitherSTM :: (Exception e) => Either e a -> STM a +fromEitherSTM :: Exception e => Either e a -> STM a fromEitherSTM = either throwSTM return bsBase16Encode :: ByteString -> Text @@ -183,7 +183,7 @@ bsBase16Encode bs = Left _ -> Text.pack $ "UTF-8 decode failed for " ++ Show.show bs Right txt -> txt -runOrThrowIO :: forall e a m. (MonadIO m) => (Exception e) => m (Either e a) -> m a +runOrThrowIO :: forall e a m. MonadIO m => Exception e => m (Either e a) -> m a runOrThrowIO ioEither = do et <- ioEither case et of diff --git a/cardano-db-sync/src/Cardano/DbSync/Ledger/Event.hs b/cardano-db-sync/src/Cardano/DbSync/Ledger/Event.hs index 24c0e8617..74fc98ab9 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Ledger/Event.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Ledger/Event.hs @@ -34,7 +34,7 @@ import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Conway.Governance import Cardano.Ledger.Conway.Rules as Conway import qualified Cardano.Ledger.Core as Ledger -import Cardano.Ledger.SafeHash (SafeHash) +import Cardano.Ledger.Hashes (SafeHash) import Cardano.Ledger.Shelley.API (AdaPots, InstantaneousRewards (..)) import Cardano.Ledger.Shelley.Rules ( RupdEvent (RupdEvent), @@ -72,19 +72,19 @@ data LedgerEvent | LedgerIncrementalRewards !EpochNo !Generic.Rewards | LedgerDeltaRewards !EpochNo !Generic.Rewards | LedgerRestrainedRewards !EpochNo !Generic.Rewards !(Set StakeCred) - | LedgerTotalRewards !EpochNo !(Map StakeCred (Set (Ledger.Reward StandardCrypto))) + | LedgerTotalRewards !EpochNo !(Map StakeCred (Set Ledger.Reward)) | LedgerAdaPots !AdaPots - | LedgerGovInfo [GovActionRefunded] [GovActionRefunded] [GovActionRefunded] (Set (GovActionId StandardCrypto)) - | LedgerDeposits (SafeHash StandardCrypto Ledger.EraIndependentTxBody) Coin + | LedgerGovInfo [GovActionRefunded] [GovActionRefunded] [GovActionRefunded] (Set GovActionId) + | LedgerDeposits (SafeHash Ledger.EraIndependentTxBody) Coin | LedgerStartAtEpoch !EpochNo | LedgerNewEpoch !EpochNo !SyncState deriving (Eq) data GovActionRefunded = GovActionRefunded - { garGovActionId :: GovActionId StandardCrypto + { garGovActionId :: GovActionId , garDeposit :: Coin - , garReturnAddr :: RewardAccount StandardCrypto - , garMTreasury :: Maybe (Map (RewardAccount StandardCrypto) Coin) + , garReturnAddr :: RewardAccount + , garMTreasury :: Maybe (Map RewardAccount Coin) } deriving (Eq) @@ -135,50 +135,49 @@ class ConvertLedgerEvent blk where instance ConvertLedgerEvent ByronBlock where toLedgerEvent _ _ = Nothing -instance ConvertLedgerEvent (ShelleyBlock protocol (ShelleyEra StandardCrypto)) where +instance ConvertLedgerEvent (ShelleyBlock protocol ShelleyEra) where toLedgerEvent hasRewards evt = case unwrapLedgerEvent evt of LEDepositShelley hsh coin -> Just $ LedgerDeposits hsh coin _ -> toLedgerEventShelley evt hasRewards -instance ConvertLedgerEvent (ShelleyBlock protocol (AllegraEra StandardCrypto)) where +instance ConvertLedgerEvent (ShelleyBlock protocol AllegraEra) where toLedgerEvent hasRewards evt = case unwrapLedgerEvent evt of LEDepositAllegra hsh coin -> Just $ LedgerDeposits hsh coin _ -> toLedgerEventShelley evt hasRewards -instance ConvertLedgerEvent (ShelleyBlock protocol (MaryEra StandardCrypto)) where +instance ConvertLedgerEvent (ShelleyBlock protocol MaryEra) where toLedgerEvent hasRewards evt = case unwrapLedgerEvent evt of LEDepositAllegra hsh coin -> Just $ LedgerDeposits hsh coin _ -> toLedgerEventShelley evt hasRewards -instance ConvertLedgerEvent (ShelleyBlock protocol (AlonzoEra StandardCrypto)) where +instance ConvertLedgerEvent (ShelleyBlock protocol AlonzoEra) where toLedgerEvent hasRewards evt = case unwrapLedgerEvent evt of LEDepositsAlonzo hsh coin -> Just $ LedgerDeposits hsh coin _ -> toLedgerEventShelley evt hasRewards -instance ConvertLedgerEvent (ShelleyBlock protocol (BabbageEra StandardCrypto)) where +instance ConvertLedgerEvent (ShelleyBlock protocol BabbageEra) where toLedgerEvent hasRewards evt = case unwrapLedgerEvent evt of LEDepositsAlonzo hsh coin -> Just $ LedgerDeposits hsh coin _ -> toLedgerEventShelley evt hasRewards -instance ConvertLedgerEvent (ShelleyBlock protocol (ConwayEra StandardCrypto)) where +instance ConvertLedgerEvent (ShelleyBlock protocol ConwayEra) where toLedgerEvent hasRewards evt = case unwrapLedgerEvent evt of LEDepositsConway hsh coin -> Just $ LedgerDeposits hsh coin _ -> toLedgerEventConway evt hasRewards toLedgerEventShelley :: - ( EraCrypto ledgerera ~ StandardCrypto - , Event (Ledger.EraRule "TICK" ledgerera) ~ ShelleyTickEvent ledgerera + ( Event (Ledger.EraRule "TICK" ledgerera) ~ ShelleyTickEvent ledgerera , Event (Ledger.EraRule "NEWEPOCH" ledgerera) ~ ShelleyNewEpochEvent ledgerera , Event (Ledger.EraRule "MIR" ledgerera) ~ ShelleyMirEvent ledgerera , Event (Ledger.EraRule "EPOCH" ledgerera) ~ ShelleyEpochEvent ledgerera , Event (Ledger.EraRule "POOLREAP" ledgerera) ~ ShelleyPoolreapEvent ledgerera - , Event (Ledger.EraRule "RUPD" ledgerera) ~ RupdEvent (EraCrypto ledgerera) + , Event (Ledger.EraRule "RUPD" ledgerera) ~ RupdEvent ) => WrapLedgerEvent (ShelleyBlock protocol ledgerera) -> Bool -> @@ -217,12 +216,11 @@ toLedgerEventShelley evt hasRewards = _ -> Nothing toLedgerEventConway :: - ( EraCrypto ledgerera ~ StandardCrypto - , Event (Ledger.EraRule "TICK" ledgerera) ~ ShelleyTickEvent ledgerera + ( Event (Ledger.EraRule "TICK" ledgerera) ~ ShelleyTickEvent ledgerera , Event (Ledger.EraRule "NEWEPOCH" ledgerera) ~ ConwayNewEpochEvent ledgerera , Event (Ledger.EraRule "EPOCH" ledgerera) ~ ConwayEpochEvent ledgerera , Event (Ledger.EraRule "POOLREAP" ledgerera) ~ ShelleyPoolreapEvent ledgerera - , Event (Ledger.EraRule "RUPD" ledgerera) ~ RupdEvent (EraCrypto ledgerera) + , Event (Ledger.EraRule "RUPD" ledgerera) ~ RupdEvent ) => WrapLedgerEvent (ShelleyBlock protocol ledgerera) -> Bool -> @@ -263,7 +261,7 @@ toLedgerEventConway evt hasRewards = (Map.keysSet uncl) _ -> Nothing where - toGovActionRefunded :: EraCrypto era ~ StandardCrypto => GovActionState era -> GovActionRefunded + toGovActionRefunded :: GovActionState era -> GovActionRefunded toGovActionRefunded gas = GovActionRefunded { garGovActionId = gasId gas @@ -332,13 +330,13 @@ mkTreasuryReward c = } convertPoolRewards :: - Map StakeCred (Set (Ledger.Reward StandardCrypto)) -> + Map StakeCred (Set Ledger.Reward) -> Generic.Rewards convertPoolRewards rmap = Generic.Rewards $ map (Set.map convertReward) rmap where - convertReward :: Ledger.Reward StandardCrypto -> Generic.Reward + convertReward :: Ledger.Reward -> Generic.Reward convertReward sr = Generic.Reward { Generic.rewardSource = rewardTypeToSource $ Ledger.rewardType sr @@ -350,14 +348,13 @@ convertPoolRewards rmap = -- Patterns for event access. pattern LEDepositShelley :: - ( EraCrypto ledgerera ~ StandardCrypto - , Event (Ledger.EraRule "BBODY" ledgerera) ~ ShelleyBbodyEvent ledgerera + ( Event (Ledger.EraRule "BBODY" ledgerera) ~ ShelleyBbodyEvent ledgerera , Event (Ledger.EraRule "LEDGERS" ledgerera) ~ ShelleyLedgersEvent ledgerera , Event (Ledger.EraRule "LEDGER" ledgerera) ~ Shelley.ShelleyLedgerEvent ledgerera , Event (Ledger.EraRule "UTXOW" ledgerera) ~ Shelley.ShelleyUtxowEvent ledgerera , Event (Ledger.EraRule "UTXO" ledgerera) ~ Shelley.UtxoEvent ledgerera ) => - SafeHash StandardCrypto Ledger.EraIndependentTxBody -> + SafeHash Ledger.EraIndependentTxBody -> Coin -> AuxLedgerEvent (LedgerState (ShelleyBlock protocol ledgerera)) pattern LEDepositShelley hsh coin <- @@ -373,14 +370,13 @@ pattern LEDepositShelley hsh coin <- ) pattern LEDepositAllegra :: - ( EraCrypto ledgerera ~ StandardCrypto - , Event (Ledger.EraRule "BBODY" ledgerera) ~ ShelleyBbodyEvent ledgerera + ( Event (Ledger.EraRule "BBODY" ledgerera) ~ ShelleyBbodyEvent ledgerera , Event (Ledger.EraRule "LEDGERS" ledgerera) ~ ShelleyLedgersEvent ledgerera , Event (Ledger.EraRule "LEDGER" ledgerera) ~ Shelley.ShelleyLedgerEvent ledgerera , Event (Ledger.EraRule "UTXOW" ledgerera) ~ Shelley.ShelleyUtxowEvent ledgerera , Event (Ledger.EraRule "UTXO" ledgerera) ~ Allegra.AllegraUtxoEvent ledgerera ) => - SafeHash StandardCrypto Ledger.EraIndependentTxBody -> + SafeHash Ledger.EraIndependentTxBody -> Coin -> AuxLedgerEvent (LedgerState (ShelleyBlock protocol ledgerera)) pattern LEDepositAllegra hsh coin <- @@ -396,15 +392,14 @@ pattern LEDepositAllegra hsh coin <- ) pattern LEDepositsAlonzo :: - ( EraCrypto ledgerera ~ StandardCrypto - , Event (Ledger.EraRule "BBODY" ledgerera) ~ Alonzo.AlonzoBbodyEvent ledgerera + ( Event (Ledger.EraRule "BBODY" ledgerera) ~ Alonzo.AlonzoBbodyEvent ledgerera , Event (Ledger.EraRule "LEDGERS" ledgerera) ~ ShelleyLedgersEvent ledgerera , Event (Ledger.EraRule "LEDGER" ledgerera) ~ Shelley.ShelleyLedgerEvent ledgerera , Event (Ledger.EraRule "UTXOW" ledgerera) ~ AlonzoUtxowEvent ledgerera , Event (Ledger.EraRule "UTXO" ledgerera) ~ AlonzoUtxoEvent ledgerera , Event (Ledger.EraRule "UTXOS" ledgerera) ~ Alonzo.AlonzoUtxosEvent ledgerera ) => - SafeHash StandardCrypto Ledger.EraIndependentTxBody -> + SafeHash Ledger.EraIndependentTxBody -> Coin -> AuxLedgerEvent (LedgerState (ShelleyBlock protocol ledgerera)) pattern LEDepositsAlonzo hsh coin <- @@ -426,15 +421,14 @@ pattern LEDepositsAlonzo hsh coin <- ) pattern LEDepositsConway :: - ( EraCrypto ledgerera ~ StandardCrypto - , Event (Ledger.EraRule "BBODY" ledgerera) ~ Alonzo.AlonzoBbodyEvent ledgerera + ( Event (Ledger.EraRule "BBODY" ledgerera) ~ Alonzo.AlonzoBbodyEvent ledgerera , Event (Ledger.EraRule "LEDGERS" ledgerera) ~ ShelleyLedgersEvent ledgerera , Event (Ledger.EraRule "LEDGER" ledgerera) ~ ConwayLedgerEvent ledgerera , Event (Ledger.EraRule "UTXOW" ledgerera) ~ AlonzoUtxowEvent ledgerera , Event (Ledger.EraRule "UTXO" ledgerera) ~ AlonzoUtxoEvent ledgerera , Event (Ledger.EraRule "UTXOS" ledgerera) ~ Conway.ConwayUtxosEvent ledgerera ) => - SafeHash StandardCrypto Ledger.EraIndependentTxBody -> + SafeHash Ledger.EraIndependentTxBody -> Coin -> AuxLedgerEvent (LedgerState (ShelleyBlock protocol ledgerera)) pattern LEDepositsConway hsh coin <- diff --git a/cardano-db-sync/src/Cardano/DbSync/Ledger/State.hs b/cardano-db-sync/src/Cardano/DbSync/Ledger/State.hs index 60bb24f12..cbf90582c 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Ledger/State.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Ledger/State.hs @@ -10,7 +10,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE NoImplicitPrelude #-} #if __GLASGOW_HASKELL__ >= 908 @@ -103,7 +102,7 @@ import Ouroboros.Consensus.Block ( ) import Ouroboros.Consensus.Block.Abstract (ConvertRawHash (..)) import Ouroboros.Consensus.BlockchainTime.WallClock.Types (SystemStart (..)) -import Ouroboros.Consensus.Cardano.Block (LedgerState (..), StandardConway, StandardCrypto) +import Ouroboros.Consensus.Cardano.Block (ConwayEra, LedgerState (..)) import Ouroboros.Consensus.Cardano.CanHardFork () import Ouroboros.Consensus.Config (TopLevelConfig (..), configCodec, configLedger) import Ouroboros.Consensus.HardFork.Abstract @@ -119,6 +118,7 @@ import Ouroboros.Consensus.Ledger.Abstract ( ledgerTipSlot, tickThenReapplyLedgerResult, ) +import Ouroboros.Consensus.Ledger.Basics (ComputeLedgerEvents (..)) import Ouroboros.Consensus.Ledger.Extended (ExtLedgerCfg (..), ExtLedgerState (..)) import qualified Ouroboros.Consensus.Ledger.Extended as Consensus import qualified Ouroboros.Consensus.Node.ProtocolInfo as Consensus @@ -292,14 +292,14 @@ applyBlock env blk = do applyToEpochBlockNo _ _ GenesisEpochBlockNo = EpochBlockNo 0 applyToEpochBlockNo _ _ EBBEpochBlockNo = EpochBlockNo 0 - getDrepState :: ExtLedgerState CardanoBlock -> Maybe (DRepPulsingState StandardConway) + getDrepState :: ExtLedgerState CardanoBlock -> Maybe (DRepPulsingState ConwayEra) getDrepState ls = ls ^? newEpochStateT . Shelley.newEpochStateDRepPulsingStateL finaliseDrepDistr :: ExtLedgerState CardanoBlock -> ExtLedgerState CardanoBlock finaliseDrepDistr ledger = - ledger & newEpochStateT %~ forceDRepPulsingState @StandardConway + ledger & newEpochStateT %~ forceDRepPulsingState @ConwayEra -getGovState :: ExtLedgerState CardanoBlock -> Maybe (ConwayGovState StandardConway) +getGovState :: ExtLedgerState CardanoBlock -> Maybe (ConwayGovState ConwayEra) getGovState ls = case ledgerState ls of LedgerStateConway cls -> Just $ Consensus.shelleyLedgerState cls ^. Shelley.newEpochStateGovStateL @@ -746,17 +746,17 @@ getRegisteredPools st = getRegisteredPoolShelley :: forall p era. - EraCrypto era ~ StandardCrypto => + Shelley.EraCertState era => LedgerState (ShelleyBlock p era) -> Set.Set PoolKeyHash getRegisteredPoolShelley lState = Map.keysSet $ - Shelley.psStakePoolParams $ - Shelley.certPState $ - Shelley.lsCertState $ - Shelley.esLState $ - Shelley.nesEs $ - Consensus.shelleyLedgerState lState + let certState = + Shelley.lsCertState $ + Shelley.esLState $ + Shelley.nesEs $ + Consensus.shelleyLedgerState lState + in Shelley.psStakePoolParams $ certState ^. Shelley.certPStateL ledgerEpochNo :: HasLedgerEnv -> ExtLedgerState CardanoBlock -> Either SyncNodeError (Maybe EpochNo) ledgerEpochNo env cls = @@ -779,7 +779,7 @@ tickThenReapplyCheckHash :: Either SyncNodeError (LedgerResult (ExtLedgerState CardanoBlock) (ExtLedgerState CardanoBlock)) tickThenReapplyCheckHash cfg block lsb = if blockPrevHash block == ledgerTipHash (ledgerState lsb) - then Right $ tickThenReapplyLedgerResult cfg block lsb + then Right $ tickThenReapplyLedgerResult ComputeLedgerEvents cfg block lsb else Left $ SNErrLedgerState $ @@ -862,7 +862,7 @@ findAdaPots = go -- | Given an committee action id and the current GovState, return the proposed committee. -- If it's not a Committee action or is not included in the proposals, return Nothing. -findProposedCommittee :: GovActionId StandardCrypto -> ConwayGovState StandardConway -> Either Text (Maybe (Committee StandardConway)) +findProposedCommittee :: GovActionId -> ConwayGovState ConwayEra -> Either Text (Maybe (Committee ConwayEra)) findProposedCommittee gaId cgs = do (rootCommittee, updateList) <- findRoot gaId computeCommittee rootCommittee updateList @@ -870,7 +870,7 @@ findProposedCommittee gaId cgs = do ps = cgsProposals cgs findRoot = findRootRecursively [] - findRootRecursively :: [GovAction StandardConway] -> GovActionId StandardCrypto -> Either Text (StrictMaybe (Committee StandardConway), [GovAction StandardConway]) + findRootRecursively :: [GovAction ConwayEra] -> GovActionId -> Either Text (StrictMaybe (Committee ConwayEra), [GovAction ConwayEra]) findRootRecursively acc gid = do gas <- fromNothing ("Didn't find proposal " <> textShow gid) $ proposalsLookupId gid ps let ga = pProcGovAction (gasProposalProcedure gas) @@ -883,7 +883,7 @@ findProposedCommittee gaId cgs = do UpdateCommittee (Ledger.SJust gpid) _ _ _ -> findRootRecursively (ga : acc) (unGovPurposeId gpid) _ -> Left "Found invalid gov action referenced by committee" - computeCommittee :: StrictMaybe (Committee StandardConway) -> [GovAction StandardConway] -> Either Text (Maybe (Committee StandardConway)) + computeCommittee :: StrictMaybe (Committee ConwayEra) -> [GovAction ConwayEra] -> Either Text (Maybe (Committee ConwayEra)) computeCommittee sCommittee actions = Ledger.strictMaybeToMaybe <$> foldM applyCommitteeUpdate sCommittee actions diff --git a/cardano-db-sync/src/Cardano/DbSync/Ledger/Types.hs b/cardano-db-sync/src/Cardano/DbSync/Ledger/Types.hs index 282c833ef..b0a98d5b0 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Ledger/Types.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Ledger/Types.hs @@ -142,7 +142,7 @@ data ApplyResult = ApplyResult , apSlotDetails :: !SlotDetails , apStakeSlice :: !Generic.StakeSliceRes , apEvents :: ![LedgerEvent] - , apGovActionState :: !(Maybe (ConwayGovState StandardConway)) + , apGovActionState :: !(Maybe (ConwayGovState ConwayEra)) , apDepositsMap :: !DepositsMap } @@ -169,11 +169,11 @@ getGovExpiresAt applyResult e = case apGovExpiresAfter applyResult of -- TODO reuse this function rom ledger after it's exported. updatedCommittee :: - Set.Set (Credential 'ColdCommitteeRole StandardCrypto) -> - Map.Map (Credential 'ColdCommitteeRole StandardCrypto) EpochNo -> + Set.Set (Credential 'ColdCommitteeRole) -> + Map.Map (Credential 'ColdCommitteeRole) EpochNo -> Ledger.UnitInterval -> - Ledger.StrictMaybe (Committee StandardConway) -> - Committee StandardConway + Ledger.StrictMaybe (Committee ConwayEra) -> + Committee ConwayEra updatedCommittee membersToRemove membersToAdd newQuorum committee = case committee of Ledger.SNothing -> Committee membersToAdd newQuorum @@ -208,7 +208,7 @@ class HasNewEpochState era where ExtLedgerState CardanoBlock -> ExtLedgerState CardanoBlock -instance HasNewEpochState StandardShelley where +instance HasNewEpochState ShelleyEra where getNewEpochState st = case ledgerState st of LedgerStateShelley shelley -> Just (shelleyLedgerState shelley) _ -> Nothing @@ -217,7 +217,7 @@ instance HasNewEpochState StandardShelley where hApplyExtLedgerState $ fn (applyNewEpochState' st) :* fn id :* fn id :* fn id :* fn id :* fn id :* Nil -instance HasNewEpochState StandardAllegra where +instance HasNewEpochState AllegraEra where getNewEpochState st = case ledgerState st of LedgerStateAllegra allegra -> Just (shelleyLedgerState allegra) _ -> Nothing @@ -226,7 +226,7 @@ instance HasNewEpochState StandardAllegra where hApplyExtLedgerState $ fn id :* fn (applyNewEpochState' st) :* fn id :* fn id :* fn id :* fn id :* Nil -instance HasNewEpochState StandardMary where +instance HasNewEpochState MaryEra where getNewEpochState st = case ledgerState st of LedgerStateMary mary -> Just (shelleyLedgerState mary) _ -> Nothing @@ -235,7 +235,7 @@ instance HasNewEpochState StandardMary where hApplyExtLedgerState $ fn id :* fn id :* fn (applyNewEpochState' st) :* fn id :* fn id :* fn id :* Nil -instance HasNewEpochState StandardAlonzo where +instance HasNewEpochState AlonzoEra where getNewEpochState st = case ledgerState st of LedgerStateAlonzo alonzo -> Just (shelleyLedgerState alonzo) _ -> Nothing @@ -244,7 +244,7 @@ instance HasNewEpochState StandardAlonzo where hApplyExtLedgerState $ fn id :* fn id :* fn id :* fn (applyNewEpochState' st) :* fn id :* fn id :* Nil -instance HasNewEpochState StandardBabbage where +instance HasNewEpochState BabbageEra where getNewEpochState st = case ledgerState st of LedgerStateBabbage babbage -> Just (shelleyLedgerState babbage) _ -> Nothing @@ -253,7 +253,7 @@ instance HasNewEpochState StandardBabbage where hApplyExtLedgerState $ fn id :* fn id :* fn id :* fn id :* fn (applyNewEpochState' st) :* fn id :* Nil -instance HasNewEpochState StandardConway where +instance HasNewEpochState ConwayEra where getNewEpochState st = case ledgerState st of LedgerStateConway conway -> Just (shelleyLedgerState conway) _ -> Nothing diff --git a/cardano-db-sync/src/Cardano/DbSync/LocalStateQuery.hs b/cardano-db-sync/src/Cardano/DbSync/LocalStateQuery.hs index 11d31ad2b..60213d335 100644 --- a/cardano-db-sync/src/Cardano/DbSync/LocalStateQuery.hs +++ b/cardano-db-sync/src/Cardano/DbSync/LocalStateQuery.hs @@ -15,7 +15,6 @@ import Cardano.DbSync.Error (SyncNodeError (..)) import Cardano.DbSync.StateQuery import Cardano.DbSync.Types import qualified Cardano.Ledger.BaseTypes as Ledger -import Cardano.Ledger.Crypto (StandardCrypto) import Cardano.Prelude hiding (atomically, (.)) import Cardano.Slotting.Slot (SlotNo (..)) import Control.Concurrent.Class.MonadSTM.Strict ( @@ -32,7 +31,7 @@ import Control.Concurrent.Class.MonadSTM.Strict ( import qualified Data.Strict.Maybe as Strict import Data.Time.Clock (getCurrentTime) import Ouroboros.Consensus.BlockchainTime.WallClock.Types (SystemStart (..)) -import Ouroboros.Consensus.Cardano.Block (BlockQuery (QueryHardFork), CardanoEras) +import Ouroboros.Consensus.Cardano.Block (BlockQuery (QueryHardFork), CardanoEras, StandardCrypto) import Ouroboros.Consensus.Cardano.Node () import Ouroboros.Consensus.HardFork.Combinator.Ledger.Query ( QueryHardFork (GetInterpreter), diff --git a/cardano-db-sync/src/Cardano/DbSync/OffChain/Vote/Types.hs b/cardano-db-sync/src/Cardano/DbSync/OffChain/Vote/Types.hs index f98544bfa..5fbd453ec 100644 --- a/cardano-db-sync/src/Cardano/DbSync/OffChain/Vote/Types.hs +++ b/cardano-db-sync/src/Cardano/DbSync/OffChain/Vote/Types.hs @@ -110,7 +110,7 @@ newtype TextValue = TextValue {textValue :: Text} instance Show TextValue where show = show . textValue -deriving instance (Show (Body tp)) => Show (OffChainVoteDataTp tp) +deriving instance Show (Body tp) => Show (OffChainVoteDataTp tp) deriving instance Generic (OffChainVoteDataTp tp) data Author = Author diff --git a/cardano-db-sync/src/Cardano/DbSync/Sync.hs b/cardano-db-sync/src/Cardano/DbSync/Sync.hs index e8724185d..9dd91441c 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Sync.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Sync.hs @@ -1,6 +1,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -23,10 +24,10 @@ module Cardano.DbSync.Sync ( runSyncNodeClient, ) where -import Cardano.BM.Data.Tracer (ToLogObject (..), ToObject) +import Cardano.BM.Data.Tracer (ToLogObject (..)) import Cardano.BM.Trace (Trace, appendName, logInfo) import qualified Cardano.BM.Trace as Logging -import Cardano.Client.Subscription (subscribe) +import Cardano.Client.Subscription (Decision (..), MuxTrace, SubscriptionParams (..), SubscriptionTrace, SubscriptionTracers (..), subscribe) import Cardano.DbSync.Api import Cardano.DbSync.Api.Types (ConsistentLevel (..), LedgerEnv (..), SyncEnv (..), envLedgerEnv, envNetworkMagic, envOptions) import Cardano.DbSync.Config @@ -40,14 +41,15 @@ import Cardano.DbSync.Util import Cardano.Prelude hiding (Meta, Nat, (%)) import Cardano.Slotting.Slot (WithOrigin (..)) import qualified Codec.CBOR.Term as CBOR +import Control.Concurrent.Async (AsyncCancelled (..)) import Control.Tracer (Tracer) import qualified Data.ByteString.Lazy as BSL import Data.Functor.Contravariant (contramap) import qualified Data.List as List import qualified Data.Text as Text -import Network.Mux (MuxTrace, WithMuxBearer) -import Network.Mux.Types (MuxMode (..)) -import Network.TypedProtocol.Pipelined (N (..), Nat (Succ, Zero)) +import qualified Network.Mux as Mux +import Network.TypedProtocol.Peer (N (..), Nat (..)) + import Ouroboros.Consensus.Block.Abstract (CodecConfig) import Ouroboros.Consensus.Byron.Node () import Ouroboros.Consensus.Cardano.Node () @@ -59,7 +61,6 @@ import Ouroboros.Consensus.Network.NodeToClient ( cTxSubmissionCodec, clientCodecs, ) -import Ouroboros.Consensus.Node.ErrorPolicy import Ouroboros.Consensus.Node.NetworkProtocolVersion (BlockNodeToClientVersion, supportedNodeToClientVersions) import Ouroboros.Network.Block ( BlockNo (..), @@ -70,23 +71,19 @@ import Ouroboros.Network.Block ( getTipBlockNo, ) import Ouroboros.Network.Driver.Simple (runPipelinedPeer) -import Ouroboros.Network.Mux (MiniProtocolCb (..), RunMiniProtocol (..), RunMiniProtocolWithMinimalCtx, mkMiniProtocolCbFromPeer) +import Ouroboros.Network.Mux (MiniProtocolCb (..), RunMiniProtocol (..), RunMiniProtocolWithMinimalCtx) +import qualified Ouroboros.Network.Mux as Mux import Ouroboros.Network.NodeToClient ( - ClientSubscriptionParams (..), ConnectionId, - ErrorPolicyTrace (..), Handshake, IOManager, LocalAddress, - NetworkSubscriptionTracers (..), NodeToClientProtocols (..), TraceSendRecv, - WithAddr (..), localSnocket, localStateQueryPeerNull, localTxMonitorPeerNull, localTxSubmissionPeerNull, - networkErrorPolicies, ) import qualified Ouroboros.Network.NodeToClient.Version as Network import Ouroboros.Network.Protocol.ChainSync.ClientPipelined ( @@ -108,8 +105,8 @@ import Ouroboros.Network.Protocol.ChainSync.PipelineDecision ( ) import Ouroboros.Network.Protocol.ChainSync.Type (ChainSync) import Ouroboros.Network.Protocol.LocalStateQuery.Client (localStateQueryClientPeer) +import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQuery import qualified Ouroboros.Network.Snocket as Snocket -import Ouroboros.Network.Subscription (SubscriptionTrace) runSyncNodeClient :: MetricSetters -> @@ -126,8 +123,8 @@ runSyncNodeClient metricsSetters syncEnv iomgr trce tc (SocketPath socketPath) = (localSnocket iomgr) (envNetworkMagic syncEnv) (supportedNodeToClientVersions (Proxy @CardanoBlock)) - networkSubscriptionTracers - clientSubscriptionParams + subscriptionTracers + subscriptionParams (dbSyncProtocols syncEnv metricsSetters tc codecConfig) where codecConfig :: CodecConfig CardanoBlock @@ -136,34 +133,35 @@ runSyncNodeClient metricsSetters syncEnv iomgr trce tc (SocketPath socketPath) = -- nonExperimentalVersions = -- filter (\a -> Just a <= snd (lastReleasedNodeVersion Proxy)) $ supportedNodeToClientVersions (Proxy @CardanoBlock) - clientSubscriptionParams = - ClientSubscriptionParams - { cspAddress = Snocket.localAddressFromPath socketPath - , cspConnectionAttemptDelay = Nothing - , cspErrorPolicies = networkErrorPolicies <> consensusErrorPolicy (Proxy @CardanoBlock) + subscriptionParams = + SubscriptionParams + { spAddress = Snocket.localAddressFromPath socketPath + , spReconnectionDelay = Nothing + , spCompleteCb = \case + Left e -> + case fromException e of + Just AsyncCancelled -> Abort + _other -> Reconnect + Right _ -> Reconnect } - networkSubscriptionTracers = - NetworkSubscriptionTracers - { nsMuxTracer = muxTracer - , nsHandshakeTracer = handshakeTracer - , nsErrorPolicyTracer = errorPolicyTracer - , nsSubscriptionTracer = subscriptionTracer + subscriptionTracers = + SubscriptionTracers + { stMuxTracer = muxTracer + , stHandshakeTracer = handshakeTracer + , stSubscriptionTracer = subscriptionTracer } - errorPolicyTracer :: Tracer IO (WithAddr LocalAddress ErrorPolicyTrace) - errorPolicyTracer = toLogObject $ appendName "ErrorPolicy" trce - - muxTracer :: (Show peer, ToObject peer) => Tracer IO (WithMuxBearer peer MuxTrace) + muxTracer :: Tracer IO (Mux.WithBearer (ConnectionId LocalAddress) MuxTrace) muxTracer = toLogObject $ appendName "Mux" trce - subscriptionTracer :: Tracer IO (Identity (SubscriptionTrace LocalAddress)) + subscriptionTracer :: Tracer IO (SubscriptionTrace ()) subscriptionTracer = toLogObject $ appendName "Subscription" trce handshakeTracer :: Tracer IO - ( WithMuxBearer + ( Mux.WithBearer (ConnectionId LocalAddress) (TraceSendRecv (Handshake Network.NodeToClientVersion CBOR.Term)) ) @@ -176,7 +174,7 @@ dbSyncProtocols :: CodecConfig CardanoBlock -> Network.NodeToClientVersion -> BlockNodeToClientVersion CardanoBlock -> - NodeToClientProtocols 'InitiatorMode LocalAddress BSL.ByteString IO () Void + NodeToClientProtocols 'Mux.InitiatorMode LocalAddress BSL.ByteString IO () Void dbSyncProtocols syncEnv metricsSetters tc codecConfig version bversion = NodeToClientProtocols { localChainSyncProtocol = localChainSyncPtcl @@ -184,7 +182,7 @@ dbSyncProtocols syncEnv metricsSetters tc codecConfig version bversion = , localStateQueryProtocol = localStateQuery , localTxMonitorProtocol = InitiatorProtocolOnly $ - mkMiniProtocolCbFromPeer $ + Mux.mkMiniProtocolCbFromPeer $ const (Logging.nullTracer, cTxMonitorCodec codecs, localTxMonitorPeerNull) } @@ -197,7 +195,7 @@ dbSyncProtocols syncEnv metricsSetters tc codecConfig version bversion = tracer :: Trace IO Text tracer = getTrace syncEnv - localChainSyncPtcl :: RunMiniProtocolWithMinimalCtx 'InitiatorMode LocalAddress BSL.ByteString IO () Void + localChainSyncPtcl :: RunMiniProtocolWithMinimalCtx 'Mux.InitiatorMode LocalAddress BSL.ByteString IO () Void localChainSyncPtcl = InitiatorProtocolOnly $ MiniProtocolCb $ \_ctx channel -> liftIO . logException tracer "ChainSyncWithBlocksPtcl: " $ do @@ -227,33 +225,35 @@ dbSyncProtocols syncEnv metricsSetters tc codecConfig version bversion = -- would like to restart a protocol on the same mux and thus bearer). pure ((), Nothing) - dummylocalTxSubmit :: RunMiniProtocolWithMinimalCtx 'InitiatorMode LocalAddress BSL.ByteString IO () Void + dummylocalTxSubmit :: RunMiniProtocolWithMinimalCtx 'Mux.InitiatorMode LocalAddress BSL.ByteString IO () Void dummylocalTxSubmit = InitiatorProtocolOnly $ - mkMiniProtocolCbFromPeer $ + Mux.mkMiniProtocolCbFromPeer $ const ( Logging.nullTracer , cTxSubmissionCodec codecs , localTxSubmissionPeerNull ) - localStateQuery :: RunMiniProtocolWithMinimalCtx 'InitiatorMode LocalAddress BSL.ByteString IO () Void + localStateQuery :: RunMiniProtocolWithMinimalCtx 'Mux.InitiatorMode LocalAddress BSL.ByteString IO () Void localStateQuery = case envLedgerEnv syncEnv of HasLedger _ -> InitiatorProtocolOnly $ - mkMiniProtocolCbFromPeer $ + Mux.mkMiniProtocolCbFromPeerSt $ const ( Logging.nullTracer , cStateQueryCodec codecs + , LocalStateQuery.StateIdle , localStateQueryPeerNull ) NoLedger nle -> InitiatorProtocolOnly $ - mkMiniProtocolCbFromPeer $ + Mux.mkMiniProtocolCbFromPeerSt $ const ( contramap (Text.pack . show) . toLogObject $ appendName "local-state-query" tracer , cStateQueryCodec codecs + , LocalStateQuery.StateIdle , localStateQueryClientPeer $ localStateQueryHandler nle ) diff --git a/cardano-db-sync/src/Cardano/DbSync/Tracing/ToObjectOrphans.hs b/cardano-db-sync/src/Cardano/DbSync/Tracing/ToObjectOrphans.hs index 982e4cb07..10d22b067 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Tracing/ToObjectOrphans.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Tracing/ToObjectOrphans.hs @@ -5,7 +5,9 @@ module Cardano.DbSync.Tracing.ToObjectOrphans () where +import Cardano.BM.Data.Severity (Severity (..)) import Cardano.BM.Data.Tracer +import Cardano.Client.Subscription (SubscriptionTrace (..)) import Cardano.Tracing.OrphanInstances.Network () import Data.Aeson ((.=)) import Data.Text (Text) @@ -27,3 +29,33 @@ instance ToObject ByronBlock where instance Transformable Text IO (TraceSendRecv (ChainSync blk (Point blk) (Tip blk))) where trTransformer = trStructuredText + +instance HasPrivacyAnnotation (SubscriptionTrace a) +instance HasSeverityAnnotation (SubscriptionTrace a) where + getSeverityAnnotation (SubscriptionResult _) = Info + getSeverityAnnotation (SubscriptionError _) = Error + getSeverityAnnotation SubscriptionReconnect = Debug + getSeverityAnnotation SubscriptionTerminate = Debug +instance Show a => ToObject (SubscriptionTrace a) where + toObject _verb (SubscriptionResult result) = + mconcat + [ "kind" .= ("SubscriptionResult" :: String) + , "result" .= show result + ] + toObject _verb (SubscriptionError err) = + mconcat + [ "kind" .= ("SubscriptionError" :: String) + , "error" .= show err + ] + toObject _verb SubscriptionReconnect = + mconcat + [ "kind" .= ("SubscriptionReconnect" :: String) + ] + toObject _verb SubscriptionTerminate = + mconcat + [ "kind" .= ("SubscriptionTerminate" :: String) + ] +instance HasTextFormatter (SubscriptionTrace a) where + formatText _ = Text.pack . show +instance Show a => Transformable Text IO (SubscriptionTrace a) where + trTransformer = trStructuredText diff --git a/cardano-db-sync/src/Cardano/DbSync/Types.hs b/cardano-db-sync/src/Cardano/DbSync/Types.hs index 3460bfb36..90b9bc5e3 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Types.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Types.hs @@ -52,7 +52,6 @@ import Cardano.Db ( import qualified Cardano.Db as DB import qualified Cardano.DbSync.OffChain.Vote.Types as Vote import qualified Cardano.Ledger.Credential as Ledger -import Cardano.Ledger.Crypto (StandardCrypto) import qualified Cardano.Ledger.Hashes as Ledger import Cardano.Ledger.Keys @@ -61,6 +60,7 @@ import Cardano.Slotting.Slot (EpochNo (..), EpochSize (..), SlotNo (..)) import qualified Data.Text as Text import Data.Time.Clock (UTCTime) import Data.Time.Clock.POSIX (POSIXTime) +import Ouroboros.Consensus.Cardano.Block (StandardCrypto) import qualified Ouroboros.Consensus.Cardano.Block as Cardano import qualified Ouroboros.Consensus.HardFork.History as History import Ouroboros.Consensus.Protocol.Praos (Praos) @@ -69,9 +69,9 @@ import Ouroboros.Consensus.Shelley.Protocol.Praos () import Ouroboros.Consensus.Shelley.Protocol.TPraos () import Ouroboros.Network.Block (BlockNo, Point) -type TPraosStandard = TPraos StandardCrypto +type TPraosStandard = TPraos -type PraosStandard = Praos StandardCrypto +type PraosStandard = Praos type CardanoBlock = Cardano.CardanoBlock StandardCrypto @@ -80,11 +80,11 @@ type CardanoInterpreter = type CardanoPoint = Point CardanoBlock -type StakeCred = Ledger.StakeCredential StandardCrypto +type StakeCred = Ledger.StakeCredential -type PoolKeyHash = KeyHash 'StakePool StandardCrypto +type PoolKeyHash = KeyHash 'StakePool -type DataHash = Ledger.DataHash StandardCrypto +type DataHash = Ledger.DataHash data BlockDetails = BlockDetails { bdBlock :: !CardanoBlock diff --git a/cardano-db-sync/src/Cardano/DbSync/Util.hs b/cardano-db-sync/src/Cardano/DbSync/Util.hs index ef0523828..f0a3aadc2 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Util.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Util.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE NoImplicitPrelude #-} @@ -63,6 +64,9 @@ import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Data.Time.Clock as Time import Ouroboros.Consensus.Block.Abstract (ConvertRawHash (..)) +import Ouroboros.Consensus.Cardano.Block (StandardCrypto) +import qualified Ouroboros.Consensus.Cardano.Block as Consensus +import Ouroboros.Consensus.Cardano.CanHardFork () import Ouroboros.Consensus.Protocol.Praos () import Ouroboros.Consensus.Shelley.HFEras () import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol () @@ -70,7 +74,7 @@ import Ouroboros.Network.Block (blockSlot, getPoint) import qualified Ouroboros.Network.Point as Point import Text.Show.Pretty (ppShow) -cardanoBlockSlotNo :: CardanoBlock -> SlotNo +cardanoBlockSlotNo :: Consensus.CardanoBlock StandardCrypto -> SlotNo cardanoBlockSlotNo = blockSlot fmap3 :: (Functor f, Functor g, Functor h) => (a -> b) -> f (g (h a)) -> f (g (h b)) diff --git a/cardano-db-sync/src/Cardano/DbSync/Util/Address.hs b/cardano-db-sync/src/Cardano/DbSync/Util/Address.hs index dbcf0d2ed..b6f8bd7e3 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Util/Address.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Util/Address.hs @@ -13,33 +13,31 @@ import qualified Cardano.Ledger.Address as Address import Cardano.Ledger.Api.Tx.Address (decodeAddrLenient) import Cardano.Ledger.BaseTypes (Network (..)) import Cardano.Ledger.Credential (PaymentCredential (), StakeReference (..)) -import Cardano.Ledger.Crypto (Crypto ()) import Cardano.Prelude import Data.ByteString.Base58 (bitcoinAlphabet, decodeBase58, encodeBase58) -import Ouroboros.Consensus.Cardano.Block (StandardCrypto) import Prelude () -- | Serialise a UTxO address. Byron era addresses serialise to base58 and -- Shelley era addresses serialise to bech32 -serialiseAddress :: Address.Addr StandardCrypto -> Text +serialiseAddress :: Address.Addr -> Text serialiseAddress (Address.AddrBootstrap addr) = serialiseByronAddress addr serialiseAddress (Address.Addr net payCred stakeRef) = serialiseShelleyAddress net payCred stakeRef -- | Deserialise a UTxO Byron era address from base58 -deserialiseByronAddress :: Crypto c => Text -> Maybe (Address.Addr c) +deserialiseByronAddress :: Text -> Maybe Address.Addr deserialiseByronAddress base58 = decodeAddrLenient =<< rawBytes where rawBytes = decodeBase58 bitcoinAlphabet $ encodeUtf8 base58 -- | Deserialise a UTxO Shelley era address from bech32 -deserialiseShelleyAddress :: Crypto c => Text -> Maybe (Address.Addr c) +deserialiseShelleyAddress :: Text -> Maybe Address.Addr deserialiseShelleyAddress bech32 = decodeAddrLenient =<< rawBytes where rawBytes = rightToMaybe $ deserialiseFromBech32 bech32 -- | Serialise a Shelley era stake address to bech32 -serialiseRewardAccount :: Address.RewardAccount StandardCrypto -> Text +serialiseRewardAccount :: Address.RewardAccount -> Text serialiseRewardAccount acnt@(Address.RewardAccount net _) = serialiseToBech32 (prefix net) (Address.serialiseRewardAccount acnt) where @@ -47,12 +45,12 @@ serialiseRewardAccount acnt@(Address.RewardAccount net _) = prefix Testnet = "stake_test" -- | Deserialise a Shelley era stake address from bech32 -deserialiseRewardAccount :: Crypto c => Text -> Maybe (Address.RewardAccount c) +deserialiseRewardAccount :: Text -> Maybe Address.RewardAccount deserialiseRewardAccount bech32 = Address.deserialiseRewardAccount =<< rawBytes where rawBytes = rightToMaybe $ deserialiseFromBech32 bech32 -serialiseByronAddress :: Address.BootstrapAddress c -> Text +serialiseByronAddress :: Address.BootstrapAddress -> Text serialiseByronAddress addr = decodeUtf8 base58 where rawBytes = Address.serialiseAddr $ Address.AddrBootstrap addr @@ -60,8 +58,8 @@ serialiseByronAddress addr = decodeUtf8 base58 serialiseShelleyAddress :: Network -> - PaymentCredential c -> - StakeReference c -> + PaymentCredential -> + StakeReference -> Text serialiseShelleyAddress net payCred stakeRef = serialiseToBech32 (prefix net) (Address.serialiseAddr addr) diff --git a/cardano-db-sync/src/Cardano/DbSync/Util/Bech32.hs b/cardano-db-sync/src/Cardano/DbSync/Util/Bech32.hs index 6b600b515..4d9a02e30 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Util/Bech32.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Util/Bech32.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} module Cardano.DbSync.Util.Bech32 ( @@ -12,11 +13,11 @@ module Cardano.DbSync.Util.Bech32 ( ) where import Cardano.Crypto.Hash.Class (hashFromBytes, hashToBytes) -import Cardano.Crypto.VRF.Class (rawDeserialiseVerKeyVRF, rawSerialiseVerKeyVRF) -import Cardano.Ledger.Crypto (StandardCrypto ()) -import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..), VerKeyVRF ()) +import Cardano.Crypto.VRF.Class (VerKeyVRF, rawDeserialiseVerKeyVRF, rawSerialiseVerKeyVRF) +import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..)) import Cardano.Prelude -import Codec.Binary.Bech32 +import Cardano.Protocol.Crypto (StandardCrypto, VRF) +import Codec.Binary.Bech32 (DecodingError, dataPartFromBytes, dataPartToBytes, decodeLenient, encodeLenient, humanReadablePartFromText) import Prelude (id) -- | Wrap Bech32 deserialisation errors @@ -48,37 +49,39 @@ deserialiseFromBech32 s = decodeLenient' s >>= dataPartToBytes' dataPartToBytes' d = maybeToEither DataPartToBytesError $ dataPartToBytes d -- | Serialise a Verification Key to bech32 address -serialiseVerKeyVrfToBech32 :: VerKeyVRF StandardCrypto -> Text +serialiseVerKeyVrfToBech32 :: VerKeyVRF (VRF StandardCrypto) -> Text serialiseVerKeyVrfToBech32 = serialiseToBech32 "vrf_vk" . rawSerialiseVerKeyVRF +-- deriving instance VRFAlgorithm (VRF PraosVRF) + -- | Deserialise a bech32 address to a Verification Key -deserialiseVerKeyVrfFromBech32 :: Text -> Either DecodeError (VerKeyVRF StandardCrypto) +deserialiseVerKeyVrfFromBech32 :: Text -> Either DecodeError (VerKeyVRF (VRF StandardCrypto)) deserialiseVerKeyVrfFromBech32 text = deserialiseFromBech32 text >>= deserialiseFromRawBytes' where - deserialiseFromRawBytes' :: ByteString -> Either DecodeError (VerKeyVRF StandardCrypto) + deserialiseFromRawBytes' :: ByteString -> Either DecodeError (VerKeyVRF (VRF StandardCrypto)) deserialiseFromRawBytes' = maybeToRight DecodeFromRawBytesError . rawDeserialiseVerKeyVRF -- | Serialise stake pool key hash to a bech32 address -serialiseStakePoolKeyHashToBech32 :: KeyHash 'StakePool StandardCrypto -> Text +serialiseStakePoolKeyHashToBech32 :: KeyHash 'StakePool -> Text serialiseStakePoolKeyHashToBech32 (KeyHash hash) = serialiseToBech32 "pool" $ hashToBytes hash -- | Deserialise a bech32 address to a stake pool key hash deserialiseStakePoolKeyHashFromBech32 :: Text -> - Either DecodeError (KeyHash 'StakePool StandardCrypto) + Either DecodeError (KeyHash 'StakePool) deserialiseStakePoolKeyHashFromBech32 text = deserialiseFromBech32 text >>= deserialiseFromRawBytes' where deserialiseFromRawBytes' :: ByteString -> - Either DecodeError (KeyHash 'StakePool StandardCrypto) + Either DecodeError (KeyHash 'StakePool) deserialiseFromRawBytes' bytes = maybeToRight DecodeFromRawBytesError $ hashFromBytes' bytes - hashFromBytes' :: ByteString -> Maybe (KeyHash 'StakePool StandardCrypto) + hashFromBytes' :: ByteString -> Maybe (KeyHash 'StakePool) hashFromBytes' bytes = KeyHash <$> hashFromBytes bytes -- | Serialise drep bech32 address diff --git a/cardano-db-sync/test/Cardano/DbSync/Era/Shelley/Generic/ScriptDataTest.hs b/cardano-db-sync/test/Cardano/DbSync/Era/Shelley/Generic/ScriptDataTest.hs index 0c154891c..8870e4952 100644 --- a/cardano-db-sync/test/Cardano/DbSync/Era/Shelley/Generic/ScriptDataTest.hs +++ b/cardano-db-sync/test/Cardano/DbSync/Era/Shelley/Generic/ScriptDataTest.hs @@ -4,7 +4,7 @@ module Cardano.DbSync.Era.Shelley.Generic.ScriptDataTest (tests) where import Cardano.DbSync.Era.Shelley.Generic.ScriptData -import Cardano.Ledger.Api (Shelley ()) +import Cardano.Ledger.Api (ShelleyEra) import Cardano.Ledger.Binary.Decoding import Cardano.Ledger.Plutus.Data (Data (..)) import qualified Cardano.Ledger.Plutus.Data as Ledger @@ -41,7 +41,7 @@ prop_scriptDataToJSON_bad = property $ do jsonText <- forAll $ Gen.element knownBadScriptData assert $ isLeft (decodeJson jsonText) where - decodeJson :: Text -> Either String (ScriptData Shelley) + decodeJson :: Text -> Either String (ScriptData ShelleyEra) decodeJson = Aeson.eitherDecodeStrict . encodeUtf8 prop_scriptDataToJSON_roundtrip :: Property @@ -84,17 +84,17 @@ knownBadScriptData = , "{\"fields\": [{\"int\": 24}], \"constructor\": 4, \"extra\": 5}" ] -genScriptData :: Gen (ScriptData Shelley) +genScriptData :: Gen (ScriptData ShelleyEra) genScriptData = ScriptData . Data <$> Gen.arbitrary -decodeCbor :: Text -> Either DecoderError (Ledger.Data Shelley) +decodeCbor :: Text -> Either DecoderError (Ledger.Data ShelleyEra) decodeCbor = decode' . LByteString.fromStrict . Base16.decodeLenient . encodeUtf8 where - decode' :: LByteString.ByteString -> Either DecoderError (Ledger.Data Shelley) + decode' :: LByteString.ByteString -> Either DecoderError (Ledger.Data ShelleyEra) decode' bytes = do Annotator ann <- decodeFull shelleyProtVer bytes pure $ ann (Full bytes) diff --git a/cardano-db-sync/test/Cardano/DbSync/Era/Shelley/Generic/ScriptTest.hs b/cardano-db-sync/test/Cardano/DbSync/Era/Shelley/Generic/ScriptTest.hs index 7ebb58436..edaad8bc8 100644 --- a/cardano-db-sync/test/Cardano/DbSync/Era/Shelley/Generic/ScriptTest.hs +++ b/cardano-db-sync/test/Cardano/DbSync/Era/Shelley/Generic/ScriptTest.hs @@ -8,7 +8,7 @@ module Cardano.DbSync.Era.Shelley.Generic.ScriptTest (tests) where import Cardano.DbSync.Era.Shelley.Generic.Script import qualified Cardano.Ledger.Allegra.Scripts as Allegra -import Cardano.Ledger.Api (Allegra (), Shelley ()) +import Cardano.Ledger.Api (AllegraEra, ShelleyEra) import Cardano.Ledger.Binary.Decoding import Cardano.Ledger.Core (NativeScript) import qualified Cardano.Ledger.Shelley.Scripts as Ledger @@ -46,7 +46,7 @@ prop_multisigToJSON = property $ do Aeson.toJSON (fromMultiSig multiSig) === json where - decodeCbor :: Text -> Either DecoderError (Ledger.MultiSig Shelley) + decodeCbor :: Text -> Either DecoderError (Ledger.MultiSig ShelleyEra) decodeCbor cbor = do let bytes = LByteString.fromStrict $ deserialiseCborFromBase16 cbor Annotator ann <- decodeFull shelleyProtVer bytes @@ -57,7 +57,7 @@ prop_multisigToJSON_bad = property $ do jsonText <- forAll $ Gen.element knownBadMultiSigs assert $ isLeft (decodeJson jsonText) where - decodeJson :: Text -> Either String (MultiSigScript Shelley) + decodeJson :: Text -> Either String (MultiSigScript ShelleyEra) decodeJson = Aeson.eitherDecodeStrict . encodeUtf8 prop_multisigToJSON_roundtrip :: Property @@ -73,7 +73,7 @@ prop_timelockToJSON = property $ do Aeson.toJSON (fromTimelock timelock) === json where - decodeCbor :: Text -> Either DecoderError (Allegra.Timelock Allegra) + decodeCbor :: Text -> Either DecoderError (Allegra.Timelock AllegraEra) decodeCbor cbor = do let bytes = LByteString.fromStrict $ deserialiseCborFromBase16 cbor Annotator ann <- decodeFull shelleyProtVer bytes @@ -84,12 +84,12 @@ prop_timelockToJSON_bad = property $ do jsonText <- forAll $ Gen.element knownBadMultiSigs assert $ isLeft (decodeJson jsonText) where - decodeJson :: Text -> Either String (TimelockScript Allegra) + decodeJson :: Text -> Either String (TimelockScript AllegraEra) decodeJson = Aeson.eitherDecodeStrict . encodeUtf8 prop_timelockToJSON_roundtrip :: Property prop_timelockToJSON_roundtrip = property $ do - timelock <- forAll (genValidTimelock @Allegra) + timelock <- forAll (genValidTimelock @AllegraEra) tripping timelock Aeson.toJSON Aeson.fromJSON knownMultiSigs :: [(Text, Text)] @@ -146,10 +146,10 @@ knownTimelocks = ) ] -genValidMultiSig :: Gen (MultiSigScript Shelley) +genValidMultiSig :: Gen (MultiSigScript ShelleyEra) genValidMultiSig = fromMultiSig <$> genValidLedgerMultiSigSized 5 10 -genValidLedgerMultiSigSized :: Int -> Size -> Gen (Ledger.MultiSig Shelley) +genValidLedgerMultiSigSized :: Int -> Size -> Gen (Ledger.MultiSig ShelleyEra) genValidLedgerMultiSigSized _ 0 = Ledger.RequireSignature <$> arbitrary genValidLedgerMultiSigSized maxListLen maxDepth = Gen.choice diff --git a/cardano-db-sync/test/Cardano/DbSync/Gen.hs b/cardano-db-sync/test/Cardano/DbSync/Gen.hs index 2fbbdb406..f0d777ff4 100644 --- a/cardano-db-sync/test/Cardano/DbSync/Gen.hs +++ b/cardano-db-sync/test/Cardano/DbSync/Gen.hs @@ -43,7 +43,9 @@ import Data.Maybe (fromJust) import Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range -import Ouroboros.Consensus.Cardano.CanHardFork (TriggerHardFork (..)) +import Ouroboros.Consensus.Cardano.Block (StandardCrypto) +import Ouroboros.Consensus.Cardano.Node (CardanoHardForkTrigger (..)) +import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock) syncPreConfig :: Gen SyncPreConfig syncPreConfig = @@ -202,12 +204,11 @@ protocolVersion = ProtocolVersion <$> word16 <*> word16 <*> word8 word16 = Gen.word16 (Range.linear minBound maxBound) word8 = Gen.word8 (Range.linear minBound maxBound) -triggerHardFork :: MonadGen m => m TriggerHardFork +triggerHardFork :: MonadGen m => m (CardanoHardForkTrigger (ShelleyBlock (crypto StandardCrypto) era)) triggerHardFork = Gen.choice - [ Gen.constant TriggerHardForkNotDuringThisExecution - , TriggerHardForkAtEpoch . EpochNo <$> Gen.word64 (Range.linear minBound maxBound) - , TriggerHardForkAtVersion <$> Gen.word16 (Range.linear minBound maxBound) + [ Gen.constant CardanoTriggerHardForkAtDefaultVersion + , CardanoTriggerHardForkAtEpoch . EpochNo <$> Gen.word64 (Range.linear minBound maxBound) ] -- | @Logging.Representation@ is not useful for our testing, so we just generate a minimal example diff --git a/cardano-db-sync/test/Cardano/DbSync/Util/AddressTest.hs b/cardano-db-sync/test/Cardano/DbSync/Util/AddressTest.hs index 16448b4f7..d909b7625 100644 --- a/cardano-db-sync/test/Cardano/DbSync/Util/AddressTest.hs +++ b/cardano-db-sync/test/Cardano/DbSync/Util/AddressTest.hs @@ -8,7 +8,6 @@ import Cardano.DbSync.Util.Address import Cardano.Ledger.Address (Addr (..), BootstrapAddress (..), RewardAccount (..)) import Cardano.Ledger.BaseTypes (Network (..)) import qualified Cardano.Ledger.Binary.Decoding as Decoding -import Cardano.Ledger.Crypto (StandardCrypto ()) import Cardano.Prelude import Data.ByteString.Base16 (decodeLenient) import Hedgehog @@ -212,13 +211,13 @@ knownStakeAddresses = ) ] -genByronAddress :: Gen (BootstrapAddress StandardCrypto) +genByronAddress :: Gen BootstrapAddress genByronAddress = arbitrary -genShelleyAddress :: Gen (Addr StandardCrypto) +genShelleyAddress :: Gen Addr genShelleyAddress = Addr <$> arbitrary <*> arbitrary <*> arbitrary -genRewardAccount :: Gen (RewardAccount StandardCrypto) +genRewardAccount :: Gen RewardAccount genRewardAccount = arbitrary deserialiseBase16 :: FromCBOR a => Text -> a @@ -229,6 +228,6 @@ decodeBase16 = deserialise' . decodeLenient . encodeUtf8 where deserialise' = Decoding.unsafeDeserialize' Decoding.shelleyProtVer -getNetwork :: Addr c -> Network +getNetwork :: Addr -> Network getNetwork (AddrBootstrap _) = Mainnet getNetwork (Addr net _ _) = net diff --git a/cardano-db-sync/test/Cardano/DbSync/Util/Bech32Test.hs b/cardano-db-sync/test/Cardano/DbSync/Util/Bech32Test.hs index 798a8df82..adedfba26 100644 --- a/cardano-db-sync/test/Cardano/DbSync/Util/Bech32Test.hs +++ b/cardano-db-sync/test/Cardano/DbSync/Util/Bech32Test.hs @@ -9,7 +9,6 @@ import Cardano.Crypto.Hash.Blake2b (Blake2b_224 ()) import Cardano.Crypto.Hash.Class (HashAlgorithm (..), hashFromBytes) import Cardano.Crypto.VRF.Praos (genSeed, keypairFromSeed) import Cardano.DbSync.Util.Bech32 -import Cardano.Ledger.Crypto (StandardCrypto ()) import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..)) import Cardano.Prelude import Data.ByteString.Base16 (decodeLenient, encode) @@ -126,11 +125,11 @@ genKey = do pure $ decodeUtf8 $ encode $ serialize' vkey -genBlake224 :: MonadGen m => m (Maybe (KeyHash 'StakePool StandardCrypto)) +genBlake224 :: MonadGen m => m (Maybe (KeyHash 'StakePool)) genBlake224 = do serialiseHash <$> Gen.bytes (Range.linear 0 100) where - serialiseHash :: ByteString -> Maybe (KeyHash 'StakePool StandardCrypto) + serialiseHash :: ByteString -> Maybe (KeyHash 'StakePool) serialiseHash = (KeyHash <$>) . hashFromBytes . digest (Proxy @Blake2b_224) -- * Utilities diff --git a/cardano-db-tool/cardano-db-tool.cabal b/cardano-db-tool/cardano-db-tool.cabal index 3dc10238b..9410d3ef6 100644 --- a/cardano-db-tool/cardano-db-tool.cabal +++ b/cardano-db-tool/cardano-db-tool.cabal @@ -61,6 +61,7 @@ library , cardano-api , cardano-db , cardano-db-sync + , cardano-ledger-api , cardano-ledger-alonzo , cardano-ledger-byron , cardano-ledger-core diff --git a/cardano-db-tool/src/Cardano/DbTool/Validate/Balance.hs b/cardano-db-tool/src/Cardano/DbTool/Validate/Balance.hs index be58a60fd..1b8f7a2a4 100644 --- a/cardano-db-tool/src/Cardano/DbTool/Validate/Balance.hs +++ b/cardano-db-tool/src/Cardano/DbTool/Validate/Balance.hs @@ -24,15 +24,13 @@ import Cardano.Chain.Common ( ) import qualified Cardano.Chain.UTxO as Byron import Cardano.Ledger.Address -import Cardano.Ledger.Alonzo (AlonzoEra) import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo +import Cardano.Ledger.Api (AlonzoEra) import Cardano.Ledger.Compactible import qualified Cardano.Ledger.Core as Ledger -import Cardano.Ledger.Era (EraCrypto) import Cardano.Ledger.Shelley.API (Coin (..)) import qualified Cardano.Ledger.Shelley.LedgerState as Shelley import Cardano.Ledger.Shelley.TxOut -import qualified Cardano.Ledger.Shelley.UTxO as Shelley import Cardano.Ledger.Val import Cardano.Prelude import qualified Data.Map.Strict as Map @@ -102,7 +100,7 @@ getByronBalance addrText utxo = do getShelleyBalance :: forall era. - (EraCrypto era ~ StandardCrypto, Ledger.TxOut era ~ ShelleyTxOut era) => + Ledger.TxOut era ~ ShelleyTxOut era => Val (Ledger.Value era) => Text -> Shelley.UTxO era -> @@ -112,20 +110,20 @@ getShelleyBalance addrText utxo = do Left err -> Left $ VBErrShelley err Right cmpAddr -> Right . fromIntegral . sum $ unCoin <$> mapMaybe (compactTxOutValue cmpAddr) (Map.elems $ Shelley.unUTxO utxo) where - compactTxOutValue :: CompactAddr (EraCrypto era) -> Ledger.TxOut era -> Maybe Coin + compactTxOutValue :: CompactAddr -> Ledger.TxOut era -> Maybe Coin compactTxOutValue caddr (TxOutCompact scaddr v) = if caddr == scaddr then Just $ coin (fromCompact v) else Nothing -getAlonzoBalance :: Text -> Shelley.UTxO (AlonzoEra StandardCrypto) -> Either ValidateBalanceError Word64 +getAlonzoBalance :: Text -> Shelley.UTxO AlonzoEra -> Either ValidateBalanceError Word64 getAlonzoBalance addrText utxo = do case covertToCompactAddress addrText of Left err -> Left $ VBErrAlonzo err Right cmpAddr -> Right . fromIntegral . sum $ unCoin <$> mapMaybe (compactTxOutValue cmpAddr) (Map.elems $ Shelley.unUTxO utxo) where compactTxOutValue :: - CompactAddr StandardCrypto -> Alonzo.AlonzoTxOut (AlonzoEra StandardCrypto) -> Maybe Coin + CompactAddr -> Alonzo.AlonzoTxOut AlonzoEra -> Maybe Coin compactTxOutValue caddr txOut = let (scaddr, val) = case txOut of Alonzo.TxOutCompact a v -> (a, v) @@ -134,7 +132,7 @@ getAlonzoBalance addrText utxo = do then Just $ coin (fromCompact val) else Nothing -covertToCompactAddress :: Text -> Either String (CompactAddr StandardCrypto) +covertToCompactAddress :: Text -> Either String CompactAddr covertToCompactAddress addrText = case Api.deserialiseAddress (Api.AsAddress Api.AsShelleyAddr) addrText of Nothing -> diff --git a/cardano-db/src/Cardano/Db/Migration.hs b/cardano-db/src/Cardano/Db/Migration.hs index be65062c1..df7523c82 100644 --- a/cardano-db/src/Cardano/Db/Migration.hs +++ b/cardano-db/src/Cardano/Db/Migration.hs @@ -35,7 +35,7 @@ import Cardano.Db.Run import Cardano.Db.Schema.BaseSchema import Cardano.Db.Schema.Core.TxOut (migrateCoreTxOutCardanoDb) import Cardano.Db.Schema.Variant.TxOut (migrateVariantAddressCardanoDb) -import Cardano.Prelude (Typeable, textShow) +import Cardano.Prelude (textShow) import Control.Exception (Exception, SomeException, handle) import Control.Monad.Extra import Control.Monad.IO.Class (MonadIO, liftIO) @@ -97,7 +97,7 @@ data MigrationValidateError = UnknownMigrationsFound { missingMigrations :: [MigrationValidate] , extraMigrations :: [MigrationValidate] } - deriving (Eq, Show, Typeable) + deriving (Eq, Show) instance Exception MigrationValidateError diff --git a/cardano-db/src/Cardano/Db/Operations/Delete.hs b/cardano-db/src/Cardano/Db/Operations/Delete.hs index e84c71cec..7ec0f0bb2 100644 --- a/cardano-db/src/Cardano/Db/Operations/Delete.hs +++ b/cardano-db/src/Cardano/Db/Operations/Delete.hs @@ -187,7 +187,7 @@ deleteTablesAfterBlockId txOutTableType blkId mtxId minIdsW = do pure (sum $ map snd blockLogs, initialLogs <> blockLogs <> offChainLogs <> afterTxIdLogs) deleteTablesAfterTxId :: - (MonadIO m) => + MonadIO m => TxOutTableType -> Maybe TxId -> MinIdsWrapper -> diff --git a/cardano-db/src/Cardano/Db/Operations/Other/ConsumedTxOut.hs b/cardano-db/src/Cardano/Db/Operations/Other/ConsumedTxOut.hs index 47f68e513..513e93ee1 100644 --- a/cardano-db/src/Cardano/Db/Operations/Other/ConsumedTxOut.hs +++ b/cardano-db/src/Cardano/Db/Operations/Other/ConsumedTxOut.hs @@ -97,7 +97,7 @@ querySetNullTxOut txOutTableType mMinTxId = do TxOutVariantAddress -> setNull where setNull :: - (MonadIO m) => + MonadIO m => ReaderT SqlBackend m () setNull = do case txOutId of diff --git a/cardano-db/src/Cardano/Db/Operations/Other/JsonbQuery.hs b/cardano-db/src/Cardano/Db/Operations/Other/JsonbQuery.hs index 7ae86600b..dc7072513 100644 --- a/cardano-db/src/Cardano/Db/Operations/Other/JsonbQuery.hs +++ b/cardano-db/src/Cardano/Db/Operations/Other/JsonbQuery.hs @@ -95,7 +95,7 @@ disableJsonbInSchema = do [] queryJsonbInSchemaExists :: - (MonadIO m) => + MonadIO m => ReaderT SqlBackend m Bool queryJsonbInSchemaExists = do isjsonb <- rawSql query [] diff --git a/cardano-db/src/Cardano/Db/Operations/Other/MinId.hs b/cardano-db/src/Cardano/Db/Operations/Other/MinId.hs index 261c47064..06af87818 100644 --- a/cardano-db/src/Cardano/Db/Operations/Other/MinId.hs +++ b/cardano-db/src/Cardano/Db/Operations/Other/MinId.hs @@ -100,7 +100,7 @@ textToMinIdsVariant txt = } _otherwise -> Nothing -minJust :: (Ord a) => Maybe a -> Maybe a -> Maybe a +minJust :: Ord a => Maybe a -> Maybe a -> Maybe a minJust Nothing y = y minJust x Nothing = x minJust (Just x) (Just y) = Just (min x y) @@ -109,7 +109,7 @@ minJust (Just x) (Just y) = Just (min x y) -- CompleteMinId -------------------------------------------------------------------------------- completeMinId :: - (MonadIO m) => + MonadIO m => Maybe TxId -> MinIdsWrapper -> ReaderT SqlBackend m MinIdsWrapper diff --git a/cardano-db/src/Cardano/Db/Operations/Query.hs b/cardano-db/src/Cardano/Db/Operations/Query.hs index 904ed1646..5402f7015 100644 --- a/cardano-db/src/Cardano/Db/Operations/Query.hs +++ b/cardano-db/src/Cardano/Db/Operations/Query.hs @@ -108,7 +108,7 @@ import Cardano.Db.Operations.QueryHelper (defaultUTCTime, isJust, maybeToEither, import Cardano.Db.Schema.BaseSchema import Cardano.Db.Types import Cardano.Ledger.BaseTypes (CertIx (..), TxIx (..)) -import Cardano.Ledger.Credential (Ptr (..)) +import Cardano.Ledger.Credential (Ptr (..), SlotNo32 (..)) import Cardano.Slotting.Slot (SlotNo (..)) import Control.Monad.Extra (join, whenJust) import Control.Monad.IO.Class (MonadIO) @@ -771,7 +771,7 @@ queryStakeAddress addr toText = do pure $ maybeToEither (DbLookupMessage $ "StakeAddress " <> toText addr) unValue (listToMaybe res) queryStakeRefPtr :: MonadIO m => Ptr -> ReaderT SqlBackend m (Maybe StakeAddressId) -queryStakeRefPtr (Ptr (SlotNo slot) (TxIx txIx) (CertIx certIx)) = do +queryStakeRefPtr (Ptr (SlotNo32 slot) (TxIx txIx) (CertIx certIx)) = do res <- select $ do (blk :& tx :& sr) <- from @@ -781,7 +781,7 @@ queryStakeRefPtr (Ptr (SlotNo slot) (TxIx txIx) (CertIx certIx)) = do `innerJoin` table @StakeRegistration `on` (\(_blk :& tx :& sr) -> sr ^. StakeRegistrationTxId ==. tx ^. TxId) - where_ (blk ^. BlockSlotNo ==. just (val slot)) + where_ (blk ^. BlockSlotNo ==. just (val $ fromIntegral slot)) where_ (tx ^. TxBlockIndex ==. val (fromIntegral txIx)) where_ (sr ^. StakeRegistrationCertIndex ==. val (fromIntegral certIx)) -- Need to order by DelegationSlotNo descending for correct behavior when there are two diff --git a/cardano-db/src/Cardano/Db/Operations/TxOut/TxOutQuery.hs b/cardano-db/src/Cardano/Db/Operations/TxOut/TxOutQuery.hs index c6af125ef..a051f7333 100644 --- a/cardano-db/src/Cardano/Db/Operations/TxOut/TxOutQuery.hs +++ b/cardano-db/src/Cardano/Db/Operations/TxOut/TxOutQuery.hs @@ -128,7 +128,7 @@ queryTxOutId txOutTableType hashIndex = -- | Like 'queryTxOutId' but also return the 'TxOutIdValue' queryTxOutIdValue :: - (MonadIO m) => + MonadIO m => TxOutTableType -> (ByteString, Word64) -> ReaderT SqlBackend m (Either LookupFail (TxId, TxOutIdW, DbLovelace)) @@ -217,7 +217,7 @@ queryAddressId addrRaw = do -- does not include staking rewards that have not yet been withdrawn. Before wihdrawal -- rewards are part of the ledger state and hence not on chain. queryTotalSupply :: - (MonadIO m) => + MonadIO m => TxOutTableType -> ReaderT SqlBackend m Ada queryTotalSupply txOutTableType = @@ -242,7 +242,7 @@ queryTotalSupply txOutTableType = -- | Return the total Genesis coin supply. queryGenesisSupply :: - (MonadIO m) => + MonadIO m => TxOutTableType -> ReaderT SqlBackend m Ada queryGenesisSupply txOutTableType = diff --git a/cardano-db/src/Cardano/Db/Operations/Types.hs b/cardano-db/src/Cardano/Db/Operations/Types.hs index 21d818870..b92aafcc0 100644 --- a/cardano-db/src/Cardano/Db/Operations/Types.hs +++ b/cardano-db/src/Cardano/Db/Operations/Types.hs @@ -116,7 +116,7 @@ data MaTxOutIdW deriving (Show) -- MaTxOut fields for a given TxOutTableType -class (PersistEntity (MaTxOutTable a)) => MaTxOutFields (a :: TxOutTableType) where +class PersistEntity (MaTxOutTable a) => MaTxOutFields (a :: TxOutTableType) where type MaTxOutTable a :: Type type MaTxOutIdFor a :: Type maTxOutTxOutIdField :: EntityField (MaTxOutTable a) (TxOutIdFor a) @@ -160,7 +160,7 @@ data CollateralTxOutIdW | VCollateralTxOutIdW !V.CollateralTxOutId deriving (Show) -class (PersistEntity (CollateralTxOutTable a)) => CollateralTxOutFields (a :: TxOutTableType) where +class PersistEntity (CollateralTxOutTable a) => CollateralTxOutFields (a :: TxOutTableType) where type CollateralTxOutTable a :: Type type CollateralTxOutIdFor a :: Type collateralTxOutIdField :: EntityField (CollateralTxOutTable a) (CollateralTxOutIdFor a) diff --git a/cardano-db/src/Cardano/Db/Schema/BaseSchema.hs b/cardano-db/src/Cardano/Db/Schema/BaseSchema.hs index 51b939650..644eb4d12 100644 --- a/cardano-db/src/Cardano/Db/Schema/BaseSchema.hs +++ b/cardano-db/src/Cardano/Db/Schema/BaseSchema.hs @@ -1,6 +1,5 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} diff --git a/cardano-db/src/Cardano/Db/Schema/Core/TxOut.hs b/cardano-db/src/Cardano/Db/Schema/Core/TxOut.hs index 57974fb82..fd3ef67f1 100644 --- a/cardano-db/src/Cardano/Db/Schema/Core/TxOut.hs +++ b/cardano-db/src/Cardano/Db/Schema/Core/TxOut.hs @@ -1,6 +1,5 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} diff --git a/cardano-db/src/Cardano/Db/Schema/Variant/TxOut.hs b/cardano-db/src/Cardano/Db/Schema/Variant/TxOut.hs index 875e71792..e27808df3 100644 --- a/cardano-db/src/Cardano/Db/Schema/Variant/TxOut.hs +++ b/cardano-db/src/Cardano/Db/Schema/Variant/TxOut.hs @@ -1,6 +1,5 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} diff --git a/cardano-db/test/Test/Property/Cardano/Db/Types.hs b/cardano-db/test/Test/Property/Cardano/Db/Types.hs index d0342100e..f6dc2afd7 100644 --- a/cardano-db/test/Test/Property/Cardano/Db/Types.hs +++ b/cardano-db/test/Test/Property/Cardano/Db/Types.hs @@ -10,7 +10,6 @@ module Test.Property.Cardano.Db.Types ( import Cardano.Chain.Common (maxLovelaceVal) import qualified Cardano.Crypto.Hash as Crypto import Cardano.Db -import Cardano.Ledger.Crypto (StandardCrypto) import qualified Cardano.Ledger.Hashes as Ledger import Cardano.Ledger.Mary.Value (AssetName (..), PolicyID (..)) import qualified Data.Aeson as Aeson @@ -44,13 +43,13 @@ prop_AssetFingerprint = H.withTests 1 . H.property $ mapM_ (\(p, a, f) -> mkAssetFingerprint (unScriptHash $ policyID p) (unAssetName a) === f) testVectors where - unScriptHash :: Ledger.ScriptHash StandardCrypto -> ByteString + unScriptHash :: Ledger.ScriptHash -> ByteString unScriptHash (Ledger.ScriptHash h) = Crypto.hashToBytes h unAssetName :: AssetName -> ByteString unAssetName = SBS.fromShort . assetNameBytes - testVectors :: [(PolicyID StandardCrypto, AssetName, AssetFingerprint)] + testVectors :: [(PolicyID, AssetName, AssetFingerprint)] testVectors = [ ( mkPolicyId "7eae28af2208be856f7a119668ae52a49b73725e326dc16579dcc373" @@ -94,7 +93,7 @@ prop_AssetFingerprint = ) ] - mkPolicyId :: ByteString -> PolicyID StandardCrypto + mkPolicyId :: ByteString -> PolicyID mkPolicyId = PolicyID . Ledger.ScriptHash diff --git a/flake.lock b/flake.lock index a8d647c65..ed6c8e283 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1732742574, - "narHash": "sha256-XUhDWQeChjNPcYluz8sCbs5vW+3jEYysxEhpKdFXbt0=", + "lastModified": 1748021818, + "narHash": "sha256-MwSc2+UaaOkLosZ6mtgJBoxeasgVp8+7HoEcGCyxjJY=", "owner": "IntersectMBO", "repo": "cardano-haskell-packages", - "rev": "375a4694472aa362b7abba0e8b7f3de787e90c91", + "rev": "3a8a6e6a49b4fd3fc5c7778b9160ef4e54400a1e", "type": "github" }, "original": { @@ -171,15 +171,16 @@ "hackageNix": { "flake": false, "locked": { - "lastModified": 1729470551, - "narHash": "sha256-AKBK4jgOjIz5DxIsIKFZR0mf30qc4Dv+Dm/DVRjdjD8=", + "lastModified": 1748219218, + "narHash": "sha256-kKe1cGUGkwp/6704BTKlH4yWTL0wmZugofJU20PcIkA=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "ee5b803d828db6efac3ef7e7e072c855287dc298", + "rev": "d3c929097030b8405f983de59ea243018d7cf877", "type": "github" }, "original": { "owner": "input-output-hk", + "ref": "for-stackage", "repo": "hackage.nix", "type": "github" } diff --git a/flake.nix b/flake.nix index 09118b85b..a8740c52f 100644 --- a/flake.nix +++ b/flake.nix @@ -9,7 +9,7 @@ inputs.hackage.follows = "hackageNix"; }; hackageNix = { - url = "github:input-output-hk/hackage.nix"; + url = "github:input-output-hk/hackage.nix?ref=for-stackage"; flake = false; }; iohkNix = { @@ -170,6 +170,11 @@ in lib.genAttrs compilers (c: { compiler-nix-name = c; }); + # cardano-cli is needed when building the docker image + cabalProjectLocal = '' + extra-packages: cardano-cli + ''; + crossPlatforms = p: lib.optional (system == "x86_64-linux") p.musl64 ++ lib.optional @@ -213,10 +218,14 @@ modules = [ ({ lib, pkgs, ... }: { + package-keys = ["ekg"]; # Ignore version bounds packages.katip.doExactConfig = true; # Split data to reduce closure size packages.ekg.components.library.enableSeparateDataOutput = true; + # Haddock is failing for these two packages (at least with GHC 8.10.7) + packages.ouroboros-network.doHaddock = config.compiler-nix-name != "ghc8107"; + packages.cardano-node.doHaddock = config.compiler-nix-name != "ghc8107"; }) ({