Medium QoL changes

cardano-api/gen/Test/Hedgehog/Roundtrip/Bech32.hs

@@ -10,8 +10,8 @@ import Hedgehog qualified as H
 
 roundtrip_Bech32
   :: (SerialiseAsBech32 a, Eq a, Show a)
-  => AsType a -> Gen a -> Property
-roundtrip_Bech32 typeProxy gen =
+  => Gen a -> Property
+roundtrip_Bech32 gen =
   H.property $ do
     val <- H.forAll gen
-    H.tripping val serialiseToBech32 (deserialiseFromBech32 typeProxy)
+    H.tripping val serialiseToBech32 deserialiseFromBech32

cardano-api/src/Cardano/Api.hs

@@ -160,6 +160,7 @@ module Cardano.Api
     -- * Type tags
   , HasTypeProxy (..)
   , AsType (..)
+  , asType
 
     -- * Cryptographic key interface
     -- $keys

cardano-api/src/Cardano/Api/Internal/Address.hs

@@ -270,7 +270,7 @@ instance SerialiseAddress (Address ShelleyAddr) where
 
   deserialiseAddress (AsAddress AsShelleyAddr) t =
     either (const Nothing) Just $
-      deserialiseFromBech32 (AsAddress AsShelleyAddr) t
+      deserialiseFromBech32 t
 
 instance ToJSON (Address ShelleyAddr) where
   toJSON = Aeson.String . serialiseAddress
@@ -384,10 +384,10 @@ instance IsShelleyBasedEra era => FromJSON (AddressInEra era) where
           addressAny <- runParsecParser parseAddressAny txt
           pure $ anyAddressInShelleyBasedEra sbe addressAny
 
-parseAddressAny :: Parsec.Parser AddressAny
+parseAddressAny :: SerialiseAddress addr => Parsec.Parser addr
 parseAddressAny = do
   str <- lexPlausibleAddressString
-  case deserialiseAddress AsAddressAny str of
+  case deserialiseAddress asType str of
     Nothing -> fail $ "invalid address: " <> Text.unpack str
     Just addr -> pure addr
 
@@ -478,7 +478,8 @@ shelleyAddressInEra
   -> Address ShelleyAddr
   -> AddressInEra era
 shelleyAddressInEra sbe =
-  AddressInEra (ShelleyAddressInEra sbe)
+  shelleyBasedEraConstraints sbe $
+    AddressInEra (ShelleyAddressInEra sbe)
 
 anyAddressInShelleyBasedEra
   :: ()
@@ -495,12 +496,12 @@ anyAddressInEra
   -> Either String (AddressInEra era)
 anyAddressInEra era = \case
   AddressByron addr ->
-    Right (AddressInEra ByronAddressInAnyEra addr)
-  AddressShelley addr ->
-    forEraInEon
-      era
-      (Left "Expected Byron based era address")
-      (\sbe -> Right (AddressInEra (ShelleyAddressInEra sbe) addr))
+    pure $ AddressInEra ByronAddressInAnyEra addr
+  AddressShelley addr -> do
+    sbe <- forEraMaybeEon era ?! "Expected Byron based era address"
+    shelleyBasedEraConstraints sbe $
+      pure $
+        AddressInEra (ShelleyAddressInEra sbe) addr
 
 toAddressAny :: Address addr -> AddressAny
 toAddressAny a@ShelleyAddress{} = AddressShelley a
@@ -589,7 +590,7 @@ instance SerialiseAddress StakeAddress where
 
   deserialiseAddress AsStakeAddress t =
     either (const Nothing) Just $
-      deserialiseFromBech32 AsStakeAddress t
+      deserialiseFromBech32 t
 
 instance ToJSON StakeAddress where
   toJSON s = Aeson.String $ serialiseAddress s
@@ -685,18 +686,20 @@ fromShelleyAddrIsSbe sbe = \case
   Shelley.AddrBootstrap (Shelley.BootstrapAddress addr) ->
     AddressInEra ByronAddressInAnyEra (ByronAddress addr)
   Shelley.Addr nw pc scr ->
-    AddressInEra (ShelleyAddressInEra sbe) (ShelleyAddress nw pc scr)
+    shelleyBasedEraConstraints sbe $
+      AddressInEra (ShelleyAddressInEra sbe) (ShelleyAddress nw pc scr)
 
 fromShelleyAddr
   :: ShelleyBasedEra era
   -> Shelley.Addr
   -> AddressInEra era
 fromShelleyAddr _ (Shelley.AddrBootstrap (Shelley.BootstrapAddress addr)) =
   AddressInEra ByronAddressInAnyEra (ByronAddress addr)
-fromShelleyAddr sBasedEra (Shelley.Addr nw pc scr) =
-  AddressInEra
-    (ShelleyAddressInEra sBasedEra)
-    (ShelleyAddress nw pc scr)
+fromShelleyAddr sbe (Shelley.Addr nw pc scr) =
+  shelleyBasedEraConstraints sbe $
+    AddressInEra
+      (ShelleyAddressInEra sbe)
+      (ShelleyAddress nw pc scr)
 
 fromShelleyStakeAddr :: Shelley.RewardAccount -> StakeAddress
 fromShelleyStakeAddr (Shelley.RewardAccount nw sc) = StakeAddress nw sc

cardano-api/src/Cardano/Api/Internal/CIP/Cip129.hs

@@ -4,8 +4,8 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Cardano.Api.Internal.CIP.Cip129
   ( Cip129 (..)
@@ -98,15 +98,17 @@ serialiseToBech32Cip129 a =
   humanReadablePart = cip129Bech32PrefixFor (proxyToAsType (Proxy :: Proxy a))
 
 deserialiseFromBech32Cip129
-  :: Cip129 a
-  => AsType a -> Text -> Either Bech32DecodeError a
-deserialiseFromBech32Cip129 asType bech32Str = do
+  :: forall a
+   . Cip129 a
+  => Text
+  -> Either Bech32DecodeError a
+deserialiseFromBech32Cip129 bech32Str = do
   (prefix, dataPart) <-
     Bech32.decodeLenient bech32Str
       ?!. Bech32DecodingError
 
   let actualPrefix = Bech32.humanReadablePartToText prefix
-      permittedPrefixes = cip129Bech32PrefixesPermitted asType
+      permittedPrefixes = cip129Bech32PrefixesPermitted (asType @a)
   guard (actualPrefix `elem` permittedPrefixes)
     ?! Bech32UnexpectedPrefix actualPrefix (fromList permittedPrefixes)
 
@@ -128,7 +130,7 @@ deserialiseFromBech32Cip129 asType bech32Str = do
   guard (header == expectedHeader)
     ?! Bech32UnexpectedHeader (toBase16Text expectedHeader) (toBase16Text header)
 
-  let expectedPrefix = Bech32.humanReadablePartToText $ cip129Bech32PrefixFor asType
+  let expectedPrefix = Bech32.humanReadablePartToText $ cip129Bech32PrefixFor (asType @a)
   guard (actualPrefix == expectedPrefix)
     ?! Bech32WrongPrefix actualPrefix expectedPrefix
 

cardano-api/src/Cardano/Api/Internal/DeserialiseAnyOf.hs

@@ -23,6 +23,7 @@ where
 
 import Cardano.Api.Internal.Address
 import Cardano.Api.Internal.Error
+import Cardano.Api.Internal.HasTypeProxy
 import Cardano.Api.Internal.Keys.Byron
 import Cardano.Api.Internal.Keys.Class
 import Cardano.Api.Internal.Keys.Praos
@@ -108,11 +109,10 @@ data DeserialiseInputResult a
 -- | Deserialise an input of some type that is formatted in some way.
 deserialiseInput
   :: forall a
-   . AsType a
-  -> NonEmpty (InputFormat a)
+   . NonEmpty (InputFormat a)
   -> ByteString
   -> Either InputDecodeError a
-deserialiseInput asType acceptedFormats inputBs =
+deserialiseInput acceptedFormats inputBs =
   go (toList acceptedFormats)
  where
   inputText :: Text
@@ -135,7 +135,7 @@ deserialiseInput asType acceptedFormats inputBs =
   deserialiseTextEnvelope = do
     let textEnvRes :: Either TextEnvelopeError a
         textEnvRes =
-          deserialiseFromTextEnvelope asType
+          deserialiseFromTextEnvelope
             =<< first TextEnvelopeAesonDecodeError (Aeson.eitherDecodeStrict' inputBs)
     case textEnvRes of
       Right res -> DeserialiseInputSuccess res
@@ -148,7 +148,7 @@ deserialiseInput asType acceptedFormats inputBs =
 
   deserialiseBech32 :: SerialiseAsBech32 a => DeserialiseInputResult a
   deserialiseBech32 =
-    case deserialiseFromBech32 asType inputText of
+    case deserialiseFromBech32 inputText of
       Right res -> DeserialiseInputSuccess res
       -- The input was not valid Bech32.
       Left (Bech32DecodingError _) -> DeserialiseInputErrorFormatMismatch
@@ -158,7 +158,7 @@ deserialiseInput asType acceptedFormats inputBs =
   deserialiseHex :: SerialiseAsRawBytes a => DeserialiseInputResult a
   deserialiseHex
     | isValidHex inputBs =
-        case deserialiseFromRawBytesHex asType inputBs of
+        case deserialiseFromRawBytesHex inputBs of
           Left _ -> DeserialiseInputError InputInvalidError
           Right x -> DeserialiseInputSuccess x
     | otherwise = DeserialiseInputErrorFormatMismatch

cardano-api/src/Cardano/Api/Internal/Eon/AllegraEraOnwards.hs

@@ -37,6 +37,7 @@ import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus
 import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
 
 import Data.Aeson
+import Data.Type.Equality
 import Data.Typeable (Typeable)
 
 data AllegraEraOnwards era where
@@ -101,6 +102,7 @@ type AllegraEraOnwardsConstraints era =
   , ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
   , ToJSON (DebugLedgerState era)
   , Typeable era
+  , (era == ByronEra) ~ False
   )
 
 allegraEraOnwardsConstraints

cardano-api/src/Cardano/Api/Internal/Eon/AlonzoEraOnwards.hs

@@ -46,6 +46,7 @@ import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus
 import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
 
 import Data.Aeson
+import Data.Type.Equality
 import Data.Typeable (Typeable)
 
 data AlonzoEraOnwards era where
@@ -115,6 +116,7 @@ type AlonzoEraOnwardsConstraints era =
   , ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
   , ToJSON (DebugLedgerState era)
   , Typeable era
+  , (era == ByronEra) ~ False
   )
 
 alonzoEraOnwardsConstraints

cardano-api/src/Cardano/Api/Internal/Eon/BabbageEraOnwards.hs

@@ -45,6 +45,7 @@ import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus
 import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
 
 import Data.Aeson
+import Data.Type.Equality
 import Data.Typeable (Typeable)
 
 data BabbageEraOnwards era where
@@ -119,6 +120,7 @@ type BabbageEraOnwardsConstraints era =
   , ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
   , ToJSON (DebugLedgerState era)
   , Typeable era
+  , (era == ByronEra) ~ False
   )
 
 babbageEraOnwardsConstraints

cardano-api/src/Cardano/Api/Internal/Eon/Convert.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE RankNTypes #-}
@@ -14,3 +15,6 @@ import Data.Kind (Type)
 -- relationship between types.
 class Convert (f :: a -> Type) (g :: a -> Type) where
   convert :: forall era. f era -> g era
+
+instance Convert a a where
+  convert = id

cardano-api/src/Cardano/Api/Internal/Eon/ConwayEraOnwards.hs

@@ -46,6 +46,7 @@ import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus
 import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
 
 import Data.Aeson
+import Data.Type.Equality
 import Data.Typeable (Typeable)
 
 data ConwayEraOnwards era where
@@ -122,6 +123,7 @@ type ConwayEraOnwardsConstraints era =
   , ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
   , ToJSON (DebugLedgerState era)
   , Typeable era
+  , (era == ByronEra) ~ False
   )
 
 conwayEraOnwardsConstraints

cardano-api/src/Cardano/Api/Internal/Eon/MaryEraOnwards.hs

@@ -40,6 +40,7 @@ import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus
 import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
 
 import Data.Aeson
+import Data.Type.Equality
 import Data.Typeable (Typeable)
 
 data MaryEraOnwards era where
@@ -103,6 +104,7 @@ type MaryEraOnwardsConstraints era =
   , ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
   , ToJSON (DebugLedgerState era)
   , Typeable era
+  , (era == ByronEra) ~ False
   )
 
 maryEraOnwardsConstraints

cardano-api/src/Cardano/Api/Internal/Eon/ShelleyBasedEra.hs

@@ -59,7 +59,7 @@ import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
 import Control.DeepSeq
 import Data.Aeson (FromJSON (..), ToJSON, toJSON, withText)
 import Data.Text qualified as Text
-import Data.Type.Equality (TestEquality (..), (:~:) (Refl))
+import Data.Type.Equality (TestEquality (..), (:~:) (Refl), type (==))
 import Data.Typeable (Typeable)
 import Text.Pretty (Pretty (..))
 
@@ -230,6 +230,7 @@ type ShelleyBasedEraConstraints era =
   , ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
   , ToJSON (L.PredicateFailure (L.EraRule "LEDGER" (ShelleyLedgerEra era)))
   , Typeable era
+  , (era == ByronEra) ~ False
   )
 
 shelleyBasedEraConstraints

cardano-api/src/Cardano/Api/Internal/Eon/ShelleyEraOnly.hs

@@ -38,6 +38,7 @@ import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus
 import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
 
 import Data.Aeson
+import Data.Type.Equality
 import Data.Typeable (Typeable)
 
 data ShelleyEraOnly era where
@@ -97,6 +98,7 @@ type ShelleyEraOnlyConstraints era =
   , ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
   , ToJSON (DebugLedgerState era)
   , Typeable era
+  , (era == ByronEra) ~ False
   )
 
 shelleyEraOnlyConstraints

cardano-api/src/Cardano/Api/Internal/Eon/ShelleyToAllegraEra.hs

@@ -39,6 +39,7 @@ import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus
 import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
 
 import Data.Aeson
+import Data.Type.Equality
 import Data.Typeable (Typeable)
 
 data ShelleyToAllegraEra era where
@@ -100,6 +101,7 @@ type ShelleyToAllegraEraConstraints era =
   , ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
   , ToJSON (DebugLedgerState era)
   , Typeable era
+  , (era == ByronEra) ~ False
   )
 
 shelleyToAllegraEraConstraints

cardano-api/src/Cardano/Api/Internal/Eon/ShelleyToAlonzoEra.hs

@@ -37,6 +37,7 @@ import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus
 import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
 
 import Data.Aeson
+import Data.Type.Equality
 import Data.Typeable (Typeable)
 
 data ShelleyToAlonzoEra era where
@@ -101,6 +102,7 @@ type ShelleyToAlonzoEraConstraints era =
   , ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
   , ToJSON (DebugLedgerState era)
   , Typeable era
+  , (era == ByronEra) ~ False
   )
 
 shelleyToAlonzoEraConstraints

cardano-api/src/Cardano/Api/Internal/Eon/ShelleyToBabbageEra.hs

@@ -37,6 +37,7 @@ import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus
 import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
 
 import Data.Aeson
+import Data.Type.Equality
 import Data.Typeable (Typeable)
 
 data ShelleyToBabbageEra era where
@@ -105,6 +106,7 @@ type ShelleyToBabbageEraConstraints era =
   , ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
   , ToJSON (DebugLedgerState era)
   , Typeable era
+  , (era == ByronEra) ~ False
   )
 
 shelleyToBabbageEraConstraints

cardano-api/src/Cardano/Api/Internal/Eon/ShelleyToMaryEra.hs

@@ -38,6 +38,7 @@ import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus
 import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
 
 import Data.Aeson
+import Data.Type.Equality
 import Data.Typeable (Typeable)
 
 data ShelleyToMaryEra era where
@@ -100,6 +101,7 @@ type ShelleyToMaryEraConstraints era =
   , ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
   , ToJSON (DebugLedgerState era)
   , Typeable era
+  , (era == ByronEra) ~ False
   )
 
 shelleyToMaryEraConstraints