Remove keys casting

IntersectMBO · Oct 26, 2023 · 0ab6808 · 0ab6808
1 parent 2626cce
commit 0ab6808
Show file tree

Hide file tree

Showing 9 changed files with 30 additions and 101 deletions.
diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal
@@ -102,7 +102,6 @@ library internal
                         Cardano.Api.Keys.Read
                         Cardano.Api.Keys.Shelley
                         Cardano.Api.Ledger.Lens
-                        Cardano.Api.Ledger.Keys
                         Cardano.Api.LedgerEvent
                         Cardano.Api.LedgerState
                         Cardano.Api.Modes

diff --git a/cardano-api/internal/Cardano/Api/Address.hs b/cardano-api/internal/Cardano/Api/Address.hs
@@ -523,7 +523,6 @@ makeShelleyAddressInEra sbe nw pc scr =
 --
 
 data StakeAddress where
-
      StakeAddress
        :: Shelley.Network
        -> Shelley.StakeCredential StandardCrypto

diff --git a/cardano-api/internal/Cardano/Api/Certificate.hs b/cardano-api/internal/Cardano/Api/Certificate.hs
@@ -81,7 +81,6 @@ import           Cardano.Api.Governance.Actions.VotingProcedure
 import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.Keys.Praos
 import           Cardano.Api.Keys.Shelley
-import           Cardano.Api.Ledger.Keys (castLedgerKey)
 import           Cardano.Api.ReexposeLedger (EraCrypto, StandardCrypto)
 import qualified Cardano.Api.ReexposeLedger as Ledger
 import           Cardano.Api.SerialiseCBOR
@@ -383,7 +382,7 @@ makeMIRCertificate (MirCertificateRequirements atMostEra mirPot mirTarget) =
 data DRepRegistrationRequirements era where
   DRepRegistrationRequirements
     :: ConwayEraOnwards era
-    -> VotingCredential era
+    -> (Ledger.Credential Ledger.DRepRole (EraCrypto (ShelleyLedgerEra era)))
     -> Lovelace
     -> DRepRegistrationRequirements era
 
@@ -392,7 +391,7 @@ makeDrepRegistrationCertificate :: ()
   => DRepRegistrationRequirements era
   -> Maybe (Ledger.Anchor (EraCrypto (ShelleyLedgerEra era)))
   -> Certificate era
-makeDrepRegistrationCertificate (DRepRegistrationRequirements conwayOnwards (VotingCredential vcred) deposit) anchor =
+makeDrepRegistrationCertificate (DRepRegistrationRequirements conwayOnwards vcred deposit) anchor =
   ConwayCertificate conwayOnwards
     . Ledger.ConwayTxCertGov
     $ Ledger.ConwayRegDRep
@@ -435,14 +434,14 @@ makeCommitteeColdkeyResignationCertificate (CommitteeColdkeyResignationRequireme
 data DRepUnregistrationRequirements era where
   DRepUnregistrationRequirements
     :: ConwayEraOnwards era
-    -> VotingCredential era
+    -> (Ledger.Credential Ledger.DRepRole (EraCrypto (ShelleyLedgerEra era)))
     -> Lovelace
     -> DRepUnregistrationRequirements era
 
 makeDrepUnregistrationCertificate :: ()
   => DRepUnregistrationRequirements era
   -> Certificate era
-makeDrepUnregistrationCertificate (DRepUnregistrationRequirements conwayOnwards (VotingCredential vcred) deposit) =
+makeDrepUnregistrationCertificate (DRepUnregistrationRequirements conwayOnwards vcred deposit) =
   ConwayCertificate conwayOnwards
     . Ledger.ConwayTxCertGov
     . Ledger.ConwayUnRegDRep vcred
@@ -474,19 +473,15 @@ selectStakeCredential = fmap fromShelleyStakeCredential . \case
       Ledger.RegTxCert sCred           -> Just sCred
       Ledger.UnRegTxCert sCred         -> Just sCred
       Ledger.DelegStakeTxCert sCred _  -> Just sCred
-      Ledger.RegPoolTxCert poolParams  ->
-        Just . castLedgerKey . Ledger.KeyHashObj $ Ledger.ppId poolParams
-      Ledger.RetirePoolTxCert poolId _ ->
-        Just . castLedgerKey $ Ledger.KeyHashObj poolId
+      Ledger.RegPoolTxCert _           -> Nothing -- StakePool should never be a credential
+      Ledger.RetirePoolTxCert _ _      -> Nothing -- StakePool should never be a credential
       Ledger.MirTxCert _               -> Nothing
       Ledger.GenesisDelegTxCert{}      -> Nothing
 
   ConwayCertificate cEra conwayCert -> conwayEraOnwardsConstraints cEra $
     case conwayCert of
-      Ledger.RegPoolTxCert poolParams        ->
-        Just . castLedgerKey . Ledger.KeyHashObj $ Ledger.ppId poolParams
-      Ledger.RetirePoolTxCert kh _           ->
-        Just . castLedgerKey $ Ledger.KeyHashObj kh
+      Ledger.RegPoolTxCert _                 -> Nothing -- StakePool should never be a credential
+      Ledger.RetirePoolTxCert _ _            -> Nothing -- StakePool should never be a credential
       Ledger.RegTxCert sCred                 -> Just sCred
       Ledger.UnRegTxCert sCred               -> Just sCred
       Ledger.RegDepositTxCert sCred _        -> Just sCred

diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs
@@ -22,7 +22,6 @@ import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Governance.Actions.ProposalProcedure
 import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.Keys.Shelley
-import           Cardano.Api.Ledger.Keys
 import qualified Cardano.Api.ReexposeLedger as Ledger
 import           Cardano.Api.Script
 import           Cardano.Api.SerialiseCBOR
@@ -56,18 +55,14 @@ instance IsShelleyBasedEra era => FromCBOR (GovernanceActionId era) where
     !v <- shelleyBasedEraConstraints (shelleyBasedEra @era) $ Ledger.fromEraCBOR @(ShelleyLedgerEra era)
     return $ GovernanceActionId v
 
-
--- TODO: Conway era -
--- These should be the different keys corresponding to the Constitutional Committee and DReps.
--- We can then derive the StakeCredentials from them.
 data Voter era
-  = VoterCommittee (VotingCredential era) -- ^ Constitutional committee
-  | VoterDRep (VotingCredential era) -- ^ Delegated representative
+  = VoterCommittee (Ledger.Credential Ledger.HotCommitteeRole (EraCrypto (ShelleyLedgerEra era))) -- ^ Constitutional committee
+  | VoterDRep (Ledger.Credential DRepRole (EraCrypto (ShelleyLedgerEra era))) -- ^ Delegated representative
   | VoterSpo (Hash StakePoolKey) -- ^ Stake pool operator
   deriving (Show, Eq, Ord)
 
 instance IsShelleyBasedEra era => ToCBOR (Voter era) where
-  toCBOR = \case
+  toCBOR = shelleyBasedEraConstraints (shelleyBasedEra @era) $ \case
     VoterCommittee v ->
       CBOR.encodeListLen 2 <> CBOR.encodeWord 0 <> toCBOR v
     VoterDRep v ->
@@ -76,7 +71,7 @@ instance IsShelleyBasedEra era => ToCBOR (Voter era) where
       CBOR.encodeListLen 2 <> CBOR.encodeWord 2 <> toCBOR v
 
 instance IsShelleyBasedEra era => FromCBOR (Voter era) where
-  fromCBOR = do
+  fromCBOR = shelleyBasedEraConstraints (shelleyBasedEra @era) $ do
     CBOR.decodeListLenOf 2
     t <- CBOR.decodeWord
     case t of
@@ -104,12 +99,9 @@ toVoterRole :: ()
   -> Ledger.Voter (L.EraCrypto (ShelleyLedgerEra era))
 toVoterRole eon =
   conwayEraOnwardsConstraints eon $ \case
-    VoterCommittee (VotingCredential cred) ->
-      Ledger.CommitteeVoter $ castLedgerKey cred
-    VoterDRep (VotingCredential cred) ->
-      Ledger.DRepVoter cred
-    VoterSpo (StakePoolKeyHash kh) ->
-      Ledger.StakePoolVoter kh
+    VoterCommittee cred -> Ledger.CommitteeVoter cred
+    VoterDRep cred -> Ledger.DRepVoter cred
+    VoterSpo (StakePoolKeyHash kh) -> Ledger.StakePoolVoter kh
 
 fromVoterRole :: ()
   => ConwayEraOnwards era
@@ -118,9 +110,9 @@ fromVoterRole :: ()
 fromVoterRole eon =
   conwayEraOnwardsConstraints eon $ \case
     Ledger.CommitteeVoter cred ->
-      VoterCommittee (VotingCredential (castLedgerKey cred))
+      VoterCommittee cred
     Ledger.DRepVoter cred ->
-      VoterDRep (VotingCredential cred)
+      VoterDRep cred
     Ledger.StakePoolVoter kh ->
       VoterSpo (StakePoolKeyHash kh)
 
@@ -133,7 +125,7 @@ toVote = \case
 toVotingCredential :: ()
   => ConwayEraOnwards era
   -> StakeCredential
-  -> Either Plain.DecoderError (VotingCredential era)
+  -> Either Plain.DecoderError (Ledger.Credential DRepRole (EraCrypto (ShelleyLedgerEra era)))
 toVotingCredential sbe (StakeCredentialByKey (StakeKeyHash kh)) = do
   let cbor = Plain.serialize $ Ledger.KeyHashObj kh
   eraDecodeVotingCredential sbe cbor
@@ -150,30 +142,8 @@ toVotingCredential _sbe (StakeCredentialByScript (ScriptHash _sh)) =
 eraDecodeVotingCredential :: ()
   => ConwayEraOnwards era
   -> ByteString
-  -> Either Plain.DecoderError (VotingCredential era)
-eraDecodeVotingCredential eon bs =
-  conwayEraOnwardsConstraints eon $
-    case Plain.decodeFull bs of
-      Left e -> Left e
-      Right x -> Right $ VotingCredential x
-
-newtype VotingCredential era = VotingCredential
-  { unVotingCredential :: Ledger.Credential 'DRepRole (EraCrypto (ShelleyLedgerEra era))
-  }
-
-deriving instance Show (VotingCredential crypto)
-deriving instance Eq (VotingCredential crypto)
-deriving instance Ord (VotingCredential crypto)
-
-instance IsShelleyBasedEra era => ToCBOR (VotingCredential era) where
-  toCBOR = \case
-    VotingCredential v ->
-      shelleyBasedEraConstraints (shelleyBasedEra @era) $ CBOR.toCBOR v
-
-instance IsShelleyBasedEra era => FromCBOR (VotingCredential era) where
-  fromCBOR = do
-    v <- shelleyBasedEraConstraints (shelleyBasedEra @era) CBOR.fromCBOR
-    return $ VotingCredential v
+  -> Either Plain.DecoderError (Ledger.Credential DRepRole (EraCrypto (ShelleyLedgerEra era)))
+eraDecodeVotingCredential eon bs = conwayEraOnwardsConstraints eon $ Plain.decodeFull bs
 
 createVotingProcedure :: ()
   => ConwayEraOnwards era

diff --git a/cardano-api/internal/Cardano/Api/Ledger/Keys.hs b/cardano-api/internal/Cardano/Api/Ledger/Keys.hs
diff --git a/cardano-api/internal/Cardano/Api/Script.hs b/cardano-api/internal/Cardano/Api/Script.hs
@@ -117,7 +117,6 @@ import           Cardano.Api.Error
 import           Cardano.Api.Hash
 import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.Keys.Shelley
-import           Cardano.Api.Ledger.Keys
 import           Cardano.Api.ScriptData
 import           Cardano.Api.SerialiseCBOR
 import           Cardano.Api.SerialiseJSON
@@ -136,6 +135,7 @@ import           Cardano.Ledger.BaseTypes (StrictMaybe (..))
 import qualified Cardano.Ledger.Binary as Binary (decCBOR, decodeFullAnnotator)
 import           Cardano.Ledger.Core (Era (EraCrypto))
 import qualified Cardano.Ledger.Core as Ledger
+import qualified Cardano.Ledger.Keys as L
 import qualified Cardano.Ledger.Shelley.Scripts as Shelley
 import           Cardano.Slotting.Slot (SlotNo)
 import           Ouroboros.Consensus.Shelley.Eras (StandardCrypto)
@@ -1197,7 +1197,7 @@ toShelleyMultiSig = go
   where
     go :: SimpleScript -> Either MultiSigError (Shelley.MultiSig era)
     go (RequireSignature (PaymentKeyHash kh)) =
-      return $ Shelley.RequireSignature (castLedgerKey kh)
+      return $ Shelley.RequireSignature (L.asWitness kh)
     go (RequireAllOf s) = mapM go s <&> Shelley.RequireAllOf
     go (RequireAnyOf s) = mapM go s <&> Shelley.RequireAnyOf
     go (RequireMOf m s) = mapM go s <&> Shelley.RequireMOf m
@@ -1211,7 +1211,7 @@ fromShelleyMultiSig = go
   where
     go (Shelley.RequireSignature kh)
                                 = RequireSignature
-                                    (PaymentKeyHash (castLedgerKey kh))
+                                    (PaymentKeyHash (L.coerceKeyRole kh))
     go (Shelley.RequireAllOf s) = RequireAllOf (map go s)
     go (Shelley.RequireAnyOf s) = RequireAnyOf (map go s)
     go (Shelley.RequireMOf m s) = RequireMOf m (map go s)
@@ -1226,7 +1226,7 @@ toAllegraTimelock = go
   where
     go :: SimpleScript -> Timelock.Timelock era
     go (RequireSignature (PaymentKeyHash kh))
-                        = Timelock.RequireSignature (castLedgerKey kh)
+                        = Timelock.RequireSignature (L.asWitness kh)
     go (RequireAllOf s) = Timelock.RequireAllOf (Seq.fromList (map go s))
     go (RequireAnyOf s) = Timelock.RequireAnyOf (Seq.fromList (map go s))
     go (RequireMOf m s) = Timelock.RequireMOf m (Seq.fromList (map go s))
@@ -1241,7 +1241,7 @@ fromAllegraTimelock :: (Era era, EraCrypto era ~ StandardCrypto)
 fromAllegraTimelock = go
   where
     go (Timelock.RequireSignature kh) = RequireSignature
-                                          (PaymentKeyHash (castLedgerKey kh))
+                                          (PaymentKeyHash (L.coerceKeyRole kh))
     go (Timelock.RequireTimeExpire t) = RequireTimeBefore t
     go (Timelock.RequireTimeStart  t) = RequireTimeAfter t
     go (Timelock.RequireAllOf      s) = RequireAllOf (map go (toList s))

diff --git a/cardano-api/internal/Cardano/Api/Tx.hs b/cardano-api/internal/Cardano/Api/Tx.hs
@@ -59,7 +59,6 @@ import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.Keys.Byron
 import           Cardano.Api.Keys.Class
 import           Cardano.Api.Keys.Shelley
-import           Cardano.Api.Ledger.Keys
 import           Cardano.Api.NetworkId
 import           Cardano.Api.SerialiseCBOR
 import           Cardano.Api.SerialiseTextEnvelope
@@ -794,16 +793,16 @@ getShelleyKeyWitnessVerificationKey
   :: ShelleySigningKey
   -> Shelley.VKey Shelley.Witness StandardCrypto
 getShelleyKeyWitnessVerificationKey (ShelleyNormalSigningKey sk) =
-      (castLedgerKey     :: Shelley.VKey Shelley.Payment StandardCrypto
+      (Shelley.asWitness :: Shelley.VKey Shelley.Payment StandardCrypto
                          -> Shelley.VKey Shelley.Witness StandardCrypto)
     . (\(PaymentVerificationKey vk) -> vk)
     . getVerificationKey
     . PaymentSigningKey
     $ sk
 
 getShelleyKeyWitnessVerificationKey (ShelleyExtendedSigningKey sk) =
-      (castLedgerKey :: Shelley.VKey Shelley.Payment StandardCrypto
-                     -> Shelley.VKey Shelley.Witness StandardCrypto)
+      (Shelley.asWitness :: Shelley.VKey Shelley.Payment StandardCrypto
+                         -> Shelley.VKey Shelley.Witness StandardCrypto)
     . (\(PaymentVerificationKey vk) -> vk)
     . (castVerificationKey :: VerificationKey PaymentExtendedKey
                            -> VerificationKey PaymentKey)

diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs
@@ -169,7 +169,6 @@ import           Cardano.Api.Hash
 import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.Keys.Byron
 import           Cardano.Api.Keys.Shelley
-import           Cardano.Api.Ledger.Keys
 import qualified Cardano.Api.Ledger.Lens as L
 import           Cardano.Api.NetworkId
 import           Cardano.Api.ProtocolParameters
@@ -2459,7 +2458,7 @@ fromLedgerTxExtraKeyWitnesses sbe body =
         then TxExtraKeyWitnessesNone
         else
           TxExtraKeyWitnesses w
-            [ PaymentKeyHash (castLedgerKey keyhash)
+            [ PaymentKeyHash (Ledger.coerceKeyRole keyhash)
             | keyhash <- Set.toList $ body ^. L.reqSignerHashesTxBodyL
             ]
     )
@@ -2673,7 +2672,7 @@ convExtraKeyWitnesses txExtraKeyWits =
   case txExtraKeyWits of
     TxExtraKeyWitnessesNone   -> Set.empty
     TxExtraKeyWitnesses _ khs -> Set.fromList
-                                   [ castLedgerKey kh
+                                   [ Shelley.asWitness kh
                                    | PaymentKeyHash kh <- khs ]
 
 convScripts

diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs
@@ -261,7 +261,6 @@ module Cardano.Api.Shelley
     GovernancePollAnswer(..),
     GovernancePollError(..),
     Vote(..),
-    VotingCredential(..),
     Voter(..),
     createProposalProcedure,
     createVotingProcedure,