Update dependencies

Note that this does not incorporate the latest changes in cardano-ledger-specs. Notable changes: * IntersectMBO/ouroboros-network#2807 * IntersectMBO/ouroboros-network#2811 * IntersectMBO/ouroboros-network#2832 network tracers: moved ToObject TxSubmission instance network tracers: added ToObjcet TxSubmission2 instance Update cabal.project index-state value
IntersectMBO · Jan 17, 2021 · 0f77fe5 · 0f77fe5
1 parent 345fe9d
commit 0f77fe5
Show file tree

Hide file tree

Showing 9 changed files with 81 additions and 58 deletions.
diff --git a/cabal.project b/cabal.project
@@ -1,4 +1,4 @@
-index-state: 2020-12-11T00:00:00Z
+index-state: 2021-01-12T00:00:00Z
 
 packages:
     cardano-api
@@ -91,8 +91,8 @@ package io-sim-classes
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-base
-  tag: 6a6ea9695ee898dd7d4fd7a5d2cc639d7d5764f7
-  --sha256: 1hkq5i9fjjr4picx3plq3s09isrmx6jifpqf57c7viqfdrwlhjnj
+  tag: 4251c0bb6e4f443f00231d28f5f70d42876da055
+  --sha256: 02a61ymvx054pcdcgvg5qj9kpybiajg993nr22iqiya196jmgciv
   subdir:
     binary
     binary/test
@@ -104,14 +104,14 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-crypto
-  tag: 2547ad1e80aeabca2899951601079408becbc92c
-  --sha256: 1p2kg2w02q5w1cvqzhfhqmxviy4xrzada3mmb096j2n6hfr20kri
+  tag: f73079303f663e028288f9f4a9e08bcca39a923e
+  --sha256: 1n87i15x54s0cjkh3nsxs4r1x016cdw1fypwmr68936n3xxsjn6q
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-ledger-specs
-  tag: a638b9fa854fced8b8165631885268e3814f2d90
-  --sha256: 0jfdiha2xjjvqqi3dy410whzjiyhs3vxyic423ddlpbi1pdr3xdd
+  tag: cf3b01490a2cc7ebbb5ac6f7a4de79e8b1d5c70f
+  --sha256: 1v15xqy0qvb7ll4080pplrq2ygqgnf443kaq5i6mj0105941mcjc
   subdir:
     byron/chain/executable-spec
     byron/crypto
@@ -159,8 +159,8 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/ouroboros-network
-  tag: 4fdc309f855792ed30271c30dcd9159232404787
-  --sha256: 1j03pzqw0n10m9af17q37b6l90x2qdajp30xjpv2247rwpgip31i
+  tag: 8b176d11ccf5946fc3f715623cc779c3c449dc8d
+  --sha256: 0bn9zgx4vrxizxw79ay2dskh8l1lywz6jb4h8h2ikipi7bvkxq7m
   subdir:
     io-sim
     io-sim-classes

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Orphans.hs b/cardano-cli/src/Cardano/CLI/Shelley/Orphans.hs
@@ -124,7 +124,6 @@ deriving newtype instance ToJSON (Ledger.Stake StandardCrypto)
 
 deriving anyclass instance ToJSON (Ledger.GenDelegs StandardCrypto)
 deriving anyclass instance ToJSON (Ledger.IndividualPoolStake StandardCrypto)
-deriving anyclass instance ToJSON (Ledger.BlocksMade StandardCrypto)
 
 deriving anyclass instance ToJSON (Ledger.ProposedPPUpdates StandardShelley)
 deriving anyclass instance ToJSON (Ledger.PPUPState StandardShelley)

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs
@@ -606,7 +606,7 @@ queryStakeDistributionFromLocalState era connectInfo@LocalNodeConnectInfo{
 queryLocalLedgerState
   :: forall era ledgerera mode block.
      ShelleyLedgerEra era ~ ledgerera
-  => Ledger.ShelleyBased ledgerera
+  => Consensus.ShelleyBasedEra ledgerera
   => ShelleyBasedEra era
   -> LocalNodeConnectInfo mode block
   -> ExceptT ShelleyQueryCmdLocalStateQueryError IO

diff --git a/cardano-node/src/Cardano/Node/Configuration/Logging.hs b/cardano-node/src/Cardano/Node/Configuration/Logging.hs
@@ -273,9 +273,6 @@ nodeBasicInfo nc p nodeStartTime' = do
           Consensus.ProtocolShelley {} ->
             let DegenLedgerConfig cfgShelley = Consensus.configLedger cfg
             in getGenesisValues "Shelley" cfgShelley
-          Consensus.ProtocolMary {} ->
-            let DegenLedgerConfig cfgMary = Consensus.configLedger cfg
-            in getGenesisValues "Mary" cfgMary
           Consensus.ProtocolCardano {} ->
             let CardanoLedgerConfig cfgByron cfgShelley cfgAllegra cfgMary = Consensus.configLedger cfg
             in getGenesisValuesByron cfg cfgByron

diff --git a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs
@@ -21,7 +21,6 @@ module Cardano.Node.Protocol.Cardano
   ) where
 
 import           Prelude
-import           Cardano.Prelude (headMay)
 
 import           Control.Monad.Trans.Except (ExceptT)
 import           Control.Monad.Trans.Except.Extra (firstExceptT)
@@ -168,7 +167,7 @@ mkConsensusProtocolCardano NodeByronProtocolConfiguration {
           shelleyBasedInitialNonce =
             Shelley.genesisHashToPraosNonce shelleyGenesisHash,
           shelleyBasedLeaderCredentials =
-            headMay shelleyLeaderCredentials
+            shelleyLeaderCredentials
         }
         Consensus.ProtocolParamsShelley {
           -- This is /not/ the Shelley protocol version. It is the protocol

diff --git a/cardano-node/src/Cardano/Node/Query.hs b/cardano-node/src/Cardano/Node/Query.hs
@@ -73,8 +73,6 @@ answerQueryWithLedgerState protocol extLedgerState query = runIdentity $
         byronQuery
       Consensus.ProtocolShelley {} ->
         shelleyBasedQuery
-      Consensus.ProtocolMary {} ->
-        shelleyBasedQuery
       Consensus.ProtocolCardano {} ->
         HF.forwardCompatQuery
           answerQueryHelper

diff --git a/cardano-node/src/Cardano/Tracing/Config.hs b/cardano-node/src/Cardano/Tracing/Config.hs
@@ -60,6 +60,7 @@ type TraceMux = ("TraceMux" :: Symbol)
 type TraceTxInbound = ("TraceTxInbound" :: Symbol)
 type TraceTxOutbound = ("TraceTxOutbound" :: Symbol)
 type TraceTxSubmissionProtocol = ("TraceTxSubmissionProtocol" :: Symbol)
+type TraceTxSubmission2Protocol = ("TraceTxSubmission2Protocol" :: Symbol)
 
 newtype OnOff (name :: Symbol) = OnOff { isOn :: Bool } deriving (Eq, Show)
 
@@ -107,6 +108,7 @@ data TraceSelection
   , traceTxInbound :: OnOff TraceTxInbound
   , traceTxOutbound :: OnOff TraceTxOutbound
   , traceTxSubmissionProtocol :: OnOff TraceTxSubmissionProtocol
+  , traceTxSubmission2Protocol :: OnOff TraceTxSubmission2Protocol
   } deriving (Eq, Show)
 
 
@@ -175,7 +177,9 @@ traceConfigParser v =
       txOutbound :: OnOff TraceTxOutbound
       txOutbound = OnOff False
       txSubmissionProtocol :: OnOff TraceTxSubmissionProtocol
-      txSubmissionProtocol = OnOff False in
+      txSubmissionProtocol = OnOff False
+      txSubmission2Protocol :: OnOff TraceTxSubmission2Protocol
+      txSubmission2Protocol = OnOff False in
 
   TracingOn <$> (TraceSelection
     <$> v .:? "TracingVerbosity" .!= NormalVerbosity
@@ -211,4 +215,5 @@ traceConfigParser v =
     <*> v .:? getName mux .!= mux
     <*> v .:? getName txInbound .!= txInbound
     <*> v .:? getName txOutbound .!= txOutbound
-    <*> v .:? getName txSubmissionProtocol .!= txSubmissionProtocol)
+    <*> v .:? getName txSubmissionProtocol .!= txSubmissionProtocol
+    <*> v .:? getName txSubmission2Protocol .!= txSubmission2Protocol)
diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs
@@ -33,7 +33,7 @@ import           Ouroboros.Network.BlockFetch.ClientState (TraceFetchClientState
                      TraceLabelPeer (..))
 import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch
 import           Ouroboros.Network.BlockFetch.Decision (FetchDecision, FetchDecline (..))
-import           Ouroboros.Network.Codec (AnyMessageAndAgency (..))
+import           Ouroboros.Network.Codec (AnyMessageAndAgency (..), PeerHasAgency (..))
 import           Ouroboros.Network.DeltaQ (GSV (..), PeerGSV (..))
 import           Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..))
 import qualified Ouroboros.Network.NodeToClient as NtC
@@ -48,6 +48,9 @@ import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQu
 import           Ouroboros.Network.Protocol.LocalTxSubmission.Type (LocalTxSubmission)
 import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Type as LocalTxSub
 import           Ouroboros.Network.Protocol.TxSubmission.Type (Message (..), TxSubmission)
+import           Ouroboros.Network.Protocol.TxSubmission2.Type (TxSubmission2)
+import           Ouroboros.Network.Protocol.Trans.Hello.Type (Message (..),
+                     ClientHasAgency (..), ServerHasAgency (..))
 import           Ouroboros.Network.Snocket (LocalAddress (..))
 import           Ouroboros.Network.Subscription (ConnectResult (..), DnsTrace (..),
                      SubscriberError (..), SubscriptionTrace (..), WithDomainName (..),
@@ -533,6 +536,63 @@ instance ToObject (AnyMessageAndAgency (ChainSync blk pt tip)) where
               , "agency" .= String (pack $ show stok)
               ]
 
+instance (Show txid, Show tx)
+      => ToObject (AnyMessageAndAgency (TxSubmission txid tx)) where
+  toObject _verb (AnyMessageAndAgency stok (MsgRequestTxs txids)) =
+    mkObject
+      [ "kind" .= String "MsgRequestTxs"
+      , "agency" .= String (pack $ show stok)
+      , "txIds" .= String (pack $ show txids)
+      ]
+  toObject _verb (AnyMessageAndAgency stok (MsgReplyTxs txs)) =
+    mkObject
+      [ "kind" .= String "MsgReplyTxs"
+      , "agency" .= String (pack $ show stok)
+      , "txs" .= String (pack $ show txs)
+      ]
+  toObject _verb (AnyMessageAndAgency stok (MsgRequestTxIds _ _ _)) =
+    mkObject
+      [ "kind" .= String "MsgRequestTxIds"
+      , "agency" .= String (pack $ show stok)
+      ]
+  toObject _verb (AnyMessageAndAgency stok (MsgReplyTxIds _)) =
+    mkObject
+      [ "kind" .= String "MsgReplyTxIds"
+      , "agency" .= String (pack $ show stok)
+      ]
+  toObject _verb (AnyMessageAndAgency stok MsgDone) =
+    mkObject
+      [ "kind" .= String "MsgDone"
+      , "agency" .= String (pack $ show stok)
+      ]
+  --TODO: Can't use 'MsgKThxBye' because NodeToNodeV_2 is not introduced yet.
+  toObject _verb (AnyMessageAndAgency stok _) =
+    mkObject
+      [ "kind" .= String "MsgKThxBye"
+      , "agency" .= String (pack $ show stok)
+      ]
+
+instance (Show txid, Show tx)
+      => ToObject (AnyMessageAndAgency (TxSubmission2 txid tx)) where
+  toObject _verb (AnyMessageAndAgency
+                   -- we need this pattern match for GHC to recognise this
+                   -- function as total.
+                   (stok@(ClientAgency TokHello))
+                   MsgHello) =
+    mkObject
+      [ "kind" .= String "MsgHello"
+      , "agency" .= String (pack $ show stok)
+      ]
+  toObject verb (AnyMessageAndAgency
+                  (ClientAgency (TokClientTalk stok))
+                  (MsgTalk msg)) =
+    toObject verb (AnyMessageAndAgency (ClientAgency stok) msg)
+  toObject verb (AnyMessageAndAgency
+                  (ServerAgency (TokServerTalk stok))
+                  (MsgTalk msg)) =
+    toObject verb (AnyMessageAndAgency (ServerAgency stok) msg)
+
+
 instance ToObject (FetchDecision [Point header]) where
   toObject _verb (Left decline) =
     mkObject [ "kind" .= String "FetchDecision declined"
@@ -635,43 +695,6 @@ instance ToObject NtN.AcceptConnectionsPolicyTrace where
              ]
 
 
-instance (Show txid, Show tx)
-      => ToObject (AnyMessageAndAgency (TxSubmission txid tx)) where
-  toObject _verb (AnyMessageAndAgency stok (MsgRequestTxs txids)) =
-    mkObject
-      [ "kind" .= String "MsgRequestTxs"
-      , "agency" .= String (pack $ show stok)
-      , "txIds" .= String (pack $ show txids)
-      ]
-  toObject _verb (AnyMessageAndAgency stok (MsgReplyTxs txs)) =
-    mkObject
-      [ "kind" .= String "MsgReplyTxs"
-      , "agency" .= String (pack $ show stok)
-      , "txs" .= String (pack $ show txs)
-      ]
-  toObject _verb (AnyMessageAndAgency stok (MsgRequestTxIds _ _ _)) =
-    mkObject
-      [ "kind" .= String "MsgRequestTxIds"
-      , "agency" .= String (pack $ show stok)
-      ]
-  toObject _verb (AnyMessageAndAgency stok (MsgReplyTxIds _)) =
-    mkObject
-      [ "kind" .= String "MsgReplyTxIds"
-      , "agency" .= String (pack $ show stok)
-      ]
-  toObject _verb (AnyMessageAndAgency stok MsgDone) =
-    mkObject
-      [ "kind" .= String "MsgDone"
-      , "agency" .= String (pack $ show stok)
-      ]
-  --TODO: Can't use 'MsgKThxBye' because NodeToNodeV_2 is not introduced yet.
-  toObject _verb (AnyMessageAndAgency stok _) =
-    mkObject
-      [ "kind" .= String "MsgKThxBye"
-      , "agency" .= String (pack $ show stok)
-      ]
-
-
 instance ConvertRawHash blk
       => ToObject (Point blk) where
   toObject _verb GenesisPoint =

diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs
@@ -327,6 +327,7 @@ mkTracers TracingOff _ _ =
       , NodeToNode.tBlockFetchTracer = nullTracer
       , NodeToNode.tBlockFetchSerialisedTracer = nullTracer
       , NodeToNode.tTxSubmissionTracer = nullTracer
+      , NodeToNode.tTxSubmission2Tracer = nullTracer
       }
     , ipSubscriptionTracer = nullTracer
     , dnsSubscriptionTracer= nullTracer
@@ -865,6 +866,7 @@ nodeToNodeTracers' trSel verb tr =
   , NodeToNode.tBlockFetchTracer = tracerOnOff (traceBlockFetchProtocol trSel) verb "BlockFetchProtocol" tr
   , NodeToNode.tBlockFetchSerialisedTracer = showOnOff (traceBlockFetchProtocolSerialised trSel) "BlockFetchProtocolSerialised" tr
   , NodeToNode.tTxSubmissionTracer = tracerOnOff (traceTxSubmissionProtocol trSel) verb "TxSubmissionProtocol" tr
+  , NodeToNode.tTxSubmission2Tracer = tracerOnOff (traceTxSubmission2Protocol trSel) verb "TxSubmission2Protocol" tr
   }
 
 teeTraceBlockFetchDecision