WIP: Switch to cardano-config

.github/workflows/actionlint.yml

@@ -23,6 +23,8 @@ jobs:
             extra-substituters = https://cache.iog.io/
       # Make the Nix environment available to next steps
       - uses: rrbutani/use-nix-shell-action@f97339023a09121113e5a58ad88fe0e9fde3406b # v1
+        with:
+          flakes: nixpkgs#shellcheck,nixpkgs#actionlint
 
       - name: actionlint
         run: |

.github/workflows/check-changelog.yml

@@ -42,9 +42,11 @@ jobs:
             extra-trusted-public-keys = hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ=
             extra-substituters = https://cache.iog.io/
 
-      - name: Check scriv fragments are correct
+      - uses: rrbutani/use-nix-shell-action@v1
         if: steps.filter.outputs.cardano == 'true'
-        uses: rrbutani/use-nix-shell-action@f97339023a09121113e5a58ad88fe0e9fde3406b # v1
         with:
-          script: cd cardano-testnet && scriv collect --version "CI-CHECK" --keep
+          flakes: nixpkgs#scriv
+      - name: Check scriv fragments are correct
+        if: steps.filter.outputs.cardano == 'true'
+        run: cd cardano-testnet && scriv collect --version "CI-CHECK" --keep
 

.github/workflows/shellcheck.yml

@@ -25,6 +25,8 @@ jobs:
             extra-substituters = https://cache.iog.io/
       # Make the Nix environment available to next steps
       - uses: rrbutani/use-nix-shell-action@f97339023a09121113e5a58ad88fe0e9fde3406b # v1
+        with:
+          flakes: nixpkgs#shellcheck
       - name: shellcheck
         run: |
           for file in $(git ls-files "*.sh")

.gitignore

@@ -77,3 +77,5 @@ cardano-tracer/cardano-tracer-test
 .idea/
 
 .codex
+
+.serena/

bench/plutus-scripts-bench/plutus-scripts-bench.cabal

@@ -82,10 +82,10 @@ library
   -- IOG dependencies
   --------------------------
   build-depends:
-    , cardano-api             ^>=11.0
-    , plutus-ledger-api       ^>=1.63
-    , plutus-tx               ^>=1.63
-    , plutus-tx-plugin        ^>=1.63
+    , cardano-api             ^>=11.3
+    , plutus-ledger-api       ^>=1.65
+    , plutus-tx               ^>=1.65
+    , plutus-tx-plugin        ^>=1.65
 
   ------------------------
   -- Non-IOG dependencies

bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/NodeToNode.hs

@@ -40,6 +40,7 @@ import           Ouroboros.Network.Mux (MiniProtocolCb (..), OuroborosApplicatio
 import           Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
 import           Ouroboros.Network.PeerSelection.PeerSharing.Codec (decodeRemoteAddress,
                    encodeRemoteAddress)
+import           Ouroboros.Network.PerasSupport (PerasSupport (..))
 import           Ouroboros.Network.Protocol.BlockFetch.Client (BlockFetchClient (..),
                    blockFetchClientPeer)
 import           Ouroboros.Network.Protocol.Handshake.Version (simpleSingletonVersions)
@@ -112,7 +113,7 @@ benchmarkConnectTxSubmit EnvConsts { .. } handshakeTracer submissionTracer codec
   supportedVers = supportedNodeToNodeVersions (Proxy @blk)
   myCodecs :: Codecs blk NtN.RemoteAddress DeserialiseFailure IO
                 ByteString ByteString ByteString ByteString ByteString ByteString
-                ByteString
+                ByteString ByteString ByteString
   myCodecs  = defaultCodecs codecConfig blkN2nVer encodeRemoteAddress decodeRemoteAddress n2nVer
   peerMultiplex :: NtN.Versions NodeToNodeVersion
                                 NtN.NodeToNodeVersionData
@@ -129,10 +130,11 @@ benchmarkConnectTxSubmit EnvConsts { .. } handshakeTracer submissionTracer codec
        , NtN.diffusionMode = NtN.InitiatorOnlyDiffusionMode
        , NtN.peerSharing = ownPeerSharing
        , NtN.query = False
+       , NtN.perasSupport = PerasUnsupported
        }) $
       \n2nData ->
         mkApp $
-        NtN.nodeToNodeProtocols NtN.defaultMiniProtocolParameters
+        NtN.nodeToNodeProtocols mempty NtN.defaultMiniProtocolParameters
           NtN.NodeToNodeProtocols
             { NtN.chainSyncProtocol = InitiatorProtocolOnly $ MiniProtocolCb $ \_ctx channel ->
                                         runPeer
@@ -160,6 +162,11 @@ benchmarkConnectTxSubmit EnvConsts { .. } handshakeTracer submissionTracer codec
                                              (cPeerSharingCodec myCodecs)
                                              channel
                                              (peerSharingClientPeer peerSharingClientNull)
+            -- TODO Peras is not supported here
+            , NtN.perasCertDiffusionProtocol = InitiatorProtocolOnly $ MiniProtocolCb $ \_ctx _channel ->
+                                          error "tx-generator: Peras cert diffusion is unsupported"
+            , NtN.perasVoteDiffusionProtocol = InitiatorProtocolOnly $ MiniProtocolCb $ \_ctx _channel ->
+                                          error "tx-generator: Peras vote diffusion is unsupported"
             }
           n2nVer
           n2nData

bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs

@@ -3,11 +3,14 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+
 module Cardano.Benchmarking.GeneratorTx.SizedMetadata
 where
 
 import           Cardano.Api
 
+import           Cardano.Ledger.BaseTypes (maybeToStrictMaybe)
+import qualified Cardano.Ledger.Core as L
 import           Cardano.TxGenerator.Utils
 
 import           Prelude
@@ -16,6 +19,7 @@ import qualified Data.ByteString as BS
 import           Data.Function ((&))
 import qualified Data.Map.Strict as Map
 import           Data.Word (Word64)
+import           Lens.Micro ((.~), (^.))
 
 
 maxMapSize :: Int
@@ -53,7 +57,7 @@ prop_mapCostsMary      = measureMapCosts AsMaryEra     == assumeMapCosts AsMaryE
 prop_mapCostsAlonzo    = measureMapCosts AsAlonzoEra   == assumeMapCosts AsAlonzoEra
 prop_mapCostsBabbage   = measureMapCosts AsBabbageEra  == assumeMapCosts AsBabbageEra
 prop_mapCostsConway    = measureMapCosts AsConwayEra   == assumeMapCosts AsConwayEra
-prop_mapCostsDijkstra  = measureMapCosts AsDijkstraEra == assumeMapCosts AsDijkstraEra 
+prop_mapCostsDijkstra  = measureMapCosts AsDijkstraEra == assumeMapCosts AsDijkstraEra
 
 assumeMapCosts :: forall era . IsShelleyBasedEra era => AsType era -> [Int]
 assumeMapCosts _proxy = stepFunction [
@@ -113,21 +117,25 @@ measureBSCosts era = map (metadataSize era . Just . bsMetadata) [0..maxBSSize]
 metadataSize :: forall era . IsShelleyBasedEra era => AsType era -> Maybe TxMetadata -> Int
 metadataSize p m = dummyTxSize p m - dummyTxSize p Nothing
 
-dummyTxSizeInEra :: IsShelleyBasedEra era => TxMetadataInEra era -> Int
-dummyTxSizeInEra metadata = case createTransactionBody shelleyBasedEra dummyTx of
-  Right b -> BS.length $ serialiseToCBOR b
-  Left err -> error $ "metaDataSize " ++ show err
+dummyTxSizeInEra :: forall era. IsShelleyBasedEra era => TxMetadataInEra era -> Int
+dummyTxSizeInEra metadata =
+  BS.length $ serialiseToCBOR dummyTx
  where
-  dummyTx = defaultTxBodyContent shelleyBasedEra
-    & setTxIns
-      [ ( mkTxIn "dbaff4e270cfb55612d9e2ac4658a27c79da4a5271c6f90853042d1403733810#0"
-        , BuildTxWith $ KeyWitness KeyWitnessForSpending
-        )
-      ]
-    & setTxFee (mkTxFee 0)
-    & setTxValidityLowerBound TxValidityNoLowerBound
-    & setTxValidityUpperBound (mkTxValidityUpperBound 0)
-    & setTxMetadata metadata
+  sbe = shelleyBasedEra @era
+  txInputs =
+    [ ( mkTxIn "dbaff4e270cfb55612d9e2ac4658a27c79da4a5271c6f90853042d1403733810#0"
+      , BuildTxWith $ KeyWitness KeyWitnessForSpending
+      )
+    ]
+  txAuxData = toAuxiliaryData sbe metadata TxAuxScriptsNone
+  ledgerTxBody =
+    mkCommonTxBody sbe txInputs [] (mkTxFee 0) TxWithdrawalsNone txAuxData
+      & invalidHereAfterTxBodyL sbe .~ convValidityUpperBound sbe (mkTxValidityUpperBound 0)
+  dummyTx :: Tx era
+  dummyTx = shelleyBasedEraConstraints sbe $
+    ShelleyTx sbe $
+      L.mkBasicTx (ledgerTxBody ^. txBodyL)
+        & L.auxDataTxL .~ maybeToStrictMaybe txAuxData
 
 dummyTxSize :: forall era . IsShelleyBasedEra era => AsType era -> Maybe TxMetadata -> Int
 dummyTxSize _p m = (dummyTxSizeInEra @era) $ metadataInEra m

bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs

@@ -101,7 +101,7 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
       fail (T.unpack err)
     let (stillUnacked, acked) = L.splitAtEnd ack unAcked
     let newStats = stats { stsAcked = stsAcked stats + Ack ack }
-    traceWith bmtr $ SubmissionClientDiscardAcknowledged  (getTxId . getTxBody <$> acked)
+    traceWith bmtr $ SubmissionClientDiscardAcknowledged  (txIdFromTx <$> acked)
     return (txSource, UnAcked stillUnacked, newStats)
 
   queueNewTxs :: [Tx era] -> LocalState era -> LocalState era
@@ -130,8 +130,8 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
     let stateC@(_, UnAcked outs , stats) = queueNewTxs newTxs stateB
 
     traceWith tr $ idListTrace (ToAnnce newTxs) blocking
-    traceWith bmtr $ SubmissionClientReplyTxIds (getTxId . getTxBody <$> newTxs)
-    traceWith bmtr $ SubmissionClientUnAcked (getTxId . getTxBody <$> outs)
+    traceWith bmtr $ SubmissionClientReplyTxIds (txIdFromTx <$> newTxs)
+    traceWith bmtr $ SubmissionClientUnAcked (txIdFromTx <$> outs)
 
     case blocking of
       SingBlocking -> case NE.nonEmpty newTxs of
@@ -155,12 +155,12 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
          reqTxIds = fmap fromGenTxId txIds
     traceWith tr $ ReqTxs (length reqTxIds)
     let UnAcked ua = unAcked
-        uaIds = getTxId . getTxBody <$> ua
-        (toSend, _retained) = L.partition ((`L.elem` reqTxIds) . getTxId . getTxBody) ua
+        uaIds = txIdFromTx <$> ua
+        (toSend, _retained) = L.partition ((`L.elem` reqTxIds) . txIdFromTx) ua
         missIds = reqTxIds L.\\ uaIds
 
     traceWith tr $ TxList (length toSend)
-    traceWith bmtr $ SubmissionClientUnAcked (getTxId . getTxBody <$> ua)
+    traceWith bmtr $ SubmissionClientUnAcked (txIdFromTx <$> ua)
     traceWith bmtr $ TraceBenchTxSubServReq reqTxIds
     unless (L.null missIds) $
       traceWith bmtr $ TraceBenchTxSubServUnav missIds
@@ -190,6 +190,10 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
   fromGenTxId (Block.GenTxIdConway  (Mempool.ShelleyTxId i)) = fromShelleyTxId i
   fromGenTxId _ = error "TODO: fix incomplete match"
 
+  txIdFromTx :: Tx era -> TxId
+  txIdFromTx (ShelleyTx sbe tx) =
+    shelleyBasedEraConstraints sbe $ fromShelleyTxId $ Ledger.txIdTxBody (tx ^. Ledger.bodyTxL)
+
   tokIsBlocking :: SingBlockingStyle a -> Bool
   tokIsBlocking = \case
     SingBlocking    -> True

bench/tx-generator/src/Cardano/Benchmarking/OuroborosImports.hs

@@ -1,6 +1,6 @@
 {- HLINT ignore "Eta reduce" -}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Cardano.Benchmarking.OuroborosImports
@@ -38,21 +38,19 @@
 
 type CardanoBlock = Consensus.CardanoBlock StandardCrypto
 
-toProtocolInfo :: SomeConsensusProtocol -> ProtocolInfo CardanoBlock
-toProtocolInfo (SomeConsensusProtocol CardanoBlockType info) = fst $ protocolInfo @IO info
+toProtocolInfo :: SomeConsensusProtocol -> IO (ProtocolInfo CardanoBlock)
+toProtocolInfo (SomeConsensusProtocol CardanoBlockType info) = fst <$> protocolInfo @IO info
 toProtocolInfo _ = error "toProtocolInfo unknown protocol"
 
-protocolToTopLevelConfig :: SomeConsensusProtocol -> TopLevelConfig CardanoBlock
-protocolToTopLevelConfig ptcl = pInfoConfig
- where
-   ProtocolInfo {pInfoConfig} = toProtocolInfo ptcl
+protocolToTopLevelConfig :: SomeConsensusProtocol -> IO (TopLevelConfig CardanoBlock)
+protocolToTopLevelConfig ptcl = pInfoConfig <$> toProtocolInfo ptcl
 
-protocolToCodecConfig :: SomeConsensusProtocol -> CodecConfig CardanoBlock
-protocolToCodecConfig = configCodec . protocolToTopLevelConfig
+protocolToCodecConfig :: SomeConsensusProtocol -> IO (CodecConfig CardanoBlock)
+protocolToCodecConfig = fmap configCodec . protocolToTopLevelConfig
 
-protocolToNetworkId :: SomeConsensusProtocol -> NetworkId
+protocolToNetworkId :: SomeConsensusProtocol -> IO NetworkId
 protocolToNetworkId ptcl
-  = Testnet $ getNetworkMagic $ configBlock $ protocolToTopLevelConfig ptcl
+  = Testnet . getNetworkMagic . configBlock <$> protocolToTopLevelConfig ptcl
 
 makeLocalConnectInfo :: NetworkId -> SocketPath -> LocalNodeConnectInfo
 makeLocalConnectInfo networkId socketPath

bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs

@@ -69,8 +69,8 @@ startProtocol configFile tracerSocket = do
   setEnvGenesis $ getGenesis protocol
   iomgr <- askIOManager
 
+  networkId <- liftIO $ protocolToNetworkId protocol
   let
-    networkId = protocolToNetworkId protocol
     tracerSocket' = (,,) iomgr networkId `fmap` tracerSocket
 
   setEnvNetworkId networkId

bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs

@@ -38,6 +38,7 @@ import           Cardano.Benchmarking.Version as Version
 import           Cardano.Benchmarking.Wallet as Wallet
 import qualified Cardano.Ledger.Coin as L
 import qualified Cardano.Ledger.Core as Ledger
+import           Cardano.Ledger.Tools (estimateMinFeeTx)
 import           Cardano.Logging hiding (LocalSocket)
 import           Cardano.TxGenerator.Fund as Fund
 import qualified Cardano.TxGenerator.FundQueue as FundQueue
@@ -56,7 +57,7 @@ import           Prelude
 import           Control.Concurrent (threadDelay)
 import           Control.Monad
 import           Control.Monad.Trans.RWS.Strict (ask)
-import           "contra-tracer" Control.Tracer (Tracer (..))
+import           "contra-tracer" Control.Tracer (mkTracer)
 import           Data.ByteString.Lazy.Char8 as BSL (writeFile)
 import           Data.Ratio ((%))
 import qualified Data.Text as Text (unpack)
@@ -136,11 +137,12 @@ getConnectClient = do
   protocol <- getEnvProtocol
   void $ return $ btSubmission2_ tracers
   envConsts <- lift ask
+  codecConfig <- liftIO $ protocolToCodecConfig protocol
   return $ benchmarkConnectTxSubmit
                        envConsts
-                       (Tracer $ traceWith (btConnect_ tracers))
+                       (mkTracer $ traceWith (btConnect_ tracers))
                        mempty -- (btSubmission2_ tracers)
-                       (protocolToCodecConfig protocol)
+                       codecConfig
                        networkMagic
 waitBenchmark :: ActionM ()
 waitBenchmark = do
@@ -353,10 +355,12 @@ evalGenerator generator txParams@TxGenTxParams{txParamFee = fee} era = do
             Right tx -> do
               let
                 txSize = txSizeInBytes tx
-                txFeeEstimate = case toLedgerPParams shelleyBasedEra protocolParameters of
-                  Left{}              -> Nothing
-                  Right ledgerPParams -> Just $
-                    evaluateTransactionFee shelleyBasedEra ledgerPParams (getTxBody tx) (fromIntegral $ inputs + 1) 0 0    -- 1 key witness per tx input + 1 collateral
+                txFeeEstimate = case tx of
+                  ShelleyTx sbe ledgerTx -> shelleyBasedEraConstraints sbe $
+                    case toLedgerPParams sbe protocolParameters of
+                      Left{}              -> Nothing
+                      Right ledgerPParams -> Just $
+                        estimateMinFeeTx ledgerPParams ledgerTx (inputs + 1) 0 0    -- 1 key witness per tx input + 1 collateral
               traceDebug $ "Projected Tx size in bytes: " ++ show txSize
               traceDebug $ "Projected Tx fee in Coin: " ++ show txFeeEstimate
               -- TODO: possibly emit a warning when (Just txFeeEstimate) is lower than specified by config in TxGenTxParams.txFee

bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
+
 {- HLINT ignore "Use map with tuple-section" -}
 
 -- | This module provides means to secure funds that are given in genesis.
@@ -21,16 +22,20 @@ where
 import           Cardano.Api hiding (ShelleyGenesis)
 
 import qualified Cardano.Ledger.Coin as L
+import qualified Cardano.Ledger.Core as Ledger
+import           Cardano.Ledger.Keys.WitVKey (WitVKey (WitVKey))
 import           Cardano.Ledger.Shelley.API (Addr (..))
 import           Cardano.TxGenerator.Fund
 import           Cardano.TxGenerator.Types
 import           Cardano.TxGenerator.Utils
 import           Ouroboros.Consensus.Shelley.Node (validateGenesis)
 
-import           Data.Bifunctor (bimap, second)
+import           Data.Bifunctor (second)
 import           Data.Function ((&))
 import           Data.List (find)
 import qualified Data.ListMap as ListMap (toList)
+import qualified Data.Set as Set
+import           Lens.Micro ((.~), (^.))
 
 
 genesisValidate ::  ShelleyGenesis -> Either String ()
@@ -105,12 +110,16 @@ genesisExpenditure networkId inputKey addr value fee ttl outputKey
   pseudoTxIn  = genesisTxInput networkId inputKey
 
   fund tx = FundInEra {
-    _fundTxIn = TxIn (getTxId $ getTxBody tx) (TxIx 0)
+    _fundTxIn = TxIn (txIdFromTx tx) (TxIx 0)
   , _fundWitness = KeyWitness KeyWitnessForSpending
   , _fundVal  = value
   , _fundSigningKey = Just outputKey
   }
 
+  txIdFromTx :: Tx era -> TxId
+  txIdFromTx (ShelleyTx sbe' tx') =
+    shelleyBasedEraConstraints sbe' $ fromShelleyTxId $ Ledger.txIdTxBody (tx' ^. Ledger.bodyTxL)
+
 mkGenesisTransaction :: forall era .
      IsShelleyBasedEra era
   => SigningKey GenesisUTxOKey
@@ -119,18 +128,24 @@ mkGenesisTransaction :: forall era .
   -> [TxIn]
   -> [TxOut CtxTx era]
   -> Either TxGenError (Tx era)
-mkGenesisTransaction key ttl fee txins txouts
-  = bimap
-      ApiError
-      (\b -> signShelleyTransaction (shelleyBasedEra @era) b [WitnessGenesisUTxOKey key])
-      (createTransactionBody (shelleyBasedEra @era) txBodyContent)
+mkGenesisTransaction key ttl fee txins txouts =
+  shelleyBasedEraConstraints sbe $
+    let txInputs = zip txins $ repeat $ BuildTxWith $ KeyWitness KeyWitnessForSpending
+        ledgerTxBody =
+          mkCommonTxBody sbe txInputs txouts (mkTxFee fee) TxWithdrawalsNone Nothing
+            & invalidHereAfterTxBodyL sbe .~ convValidityUpperBound sbe (mkTxValidityUpperBound ttl)
+        rawBody = ledgerTxBody ^. txBodyL
+        unsignedLedgerTx = Ledger.mkBasicTx rawBody
+        txHash = Ledger.extractHash $ Ledger.hashAnnotated rawBody
+        shelleySigningKey = toShelleySigningKey (WitnessGenesisUTxOKey key)
+        witVKey = WitVKey
+          (getShelleyKeyWitnessVerificationKey shelleySigningKey)
+          (makeShelleySignature txHash shelleySigningKey)
+        signedLedgerTx = unsignedLedgerTx
+          & Ledger.witsTxL .~ (Ledger.mkBasicTxWits & Ledger.addrTxWitsL .~ Set.singleton witVKey)
+    in Right $ ShelleyTx sbe signedLedgerTx
  where
-  txBodyContent = defaultTxBodyContent shelleyBasedEra
-    & setTxIns (zip txins $ repeat $ BuildTxWith $ KeyWitness KeyWitnessForSpending)
-    & setTxOuts txouts
-    & setTxFee (mkTxFee fee)
-    & setTxValidityLowerBound TxValidityNoLowerBound
-    & setTxValidityUpperBound (mkTxValidityUpperBound ttl)
+  sbe = shelleyBasedEra @era
 
 castKey :: SigningKey PaymentKey -> SigningKey GenesisUTxOKey
 castKey (PaymentSigningKey skey) = GenesisUTxOSigningKey skey