WIP

IntersectMBO · Jan 14, 2021 · c991c13 · c991c13
1 parent fef74e6
commit c991c13
Show file tree

Hide file tree

Showing 8 changed files with 121 additions and 36 deletions.
diff --git a/cardano-api/src/Cardano/Api/Address.hs b/cardano-api/src/Cardano/Api/Address.hs
@@ -388,6 +388,7 @@ anyAddressInEra era (AddressShelley addr) =
     case cardanoEraStyle era of
       LegacyByronEra       -> Nothing
       ShelleyBasedEra era' -> Just (AddressInEra (ShelleyAddressInEra era') addr)
+      AlonzoBasedEra       -> error "TODO"
 
 toAddressAny :: Address addr -> AddressAny
 toAddressAny a@ShelleyAddress{} = AddressShelley a

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.
@@ -12,6 +12,7 @@ module Cardano.Api.Eras
   , ShelleyEra
   , AllegraEra
   , MaryEra
+  , AlonzoEra
   , CardanoEra(..)
   , IsCardanoEra(..)
   , AnyCardanoEra(..)
@@ -39,16 +40,17 @@ module Cardano.Api.Eras
     -- * Data family instances
   , AsType(AsByronEra, AsShelleyEra, AsAllegraEra, AsMaryEra,
            AsByron,    AsShelley,    AsAllegra,    AsMary)
+
   ) where
 
 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
 
@@ -65,6 +67,9 @@ data AllegraEra
 -- | A type used as a tag to distinguish the Mary era.
 data MaryEra
 
+-- | A type used as a tag to distinguish the Alonzo era.
+data AlonzoEra
+
 
 instance HasTypeProxy ByronEra where
     data AsType ByronEra = AsByronEra
@@ -82,6 +87,9 @@ instance HasTypeProxy MaryEra where
     data AsType MaryEra = AsMaryEra
     proxyToAsType _ = AsMaryEra
 
+instance HasTypeProxy AlonzoEra where
+    data AsType AlonzoEra = AsAlonzoEra
+    proxyToAsType _ = AsAlonzoEra
 
 -- ----------------------------------------------------------------------------
 -- Deprecated aliases
@@ -133,6 +141,7 @@ data CardanoEra era where
      ShelleyEra :: CardanoEra ShelleyEra
      AllegraEra :: CardanoEra AllegraEra
      MaryEra    :: CardanoEra MaryEra
+     AlonzoEra  :: CardanoEra AlonzoEra
 
 deriving instance Eq   (CardanoEra era)
 deriving instance Ord  (CardanoEra era)
@@ -143,6 +152,7 @@ instance TestEquality CardanoEra where
     testEquality ShelleyEra ShelleyEra = Just Refl
     testEquality AllegraEra AllegraEra = Just Refl
     testEquality MaryEra    MaryEra    = Just Refl
+    testEquality AlonzoEra  AlonzoEra  = Just Refl
     testEquality _          _          = Nothing
 
 
@@ -165,6 +175,8 @@ instance IsCardanoEra AllegraEra where
 instance IsCardanoEra MaryEra where
    cardanoEra      = MaryEra
 
+instance IsCardanoEra AlonzoEra where
+   cardanoEra      = AlonzoEra
 
 data AnyCardanoEra where
      AnyCardanoEra :: IsCardanoEra era  -- Provide class constraint
@@ -184,16 +196,18 @@ instance Enum AnyCardanoEra where
     toEnum 1 = AnyCardanoEra ShelleyEra
     toEnum 2 = AnyCardanoEra AllegraEra
     toEnum 3 = AnyCardanoEra MaryEra
+    toEnum 4 = AnyCardanoEra AlonzoEra
     toEnum _ = error "AnyCardanoEra.toEnum: bad argument"
 
     fromEnum (AnyCardanoEra ByronEra)   = 0
     fromEnum (AnyCardanoEra ShelleyEra) = 1
     fromEnum (AnyCardanoEra AllegraEra) = 2
     fromEnum (AnyCardanoEra MaryEra)    = 3
+    fromEnum (AnyCardanoEra AlonzoEra)  = 4
 
 instance Bounded AnyCardanoEra where
     minBound = AnyCardanoEra ByronEra
-    maxBound = AnyCardanoEra MaryEra
+    maxBound = AnyCardanoEra AlonzoEra
 
 -- | Like the 'AnyCardanoEra' constructor but does not demand a 'IsCardanoEra'
 -- class constraint.
@@ -203,6 +217,7 @@ anyCardanoEra ByronEra   = AnyCardanoEra ByronEra
 anyCardanoEra ShelleyEra = AnyCardanoEra ShelleyEra
 anyCardanoEra AllegraEra = AnyCardanoEra AllegraEra
 anyCardanoEra MaryEra    = AnyCardanoEra MaryEra
+anyCardanoEra AlonzoEra  = AnyCardanoEra AlonzoEra
 
 
 -- | This pairs up some era-dependent type with a 'CardanoEra' value that tells
@@ -283,6 +298,7 @@ data CardanoEraStyle era where
      ShelleyBasedEra :: IsShelleyBasedEra era -- Also provide class constraint
                      => ShelleyBasedEra era
                      -> CardanoEraStyle era
+     AlonzoBasedEra  :: CardanoEraStyle AlonzoEra
 
 deriving instance Eq   (CardanoEraStyle era)
 deriving instance Ord  (CardanoEraStyle era)
@@ -295,6 +311,7 @@ cardanoEraStyle ByronEra   = LegacyByronEra
 cardanoEraStyle ShelleyEra = ShelleyBasedEra ShelleyBasedEraShelley
 cardanoEraStyle AllegraEra = ShelleyBasedEra ShelleyBasedEraAllegra
 cardanoEraStyle MaryEra    = ShelleyBasedEra ShelleyBasedEraMary
+cardanoEraStyle AlonzoEra  = AlonzoBasedEra
 
 
 -- ----------------------------------------------------------------------------

diff --git a/cardano-api/src/Cardano/Api/Query.hs b/cardano-api/src/Cardano/Api/Query.hs
@@ -25,33 +25,33 @@ module Cardano.Api.Query (
     fromConsensusQueryResult,
   ) where
 
-import           Prelude
 import           Data.Bifunctor (bimap)
+import           Data.Map (Map)
+import qualified Data.Map as Map
 import           Data.Maybe (mapMaybe)
-import qualified Data.Set as Set
 import           Data.Set (Set)
-import qualified Data.Map as Map
-import           Data.Map (Map)
+import qualified Data.Set as Set
 import           Data.SOP.Strict (SListI)
+import           Prelude
 
-import           Ouroboros.Network.Protocol.LocalStateQuery.Client (Some(..))
+import           Ouroboros.Network.Protocol.LocalStateQuery.Client (Some (..))
 
 import qualified Ouroboros.Consensus.HardFork.Combinator as Consensus
-import qualified Ouroboros.Consensus.HardFork.Combinator.Degenerate as Consensus
-import qualified Ouroboros.Consensus.HardFork.Combinator.AcrossEras as Consensus
 import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch)
+import qualified Ouroboros.Consensus.HardFork.Combinator.AcrossEras as Consensus
+import qualified Ouroboros.Consensus.HardFork.Combinator.Degenerate as Consensus
 
-import qualified Ouroboros.Consensus.Byron.Ledger       as Consensus
-import qualified Ouroboros.Consensus.Shelley.Ledger     as Consensus
-import qualified Ouroboros.Consensus.Cardano.Block      as Consensus
+import qualified Ouroboros.Consensus.Byron.Ledger as Consensus
 import           Ouroboros.Consensus.Cardano.Block (StandardCrypto)
+import qualified Ouroboros.Consensus.Cardano.Block as Consensus
+import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus
 
 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 Cardano.Ledger.Shelley.Constraints as Ledger
 
-import qualified Shelley.Spec.Ledger.API         as Shelley
+import qualified Shelley.Spec.Ledger.API as Shelley
 import qualified Shelley.Spec.Ledger.LedgerState as Shelley
 
 import           Cardano.Api.Address
@@ -128,8 +128,8 @@ data QueryInShelleyBasedEra era result where
                                       Map StakeCredential PoolId)
 
 --     QueryPoolRanking
---       :: 
---       -> QueryInShelleyBasedEra 
+--       ::
+--       -> QueryInShelleyBasedEra
 
 --     QueryLedgerState
 --       :: QueryInShelleyBasedEra LedgerState
@@ -163,20 +163,22 @@ toShelleyAddrSet era =
     -- appear in the UTxO anyway.
   . mapMaybe (anyAddressInEra era)
   . Set.toList
-
-fromShelleyUTxO :: ShelleyLedgerEra era ~ ledgerera
+{-
+ShelleyLedgerEra era ~ ledgerera
                 => IsShelleyBasedEra era
                 => Ledger.ShelleyBased ledgerera
                 => Ledger.Crypto ledgerera ~ Consensus.StandardCrypto
-                => Shelley.UTxO ledgerera -> UTxO era
-fromShelleyUTxO =
+                =>
+-}
+fromShelleyUTxO :: Shelley.UTxO ledgerera -> UTxO era
+fromShelleyUTxO = error ""
     --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
+--    UTxO
+--  . Map.fromList
+--  . map (bimap fromShelleyTxIn fromShelleyTxOut)
+--  . Map.toList
+--  . Shelley.unUTxO
 
 
 fromShelleyPoolDistr :: Shelley.PoolDistr StandardCrypto
@@ -370,12 +372,14 @@ fromConsensusQueryResult (QueryInEra MaryEraInCardanoMode
               r'
       _ -> fromConsensusQueryResultMismatch
 
-
-fromConsensusQueryResultShelleyBased
-  :: forall era ledgerera result result'.
+{-
      ShelleyLedgerEra era ~ ledgerera
   => IsShelleyBasedEra era
-  => Consensus.ShelleyBasedEra ledgerera
+-}
+fromConsensusQueryResultShelleyBased
+  :: forall era ledgerera result result'.
+
+     Consensus.ShelleyBasedEra ledgerera
   => Ledger.Crypto ledgerera ~ Consensus.StandardCrypto
   => QueryInShelleyBasedEra era result
   -> Consensus.Query (Consensus.ShelleyBlock ledgerera) result'

diff --git a/cardano-api/src/Cardano/Api/Script.hs b/cardano-api/src/Cardano/Api/Script.hs
@@ -66,7 +66,7 @@ import           Data.String (IsString)
 import           Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
-import           Data.Type.Equality (TestEquality(..), (:~:)(Refl))
+import           Data.Type.Equality ((:~:) (Refl), TestEquality (..))
 
 import           Data.Aeson (Value (..), object, (.:), (.=))
 import qualified Data.Aeson as Aeson
@@ -806,6 +806,7 @@ instance IsCardanoEra era => FromJSON (ScriptInEra era) where
                                      (SimpleScript SimpleScriptV2 s)
               Just s' -> ScriptInEra SimpleScriptV1InMary
                                      (SimpleScript SimpleScriptV1 s')
+      AlonzoEra -> error "TODO"
 
 
 instance IsSimpleScriptLanguage lang => FromJSON (SimpleScript lang) where

diff --git a/cardano-api/src/Cardano/Api/Tx.hs b/cardano-api/src/Cardano/Api/Tx.hs
@@ -196,6 +196,7 @@ instance IsCardanoEra era => SerialiseAsCBOR (Tx era) where
                         (ShelleyTx ShelleyBasedEraAllegra) bs
         MaryEra    -> deserialiseShelleyBasedTx
                         (ShelleyTx ShelleyBasedEraMary) bs
+        AlonzoEra  -> error "TODO"
 
 -- | The serialisation format for the different Shelley-based eras are not the
 -- same, but they can be handled generally with one overloaded implementation.
@@ -218,6 +219,7 @@ instance IsCardanoEra era => HasTextEnvelope (Tx era) where
         ShelleyEra -> "TxSignedShelley"
         AllegraEra -> "Tx AllegraEra"
         MaryEra    -> "Tx MaryEra"
+        AlonzoEra  -> "Tx AlonzoEra"
 
 
 data Witness era where
@@ -371,6 +373,7 @@ instance IsCardanoEra era => SerialiseAsCBOR (Witness era) where
         ShelleyEra -> decodeShelleyBasedWitness ShelleyBasedEraShelley bs
         AllegraEra -> decodeShelleyBasedWitness ShelleyBasedEraAllegra bs
         MaryEra    -> decodeShelleyBasedWitness ShelleyBasedEraMary    bs
+        AlonzoEra  -> error "TODO"
 
 
 encodeShelleyBasedKeyWitness :: ToCBOR w => w -> CBOR.Encoding
@@ -430,6 +433,7 @@ instance IsCardanoEra era => HasTextEnvelope (Witness era) where
         ShelleyEra -> "TxWitnessShelley"
         AllegraEra -> "TxWitness AllegraEra"
         MaryEra    -> "TxWitness MaryEra"
+        AlonzoEra  -> "TxWitness AlonzoEra"
 
 
 getTxBody :: forall era. Tx era -> TxBody era