Merge pull request #335 from input-output-hk/newhoggy/make-byron-cons…

…tructor-and-functions-propagate-ByronEraOnly

Make Byron constructors and functions propagate `ByronEraOnly` eon. Delete `CardanoEraStyle`

cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs

@@ -182,16 +182,15 @@ genAddressShelley = makeShelleyAddress <$> genNetworkId
                                        <*> genStakeAddressReference
 
 genAddressInEra :: CardanoEra era -> Gen (AddressInEra era)
-genAddressInEra era =
-  case cardanoEraStyle era of
-    LegacyByronEra ->
-      byronAddressInEra <$> genAddressByron
-
-    ShelleyBasedEra sbe ->
+genAddressInEra =
+  inEonForEra
+    (byronAddressInEra <$> genAddressByron)
+    (\sbe ->
       Gen.choice
         [ byronAddressInEra       <$> genAddressByron
         , shelleyAddressInEra sbe <$> genAddressShelley
         ]
+    )
 
 genKESPeriod :: Gen KESPeriod
 genKESPeriod = KESPeriod <$> Gen.word Range.constantBounded
@@ -643,9 +642,7 @@ genTxBodyContent era = do
   txMetadata <- genTxMetadataInEra era
   txAuxScripts <- genTxAuxScripts era
   let txExtraKeyWits = TxExtraKeyWitnessesNone --TODO: Alonzo era: Generate witness key hashes
-  txProtocolParams <- BuildTxWith <$> case cardanoEraStyle era of
-                                        LegacyByronEra -> return Nothing
-                                        ShelleyBasedEra sbe -> Gen.maybe $ genValidProtocolParameters sbe
+  txProtocolParams <- BuildTxWith <$> forEraInEon era (pure Nothing) (Gen.maybe . genValidProtocolParameters)
   txWithdrawals <- genTxWithdrawals era
   txCertificates <- genTxCertificates era
   txUpdateProposal <- genTxUpdateProposal era
@@ -755,13 +752,14 @@ genTx era =
     <*> genTxBody era
 
 genWitnesses :: CardanoEra era -> Gen [KeyWitness era]
-genWitnesses era =
-  case cardanoEraStyle era of
-    LegacyByronEra -> Gen.list (Range.constant 1 10) genByronKeyWitness
-    ShelleyBasedEra sbe -> do
+genWitnesses =
+  caseByronOrShelleyBasedEra
+    (Gen.list (Range.constant 1 10) . genByronKeyWitness)
+    (\sbe -> do
       bsWits  <- Gen.list (Range.constant 0 10) (genShelleyBootstrapWitness sbe)
       keyWits <- Gen.list (Range.constant 0 10) (genShelleyKeyWitness sbe)
       return $ bsWits ++ keyWits
+    )
 
 genVerificationKey :: ()
 #if MIN_VERSION_base(4,17,0)
@@ -786,8 +784,8 @@ genVerificationKeyHash :: ()
 genVerificationKeyHash roletoken =
   verificationKeyHash <$> genVerificationKey roletoken
 
-genByronKeyWitness :: Gen (KeyWitness ByronEra)
-genByronKeyWitness = do
+genByronKeyWitness :: ByronEraOnly era -> Gen (KeyWitness era)
+genByronKeyWitness ByronEraOnlyByron = do
   pmId <- genProtocolMagicId
   txinWitness <- genVKWitness pmId
   return $ ByronKeyWitness txinWitness
@@ -838,9 +836,7 @@ genShelleyWitnessSigningKey =
 genCardanoKeyWitness :: ()
   => CardanoEra era
   -> Gen (KeyWitness era)
-genCardanoKeyWitness era = case cardanoEraStyle era of
-  LegacyByronEra -> genByronKeyWitness
-  ShelleyBasedEra sbe -> genShelleyWitness sbe
+genCardanoKeyWitness = caseByronOrShelleyBasedEra genByronKeyWitness genShelleyWitness
 
 genSeed :: Int -> Gen Crypto.Seed
 genSeed n = Crypto.mkSeedFromBytes <$> Gen.bytes (Range.singleton n)

cardano-api/internal/Cardano/Api/Address.hs

@@ -489,13 +489,13 @@ anyAddressInShelleyBasedEra sbe = \case
 anyAddressInEra :: CardanoEra era
                 -> AddressAny
                 -> Either String (AddressInEra era)
-anyAddressInEra _ (AddressByron addr) =
+anyAddressInEra era = \case
+  AddressByron addr ->
     Right (AddressInEra ByronAddressInAnyEra addr)
-
-anyAddressInEra era (AddressShelley addr) =
-    case cardanoEraStyle era of
-      LegacyByronEra       -> Left "Expected Byron based era address"
-      ShelleyBasedEra era' -> Right (AddressInEra (ShelleyAddressInEra era') addr)
+  AddressShelley addr ->
+    forEraInEon era
+      (Left "Expected Byron based era address")
+      (\sbe -> Right (AddressInEra (ShelleyAddressInEra sbe) addr))
 
 toAddressAny :: Address addr -> AddressAny
 toAddressAny a@ShelleyAddress{} = AddressShelley a

cardano-api/internal/Cardano/Api/Block.hs

@@ -51,6 +51,7 @@ module Cardano.Api.Block (
     makeChainTip,
   ) where
 
+import           Cardano.Api.Eon.ByronEraOnly
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eras
 import           Cardano.Api.Hash
@@ -172,7 +173,7 @@ getBlockTxs = \case
             Byron.ABody {
               Byron.bodyTxPayload = Byron.ATxPayload txs
             }
-        } -> map ByronTx txs
+        } -> map (ByronTx ByronEraOnlyByron) txs
   ShelleyBlock sbe Consensus.ShelleyBlock{Consensus.shelleyBlockRaw} ->
     shelleyBasedEraConstraints sbe $
       getShelleyBlockTxs sbe shelleyBlockRaw

cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs

@@ -25,10 +25,6 @@ module Cardano.Api.Eon.ShelleyBasedEra
   , forShelleyBasedEraInEonMaybe
   , forShelleyBasedEraMaybeEon
 
-    -- * Cardano eras, as Byron vs Shelley-based
-  , CardanoEraStyle(..)
-  , cardanoEraStyle
-
     -- * Assertions on era
   , requireShelleyBasedEra
 
@@ -316,40 +312,6 @@ shelleyBasedToCardanoEra ShelleyBasedEraAlonzo  = AlonzoEra
 shelleyBasedToCardanoEra ShelleyBasedEraBabbage = BabbageEra
 shelleyBasedToCardanoEra ShelleyBasedEraConway  = ConwayEra
 
--- ----------------------------------------------------------------------------
--- Cardano eras factored as Byron vs Shelley-based
---
-
--- | This is the same essential information as 'CardanoEra' but instead of a
--- flat set of alternative eras, it is factored into the legcy Byron era and
--- the current Shelley-based eras.
---
--- This way of factoring the eras is useful because in many cases the
--- major differences are between the Byron and Shelley-based eras, and
--- the Shelley-based eras can often be treated uniformly.
---
-data CardanoEraStyle era where
-  LegacyByronEra  :: CardanoEraStyle ByronEra
-
-  ShelleyBasedEra
-    :: ShelleyBasedEra era
-    -> CardanoEraStyle era
-
-deriving instance Eq   (CardanoEraStyle era)
-deriving instance Ord  (CardanoEraStyle era)
-deriving instance Show (CardanoEraStyle era)
-
--- | The 'CardanoEraStyle' for a 'CardanoEra'.
---
-cardanoEraStyle :: CardanoEra era -> CardanoEraStyle era
-cardanoEraStyle ByronEra   = LegacyByronEra
-cardanoEraStyle ShelleyEra = ShelleyBasedEra ShelleyBasedEraShelley
-cardanoEraStyle AllegraEra = ShelleyBasedEra ShelleyBasedEraAllegra
-cardanoEraStyle MaryEra    = ShelleyBasedEra ShelleyBasedEraMary
-cardanoEraStyle AlonzoEra  = ShelleyBasedEra ShelleyBasedEraAlonzo
-cardanoEraStyle BabbageEra = ShelleyBasedEra ShelleyBasedEraBabbage
-cardanoEraStyle ConwayEra  = ShelleyBasedEra ShelleyBasedEraConway
-
 -- ----------------------------------------------------------------------------
 -- Conversion to Shelley ledger library types
 --
@@ -384,7 +346,4 @@ requireShelleyBasedEra :: ()
   => Applicative m
   => CardanoEra era
   -> m (Maybe (ShelleyBasedEra era))
-requireShelleyBasedEra era =
-  case cardanoEraStyle era of
-    LegacyByronEra -> pure Nothing
-    ShelleyBasedEra sbe -> pure (Just sbe)
+requireShelleyBasedEra = inEonForEra (pure Nothing) (pure . Just)

cardano-api/internal/Cardano/Api/Fees.hs

@@ -48,6 +48,7 @@ module Cardano.Api.Fees (
 import           Cardano.Api.Address
 import           Cardano.Api.Certificate
 import           Cardano.Api.Eon.BabbageEraOnwards
+import           Cardano.Api.Eon.ByronEraOnly
 import           Cardano.Api.Eon.MaryEraOnwards
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eon.ShelleyToAllegraEra
@@ -120,7 +121,7 @@ transactionFee sbe txFeeFixed txFeePerByte tx =
     ShelleyTx _ tx' ->
       let x = shelleyBasedEraConstraints sbe $ tx' ^. L.sizeTxF in Lovelace (a * x + b)
       --TODO: This can be made to work for Byron txs too.
-    ByronTx _ -> case sbe of {}
+    ByronTx ByronEraOnlyByron _ -> case sbe of {}
 
 {-# DEPRECATED transactionFee "Use 'evaluateTransactionFee' instead" #-}
 
@@ -148,7 +149,7 @@ estimateTransactionFee :: ()
   -> Lovelace
 estimateTransactionFee sbe nw txFeeFixed txFeePerByte = \case
   -- TODO: This can be made to work for Byron txs too.
-  ByronTx _ ->
+  ByronTx ByronEraOnlyByron _ ->
     case sbe of {}
   ShelleyTx era tx ->
     let Lovelace baseFee = transactionFee sbe txFeeFixed txFeePerByte (ShelleyTx era tx)
@@ -218,7 +219,7 @@ evaluateTransactionFee _ _ _ _ byronwitcount | byronwitcount > 0 =
 evaluateTransactionFee sbe pp txbody keywitcount _byronwitcount =
   shelleyBasedEraConstraints sbe $
     case makeSignedTransaction [] txbody of
-      ByronTx{} -> case sbe of {}
+      ByronTx ByronEraOnlyByron _ -> case sbe of {}
       --TODO: we could actually support Byron here, it'd be different but simpler
 
       ShelleyTx _ tx -> fromShelleyLovelace $ Ledger.evaluateTransactionFee pp tx keywitcount
@@ -566,7 +567,7 @@ evaluateTransactionBalance :: forall era. ()
                            -> UTxO era
                            -> TxBody era
                            -> TxOutValue era
-evaluateTransactionBalance sbe _ _ _ _ _ (ByronTxBody _) =
+evaluateTransactionBalance sbe _ _ _ _ _ (ByronTxBody ByronEraOnlyByron _) =
   -- TODO: we could actually support Byron here, it'd be different but simpler
   case sbe of {}
 

cardano-api/internal/Cardano/Api/InMode.hs

@@ -25,6 +25,7 @@ module Cardano.Api.InMode (
     fromConsensusApplyTxErr,
   ) where
 
+import           Cardano.Api.Eon.ByronEraOnly
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eras
 import           Cardano.Api.Modes
@@ -111,12 +112,12 @@ fromConsensusGenTx CardanoMode (Consensus.HardForkGenTx (Consensus.OneEraGenTx (
 toConsensusGenTx :: ConsensusBlockForMode mode ~ block
                  => TxInMode mode
                  -> Consensus.GenTx block
-toConsensusGenTx (TxInMode (ByronTx tx) ByronEraInByronMode) =
+toConsensusGenTx (TxInMode (ByronTx ByronEraOnlyByron tx) ByronEraInByronMode) =
     Consensus.HardForkGenTx (Consensus.OneEraGenTx (Z tx'))
   where
     tx' = Consensus.ByronTx (Consensus.byronIdTx tx) tx
 
-toConsensusGenTx (TxInMode (ByronTx tx) ByronEraInCardanoMode) =
+toConsensusGenTx (TxInMode (ByronTx ByronEraOnlyByron tx) ByronEraInCardanoMode) =
     Consensus.HardForkGenTx (Consensus.OneEraGenTx (Z tx'))
   where
     tx' = Consensus.ByronTx (Consensus.byronIdTx tx) tx

cardano-api/internal/Cardano/Api/SerialiseLedgerCddl.hs

@@ -160,11 +160,10 @@ deserialiseTx :: ()
   -> ByteString
   -> Either DecoderError (Tx era)
 deserialiseTx era bs =
-  case era of
-    ByronEra ->
-      ByronTx
-        <$> CBOR.decodeFullAnnotatedBytes CBOR.byronProtVer "Byron Tx" CBOR.decCBOR (LBS.fromStrict bs)
-    _ -> cardanoEraConstraints era $ deserialiseFromCBOR (AsTx (proxyToAsType Proxy)) bs
+  caseByronOrShelleyBasedEra
+    (\w -> ByronTx w <$> CBOR.decodeFullAnnotatedBytes CBOR.byronProtVer "Byron Tx" CBOR.decCBOR (LBS.fromStrict bs))
+    (const $ cardanoEraConstraints era $ deserialiseFromCBOR (AsTx (proxyToAsType Proxy)) bs)
+    era
 
 serialiseWitnessLedgerCddl :: forall era. ShelleyBasedEra era -> KeyWitness era -> TextEnvelopeCddl
 serialiseWitnessLedgerCddl sbe kw =
@@ -270,10 +269,9 @@ deserialiseFromTextEnvelopeCddlAnyOf types teCddl =
 
       Just (FromCDDLWitness ttoken f) -> do
          AnyCardanoEra era <- cddlTypeToEra ttoken
-         case cardanoEraStyle era of
-           LegacyByronEra -> Left TextEnvelopeCddlErrByronKeyWitnessUnsupported
-           ShelleyBasedEra sbe ->
-             f . InAnyCardanoEra era <$> deserialiseWitnessLedgerCddl sbe teCddl
+         forEraInEon era
+           (Left TextEnvelopeCddlErrByronKeyWitnessUnsupported)
+           (\sbe -> f . InAnyCardanoEra era <$> deserialiseWitnessLedgerCddl sbe teCddl)
   where
    actualType :: Text
    actualType = teCddlType teCddl