Remove keys casting

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

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

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

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,74 +55,24 @@ 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
-  | VoterSpo (Hash StakePoolKey) -- ^ Stake pool operator
+newtype Voter era = Voter (Ledger.Voter (L.EraCrypto (ShelleyLedgerEra era)))
   deriving (Show, Eq, Ord)
 
 instance IsShelleyBasedEra era => ToCBOR (Voter era) where
-  toCBOR = \case
-    VoterCommittee v ->
-      CBOR.encodeListLen 2 <> CBOR.encodeWord 0 <> toCBOR v
-    VoterDRep v ->
-      CBOR.encodeListLen 2 <> CBOR.encodeWord 1 <> toCBOR v
-    VoterSpo v ->
-      CBOR.encodeListLen 2 <> CBOR.encodeWord 2 <> toCBOR v
+  toCBOR (Voter v) = shelleyBasedEraConstraints (shelleyBasedEra @era) $ Ledger.toEraCBOR @(ShelleyLedgerEra era) v
 
 instance IsShelleyBasedEra era => FromCBOR (Voter era) where
   fromCBOR = do
-    CBOR.decodeListLenOf 2
-    t <- CBOR.decodeWord
-    case t of
-      0 -> do
-        !x <- fromCBOR
-        return $ VoterCommittee x
-      1 -> do
-        !x <- fromCBOR
-        return $ VoterDRep x
-      2 -> do
-        !x <- fromCBOR
-        return $ VoterSpo x
-      _ ->
-        CBOR.cborError $ CBOR.DecoderErrorUnknownTag "Voter era" (fromIntegral t)
+    !v <- shelleyBasedEraConstraints (shelleyBasedEra @era) $ Ledger.fromEraCBOR @(ShelleyLedgerEra era)
+    pure $ Voter v
+
 
 data Vote
   = No
   | Yes
   | Abstain
   deriving (Show, Eq)
 
-toVoterRole :: ()
-  => ConwayEraOnwards era
-  -> Voter era
-  -> 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
-
-fromVoterRole :: ()
-  => ConwayEraOnwards era
-  -> Ledger.Voter (L.EraCrypto (ShelleyLedgerEra era))
-  -> Voter era
-fromVoterRole eon =
-  conwayEraOnwardsConstraints eon $ \case
-    Ledger.CommitteeVoter cred ->
-      VoterCommittee (VotingCredential (castLedgerKey cred))
-    Ledger.DRepVoter cred ->
-      VoterDRep (VotingCredential cred)
-    Ledger.StakePoolVoter kh ->
-      VoterSpo (StakePoolKeyHash kh)
-
 toVote :: Vote -> Ledger.Vote
 toVote = \case
   No -> Ledger.VoteNo
@@ -133,7 +82,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 +99,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

cardano-api/internal/Cardano/Api/Keys/Shelley.hs

@@ -37,6 +37,9 @@ module Cardano.Api.Keys.Shelley (
     VerificationKey(..),
     SigningKey(..),
     Hash(..),
+
+    -- * Utilities
+    fromWitness
   ) where
 
 import           Cardano.Api.Error
@@ -1735,7 +1738,9 @@ instance CastVerificationKeyRole DRepExtendedKey DRepKey where
         impossible =
           error "castVerificationKey (DRep): byron and shelley key sizes do not match!"
 
---
--- Committee keys
---
 
+-- | Coerce a key from a witness key into an arbitrary key. Dual to @Shelley.asWitness@.
+fromWitness :: Shelley.HasKeyRole a
+            => a Shelley.Witness c
+            -> a r c
+fromWitness = Shelley.coerceKeyRole

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 Shelley
 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 (Shelley.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 (fromWitness 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 (Shelley.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 (fromWitness kh))
     go (Timelock.RequireTimeExpire t) = RequireTimeBefore t
     go (Timelock.RequireTimeStart  t) = RequireTimeAfter t
     go (Timelock.RequireAllOf      s) = RequireAllOf (map go (toList s))

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)

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 (fromWitness 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

cardano-api/src/Cardano/Api/Shelley.hs

@@ -261,7 +261,6 @@ module Cardano.Api.Shelley
     GovernancePollAnswer(..),
     GovernancePollError(..),
     Vote(..),
-    VotingCredential(..),
     Voter(..),
     createProposalProcedure,
     createVotingProcedure,