Merge pull request #313 from input-output-hk/newhoggy/less-reliance-o…

…n-IsShelleyBasedEra

Avoid `IsShelleyBasedEra` and `IsCardanoEra` where possible

cardano-api/cardano-api.cabal

@@ -76,7 +76,6 @@ library internal
                         Cardano.Api.Eon.ShelleyToMaryEra
                         Cardano.Api.Eras
                         Cardano.Api.Eras.Case
-                        Cardano.Api.Eras.Constraints
                         Cardano.Api.Eras.Core
                         Cardano.Api.Error
                         Cardano.Api.Feature

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

@@ -188,10 +188,10 @@ genAddressInEra era =
     LegacyByronEra ->
       byronAddressInEra <$> genAddressByron
 
-    ShelleyBasedEra _ ->
+    ShelleyBasedEra sbe ->
       Gen.choice
-        [ byronAddressInEra   <$> genAddressByron
-        , shelleyAddressInEra <$> genAddressShelley
+        [ byronAddressInEra       <$> genAddressByron
+        , shelleyAddressInEra sbe <$> genAddressShelley
         ]
 
 genKESPeriod :: Gen KESPeriod
@@ -717,9 +717,9 @@ genTxFee =
     (pure . TxFeeImplicit)
     (\w -> TxFeeExplicit w <$> genLovelace)
 
-genTxBody :: IsCardanoEra era => CardanoEra era -> Gen (TxBody era)
+genTxBody :: CardanoEra era -> Gen (TxBody era)
 genTxBody era = do
-  res <- Api.createAndValidateTransactionBody <$> genTxBodyContent era
+  res <- Api.createAndValidateTransactionBody era <$> genTxBodyContent era
   case res of
     Left err -> fail (displayError err)
     Right txBody -> pure txBody
@@ -753,7 +753,9 @@ genTxScriptValidity =
 genScriptValidity :: Gen ScriptValidity
 genScriptValidity = Gen.element [ScriptInvalid, ScriptValid]
 
-genTx :: forall era. IsCardanoEra era => CardanoEra era -> Gen (Tx era)
+genTx :: ()
+  => CardanoEra era
+  -> Gen (Tx era)
 genTx era =
   makeSignedTransaction
     <$> genWitnesses era
@@ -762,12 +764,10 @@ genTx era =
 genWitnesses :: CardanoEra era -> Gen [KeyWitness era]
 genWitnesses era =
   case cardanoEraStyle era of
-    LegacyByronEra    -> Gen.list (Range.constant 1 10) genByronKeyWitness
-    ShelleyBasedEra _ -> do
-      bsWits  <- Gen.list (Range.constant 0 10)
-                          (genShelleyBootstrapWitness era)
-      keyWits <- Gen.list (Range.constant 0 10)
-                          (genShelleyKeyWitness era)
+    LegacyByronEra -> Gen.list (Range.constant 1 10) genByronKeyWitness
+    ShelleyBasedEra sbe -> do
+      bsWits  <- Gen.list (Range.constant 0 10) (genShelleyBootstrapWitness sbe)
+      keyWits <- Gen.list (Range.constant 0 10) (genShelleyKeyWitness sbe)
       return $ bsWits ++ keyWits
 
 genVerificationKey :: ()
@@ -806,33 +806,30 @@ genWitnessNetworkIdOrByronAddress =
     , WitnessByronAddress <$> genAddressByron
     ]
 
-genShelleyBootstrapWitness
-  :: IsShelleyBasedEra era
-  => CardanoEra era
+genShelleyBootstrapWitness :: ()
+  => ShelleyBasedEra era
   -> Gen (KeyWitness era)
-genShelleyBootstrapWitness era =
- makeShelleyBootstrapWitness
+genShelleyBootstrapWitness sbe =
+ makeShelleyBootstrapWitness sbe
    <$> genWitnessNetworkIdOrByronAddress
-   <*> genTxBody era
+   <*> genTxBody (shelleyBasedToCardanoEra sbe)
    <*> genSigningKey AsByronKey
 
-genShelleyKeyWitness
-  :: IsShelleyBasedEra era
-  => CardanoEra era
+genShelleyKeyWitness :: ()
+  => ShelleyBasedEra era
   -> Gen (KeyWitness era)
-genShelleyKeyWitness era =
-  makeShelleyKeyWitness
-    <$> genTxBody era
+genShelleyKeyWitness sbe =
+  makeShelleyKeyWitness sbe
+    <$> genTxBody (shelleyBasedToCardanoEra sbe)
     <*> genShelleyWitnessSigningKey
 
-genShelleyWitness
-  :: IsShelleyBasedEra era
-  => CardanoEra era
+genShelleyWitness :: ()
+  => ShelleyBasedEra era
   -> Gen (KeyWitness era)
-genShelleyWitness era =
+genShelleyWitness sbe =
   Gen.choice
-   [ genShelleyKeyWitness era
-   , genShelleyBootstrapWitness era
+   [ genShelleyKeyWitness sbe
+   , genShelleyBootstrapWitness sbe
    ]
 
 genShelleyWitnessSigningKey :: Gen ShelleyWitnessSigningKey
@@ -845,12 +842,12 @@ genShelleyWitnessSigningKey =
              , WitnessGenesisUTxOKey <$>  genSigningKey AsGenesisUTxOKey
              ]
 
-genCardanoKeyWitness
-  :: CardanoEra era
+genCardanoKeyWitness :: ()
+  => CardanoEra era
   -> Gen (KeyWitness era)
 genCardanoKeyWitness era = case cardanoEraStyle era of
   LegacyByronEra -> genByronKeyWitness
-  ShelleyBasedEra _ -> genShelleyWitness era
+  ShelleyBasedEra sbe -> genShelleyWitness sbe
 
 genSeed :: Int -> Gen Crypto.Seed
 genSeed n = Crypto.mkSeedFromBytes <$> Gen.bytes (Range.singleton n)

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

@@ -6,6 +6,7 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
 {- HLINT ignore "Avoid lambda using `infix`" -}
@@ -373,9 +374,11 @@ instance IsCardanoEra era => ToJSON (AddressInEra era) where
   toJSON = Aeson.String . serialiseAddress
 
 instance IsShelleyBasedEra era => FromJSON (AddressInEra era) where
-  parseJSON = withText "AddressInEra" $ \txt -> do
-    addressAny <- runParsecParser parseAddressAny txt
-    pure $ anyAddressInShelleyBasedEra addressAny
+  parseJSON =
+    let sbe = shelleyBasedEra @era in
+    withText "AddressInEra" $ \txt -> do
+      addressAny <- runParsecParser parseAddressAny txt
+      pure $ anyAddressInShelleyBasedEra sbe addressAny
 
 parseAddressAny :: Parsec.Parser AddressAny
 parseAddressAny = do
@@ -467,15 +470,20 @@ byronAddressInEra :: Address ByronAddr -> AddressInEra era
 byronAddressInEra = AddressInEra ByronAddressInAnyEra
 
 
-shelleyAddressInEra :: IsShelleyBasedEra era
-                    => Address ShelleyAddr -> AddressInEra era
-shelleyAddressInEra = AddressInEra (ShelleyAddressInEra shelleyBasedEra)
-
+shelleyAddressInEra :: ()
+  => ShelleyBasedEra era
+  -> Address ShelleyAddr
+  -> AddressInEra era
+shelleyAddressInEra sbe =
+  AddressInEra (ShelleyAddressInEra sbe)
 
-anyAddressInShelleyBasedEra :: IsShelleyBasedEra era
-                            => AddressAny -> AddressInEra era
-anyAddressInShelleyBasedEra (AddressByron   addr) = byronAddressInEra addr
-anyAddressInShelleyBasedEra (AddressShelley addr) = shelleyAddressInEra addr
+anyAddressInShelleyBasedEra :: ()
+  => ShelleyBasedEra era
+  -> AddressAny
+  -> AddressInEra era
+anyAddressInShelleyBasedEra sbe = \case
+  AddressByron   addr -> byronAddressInEra addr
+  AddressShelley addr -> shelleyAddressInEra sbe addr
 
 
 anyAddressInEra :: CardanoEra era
@@ -500,13 +508,14 @@ makeByronAddressInEra nw vk =
     byronAddressInEra (makeByronAddress nw vk)
 
 
-makeShelleyAddressInEra :: IsShelleyBasedEra era
-                        => NetworkId
-                        -> PaymentCredential
-                        -> StakeAddressReference
-                        -> AddressInEra era
-makeShelleyAddressInEra nw pc scr =
-    shelleyAddressInEra (makeShelleyAddress nw pc scr)
+makeShelleyAddressInEra :: ()
+  => ShelleyBasedEra era
+  -> NetworkId
+  -> PaymentCredential
+  -> StakeAddressReference
+  -> AddressInEra era
+makeShelleyAddressInEra sbe nw pc scr =
+  shelleyAddressInEra sbe (makeShelleyAddress nw pc scr)
 
 
 -- ----------------------------------------------------------------------------
@@ -659,15 +668,15 @@ toShelleyStakeReference (StakeAddressByPointer ptr) =
 toShelleyStakeReference  NoStakeAddress =
     Shelley.StakeRefNull
 
-fromShelleyAddrIsSbe :: IsShelleyBasedEra era
-                     => Shelley.Addr StandardCrypto -> AddressInEra era
-fromShelleyAddrIsSbe (Shelley.AddrBootstrap (Shelley.BootstrapAddress addr)) =
-  AddressInEra ByronAddressInAnyEra (ByronAddress addr)
-
-fromShelleyAddrIsSbe (Shelley.Addr nw pc scr) =
-  AddressInEra
-    (ShelleyAddressInEra shelleyBasedEra)
-    (ShelleyAddress nw pc scr)
+fromShelleyAddrIsSbe :: ()
+  => ShelleyBasedEra era
+  -> Shelley.Addr StandardCrypto
+  -> AddressInEra era
+fromShelleyAddrIsSbe sbe = \case
+  Shelley.AddrBootstrap (Shelley.BootstrapAddress addr) ->
+    AddressInEra ByronAddressInAnyEra (ByronAddress addr)
+  Shelley.Addr nw pc scr ->
+    AddressInEra (ShelleyAddressInEra sbe) (ShelleyAddress nw pc scr)
 
 fromShelleyAddr
   :: ShelleyBasedEra era

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

@@ -53,7 +53,6 @@ module Cardano.Api.Block (
 
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eras
-import           Cardano.Api.Eras.Constraints
 import           Cardano.Api.Hash
 import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.Keys.Shelley
@@ -200,7 +199,11 @@ getShelleyBlockTxs era (Ledger.Block _header txs) =
 -- different block types for all the eras. It is used in the ChainSync protocol.
 --
 data BlockInMode mode where
-     BlockInMode :: IsCardanoEra era => Block era -> EraInMode era mode -> BlockInMode mode
+  BlockInMode
+    :: CardanoEra era
+    -> Block era
+    -> EraInMode era mode
+    -> BlockInMode mode
 
 deriving instance Show (BlockInMode mode)
 
@@ -213,41 +216,41 @@ fromConsensusBlock :: ConsensusBlockForMode mode ~ block
 fromConsensusBlock ByronMode =
     \b -> case b of
       Consensus.DegenBlock b' ->
-        BlockInMode (ByronBlock b') ByronEraInByronMode
+        BlockInMode cardanoEra (ByronBlock b') ByronEraInByronMode
 
 fromConsensusBlock ShelleyMode =
   \b -> case b of
     Consensus.DegenBlock b' ->
-      BlockInMode (ShelleyBlock ShelleyBasedEraShelley b')
+      BlockInMode cardanoEra (ShelleyBlock ShelleyBasedEraShelley b')
                    ShelleyEraInShelleyMode
 
 fromConsensusBlock CardanoMode =
     \b -> case b of
       Consensus.BlockByron b' ->
-        BlockInMode (ByronBlock b') ByronEraInCardanoMode
+        BlockInMode cardanoEra (ByronBlock b') ByronEraInCardanoMode
 
       Consensus.BlockShelley b' ->
-        BlockInMode (ShelleyBlock ShelleyBasedEraShelley b')
+        BlockInMode cardanoEra (ShelleyBlock ShelleyBasedEraShelley b')
                      ShelleyEraInCardanoMode
 
       Consensus.BlockAllegra b' ->
-        BlockInMode (ShelleyBlock ShelleyBasedEraAllegra b')
+        BlockInMode cardanoEra (ShelleyBlock ShelleyBasedEraAllegra b')
                      AllegraEraInCardanoMode
 
       Consensus.BlockMary b' ->
-        BlockInMode (ShelleyBlock ShelleyBasedEraMary b')
+        BlockInMode cardanoEra (ShelleyBlock ShelleyBasedEraMary b')
                      MaryEraInCardanoMode
 
       Consensus.BlockAlonzo b' ->
-        BlockInMode (ShelleyBlock ShelleyBasedEraAlonzo b')
+        BlockInMode cardanoEra (ShelleyBlock ShelleyBasedEraAlonzo b')
                      AlonzoEraInCardanoMode
 
       Consensus.BlockBabbage b' ->
-        BlockInMode (ShelleyBlock ShelleyBasedEraBabbage b')
+        BlockInMode cardanoEra (ShelleyBlock ShelleyBasedEraBabbage b')
                      BabbageEraInCardanoMode
 
       Consensus.BlockConway b' ->
-        BlockInMode (ShelleyBlock ShelleyBasedEraConway b')
+        BlockInMode cardanoEra (ShelleyBlock ShelleyBasedEraConway b')
                      ConwayEraInCardanoMode
 
 toConsensusBlock
@@ -260,19 +263,19 @@ toConsensusBlock
 toConsensusBlock bInMode =
   case bInMode of
     -- Byron mode
-    BlockInMode (ByronBlock b') ByronEraInByronMode -> Consensus.DegenBlock b'
+    BlockInMode _ (ByronBlock b') ByronEraInByronMode -> Consensus.DegenBlock b'
 
     -- Shelley mode
-    BlockInMode (ShelleyBlock ShelleyBasedEraShelley b') ShelleyEraInShelleyMode -> Consensus.DegenBlock b'
+    BlockInMode _ (ShelleyBlock ShelleyBasedEraShelley b') ShelleyEraInShelleyMode -> Consensus.DegenBlock b'
 
     -- Cardano mode
-    BlockInMode (ByronBlock b') ByronEraInCardanoMode -> Consensus.BlockByron b'
-    BlockInMode (ShelleyBlock ShelleyBasedEraShelley b') ShelleyEraInCardanoMode -> Consensus.BlockShelley b'
-    BlockInMode (ShelleyBlock ShelleyBasedEraAllegra b') AllegraEraInCardanoMode -> Consensus.BlockAllegra b'
-    BlockInMode (ShelleyBlock ShelleyBasedEraMary b') MaryEraInCardanoMode -> Consensus.BlockMary b'
-    BlockInMode (ShelleyBlock ShelleyBasedEraAlonzo b') AlonzoEraInCardanoMode -> Consensus.BlockAlonzo b'
-    BlockInMode (ShelleyBlock ShelleyBasedEraBabbage b') BabbageEraInCardanoMode -> Consensus.BlockBabbage b'
-    BlockInMode (ShelleyBlock ShelleyBasedEraConway b') ConwayEraInCardanoMode -> Consensus.BlockConway b'
+    BlockInMode _ (ByronBlock b') ByronEraInCardanoMode -> Consensus.BlockByron b'
+    BlockInMode _ (ShelleyBlock ShelleyBasedEraShelley b') ShelleyEraInCardanoMode -> Consensus.BlockShelley b'
+    BlockInMode _ (ShelleyBlock ShelleyBasedEraAllegra b') AllegraEraInCardanoMode -> Consensus.BlockAllegra b'
+    BlockInMode _ (ShelleyBlock ShelleyBasedEraMary b') MaryEraInCardanoMode -> Consensus.BlockMary b'
+    BlockInMode _ (ShelleyBlock ShelleyBasedEraAlonzo b') AlonzoEraInCardanoMode -> Consensus.BlockAlonzo b'
+    BlockInMode _ (ShelleyBlock ShelleyBasedEraBabbage b') BabbageEraInCardanoMode -> Consensus.BlockBabbage b'
+    BlockInMode _ (ShelleyBlock ShelleyBasedEraConway b') ConwayEraInCardanoMode -> Consensus.BlockConway b'
 
 -- ----------------------------------------------------------------------------
 -- Block headers

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

@@ -78,7 +78,6 @@ import           Cardano.Api.Eon.ConwayEraOnwards
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eon.ShelleyToBabbageEra
 import           Cardano.Api.Eras
-import           Cardano.Api.Eras.Constraints
 import           Cardano.Api.Governance.Actions.VotingProcedure
 import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.Keys.Praos

cardano-api/internal/Cardano/Api/Convenience/Construction.hs

@@ -41,9 +41,9 @@ import qualified Data.Text as Text
 -- See Cardano.Api.Convenience.Query.queryStateForBalancedTx for a
 -- convenient way of querying the node to get the required arguements
 -- for constructBalancedTx.
-constructBalancedTx
-  :: IsShelleyBasedEra era
-  => TxBodyContent BuildTx era
+constructBalancedTx :: ()
+  => ShelleyBasedEra era
+  -> TxBodyContent BuildTx era
   -> AddressInEra era -- ^ Change address
   -> Maybe Word       -- ^ Override key witnesses
   -> UTxO era         -- ^ Just the transaction inputs, not the entire 'UTxO'.
@@ -55,17 +55,17 @@ constructBalancedTx
   -> Map.Map (L.Credential L.DRepRole L.StandardCrypto) Lovelace
   -> [ShelleyWitnessSigningKey]
   -> Either TxBodyErrorAutoBalance (Tx era)
-constructBalancedTx txbodcontent changeAddr mOverrideWits utxo lpp
+constructBalancedTx sbe txbodcontent changeAddr mOverrideWits utxo lpp
                     ledgerEpochInfo systemStart stakePools
                     stakeDelegDeposits drepDelegDeposits shelleyWitSigningKeys = do
 
   BalancedTxBody _ txbody _txBalanceOutput _fee
     <- makeTransactionBodyAutoBalance
-         systemStart ledgerEpochInfo
+         sbe systemStart ledgerEpochInfo
          lpp stakePools stakeDelegDeposits drepDelegDeposits utxo txbodcontent
          changeAddr mOverrideWits
 
-  let keyWits = map (makeShelleyKeyWitness txbody) shelleyWitSigningKeys
+  let keyWits = map (makeShelleyKeyWitness sbe txbody) shelleyWitSigningKeys
   return $ makeSignedTransaction keyWits txbody
 
 data TxInsExistError

cardano-api/internal/Cardano/Api/Convenience/Query.hs

@@ -96,7 +96,7 @@ queryStateForBalancedTx era allTxIns certs = runExceptT $ do
     & onNothing (left ByronEraNotSupported)
 
   qeInMode <- pure (toEraInMode era CardanoMode)
-    & onNothing (left (EraConsensusModeMismatch (AnyConsensusMode CardanoMode) (cardanoEraConstraints era $ AnyCardanoEra era)))
+    & onNothing (left (EraConsensusModeMismatch (AnyConsensusMode CardanoMode) (anyCardanoEra era)))
 
   let stakeCreds = Set.fromList $ mapMaybe filterUnRegCreds certs
       drepCreds  = Set.fromList $ mapMaybe filterUnRegDRepCreds certs
@@ -175,9 +175,7 @@ executeQueryAnyMode era localNodeConnInfo q = runExceptT $ do
   let cMode = consensusModeOnly $ localConsensusModeParams localNodeConnInfo
 
   eraInMode <- pure (toEraInMode era cMode)
-    & onNothing (left $ EraConsensusModeMismatch
-        (AnyConsensusMode CardanoMode)
-        (cardanoEraConstraints era $ AnyCardanoEra era))
+    & onNothing (left $ EraConsensusModeMismatch (AnyConsensusMode CardanoMode) (anyCardanoEra era))
 
   case eraInMode of
     ByronEraInByronMode -> left ByronEraNotSupported