Remove CBOR encoding from AnyStakePoolVerificationKey and fix OperationalCertificate types

Author: palas

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

@@ -187,6 +187,7 @@ import           Hedgehog (Gen, MonadGen, Range)
 import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Gen.QuickCheck as Q
 import qualified Hedgehog.Range as Range
+import Data.Bifunctor (first)
 
 
 
@@ -560,13 +561,13 @@ genOperationalCertificateWithCounter
 genOperationalCertificateWithCounter = do
   kesVKey <- genVerificationKey AsKesKey
   stkPoolOrGenDelExtSign <-
-    Gen.either (AnyStakePoolNormalSigningKey <$> genSigningKey AsStakePoolKey) (genSigningKey AsGenesisDelegateExtendedKey)
+    Gen.either (genSigningKey AsStakePoolKey) (genSigningKey AsGenesisDelegateExtendedKey)
   kesP <- genKESPeriod
   c <- Gen.integral $ Range.linear 0 1000
-  let stakePoolVer = either anyStakePoolSigningKeyToVerificationKey (AnyStakePoolNormalVerificationKey . convert' . getVerificationKey) stkPoolOrGenDelExtSign
+  let stakePoolVer = either getVerificationKey (convert' . getVerificationKey) stkPoolOrGenDelExtSign
       iCounter = OperationalCertificateIssueCounter c stakePoolVer
 
-  case issueOperationalCertificate kesVKey stkPoolOrGenDelExtSign kesP iCounter of
+  case issueOperationalCertificate kesVKey (first AnyStakePoolNormalSigningKey stkPoolOrGenDelExtSign) kesP iCounter of
     -- This case should be impossible as we clearly derive the verification
     -- key from the generated signing key.
     Left err -> error $ docToString $ prettyError err

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

cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs

@@ -215,8 +215,8 @@ test_OperationalCertIssueError =
     [
       ( "OperationalCertKeyMismatch"
       , OperationalCertKeyMismatch
-          (AnyStakePoolNormalVerificationKey stakePoolVerKey1)
-          (AnyStakePoolNormalVerificationKey stakePoolVerKey2)
+          stakePoolVerKey1
+          stakePoolVerKey2
       )
     ]