diff --git a/cardano-api/internal/Cardano/Api/Experimental/Tx.hs b/cardano-api/internal/Cardano/Api/Experimental/Tx.hs index 0ce0f2ebf7..8fdbef9e7c 100644 --- a/cardano-api/internal/Cardano/Api/Experimental/Tx.hs +++ b/cardano-api/internal/Cardano/Api/Experimental/Tx.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE EmptyCase #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} @@ -32,7 +31,7 @@ import Lens.Micro -t :: Either UnsignedTxError (Ledger.TxBody BabbageEra) +t :: Either UnsignedTxError (Ledger.TxBody (ToConstrainedEra ConwayEra)) t = eraSpecificLedgerTxBody CurrentEra undefined undefined -- | A transaction that can contain everything @@ -125,13 +124,6 @@ eraSpecificLedgerTxBody -> Ledger.TxBody (ToConstrainedEra era) -> TxBodyContent BuildTx (AvailableErasToSbe era) -> Either UnsignedTxError (Ledger.TxBody (ToConstrainedEra era)) -eraSpecificLedgerTxBody UpcomingEra ledgerbody _bc = return ledgerbody --- sbe <- maybe (Left $ error "eraSpecificLedgerTxBody: TODO") Right $ protocolVersionToSbe CurrentEra --- --- setUpdateProposal <- first UnsignedTxError $ convTxUpdateProposal sbe (txUpdateProposal bc) --- --- return $ ledgerbody & L.updateTxBodyL .~ setUpdateProposal - eraSpecificLedgerTxBody CurrentEra ledgerbody bc = let propProcedures = txProposalProcedures bc voteProcedures = txVotingProcedures bc @@ -144,22 +136,11 @@ eraSpecificLedgerTxBody CurrentEra ledgerbody bc = & L.treasuryDonationTxBodyL .~ maybe (L.Coin 0) unFeatured treasuryDonation & L.currentTreasuryValueTxBodyL .~ L.maybeToStrictMaybe (unFeatured <$> currentTresuryValue) --- test :: Either UnsignedTxError _ --- test = eraSpecificLedgerTxBody_ UpcomingEra undefined undefined - eraSpecificLedgerTxBody_ :: Era era -> Ledger.TxBody (ToConstrainedEra era) -> TxBodyContent BuildTx (AvailableErasToSbe era) -> Either UnsignedTxError (Ledger.TxBody (ToConstrainedEra era)) -eraSpecificLedgerTxBody_ UpcomingEra ledgerbody _bc = return ledgerbody - --- sbe <- maybe (Left $ error "eraSpecificLedgerTxBody: TODO") Right $ protocolVersionToSbe CurrentEra --- --- setUpdateProposal <- first UnsignedTxError $ convTxUpdateProposal sbe (txUpdateProposal bc) --- --- return $ ledgerbody & L.updateTxBodyL .~ setUpdateProposal - eraSpecificLedgerTxBody_ CurrentEra ledgerbody bc = let propProcedures = txProposalProcedures bc voteProcedures = txVotingProcedures bc diff --git a/cardano-api/internal/Cardano/Api/Protocol/AvailableEras.hs b/cardano-api/internal/Cardano/Api/Protocol/AvailableEras.hs index 124aa394c7..88ecf8d572 100644 --- a/cardano-api/internal/Cardano/Api/Protocol/AvailableEras.hs +++ b/cardano-api/internal/Cardano/Api/Protocol/AvailableEras.hs @@ -3,11 +3,9 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilyDependencies #-} -- UndecidableInstances needed for 9.2.7 and 8.10.7 {-# LANGUAGE UndecidableInstances #-} @@ -78,7 +76,7 @@ data Era era where -- | The era currently active on Cardano's mainnet. CurrentEra :: Era ConwayEra -- | The era planned for the next hardfork on Cardano's mainnet. - UpcomingEra :: Era (UninhabitableType EraCurrentlyNonExistent) + UpcomingEra :: UninhabitableType EraCurrentlyNonExistent => Era (UninhabitableType EraCurrentlyNonExistent) @@ -142,7 +140,6 @@ protocolVersionToSbe :: Era era -> Maybe (ShelleyBasedEra (AvailableErasToSbe era)) protocolVersionToSbe CurrentEra = Just ShelleyBasedEraConway -protocolVersionToSbe UpcomingEra = Nothing ------------------------------------------------------------------------- @@ -167,3 +164,7 @@ type family UninhabitableType a where TypeError ('Text "There is currently no planned upcoming era. Use CurrentEra instead.") + +doStuff :: Era era -> IO () +doStuff CurrentEra = {- feature supported -} pure () +doStuff UpcomingEra = error "feature not supported"