UTxO-HD targeting main

.github/workflows/haskell.yml

@@ -97,6 +97,19 @@ jobs:
       with:
         use-sodium-vrf: true # default is true
 
+    - name: Linux install lmdb
+      if: matrix.sys.os == 'ubuntu-latest'
+      run: sudo apt install liblmdb-dev
+
+    - name: Mac install lmdb
+      if: matrix.sys.os == 'macos-13'
+      run: brew install lmdb
+
+    - name: Windows install lmdb
+      if: matrix.sys.os == 'windows-latest'
+      shell: 'C:/msys64/usr/bin/bash.exe -e {0}'
+      run: /usr/bin/pacman --noconfirm -S mingw-w64-x86_64-lmdb
+
     - uses: actions/checkout@v4
 
     - name: Cabal update

.gitignore

@@ -7,9 +7,7 @@
 /cabal.project.old
 configuration/defaults/simpleview/genesis/
 configuration/defaults/liveview/genesis/
-dist-newstyle
-dist-newstyle/
-dist-profiled/
+dist-*
 dist/
 *~
 \#*
@@ -20,12 +18,13 @@ dist/
 result*
 /launch-*
 stack.yaml.lock
+.ghcid
 
 /.cache
 /db
 /db-[0-9]
 /logs
-/mainnet
+/mainnet*
 /profile
 /launch_*
 /state-*

bench/locli/locli.cabal

@@ -119,7 +119,7 @@ library
                       , hashable
                       , optparse-applicative-fork >= 0.18.1
                       , ouroboros-consensus
-                      , ouroboros-network-api ^>= 0.10
+                      , ouroboros-network-api ^>= 0.12
                       , sop-core
                       , split
                       , sqlite-easy >= 1.1.0.1
@@ -189,7 +189,7 @@ test-suite test-locli
   build-depends:        cardano-prelude
                       , containers
                       , hedgehog
-                      , hedgehog-extras ^>= 0.6.4
+                      , hedgehog-extras >= 0.6.4 && <0.6.5.1
                       , locli
                       , text
 

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

@@ -82,10 +82,10 @@ library
   -- IOG dependencies
   --------------------------
   build-depends:
-    , cardano-api             ^>=10.1
-    , plutus-ledger-api       ^>=1.36
-    , plutus-tx               ^>=1.36
-    , plutus-tx-plugin        ^>=1.36
+    , cardano-api             ^>=10.5
+    , plutus-ledger-api       ^>=1.38
+    , plutus-tx               ^>=1.38
+    , plutus-tx-plugin        ^>=1.38
 
   ------------------------
   -- Non-IOG dependencies

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

@@ -13,7 +13,7 @@ module Cardano.Benchmarking.GeneratorTx.NodeToNode
   , benchmarkConnectTxSubmit
   ) where
 
-import           Cardano.Prelude (forever, liftIO)
+import           Cardano.Prelude (forever, liftIO, throwIO)
 import           Prelude
 
 import           "contra-tracer" Control.Tracer (Tracer (..))
@@ -25,7 +25,8 @@ import           Data.ByteString.Lazy (ByteString)
 import           Data.Foldable (fold)
 import qualified Data.Map.Strict as Map
 import           Data.Proxy (Proxy (..))
-import           Data.Void (Void)
+import           Data.Void (Void, absurd)
+import qualified Network.Mux as Mux
 import           Network.Socket (AddrInfo (..))
 import           System.Random (newStdGen)
 
@@ -45,7 +46,7 @@ import           Ouroboros.Network.DeltaQ (defaultGSV)
 import           Ouroboros.Network.Driver (runPeer, runPeerWithLimits)
 import           Ouroboros.Network.KeepAlive
 import           Ouroboros.Network.Magic
-import           Ouroboros.Network.Mux (MiniProtocolCb (..), MuxMode (..),
+import           Ouroboros.Network.Mux (MiniProtocolCb (..),
                    OuroborosApplication (..), OuroborosBundle, RunMiniProtocol (..))
 import           Ouroboros.Network.NodeToClient (chainSyncPeerNull)
 import           Ouroboros.Network.NodeToNode (NetworkConnectTracers (..))
@@ -84,8 +85,8 @@ benchmarkConnectTxSubmit
   -- ^ the particular txSubmission peer
   -> IO ()
 
-benchmarkConnectTxSubmit EnvConsts { .. } handshakeTracer submissionTracer codecConfig networkMagic remoteAddr myTxSubClient =
-  NtN.connectTo
+benchmarkConnectTxSubmit EnvConsts { .. } handshakeTracer submissionTracer codecConfig networkMagic remoteAddr myTxSubClient = do
+  done <- NtN.connectTo
     (socketSnocket envIOManager)
     NetworkConnectTracers {
         nctMuxTracer       = mempty,
@@ -94,6 +95,11 @@ benchmarkConnectTxSubmit EnvConsts { .. } handshakeTracer submissionTracer codec
     peerMultiplex
     (addrAddress <$> Nothing)
     (addrAddress remoteAddr)
+  case done of
+    Left err -> throwIO err
+    Right choice -> case choice of
+      Left () -> return ()
+      Right void -> absurd void
  where
   ownPeerSharing = PeerSharingDisabled
   mkApp :: OuroborosBundle      mode initiatorCtx responderCtx bs m a b
@@ -114,7 +120,7 @@ benchmarkConnectTxSubmit EnvConsts { .. } handshakeTracer submissionTracer codec
   peerMultiplex :: NtN.Versions NodeToNodeVersion
                                 NtN.NodeToNodeVersionData
                                 (OuroborosApplication
-                                  'InitiatorMode
+                                  'Mux.InitiatorMode
                                   (MinimalInitiatorContext NtN.RemoteAddress)
                                   (ResponderContext NtN.RemoteAddress)
                                   ByteString IO () Void)

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

@@ -45,7 +45,7 @@ import           Cardano.Tracing.OrphanInstances.Consensus ()
 import           Cardano.Tracing.OrphanInstances.Network ()
 import           Cardano.Tracing.OrphanInstances.Shelley ()
 
-import           Ouroboros.Network.Protocol.TxSubmission2.Type (TokBlockingStyle (..))
+import           Ouroboros.Network.Protocol.TxSubmission2.Type (SingBlockingStyle (..))
 
 import           Cardano.Api hiding (Active)
 import           Cardano.TxGenerator.Types (TPSRate, TxGenError)
@@ -124,11 +124,11 @@ mkSubmissionSummary startTime reportsRefs
 txStreamSource :: forall era. MVar (StreamState (TxStream IO era)) -> TpsThrottle -> TxSource era
 txStreamSource streamRef tpsThrottle = Active worker
  where
-  worker :: forall m blocking . MonadIO m => TokBlockingStyle blocking -> Req -> m (TxSource era, [Tx era])
+  worker :: forall m blocking . MonadIO m => SingBlockingStyle blocking -> Req -> m (TxSource era, [Tx era])
   worker blocking req = do
     (done, txCount) <- case blocking of
-       TokBlocking -> liftIO $ consumeTxsBlocking tpsThrottle req
-       TokNonBlocking -> liftIO $ consumeTxsNonBlocking tpsThrottle req
+       SingBlocking -> liftIO $ consumeTxsBlocking tpsThrottle req
+       SingNonBlocking -> liftIO $ consumeTxsNonBlocking tpsThrottle req
     txList <- liftIO $ unFold txCount
     case done of
       Stop -> return (Exhausted, txList)

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

@@ -46,7 +46,7 @@ import qualified Ouroboros.Consensus.Shelley.Ledger.Mempool as Mempool (TxId (Sh
 import           Ouroboros.Network.Protocol.TxSubmission2.Client (ClientStIdle (..),
                    ClientStTxIds (..), ClientStTxs (..), TxSubmissionClient (..))
 import           Ouroboros.Network.Protocol.TxSubmission2.Type (BlockingReplyList (..),
-                   NumTxIdsToAck (..), NumTxIdsToReq (..), TokBlockingStyle (..))
+                   NumTxIdsToAck (..), NumTxIdsToReq (..), SingBlockingStyle (..))
 import           Ouroboros.Network.SizeInBytes
 
 import           Prelude (error, fail)
@@ -71,14 +71,14 @@ data TxSource era
   = Exhausted
   | Active (ProduceNextTxs era)
 
-type ProduceNextTxs era = (forall m blocking . MonadIO m => TokBlockingStyle blocking -> Req -> m (TxSource era, [Tx era]))
+type ProduceNextTxs era = (forall m blocking . MonadIO m => SingBlockingStyle blocking -> Req -> m (TxSource era, [Tx era]))
 
-produceNextTxs :: forall m blocking era . MonadIO m => TokBlockingStyle blocking -> Req -> LocalState era -> m (LocalState era, [Tx era])
+produceNextTxs :: forall m blocking era . MonadIO m => SingBlockingStyle blocking -> Req -> LocalState era -> m (LocalState era, [Tx era])
 produceNextTxs blocking req (txProducer, unack, stats) = do
   (newTxProducer, txList) <- produceNextTxs' blocking req txProducer
   return ((newTxProducer, unack, stats), txList)
 
-produceNextTxs' :: forall m blocking era . MonadIO m => TokBlockingStyle blocking -> Req -> TxSource era -> m (TxSource era, [Tx era])
+produceNextTxs' :: forall m blocking era . MonadIO m => SingBlockingStyle blocking -> Req -> TxSource era -> m (TxSource era, [Tx era])
 produceNextTxs' _ _ Exhausted = return (Exhausted, [])
 produceNextTxs' blocking req (Active callback) = callback blocking req
 
@@ -99,10 +99,10 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
   TxSubmissionClient $
     pure $ client (initialTxSource, UnAcked [], SubmissionThreadStats 0 0 0)
  where
-  discardAcknowledged :: TokBlockingStyle a -> Ack -> LocalState era -> m (LocalState era)
+  discardAcknowledged :: SingBlockingStyle a -> Ack -> LocalState era -> m (LocalState era)
   discardAcknowledged blocking (Ack ack) (txSource, UnAcked unAcked, stats) = do
     when (tokIsBlocking blocking && ack /= length unAcked) $ do
-      let err = "decideAnnouncement: TokBlocking, but length unAcked != ack"
+      let err = "decideAnnouncement: SingBlocking, but length unAcked != ack"
       traceWith bmtr (TraceBenchTxSubError err)
       fail (T.unpack err)
     let (stillUnacked, acked) = L.splitAtEnd ack unAcked
@@ -123,7 +123,7 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
 
   requestTxIds :: forall blocking.
        LocalState era
-    -> TokBlockingStyle blocking
+    -> SingBlockingStyle blocking
     -> NumTxIdsToAck
     -> NumTxIdsToReq
     -> m (ClientStTxIds blocking (GenTxId CardanoBlock) (GenTx CardanoBlock) m ())
@@ -140,15 +140,15 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
     traceWith bmtr $ SubmissionClientUnAcked (getTxId . getTxBody <$> outs)
 
     case blocking of
-      TokBlocking -> case NE.nonEmpty newTxs of
+      SingBlocking -> case NE.nonEmpty newTxs of
         Nothing -> do
           traceWith tr EndOfProtocol
           endOfProtocolCallback stats
           pure $ SendMsgDone ()
         (Just txs) -> pure $ SendMsgReplyTxIds
                               (BlockingReply $ txToIdSize <$> txs)
                               (client stateC)
-      TokNonBlocking ->  pure $ SendMsgReplyTxIds
+      SingNonBlocking ->  pure $ SendMsgReplyTxIds
                              (NonBlockingReply $ txToIdSize <$> newTxs)
                              (client stateC)
 
@@ -196,17 +196,17 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
   fromGenTxId (Block.GenTxIdConway  (Mempool.ShelleyTxId i)) = fromShelleyTxId i
   fromGenTxId _ = error "TODO: fix incomplete match"
 
-  tokIsBlocking :: TokBlockingStyle a -> Bool
+  tokIsBlocking :: SingBlockingStyle a -> Bool
   tokIsBlocking = \case
-    TokBlocking    -> True
-    TokNonBlocking -> False
+    SingBlocking    -> True
+    SingNonBlocking -> False
 
-  reqIdsTrace :: Ack -> Req -> TokBlockingStyle a -> NodeToNodeSubmissionTrace
+  reqIdsTrace :: Ack -> Req -> SingBlockingStyle a -> NodeToNodeSubmissionTrace
   reqIdsTrace ack req = \case
-     TokBlocking    -> ReqIdsBlocking ack req
-     TokNonBlocking -> ReqIdsNonBlocking ack req
+     SingBlocking    -> ReqIdsBlocking ack req
+     SingNonBlocking -> ReqIdsNonBlocking ack req
 
-  idListTrace :: ToAnnce tx -> TokBlockingStyle a -> NodeToNodeSubmissionTrace
+  idListTrace :: ToAnnce tx -> SingBlockingStyle a -> NodeToNodeSubmissionTrace
   idListTrace (ToAnnce toAnn) = \case
-     TokBlocking    -> IdsListBlocking $ length toAnn
-     TokNonBlocking -> IdsListNonBlocking $ length toAnn
+     SingBlocking    -> IdsListBlocking $ length toAnn
+     SingNonBlocking -> IdsListNonBlocking $ length toAnn

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

@@ -51,7 +51,7 @@ import qualified Control.Concurrent.STM as STM (TVar)
 import           Data.Text
 import           Data.Time.Clock (DiffTime, NominalDiffTime)
 import           GHC.Generics
-import           Network.Mux (WithMuxBearer (..))
+import qualified Network.Mux as Mux
 
 data AsyncBenchmarkControl =
   AsyncBenchmarkControl
@@ -149,7 +149,7 @@ data NodeToNodeSubmissionTrace
 
 type SendRecvTxSubmission2 = TraceSendRecv (TxSubmission2 (GenTxId CardanoBlock) (GenTx CardanoBlock))
 
-type SendRecvConnect = WithMuxBearer
+type SendRecvConnect = Mux.WithBearer
                          RemoteConnectionId
                          (TraceSendRecv (Handshake
                                            NodeToNodeVersion

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingStrategies #-}
@@ -123,17 +124,19 @@ initTxGenTracers mbForwarding = do
   prepareForwardingTracer = forM mbForwarding $
     \(iomgr, networkId, tracerSocket) -> do
         let forwardingConf = fromMaybe defaultForwarder (tcForwarder initialTraceConfig)
-        (forwardSink :: ForwardSink TraceObject, dpStore) <-
-          initForwarding iomgr forwardingConf (toNetworkMagic networkId) Nothing $ Just (tracerSocket, Initiator)
+        (forwardSink :: ForwardSink TraceObject, dpStore, kickoffForwarder) <-
+            initForwardingDelayed iomgr forwardingConf (toNetworkMagic networkId) Nothing $ Just (tracerSocket, Initiator)
 
         -- we need to provide NodeInfo DataPoint, to forward generator's name
         -- to the acceptor application (for example, 'cardano-tracer').
         let
           dpt :: Trace IO DataPoint
           dpt = dataPointTracer dpStore
         nodeInfoTracer <- mkDataPointTracer dpt
-        prepareGenInfo >>= traceWith nodeInfoTracer
+        !genInfo <- prepareGenInfo
+        traceWith nodeInfoTracer genInfo
 
+        kickoffForwarder
         pure $ forwardTracer forwardSink
 
   prepareGenInfo :: IO NodeInfo

bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs

@@ -259,7 +259,7 @@ preExecutePlutusV3 (major, _minor) (PlutusScript _ (PlutusScriptSerialised (scri
       { PlutusV3.txInfoInputs = []
       , PlutusV3.txInfoOutputs = []
       , PlutusV3.txInfoFee = 0
-      , PlutusV3.txInfoMint = mempty
+      , PlutusV3.txInfoMint = PlutusV3.emptyMintValue
       , PlutusV3.txInfoTxCerts = []
       , PlutusV3.txInfoWdrl = PlutusV3.unsafeFromList []
       , PlutusV3.txInfoValidRange = PlutusV3.always

bench/tx-generator/tx-generator.cabal

@@ -106,9 +106,9 @@ library
                       , attoparsec-aeson
                       , base16-bytestring
                       , bytestring
-                      , cardano-api ^>= 10.1
+                      , cardano-api ^>= 10.5
                       , cardano-binary
-                      , cardano-cli ^>= 10.1
+                      , cardano-cli ^>= 10.2
                       , cardano-crypto-class
                       , cardano-crypto-wrapper
                       , cardano-data
@@ -158,6 +158,7 @@ library
                       , transformers-except
                       , unordered-containers
                       , yaml
+                      , microlens
 
   default-language:     Haskell2010
   default-extensions:   OverloadedStrings