Remove CBOR encoding from AnyStakePoolVerificationKey and fix OperationalCertificate types

Author: palas

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

@@ -6,7 +6,6 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE InstanceSigs #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -61,7 +60,6 @@ import Cardano.Api.Internal.SerialiseRaw
 import Cardano.Api.Internal.SerialiseTextEnvelope
 import Cardano.Api.Internal.SerialiseUsing
 
-import Cardano.Binary (DecoderError (DecoderErrorUnknownTag), cborError)
 import Cardano.Crypto.DSIGN.Class qualified as Crypto
 import Cardano.Crypto.Hash.Class qualified as Crypto
 import Cardano.Crypto.Seed qualified as Crypto
@@ -70,8 +68,6 @@ import Cardano.Ledger.Crypto (StandardCrypto)
 import Cardano.Ledger.Crypto qualified as Shelley (DSIGN)
 import Cardano.Ledger.Keys qualified as Shelley
 
-import Codec.CBOR.Decoding (Decoder, TokenType (TypeListLen), decodeListLenOf, peekTokenType)
-import Codec.CBOR.Encoding (Encoding, encodeListLen)
 import Data.Aeson.Types
   ( ToJSONKey (..)
   , toJSONKeyText
@@ -83,7 +79,6 @@ import Data.ByteString qualified as BS
 import Data.Either.Combinators (maybeToRight)
 import Data.Maybe
 import Data.String (IsString (..))
-import Data.Word (Word8)
 
 --
 -- Shelley payment keys
@@ -1681,27 +1676,6 @@ data AnyStakePoolVerificationKey
   | AnyStakePoolExtendedVerificationKey (VerificationKey StakePoolExtendedKey)
   deriving (Show, Eq)
 
-instance ToCBOR AnyStakePoolVerificationKey where
-  toCBOR :: AnyStakePoolVerificationKey -> Encoding
-  toCBOR (AnyStakePoolNormalVerificationKey vk) =
-    encodeListLen 2 <> toCBOR (0 :: Word8) <> toCBOR vk
-  toCBOR (AnyStakePoolExtendedVerificationKey vk) =
-    encodeListLen 2 <> toCBOR (1 :: Word8) <> toCBOR vk
-
-instance FromCBOR AnyStakePoolVerificationKey where
-  fromCBOR :: Decoder s AnyStakePoolVerificationKey
-  fromCBOR =
-    peekTokenType >>= \case
-      TypeListLen ->
-        decodeListLenOf 2 >> do
-          tag <- fromCBOR
-          case tag of
-            0 -> AnyStakePoolNormalVerificationKey <$> fromCBOR
-            1 -> AnyStakePoolExtendedVerificationKey <$> fromCBOR
-            _ -> cborError $ DecoderErrorUnknownTag "AnyStakePoolVerificationKey" tag
-      -- This case is for backwards compatibility (with CBOR encoding that doesn't support extended keys)
-      _ -> AnyStakePoolNormalVerificationKey <$> fromCBOR
-
 anyStakePoolVerificationKeyHash :: AnyStakePoolVerificationKey -> Hash StakePoolKey
 anyStakePoolVerificationKeyHash (AnyStakePoolNormalVerificationKey vk) = verificationKeyHash vk
 anyStakePoolVerificationKeyHash (AnyStakePoolExtendedVerificationKey vk) =

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

@@ -44,14 +44,14 @@ import Data.Word
 data OperationalCertificate
   = OperationalCertificate
       !(Shelley.OCert StandardCrypto)
-      !AnyStakePoolVerificationKey
+      !(VerificationKey StakePoolKey)
   deriving (Eq, Show)
   deriving anyclass SerialiseAsCBOR
 
 data OperationalCertificateIssueCounter
   = OperationalCertificateIssueCounter
   { opCertIssueCount :: !Word64
-  , opCertIssueColdKey :: !AnyStakePoolVerificationKey -- For consistency checking
+  , opCertIssueColdKey :: !(VerificationKey StakePoolKey) -- For consistency checking
   }
   deriving (Eq, Show)
   deriving anyclass SerialiseAsCBOR
@@ -95,8 +95,8 @@ data OperationalCertIssueError
     --
     -- Order: pool vkey expected, pool skey supplied
     OperationalCertKeyMismatch
-      AnyStakePoolVerificationKey
-      AnyStakePoolVerificationKey
+      (VerificationKey StakePoolKey)
+      (VerificationKey StakePoolKey)
   deriving Show
 
 instance Error OperationalCertIssueError where
@@ -133,11 +133,20 @@ issueOperationalCertificate
           , OperationalCertificateIssueCounter (succ counter) poolVKey
           )
    where
-    poolVKey' :: AnyStakePoolVerificationKey
+    castAnyStakePoolSigningKeyToNormalVerificationKey
+      :: AnyStakePoolSigningKey
+      -> VerificationKey StakePoolKey
+    castAnyStakePoolSigningKeyToNormalVerificationKey anyStakePoolSKey =
+      case anyStakePoolSigningKeyToVerificationKey anyStakePoolSKey of
+        AnyStakePoolNormalVerificationKey normalStakePoolVKey -> normalStakePoolVKey
+        AnyStakePoolExtendedVerificationKey extendedStakePoolVKey ->
+          castVerificationKey extendedStakePoolVKey
+
+    poolVKey' :: VerificationKey StakePoolKey
     poolVKey' =
       either
-        anyStakePoolSigningKeyToVerificationKey
-        (AnyStakePoolNormalVerificationKey . convert . getVerificationKey)
+        castAnyStakePoolSigningKeyToNormalVerificationKey
+        (convert . getVerificationKey)
         skey
      where
       convert