diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index 7286a2bdea..7abe632c9d 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -197,8 +197,6 @@ import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Gen.QuickCheck as Q import qualified Hedgehog.Range as Range - - genAddressByron :: Gen (Address ByronAddr) genAddressByron = makeByronAddress @@ -572,10 +570,13 @@ genOperationalCertificateWithCounter genOperationalCertificateWithCounter = do kesVKey <- genVerificationKey AsKesKey stkPoolOrGenDelExtSign <- - Gen.either (genSigningKey AsStakePoolKey) (genSigningKey AsGenesisDelegateExtendedKey) + Gen.either (Gen.choice [ AnyStakePoolNormalSigningKey <$> genSigningKey AsStakePoolKey + , AnyStakePoolExtendedSigningKey <$> genSigningKey AsStakePoolExtendedKey + ]) + (genSigningKey AsGenesisDelegateExtendedKey) kesP <- genKESPeriod c <- Gen.integral $ Range.linear 0 1000 - let stakePoolVer = either getVerificationKey (convert' . getVerificationKey) stkPoolOrGenDelExtSign + let stakePoolVer = either castAnyStakePoolSigningKeyToNormalVerificationKey (convert' . getVerificationKey) stkPoolOrGenDelExtSign iCounter = OperationalCertificateIssueCounter c stakePoolVer case issueOperationalCertificate kesVKey stkPoolOrGenDelExtSign kesP iCounter of @@ -584,6 +585,15 @@ genOperationalCertificateWithCounter = do Left err -> error $ docToString $ prettyError err Right pair -> return pair where + castAnyStakePoolSigningKeyToNormalVerificationKey + :: AnyStakePoolSigningKey + -> VerificationKey StakePoolKey + castAnyStakePoolSigningKeyToNormalVerificationKey anyStakePoolSKey = + case anyStakePoolSigningKeyToVerificationKey anyStakePoolSKey of + AnyStakePoolNormalVerificationKey normalStakePoolVKey -> normalStakePoolVKey + AnyStakePoolExtendedVerificationKey extendedStakePoolVKey -> + castVerificationKey extendedStakePoolVKey + convert' :: VerificationKey GenesisDelegateExtendedKey -> VerificationKey StakePoolKey diff --git a/cardano-api/src/Cardano/Api/Internal/Keys/Shelley.hs b/cardano-api/src/Cardano/Api/Internal/Keys/Shelley.hs index 0e582c5b70..5a4e7812cc 100644 --- a/cardano-api/src/Cardano/Api/Internal/Keys/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Internal/Keys/Shelley.hs @@ -1,12 +1,16 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} -- The Shelley ledger uses promoted data kinds which we have to use, but we do -- not export any from this API. We also use them unticked as nature intended. {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} @@ -37,6 +41,10 @@ module Cardano.Api.Internal.Keys.Shelley , VerificationKey (..) , SigningKey (..) , Hash (..) + , AnyStakePoolVerificationKey (..) + , anyStakePoolVerificationKeyHash + , AnyStakePoolSigningKey (..) + , anyStakePoolSigningKeyToVerificationKey ) where @@ -60,7 +68,11 @@ import Cardano.Crypto.Wallet qualified as Crypto.HD import Cardano.Ledger.Keys (DSIGN) import Cardano.Ledger.Keys qualified as Shelley -import Data.Aeson.Types (ToJSONKey (..), toJSONKeyText, withText) +import Data.Aeson.Types + ( ToJSONKey (..) + , toJSONKeyText + , withText + ) import Data.Bifunctor (first) import Data.ByteString (ByteString) import Data.ByteString qualified as BS @@ -1658,6 +1670,29 @@ instance CastSigningKeyRole GenesisUTxOKey PaymentKey where -- stake pool keys -- +-- | Wrapper that handles both normal and extended StakePoolKeys VerificationKeys +data AnyStakePoolVerificationKey + = AnyStakePoolNormalVerificationKey (VerificationKey StakePoolKey) + | AnyStakePoolExtendedVerificationKey (VerificationKey StakePoolExtendedKey) + deriving (Show, Eq) + +anyStakePoolVerificationKeyHash :: AnyStakePoolVerificationKey -> Hash StakePoolKey +anyStakePoolVerificationKeyHash (AnyStakePoolNormalVerificationKey vk) = verificationKeyHash vk +anyStakePoolVerificationKeyHash (AnyStakePoolExtendedVerificationKey vk) = + let StakePoolExtendedKeyHash hash = verificationKeyHash vk in StakePoolKeyHash hash + +-- | Wrapper that handles both normal and extended StakePoolKeys SigningKeys +data AnyStakePoolSigningKey + = AnyStakePoolNormalSigningKey (SigningKey StakePoolKey) + | AnyStakePoolExtendedSigningKey (SigningKey StakePoolExtendedKey) + deriving Show + +anyStakePoolSigningKeyToVerificationKey :: AnyStakePoolSigningKey -> AnyStakePoolVerificationKey +anyStakePoolSigningKeyToVerificationKey (AnyStakePoolNormalSigningKey sk) = + AnyStakePoolNormalVerificationKey (getVerificationKey sk) +anyStakePoolSigningKeyToVerificationKey (AnyStakePoolExtendedSigningKey vk) = + AnyStakePoolExtendedVerificationKey (getVerificationKey vk) + data StakePoolKey instance HasTypeProxy StakePoolKey where @@ -1892,6 +1927,10 @@ instance SerialiseAsRawBytes (Hash StakePoolExtendedKey) where (SerialiseAsRawBytesError "Unable to deserialise Hash StakePoolExtendedKey") (StakePoolExtendedKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs) +instance SerialiseAsBech32 (Hash StakePoolExtendedKey) where + bech32PrefixFor _ = "pool_xvkh" + bech32PrefixesPermitted _ = ["pool_xvkh"] + instance HasTextEnvelope (VerificationKey StakePoolExtendedKey) where textEnvelopeType _ = "StakePoolExtendedVerificationKey_ed25519_bip32" @@ -1906,6 +1945,24 @@ instance SerialiseAsBech32 (SigningKey StakePoolExtendedKey) where bech32PrefixFor _ = "pool_xsk" bech32PrefixesPermitted _ = ["pool_xsk"] +instance ToJSON (Hash StakePoolExtendedKey) where + toJSON = toJSON . serialiseToBech32 + +instance ToJSONKey (Hash StakePoolExtendedKey) where + toJSONKey = toJSONKeyText serialiseToBech32 + +instance FromJSON (Hash StakePoolExtendedKey) where + parseJSON = withText "PoolId" $ \str -> + case deserialiseFromBech32 (AsHash AsStakePoolExtendedKey) str of + Left err -> + fail $ + docToString $ + mconcat + [ "Error deserialising Hash StakePoolKey: " <> pretty str + , " Error: " <> prettyError err + ] + Right h -> pure h + instance CastVerificationKeyRole StakePoolExtendedKey StakePoolKey where castVerificationKey (StakePoolExtendedVerificationKey vk) = StakePoolVerificationKey diff --git a/cardano-api/src/Cardano/Api/Internal/OperationalCertificate.hs b/cardano-api/src/Cardano/Api/Internal/OperationalCertificate.hs index 6be2bc0ffe..2846a5aff1 100644 --- a/cardano-api/src/Cardano/Api/Internal/OperationalCertificate.hs +++ b/cardano-api/src/Cardano/Api/Internal/OperationalCertificate.hs @@ -109,7 +109,7 @@ instance Error OperationalCertIssueError where issueOperationalCertificate :: VerificationKey KesKey -> Either - (SigningKey StakePoolKey) + AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey) -- TODO: this may be better with a type that -- captured the three (four?) choices, stake pool @@ -134,8 +134,21 @@ issueOperationalCertificate , OperationalCertificateIssueCounter (succ counter) poolVKey ) where + castAnyStakePoolSigningKeyToNormalVerificationKey + :: AnyStakePoolSigningKey + -> VerificationKey StakePoolKey + castAnyStakePoolSigningKeyToNormalVerificationKey anyStakePoolSKey = + case anyStakePoolSigningKeyToVerificationKey anyStakePoolSKey of + AnyStakePoolNormalVerificationKey normalStakePoolVKey -> normalStakePoolVKey + AnyStakePoolExtendedVerificationKey extendedStakePoolVKey -> + castVerificationKey extendedStakePoolVKey + poolVKey' :: VerificationKey StakePoolKey - poolVKey' = either getVerificationKey (convert . getVerificationKey) skey + poolVKey' = + either + castAnyStakePoolSigningKeyToNormalVerificationKey + (convert . getVerificationKey) + skey where convert :: VerificationKey GenesisDelegateExtendedKey @@ -164,8 +177,13 @@ issueOperationalCertificate where skey' :: ShelleySigningKey skey' = case skey of - Left (StakePoolSigningKey poolSKey) -> + Left (AnyStakePoolNormalSigningKey (StakePoolSigningKey poolSKey)) -> ShelleyNormalSigningKey poolSKey + Left + ( AnyStakePoolExtendedSigningKey + (StakePoolExtendedSigningKey poolExtendedSKey) + ) -> + ShelleyExtendedSigningKey poolExtendedSKey Right (GenesisDelegateExtendedSigningKey delegSKey) -> ShelleyExtendedSigningKey delegSKey diff --git a/cardano-api/src/Cardano/Api/Internal/Tx/Sign.hs b/cardano-api/src/Cardano/Api/Internal/Tx/Sign.hs index 02caec080f..bccd7afa91 100644 --- a/cardano-api/src/Cardano/Api/Internal/Tx/Sign.hs +++ b/cardano-api/src/Cardano/Api/Internal/Tx/Sign.hs @@ -790,6 +790,7 @@ data ShelleyWitnessSigningKey | WitnessStakeKey (SigningKey StakeKey) | WitnessStakeExtendedKey (SigningKey StakeExtendedKey) | WitnessStakePoolKey (SigningKey StakePoolKey) + | WitnessStakePoolExtendedKey (SigningKey StakePoolExtendedKey) | WitnessGenesisKey (SigningKey GenesisKey) | WitnessGenesisExtendedKey (SigningKey GenesisExtendedKey) | WitnessGenesisDelegateKey (SigningKey GenesisDelegateKey) @@ -1163,6 +1164,7 @@ toShelleySigningKey key = case key of -- The cases for extended keys WitnessPaymentExtendedKey (PaymentExtendedSigningKey sk) -> ShelleyExtendedSigningKey sk WitnessStakeExtendedKey (StakeExtendedSigningKey sk) -> ShelleyExtendedSigningKey sk + WitnessStakePoolExtendedKey (StakePoolExtendedSigningKey sk) -> ShelleyExtendedSigningKey sk WitnessGenesisExtendedKey (GenesisExtendedSigningKey sk) -> ShelleyExtendedSigningKey sk WitnessGenesisDelegateExtendedKey (GenesisDelegateExtendedSigningKey sk) -> ShelleyExtendedSigningKey sk WitnessCommitteeColdExtendedKey (CommitteeColdExtendedSigningKey sk) -> ShelleyExtendedSigningKey sk diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs index 4f6a75d160..49c1caba99 100644 --- a/cardano-api/src/Cardano/Api/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Shelley.hs @@ -199,6 +199,10 @@ module Cardano.Api.Shelley , DRepMetadataReference (DRepMetadataReference) -- ** Stake pool operator's keys + , AnyStakePoolVerificationKey (..) + , anyStakePoolVerificationKeyHash + , AnyStakePoolSigningKey (..) + , anyStakePoolSigningKeyToVerificationKey , StakePoolExtendedKey , StakePoolKey , PoolId diff --git a/cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs b/cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs index 390569fe0a..84e8e514e4 100644 --- a/cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs +++ b/cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs @@ -211,7 +211,12 @@ test_OperationalCertIssueError = testAllErrorMessages_ "Cardano.Api.OperationalCertificate" "OperationalCertIssueError" - [ ("OperationalCertKeyMismatch", OperationalCertKeyMismatch stakePoolVerKey1 stakePoolVerKey2) + [ + ( "OperationalCertKeyMismatch" + , OperationalCertKeyMismatch + stakePoolVerKey1 + stakePoolVerKey2 + ) ] test_ProtocolParametersError :: TestTree