IntersectMBO · iohk-bors · Dec 22, 2020 · Dec 22, 2020 · Dec 22, 2020 · Dec 21, 2020
@@ -152,8 +152,8 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-ledger-specs
-  tag: 5dc8d805bf7f63fe24c919c4b016b4d591abe66e
-  --sha256: 14985r1sn1bbjdn1bami4aahza5vm29aj6psz2zyvichhcma90vn
+  tag: cf3b01490a2cc7ebbb5ac6f7a4de79e8b1d5c70f
+  --sha256: 1v15xqy0qvb7ll4080pplrq2ygqgnf443kaq5i6mj0105941mcjc
   subdir:
     byron/chain/executable-spec
     byron/crypto

@@ -35,6 +35,7 @@ module Ouroboros.Consensus.ByronSpec.Ledger.Rules (
 import           Control.Monad
 import           Control.Monad.Trans.Except
 import           Data.Functor.Identity
+import           Data.Proxy
 import qualified Data.Set as Set
 
 import qualified Byron.Spec.Chain.STS.Rule.BBody as Spec
@@ -142,11 +143,12 @@ data RuleContext sts = RuleContext {
     }
 
 applySTS :: forall sts. (Spec.STS sts, Spec.BaseM sts ~ Identity)
-         => Spec.Environment sts
+         => Proxy sts
+         -> Spec.Environment sts
          -> Spec.Signal sts
          -> Spec.State sts
          -> Except [[Spec.PredicateFailure sts]] (Spec.State sts)
-applySTS env signal state = except $
+applySTS _ env signal state = except $
     Spec.applySTS @sts $ Spec.TRC (env, state, signal)
 
 type LiftedRule sts = Spec.Signal sts
@@ -159,7 +161,7 @@ liftRule :: forall sts. (Spec.STS sts, Spec.BaseM sts ~ Identity)
          => RuleContext sts -> LiftedRule sts
 liftRule RuleContext{..} signal st =
     withExcept (map (map liftFailure)) $
-      modRuleState (applySTS @sts (getRuleEnv st) signal) st
+      modRuleState (applySTS (Proxy @sts) (getRuleEnv st) signal) st
 
 {-------------------------------------------------------------------------------
   Instances of 'RuleContext'

@@ -37,4 +37,5 @@ instance CardanoHardForkConstraints c
     CardanoNodeToClientVersion3 -> "CardanoNodeToClientVersion3"
     CardanoNodeToClientVersion4 -> "CardanoNodeToClientVersion4"
     CardanoNodeToClientVersion5 -> "CardanoNodeToClientVersion5"
+    CardanoNodeToClientVersion6 -> "CardanoNodeToClientVersion6"
     _                           -> error $ "Unknown version: " <> show v
@@ -0,0 +1 @@
+�
@@ -0,0 +1 @@
+��	X �TF����b�Nެ�K��wy�=�Th�|Y
@@ -0,0 +1 @@
+��X��ts.���?9Z�E����P#��2�d

@@ -0,0 +1 @@
+��X�1���s��]k?�ժ�P�[{%A��X �����-�ò^46���R�>b�{L
@@ -0,0 +1 @@
+�
@@ -0,0 +1 @@
+��	X ��E<���p���2W@Y��rJt=&��v��j
@@ -0,0 +1 @@
+��X��ts.���?9Z�E����P#��2�d

@@ -0,0 +1 @@
+��X�1���s��]k?�ժ�P�[{%A��X �����-�ò^46���R�>b�{L
@@ -0,0 +1 @@
+�
@@ -0,0 +1 @@
+��	X ��� u��'9Ki�(�׺y���C����)�l
@@ -0,0 +1 @@
+��X��ts.���?9Z�E����P#��2�d

@@ -0,0 +1 @@
+��X�1���s��]k?�ժ�P�[{%A��X �����-�ò^46���R�>b�{L
@@ -0,0 +1 @@
+�O<CARDANO_BLOCK>
@@ -0,0 +1 @@
+�O<CARDANO_BLOCK>
@@ -0,0 +1 @@
+�O<CARDANO_BLOCK>
@@ -0,0 +1 @@
+�O<CARDANO_BLOCK>
@@ -0,0 +1 @@
+�O<CARDANO_BLOCK>
@@ -29,6 +29,7 @@ module Ouroboros.Consensus.Cardano.Node (
   , pattern CardanoNodeToClientVersion3
   , pattern CardanoNodeToClientVersion4
   , pattern CardanoNodeToClientVersion5
+  , pattern CardanoNodeToClientVersion6
   ) where
 
 import qualified Codec.CBOR.Decoding as CBOR
@@ -297,6 +298,20 @@ pattern CardanoNodeToClientVersion5 =
       :* Nil
       )
 
+-- | The hard fork enabled, and the Shelley, Allegra, and Mary eras enabled, but
+-- using 'ShelleyNodeToClientVersion3' for the Shelley-based eras , which
+-- enables new queries.
+pattern CardanoNodeToClientVersion6 :: BlockNodeToClientVersion (CardanoBlock c)
+pattern CardanoNodeToClientVersion6 =
+    HardForkNodeToClientEnabled
+      HardForkSpecificNodeToClientVersion2
+      (  EraNodeToClientEnabled ByronNodeToClientVersion1
+      :* EraNodeToClientEnabled ShelleyNodeToClientVersion3
+      :* EraNodeToClientEnabled ShelleyNodeToClientVersion3
+      :* EraNodeToClientEnabled ShelleyNodeToClientVersion3
+      :* Nil
+      )
+
 instance CardanoHardForkConstraints c
       => SupportedNetworkProtocolVersion (CardanoBlock c) where
   supportedNodeToNodeVersions _ = Map.fromList $
@@ -314,6 +329,7 @@ instance CardanoHardForkConstraints c
       , (NodeToClientV_4, CardanoNodeToClientVersion3)
       , (NodeToClientV_5, CardanoNodeToClientVersion4)
       , (NodeToClientV_6, CardanoNodeToClientVersion5)
+      , (NodeToClientV_7, CardanoNodeToClientVersion6)
       ]
 
 {-------------------------------------------------------------------------------

@@ -72,7 +72,6 @@ import           Ouroboros.Consensus.Util.Time
 import qualified Cardano.Ledger.AuxiliaryData as SL (AuxiliaryDataHash (..))
 import qualified Cardano.Ledger.Core as Core
 import           Cardano.Ledger.Crypto (ADDRHASH, Crypto, DSIGN, HASH, VRF)
-import qualified Cardano.Ledger.Val as Val
 import           Shelley.Spec.Ledger.API (StrictMaybe (..))
 import qualified Shelley.Spec.Ledger.API as SL
 import qualified Shelley.Spec.Ledger.BaseTypes as SL (Seed (..),
@@ -320,7 +319,7 @@ exampleTxBodyShelley = SL.TxBody
         SL.AuxiliaryDataHash $ mkDummyHash (Proxy @(HASH StandardCrypto)) 30
 
 exampleTxBodyMA ::
-     forall era. (ShelleyBasedEra era, Val.EncodeMint (Core.Value era))
+     forall era. ShelleyBasedEra era
   => Core.Value era -> MA.TxBody era
 exampleTxBodyMA value = MA.TxBody
     exampleTxIns

@@ -0,0 +1 @@
+�
@@ -0,0 +1 @@
+�
@@ -0,0 +1 @@
+�
@@ -0,0 +1 @@
+�
@@ -0,0 +1 @@
+�
@@ -0,0 +1 @@
+
@@ -0,0 +1 @@
+�	X ��� u��'9Ki�(�׺y���C����)�l
@@ -0,0 +1 @@
+�X��ts.���?9Z�E����P#��2�d

@@ -0,0 +1 @@
+�X�1���s��]k?�ժ�P�[{%A��X �����-�ò^46���R�>b�{L
@@ -0,0 +1 @@
+�G<BLOCK>
@@ -21,6 +21,9 @@ data ShelleyNodeToClientVersion =
 
     -- | New queries introduced
   | ShelleyNodeToClientVersion2
+
+    -- | New query introduced
+  | ShelleyNodeToClientVersion3
   deriving (Show, Eq, Ord, Enum, Bounded)
 
 instance HasNetworkProtocolVersion (ShelleyBlock era) where
@@ -38,8 +41,12 @@ instance SupportedNetworkProtocolVersion (ShelleyBlock era) where
         (NodeToClientV_1, ShelleyNodeToClientVersion1)
         -- Enable the LocalStateQuery protocol, no serialisation changes
       , (NodeToClientV_2, ShelleyNodeToClientVersion1)
-        -- V_3 enables the hard fork, which didn't affect Shelley-only when
-        -- introduced. However, we have retroactively claimed V_3 to enable
-        -- 'ShelleyNodeToClientVersion2'.
+        -- V_3 enables the hard fork to Shelley, which didn't affect
+        -- Shelley-only when introduced. However, we have retroactively claimed
+        -- V_3 to enable 'ShelleyNodeToClientVersion2'.
       , (NodeToClientV_3, ShelleyNodeToClientVersion2)
+        -- V_4 enables the hard fork to Allegra, which didn't affect
+        -- Shelley-only when introduced. However, we have retroactively claimed
+        -- V_4 to enable 'ShelleyNodeToClientVersion3'.
+      , (NodeToClientV_4, ShelleyNodeToClientVersion3)
       ]
@@ -48,6 +48,7 @@ import           Ouroboros.Consensus.Util (ShowProxy (..))
 
 import qualified Shelley.Spec.Ledger.API as SL
 import qualified Shelley.Spec.Ledger.LedgerState as SL (RewardAccounts)
+import qualified Shelley.Spec.Ledger.RewardProvenance as SL (RewardProvenance)
 
 import           Ouroboros.Consensus.Shelley.Eras (EraCrypto)
 import           Ouroboros.Consensus.Shelley.Ledger.Block
@@ -142,6 +143,23 @@ data instance Query (ShelleyBlock era) :: Type -> Type where
   DebugChainDepState
     :: Query (ShelleyBlock era) (SL.ChainDepState (EraCrypto era))
 
+  GetRewardProvenance
+    :: Query (ShelleyBlock era) (SL.RewardProvenance (EraCrypto era))
+
+  -- WARNING: please add new queries to the end of the list and stick to this
+  -- order in all other pattern matches on queries. This helps in particular
+  -- with the en/decoders, as we want the CBOR tags to be ordered.
+  --
+  -- WARNING: when adding a new query, a new @ShelleyNodeToClientVersionX@ must
+  -- be added. See #2830 for a template on how to do this.
+  --
+  -- WARNING: never modify an existing query that has been incorporated in a
+  -- release of the node, as it will break compatibility with deployed nodes.
+  -- Instead, add a new query. To remove the old query, first to stop supporting
+  -- it by modifying 'querySupportedVersion' (@< X@) and when the version is no
+  -- longer used (because mainnet has hard-forked to a newer version), it can be
+  -- removed.
+
 instance Typeable era => ShowProxy (Query (ShelleyBlock era)) where
 
 instance ShelleyBasedEra era => QueryLedger (ShelleyBlock era) where
@@ -177,6 +195,8 @@ instance ShelleyBasedEra era => QueryLedger (ShelleyBlock era) where
           st
         DebugChainDepState ->
           tpraosStateChainDepState (headerStateChainDep hst)
+        GetRewardProvenance ->
+          snd $ SL.getRewardInfo globals st
     where
       lcfg    = configLedger $ getExtLedgerCfg cfg
       globals = shelleyLedgerGlobals lcfg
@@ -258,6 +278,10 @@ instance SameDepIndex (Query (ShelleyBlock era)) where
     = Just Refl
   sameDepIndex DebugChainDepState _
     = Nothing
+  sameDepIndex GetRewardProvenance GetRewardProvenance
+    = Just Refl
+  sameDepIndex GetRewardProvenance _
+    = Nothing
 
 deriving instance Eq   (Query (ShelleyBlock era) result)
 deriving instance Show (Query (ShelleyBlock era) result)
@@ -278,6 +302,7 @@ instance ShelleyBasedEra era => ShowQuery (Query (ShelleyBlock era)) where
       GetGenesisConfig                           -> show
       DebugNewEpochState                         -> show
       DebugChainDepState                         -> show
+      GetRewardProvenance                        -> show
 
 -- | Is the given query supported by the given 'ShelleyNodeToClientVersion'?
 querySupportedVersion :: Query (ShelleyBlock era) result -> ShelleyNodeToClientVersion -> Bool
@@ -296,9 +321,13 @@ querySupportedVersion = \case
     GetGenesisConfig                           -> (>= v2)
     DebugNewEpochState                         -> (>= v2)
     DebugChainDepState                         -> (>= v2)
+    GetRewardProvenance                        -> (>= v3)
+    -- WARNING: when adding a new query, a new @ShelleyNodeToClientVersionX@
+    -- must be added. See #2830 for a template on how to do this.
   where
     v1 = ShelleyNodeToClientVersion1
     v2 = ShelleyNodeToClientVersion2
+    v3 = ShelleyNodeToClientVersion3
 
 {-------------------------------------------------------------------------------
   Auxiliary
@@ -362,6 +391,8 @@ encodeShelleyQuery query = case query of
       CBOR.encodeListLen 1 <> CBOR.encodeWord8 12
     DebugChainDepState ->
       CBOR.encodeListLen 1 <> CBOR.encodeWord8 13
+    GetRewardProvenance ->
+      CBOR.encodeListLen 1 <> CBOR.encodeWord8 14
 
 decodeShelleyQuery ::
      ShelleyBasedEra era
@@ -384,6 +415,7 @@ decodeShelleyQuery = do
       (1, 11) -> return $ SomeSecond GetGenesisConfig
       (1, 12) -> return $ SomeSecond DebugNewEpochState
       (1, 13) -> return $ SomeSecond DebugChainDepState
+      (1, 14) -> return $ SomeSecond GetRewardProvenance
       _       -> fail $
         "decodeShelleyQuery: invalid (len, tag): (" <>
         show len <> ", " <> show tag <> ")"
@@ -406,6 +438,7 @@ encodeShelleyResult query = case query of
     GetGenesisConfig                           -> toCBOR
     DebugNewEpochState                         -> toCBOR
     DebugChainDepState                         -> toCBOR
+    GetRewardProvenance                        -> toCBOR
 
 decodeShelleyResult ::
      ShelleyBasedEra era
@@ -426,3 +459,4 @@ decodeShelleyResult query = case query of
     GetGenesisConfig                           -> fromCBOR
     DebugNewEpochState                         -> fromCBOR
     DebugChainDepState                         -> fromCBOR
+    GetRewardProvenance                        -> fromCBOR
@@ -17,8 +17,8 @@ import qualified Codec.CBOR.Term as CBOR
 
 import           Ouroboros.Network.CodecCBORTerm
 import           Ouroboros.Network.Magic
-import           Ouroboros.Network.Protocol.Handshake.Version
-                  (Acceptable (..), Accept (..))
+import           Ouroboros.Network.Protocol.Handshake.Version (Accept (..),
+                     Acceptable (..))
 
 
 -- | Enumeration of node to client protocol versions.
@@ -35,6 +35,8 @@ data NodeToClientVersion
     -- ^ enabled @CardanoNodeToClientVersion4@, i.e., Allegra
     | NodeToClientV_6
     -- ^ enabled @CardanoNodeToClientVersion5@, i.e., Mary
+    | NodeToClientV_7
+    -- ^ enabled @CardanoNodeToClientVersion6@, adding a query
   deriving (Eq, Ord, Enum, Bounded, Show, Typeable)
 
 -- | We set 16ths bit to distinguish `NodeToNodeVersion` and
@@ -53,6 +55,7 @@ nodeToClientVersionCodec = CodecCBORTerm { encodeTerm, decodeTerm }
       encodeTerm NodeToClientV_4 = CBOR.TInt (4 `setBit` nodeToClientVersionBit)
       encodeTerm NodeToClientV_5 = CBOR.TInt (5 `setBit` nodeToClientVersionBit)
       encodeTerm NodeToClientV_6 = CBOR.TInt (6 `setBit` nodeToClientVersionBit)
+      encodeTerm NodeToClientV_7 = CBOR.TInt (7 `setBit` nodeToClientVersionBit)
 
       decodeTerm (CBOR.TInt tag) =
        case ( tag `clearBit` nodeToClientVersionBit
@@ -64,6 +67,7 @@ nodeToClientVersionCodec = CodecCBORTerm { encodeTerm, decodeTerm }
         (4, True)  -> Right NodeToClientV_4
         (5, True)  -> Right NodeToClientV_5
         (6, True)  -> Right NodeToClientV_6
+        (7, True)  -> Right NodeToClientV_7
         (n, _)     -> Left ( T.pack "decode NodeToClientVersion: unknown tag: " <> T.pack (show tag)
                             , Just n)
       decodeTerm _  = Left ( T.pack "decode NodeToClientVersion: unexpected term"