Merge #2291

2291: Bump to latest cardano-ledger-specs. r=dcoutts a=nc6 Since the ledger is now starting to generalise things for Alonzo, some similar changes must be made here: - Reference to the `EraRule` family, which is used to encode the set of rules used in a given era. - Various things (particularly `TxOut`) are now era-dependent, and so we cannot assume a Shelley-era TxOut. Co-authored-by: Nicholas Clarke <nick@topos.org.uk>
IntersectMBO · Jan 20, 2021 · 94f79cc · 94f79cc
2 parents 50beca1 + eff4355
commit 94f79cc
Show file tree

Hide file tree

Showing 15 changed files with 226 additions and 143 deletions.
diff --git a/cabal.project b/cabal.project
@@ -110,8 +110,8 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-ledger-specs
-  tag: cf3b01490a2cc7ebbb5ac6f7a4de79e8b1d5c70f
-  --sha256: 1v15xqy0qvb7ll4080pplrq2ygqgnf443kaq5i6mj0105941mcjc
+  tag: 3b27f2d472972f64fe2f59f9b7b2d0d2ccb1efaa
+  --sha256: 1yqx0nxi907q4a3rby31nxmryqv8in0y4fmvk3z4zjcqwn3rpi0v
   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: 8b176d11ccf5946fc3f715623cc779c3c449dc8d
-  --sha256: 0bn9zgx4vrxizxw79ay2dskh8l1lywz6jb4h8h2ikipi7bvkxq7m
+  tag: 7bfdf6ec5ab41e8ea690bfee994688db0d3cf3d0
+  --sha256: 11zgfwqqjvy9halv2iy2h1d5jmzdgw8pbp2a1w4zrav3mhckikpb
   subdir:
     io-sim
     io-sim-classes

diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal
@@ -23,6 +23,7 @@ library
                         -- is fully integrated, or re-exported via the export
                         -- modules above
                         Cardano.Api.Crypto.Ed25519Bip32
+                        Cardano.Api.Eras
                         Cardano.Api.LocalChainSync
                         Cardano.Api.Protocol
                         Cardano.Api.Protocol.Byron
@@ -46,7 +47,6 @@ library
                         Cardano.Api.Address
                         Cardano.Api.Block
                         Cardano.Api.Certificate
-                        Cardano.Api.Eras
                         Cardano.Api.Error
                         Cardano.Api.Fees
                         Cardano.Api.Hash

diff --git a/cardano-api/src/Cardano/Api/Eras.hs b/cardano-api/src/Cardano/Api/Eras.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE PatternSynonyms #-}
 
 
 -- | Cardano eras, sometimes we have to distinguish them.
@@ -43,12 +43,12 @@ module Cardano.Api.Eras
 
 import           Prelude
 
-import           Data.Type.Equality (TestEquality(..), (:~:)(Refl))
+import           Data.Type.Equality ((:~:) (Refl), TestEquality (..))
 
 import           Cardano.Ledger.Era as Ledger (Crypto)
 
-import           Ouroboros.Consensus.Shelley.Eras as Ledger
-                   (StandardShelley, StandardAllegra, StandardMary, StandardCrypto)
+import           Ouroboros.Consensus.Shelley.Eras as Ledger (StandardAllegra, StandardCrypto,
+                     StandardMary, StandardShelley)
 
 import           Cardano.Api.HasTypeProxy
 

diff --git a/cardano-api/src/Cardano/Api/IPC.hs b/cardano-api/src/Cardano/Api/IPC.hs
@@ -214,15 +214,16 @@ mkVersionedProtocols networkid ptcl
             NodeToClientVersionData {
               networkMagic = toNetworkMagic networkid
             }
-            (\_connid _ctl -> protocols ptclBlockVersion))
+            (\_connid _ctl -> protocols ptclBlockVersion ptclVersion))
       (Map.toList (Consensus.supportedNodeToClientVersions proxy))
   where
     proxy :: Proxy block
     proxy = Proxy
 
     protocols :: Consensus.BlockNodeToClientVersion block
+              -> Consensus.NodeToClientVersion
               -> NodeToClientProtocols Net.InitiatorMode LBS.ByteString IO () Void
-    protocols ptclBlockVersion =
+    protocols ptclBlockVersion ptclVersion =
         NodeToClientProtocols {
           localChainSyncProtocol =
             Net.InitiatorProtocolOnly $
@@ -255,7 +256,7 @@ mkVersionedProtocols networkid ptcl
           Consensus.cChainSyncCodec,
           Consensus.cTxSubmissionCodec,
           Consensus.cStateQueryCodec
-        } = Consensus.clientCodecs codecConfig ptclBlockVersion
+        } = Consensus.clientCodecs codecConfig ptclBlockVersion ptclVersion
 
     codecConfig :: Consensus.CodecConfig block
     codecConfig = Consensus.pClientInfoCodecConfig
@@ -419,7 +420,7 @@ queryNodeLocalState connctInfo point query = do
                                          (QueryInMode mode) IO ()
     localStateQuerySingle resultVar =
       LocalStateQueryClient $ pure $
-        Net.Query.SendMsgAcquire point $
+        Net.Query.SendMsgAcquire (Just point) $
         Net.Query.ClientStAcquiring {
           Net.Query.recvMsgAcquired =
             Net.Query.SendMsgQuery query $

diff --git a/cardano-api/src/Cardano/Api/Query.hs b/cardano-api/src/Cardano/Api/Query.hs
@@ -54,7 +54,6 @@ import           Ouroboros.Network.Block (Serialised)
 import qualified Cardano.Chain.Update.Validation.Interface as Byron.Update
 
 import qualified Cardano.Ledger.Era as Ledger
-import qualified Cardano.Ledger.Shelley.Constraints as Ledger
 
 import qualified Shelley.Spec.Ledger.API as Shelley
 import qualified Shelley.Spec.Ledger.LedgerState as Shelley
@@ -173,20 +172,23 @@ toShelleyAddrSet era =
   . mapMaybe (anyAddressInEra era)
   . Set.toList
 
-fromShelleyUTxO :: ShelleyLedgerEra era ~ ledgerera
-                => IsShelleyBasedEra era
-                => Ledger.ShelleyBased ledgerera
-                => Ledger.Crypto ledgerera ~ Consensus.StandardCrypto
-                => Shelley.UTxO ledgerera -> UTxO era
-fromShelleyUTxO =
-    --TODO: write an appropriate property to show it is safe to use
-    -- Map.fromListAsc or to use Map.mapKeysMonotonic
-    UTxO
-  . Map.fromList
-  . map (bimap fromShelleyTxIn fromShelleyTxOut)
-  . Map.toList
-  . Shelley.unUTxO
 
+fromUTxO
+  :: ShelleyLedgerEra era ~ ledgerera
+  => ShelleyBasedEra era
+  -> Shelley.UTxO ledgerera
+  -> UTxO era
+fromUTxO eraConversion utxo =
+  case eraConversion of
+    ShelleyBasedEraShelley ->
+      let Shelley.UTxO sUtxo = utxo
+      in UTxO . Map.fromList . map (bimap fromShelleyTxIn fromShelleyTxOut) $ Map.toList sUtxo
+    ShelleyBasedEraAllegra ->
+      let Shelley.UTxO sUtxo = utxo
+      in UTxO . Map.fromList . map (bimap fromShelleyTxIn (fromTxOut ShelleyBasedEraAllegra)) $ Map.toList sUtxo
+    ShelleyBasedEraMary ->
+      let Shelley.UTxO sUtxo = utxo
+      in UTxO . Map.fromList . map (bimap fromShelleyTxIn (fromTxOut ShelleyBasedEraMary)) $ Map.toList sUtxo
 
 fromShelleyPoolDistr :: Shelley.PoolDistr StandardCrypto
                      -> Map (Hash StakePoolKey) Rational
@@ -351,7 +353,7 @@ fromConsensusQueryResult (QueryInEra ShelleyEraInShelleyMode
                                      (QueryInShelleyBasedEra _era q)) q' r' =
     case (q', r') of
       (Consensus.DegenQuery q'', Consensus.DegenQueryResult r'') ->
-        Right (fromConsensusQueryResultShelleyBased q q'' r'')
+        Right (fromConsensusQueryResultShelleyBased ShelleyBasedEraShelley q q'' r'')
 
 fromConsensusQueryResult (QueryInEra ByronEraInCardanoMode
                                      (QueryInShelleyBasedEra era _)) _ _ =
@@ -362,7 +364,7 @@ fromConsensusQueryResult (QueryInEra ShelleyEraInCardanoMode
     case q' of
       Consensus.QueryIfCurrentShelley q'' ->
         bimap fromConsensusEraMismatch
-              (fromConsensusQueryResultShelleyBased q q'')
+              (fromConsensusQueryResultShelleyBased ShelleyBasedEraShelley q q'')
               r'
       _ -> fromConsensusQueryResultMismatch
 
@@ -371,7 +373,7 @@ fromConsensusQueryResult (QueryInEra AllegraEraInCardanoMode
     case q' of
       Consensus.QueryIfCurrentAllegra q'' ->
         bimap fromConsensusEraMismatch
-              (fromConsensusQueryResultShelleyBased q q'')
+              (fromConsensusQueryResultShelleyBased ShelleyBasedEraAllegra q q'')
               r'
       _ -> fromConsensusQueryResultMismatch
 
@@ -380,76 +382,76 @@ fromConsensusQueryResult (QueryInEra MaryEraInCardanoMode
     case q' of
       Consensus.QueryIfCurrentMary q'' ->
         bimap fromConsensusEraMismatch
-              (fromConsensusQueryResultShelleyBased q q'')
+              (fromConsensusQueryResultShelleyBased ShelleyBasedEraMary q q'')
               r'
       _ -> fromConsensusQueryResultMismatch
 
 
 fromConsensusQueryResultShelleyBased
   :: forall era ledgerera result result'.
      ShelleyLedgerEra era ~ ledgerera
-  => IsShelleyBasedEra era
   => Consensus.ShelleyBasedEra ledgerera
   => Ledger.Crypto ledgerera ~ Consensus.StandardCrypto
-  => QueryInShelleyBasedEra era result
+  => ShelleyBasedEra era
+  -> QueryInShelleyBasedEra era result
   -> Consensus.Query (Consensus.ShelleyBlock ledgerera) result'
   -> result'
   -> result
-fromConsensusQueryResultShelleyBased QueryChainPoint q' point =
+fromConsensusQueryResultShelleyBased _ QueryChainPoint q' point =
     case q' of
       Consensus.GetLedgerTip -> fromConsensusPoint point
       _                      -> fromConsensusQueryResultMismatch
 
-fromConsensusQueryResultShelleyBased QueryEpoch q' epoch =
+fromConsensusQueryResultShelleyBased _ QueryEpoch q' epoch =
     case q' of
       Consensus.GetEpochNo -> epoch
       _                    -> fromConsensusQueryResultMismatch
 
-fromConsensusQueryResultShelleyBased QueryGenesisParameters q' r' =
+fromConsensusQueryResultShelleyBased _ QueryGenesisParameters q' r' =
     case q' of
       Consensus.GetGenesisConfig -> fromShelleyGenesis
                                       (Consensus.getCompactGenesis r')
       _                          -> fromConsensusQueryResultMismatch
 
-fromConsensusQueryResultShelleyBased QueryProtocolParameters q' r' =
+fromConsensusQueryResultShelleyBased _ QueryProtocolParameters q' r' =
     case q' of
       Consensus.GetCurrentPParams -> fromShelleyPParams r'
       _                           -> fromConsensusQueryResultMismatch
 
-fromConsensusQueryResultShelleyBased QueryProtocolParametersUpdate q' r' =
+fromConsensusQueryResultShelleyBased _ QueryProtocolParametersUpdate q' r' =
     case q' of
       Consensus.GetProposedPParamsUpdates -> fromShelleyProposedPPUpdates r'
       _                                   -> fromConsensusQueryResultMismatch
 
-fromConsensusQueryResultShelleyBased QueryStakeDistribution q' r' =
+fromConsensusQueryResultShelleyBased _ QueryStakeDistribution q' r' =
     case q' of
       Consensus.GetStakeDistribution -> fromShelleyPoolDistr r'
       _                              -> fromConsensusQueryResultMismatch
 
-fromConsensusQueryResultShelleyBased (QueryUTxO Nothing) q' utxo' =
+fromConsensusQueryResultShelleyBased shelleyBasedEra' (QueryUTxO Nothing) q' utxo' =
     case q' of
-      Consensus.GetUTxO -> fromShelleyUTxO utxo'
+      Consensus.GetUTxO -> fromUTxO shelleyBasedEra' utxo'
       _                 -> fromConsensusQueryResultMismatch
 
-fromConsensusQueryResultShelleyBased (QueryUTxO Just{}) q' utxo' =
+fromConsensusQueryResultShelleyBased shelleyBasedEra' (QueryUTxO Just{}) q' utxo' =
     case q' of
-      Consensus.GetFilteredUTxO{} -> fromShelleyUTxO utxo'
+      Consensus.GetFilteredUTxO{} -> fromUTxO shelleyBasedEra' utxo'
       _                           -> fromConsensusQueryResultMismatch
 
-fromConsensusQueryResultShelleyBased QueryStakeAddresses{} q' r' =
+fromConsensusQueryResultShelleyBased _ QueryStakeAddresses{} q' r' =
     case q' of
       Consensus.GetFilteredDelegationsAndRewardAccounts{}
         -> let (delegs, rwaccs) = r'
             in (fromShelleyRewardAccounts rwaccs,
                 fromShelleyDelegations delegs)
       _ -> fromConsensusQueryResultMismatch
 
-fromConsensusQueryResultShelleyBased QueryLedgerState{} q' r' =
+fromConsensusQueryResultShelleyBased _ QueryLedgerState{} q' r' =
     case q' of
       Consensus.GetCBOR Consensus.DebugNewEpochState -> LedgerState r'
       _                                              -> fromConsensusQueryResultMismatch
 
-fromConsensusQueryResultShelleyBased QueryProtocolState q' r' =
+fromConsensusQueryResultShelleyBased _ QueryProtocolState q' r' =
     case q' of
       Consensus.GetCBOR Consensus.DebugChainDepState -> ProtocolState r'
       _                                              -> fromConsensusQueryResultMismatch
@@ -476,4 +478,3 @@ fromConsensusQueryResultMismatch =
 fromConsensusEraMismatch :: SListI xs
                          => Consensus.MismatchEraInfo xs -> EraMismatch
 fromConsensusEraMismatch = Consensus.mkEraMismatch
-
diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE EmptyCase #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -76,13 +77,14 @@ module Cardano.Api.TxBody (
     certificatesSupportedInEra,
     updateProposalSupportedInEra,
 
-    -- * Internal conversion functions
+    -- * Internal conversion functions & types
     toShelleyTxId,
     toShelleyTxIn,
     toShelleyTxOut,
     fromShelleyTxId,
     fromShelleyTxIn,
     fromShelleyTxOut,
+    fromTxOut,
 
     -- * Data family instances
     AsType(AsTxId, AsTxBody, AsByronTxBody, AsShelleyTxBody),
@@ -121,6 +123,7 @@ import qualified Cardano.Crypto.Hashing as Byron
 
 import qualified Cardano.Ledger.AuxiliaryData as Ledger (hashAuxiliaryData)
 import qualified Cardano.Ledger.Core as Ledger
+import qualified Cardano.Ledger.Core as Core
 import qualified Cardano.Ledger.Era as Ledger
 import qualified Cardano.Ledger.Shelley.Constraints as Ledger
 import qualified Cardano.Ledger.ShelleyMA.AuxiliaryData as Allegra
@@ -207,7 +210,7 @@ getTxId (ShelleyTxBody era tx _) =
       ShelleyBasedEraMary    -> getTxIdShelley tx
   where
     getTxIdShelley :: Ledger.Crypto ledgerera ~ StandardCrypto
-                   => Ledger.TxBodyConstraints ledgerera
+                   => Ledger.UsesTxBody ledgerera
                    => Ledger.TxBody ledgerera -> TxId
     getTxIdShelley =
         TxId
@@ -286,25 +289,28 @@ toShelleyTxOut (TxOut addr (TxOutAdaOnly AdaOnlyInAllegraEra value)) =
 toShelleyTxOut (TxOut addr (TxOutValue MultiAssetInMaryEra value)) =
     Shelley.TxOut (toShelleyAddr addr) (toMaryValue value)
 
-
-fromShelleyTxOut :: forall era ledgerera.
-                   (ShelleyLedgerEra era ~ ledgerera,
-                    IsShelleyBasedEra era, Ledger.ShelleyBased ledgerera)
-                 => Shelley.TxOut ledgerera -> TxOut era
-fromShelleyTxOut (Shelley.TxOut addr value) =
-    case shelleyBasedEra :: ShelleyBasedEra era of
-      ShelleyBasedEraShelley -> TxOut (fromShelleyAddr addr)
-                                      (TxOutAdaOnly AdaOnlyInShelleyEra
-                                                    (fromShelleyLovelace value))
-
-      ShelleyBasedEraAllegra -> TxOut (fromShelleyAddr addr)
-                                      (TxOutAdaOnly AdaOnlyInAllegraEra
-                                                    (fromShelleyLovelace value))
-
-      ShelleyBasedEraMary    -> TxOut (fromShelleyAddr addr)
-                                      (TxOutValue MultiAssetInMaryEra
-                                                  (fromMaryValue value))
-
+fromShelleyTxOut :: Shelley.TxOut StandardShelley -> TxOut ShelleyEra
+fromShelleyTxOut = fromTxOut ShelleyBasedEraShelley
+
+fromTxOut
+  :: ShelleyLedgerEra era ~ ledgerera
+  => ShelleyBasedEra era
+  -> Core.TxOut ledgerera
+  -> TxOut era
+fromTxOut shelleyBasedEra' ledgerTxOut =
+  case shelleyBasedEra' of
+    ShelleyBasedEraShelley -> let (Shelley.TxOut addr value) = ledgerTxOut
+                              in TxOut (fromShelleyAddr addr)
+                                       (TxOutAdaOnly AdaOnlyInShelleyEra
+                                                      (fromShelleyLovelace value))
+    ShelleyBasedEraAllegra -> let (Shelley.TxOut addr value) = ledgerTxOut
+                              in TxOut (fromShelleyAddr addr)
+                                        (TxOutAdaOnly AdaOnlyInAllegraEra
+                                                      (fromShelleyLovelace value))
+    ShelleyBasedEraMary    -> let (Shelley.TxOut addr value) = ledgerTxOut
+                              in TxOut (fromShelleyAddr addr)
+                                        (TxOutValue MultiAssetInMaryEra
+                                                      (fromMaryValue value))
 
 -- ----------------------------------------------------------------------------
 -- Era-dependent transaction body features