Builds

IntersectMBO · Jul 24, 2024 · fc03c3e · fc03c3e
1 parent 04f540f
commit fc03c3e
Show file tree

Hide file tree

Showing 2 changed files with 7 additions and 25 deletions.
diff --git 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
@@ -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"