From 2a13c9f282873530c09afe0beeeb6784df8f9a97 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 8 Sep 2026 10:29:18 +0000 Subject: [PATCH 1/7] Depend on cardano-keys The key layer now lives in its own package. The source-repository-package is temporary, until cardano-keys has its first CHaP release, so the repo is listed in master-check-exceptions.list. random is no longer imported directly by the library. --- cabal.project | 2 +- cardano-api/cardano-api.cabal | 2 +- flake.lock | 6 +++--- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/cabal.project b/cabal.project index 5088d490d3..2605743ab4 100644 --- a/cabal.project +++ b/cabal.project @@ -14,7 +14,7 @@ repository cardano-haskell-packages -- you need to run if you change them index-state: , hackage.haskell.org 2026-08-02T17:21:34Z - , cardano-haskell-packages 2026-09-03T10:20:53Z + , cardano-haskell-packages 2026-09-15T21:40:46Z packages: cardano-api diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 8a5fe60f16..f319c988db 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -140,6 +140,7 @@ library cardano-crypto-wrapper ^>=1.7, cardano-data >=1.0, cardano-diffusion:{api, cardano-diffusion} ^>=1.1, + cardano-keys ^>=11.0, cardano-ledger-allegra >=1.7, cardano-ledger-alonzo >=1.15, cardano-ledger-api ^>=1.14, @@ -188,7 +189,6 @@ library prettyprinter, prettyprinter-ansi-terminal, prettyprinter-configurable ^>=1.36, - random, resource-registry ^>=0.3, safe-exceptions, scientific, diff --git a/flake.lock b/flake.lock index 1ca971dc76..d29ca237fb 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1788439818, - "narHash": "sha256-+sjKSr1tFhiLrxhplOOToCjXMyWZV4ZbvYOdkqwHzBg=", + "lastModified": 1789511624, + "narHash": "sha256-Y29/jJurAjnclBbW1Wn4Bfr4Rm4rzGpdD6liEHhAJI8=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "95889113a879bc92976bba48cf743bd78f99710f", + "rev": "869e3b32ffc5f0f59f11648c8bd9adeade286694", "type": "github" }, "original": { From 1c7ca33194cf40353a58307c75d2946fc10d9324 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 8 Sep 2026 10:29:19 +0000 Subject: [PATCH 2/7] Replace the moved key and serialisation modules with re-exports Module names and export lists are unchanged. What each module still holds locally is what cardano-keys does not provide: the Error instances, the parsec parsers, the era-coupled and file-based text-envelope functions, and the operational certificate issuing half. The golden error files are keyed by the defining module of the error type, so the two directories for the types that moved are renamed. Their contents are unchanged. --- .../src/Cardano/Api/Byron/Internal/Key.hs | 297 +-- .../Internal/OperationalCertificate.hs | 77 +- cardano-api/src/Cardano/Api/HasTypeProxy.hs | 67 +- cardano-api/src/Cardano/Api/Hash.hs | 36 +- cardano-api/src/Cardano/Api/Key/Internal.hs | 2236 +---------------- .../src/Cardano/Api/Key/Internal/Class.hs | 109 +- .../src/Cardano/Api/Key/Internal/Leios.hs | 217 +- .../src/Cardano/Api/Key/Internal/Praos.hs | 256 +- .../src/Cardano/Api/Serialise/Bech32.hs | 189 +- cardano-api/src/Cardano/Api/Serialise/Cbor.hs | 30 +- cardano-api/src/Cardano/Api/Serialise/Raw.hs | 154 +- .../Cardano/Api/Serialise/SerialiseUsing.hs | 113 +- .../Api/Serialise/TextEnvelope/Internal.hs | 247 +- .../Bech32DataPartToBytesError.txt | 0 .../Bech32DecodingError.txt | 0 .../Bech32DeserialiseFromBytesError.txt | 0 .../Bech32InvalidUtf8.txt | 0 .../Bech32UnexpectedHeader.txt | 0 .../Bech32UnexpectedPrefix.txt | 0 .../Bech32WrongPrefix.txt | 0 .../TextEnvelopeAesonDecodeError.txt | 0 .../TextEnvelopeDecodeError.txt | 0 .../TextEnvelopeTypeError.txt | 0 .../TextEnvelopeUnknownKeyWitness.txt | 0 .../TextEnvelopeUnknownType.txt | 0 25 files changed, 73 insertions(+), 3955 deletions(-) rename cardano-api/test/cardano-api-golden/files/errors/{Cardano.Api.Serialise.Bech32.Bech32DecodeError => Cardano.Keys.Serialise.Bech32.Bech32DecodeError}/Bech32DataPartToBytesError.txt (100%) rename cardano-api/test/cardano-api-golden/files/errors/{Cardano.Api.Serialise.Bech32.Bech32DecodeError => Cardano.Keys.Serialise.Bech32.Bech32DecodeError}/Bech32DecodingError.txt (100%) rename cardano-api/test/cardano-api-golden/files/errors/{Cardano.Api.Serialise.Bech32.Bech32DecodeError => Cardano.Keys.Serialise.Bech32.Bech32DecodeError}/Bech32DeserialiseFromBytesError.txt (100%) rename cardano-api/test/cardano-api-golden/files/errors/{Cardano.Api.Serialise.Bech32.Bech32DecodeError => Cardano.Keys.Serialise.Bech32.Bech32DecodeError}/Bech32InvalidUtf8.txt (100%) rename cardano-api/test/cardano-api-golden/files/errors/{Cardano.Api.Serialise.Bech32.Bech32DecodeError => Cardano.Keys.Serialise.Bech32.Bech32DecodeError}/Bech32UnexpectedHeader.txt (100%) rename cardano-api/test/cardano-api-golden/files/errors/{Cardano.Api.Serialise.Bech32.Bech32DecodeError => Cardano.Keys.Serialise.Bech32.Bech32DecodeError}/Bech32UnexpectedPrefix.txt (100%) rename cardano-api/test/cardano-api-golden/files/errors/{Cardano.Api.Serialise.Bech32.Bech32DecodeError => Cardano.Keys.Serialise.Bech32.Bech32DecodeError}/Bech32WrongPrefix.txt (100%) rename cardano-api/test/cardano-api-golden/files/errors/{Cardano.Api.Serialise.TextEnvelope.Internal.TextEnvelopeError => Cardano.Keys.Serialise.TextEnvelope.TextEnvelopeError}/TextEnvelopeAesonDecodeError.txt (100%) rename cardano-api/test/cardano-api-golden/files/errors/{Cardano.Api.Serialise.TextEnvelope.Internal.TextEnvelopeError => Cardano.Keys.Serialise.TextEnvelope.TextEnvelopeError}/TextEnvelopeDecodeError.txt (100%) rename cardano-api/test/cardano-api-golden/files/errors/{Cardano.Api.Serialise.TextEnvelope.Internal.TextEnvelopeError => Cardano.Keys.Serialise.TextEnvelope.TextEnvelopeError}/TextEnvelopeTypeError.txt (100%) rename cardano-api/test/cardano-api-golden/files/errors/{Cardano.Api.Serialise.TextEnvelope.Internal.TextEnvelopeError => Cardano.Keys.Serialise.TextEnvelope.TextEnvelopeError}/TextEnvelopeUnknownKeyWitness.txt (100%) rename cardano-api/test/cardano-api-golden/files/errors/{Cardano.Api.Serialise.TextEnvelope.Internal.TextEnvelopeError => Cardano.Keys.Serialise.TextEnvelope.TextEnvelopeError}/TextEnvelopeUnknownType.txt (100%) diff --git a/cardano-api/src/Cardano/Api/Byron/Internal/Key.hs b/cardano-api/src/Cardano/Api/Byron/Internal/Key.hs index 6b8add894c..cf50d2cde9 100644 --- a/cardano-api/src/Cardano/Api/Byron/Internal/Key.hs +++ b/cardano-api/src/Cardano/Api/Byron/Internal/Key.hs @@ -1,298 +1,9 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DerivingVia #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} - -- | Byron key types and their 'Key' class instances +-- +-- This module now lives in the cardano-keys package; re-exported here for compatibility. module Cardano.Api.Byron.Internal.Key - ( -- * Key types - ByronKey - , ByronKeyLegacy - - -- * Data family instances - , AsType (..) - , VerificationKey (..) - , SigningKey (..) - , Hash (..) - - -- * Legacy format - , IsByronKey (..) - , ByronKeyFormat (..) - , SomeByronSigningKey (..) - , toByronSigningKey + ( module Cardano.Keys.Byron ) where -import Cardano.Api.HasTypeProxy -import Cardano.Api.Hash -import Cardano.Api.Key.Internal -import Cardano.Api.Key.Internal.Class -import Cardano.Api.Pretty -import Cardano.Api.Serialise.Cbor -import Cardano.Api.Serialise.Raw -import Cardano.Api.Serialise.SerialiseUsing -import Cardano.Api.Serialise.TextEnvelope.Internal - -import Cardano.Binary (cborError, toStrictByteString) -import Cardano.Chain.Common qualified as Crypto -import Cardano.Crypto.DSIGN.Class qualified as Crypto -import Cardano.Crypto.Hashing qualified as Crypto -import Cardano.Crypto.Seed qualified as Crypto -import Cardano.Crypto.Signing qualified as Crypto -import Cardano.Crypto.Wallet qualified as Crypto.HD -import Cardano.Crypto.Wallet qualified as Wallet - -import Codec.CBOR.Decoding qualified as CBOR -import Codec.CBOR.Read qualified as CBOR -import Control.Monad -import Data.Bifunctor -import Data.ByteString.Lazy qualified as LB -import Data.Either.Combinators -import Data.Text qualified as Text -import Formatting (build, formatToString) - --- | Byron-era payment keys. Used for Byron addresses and witnessing --- transactions that spend from these addresses. --- --- These use Ed25519 but with a 32byte \"chaincode\" used in HD derivation. --- The inclusion of the chaincode is a design mistake but one that cannot --- be corrected for the Byron era. The Shelley era 'PaymentKey's do not include --- a chaincode. It is safe to use a zero or random chaincode for new Byron keys. --- --- This is a type level tag, used with other interfaces like 'Key'. -data ByronKey - -data ByronKeyLegacy - -class IsByronKey key where - byronKeyFormat :: ByronKeyFormat key - -data ByronKeyFormat key where - ByronLegacyKeyFormat :: ByronKeyFormat ByronKeyLegacy - ByronModernKeyFormat :: ByronKeyFormat ByronKey - -data SomeByronSigningKey - = AByronSigningKeyLegacy (SigningKey ByronKeyLegacy) - | AByronSigningKey (SigningKey ByronKey) - -toByronSigningKey :: SomeByronSigningKey -> Crypto.SigningKey -toByronSigningKey bWit = - case bWit of - AByronSigningKeyLegacy (ByronSigningKeyLegacy sKey) -> sKey - AByronSigningKey (ByronSigningKey sKey) -> sKey - --- --- Byron key --- - -instance Key ByronKey where - newtype VerificationKey ByronKey - = ByronVerificationKey Crypto.VerificationKey - deriving stock Eq - deriving (Show, Pretty) via UsingRawBytesHex (VerificationKey ByronKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - newtype SigningKey ByronKey - = ByronSigningKey Crypto.SigningKey - deriving (Show, Pretty) via UsingRawBytesHex (SigningKey ByronKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - deterministicSigningKey :: AsType ByronKey -> Crypto.Seed -> SigningKey ByronKey - deterministicSigningKey AsByronKey seed = - ByronSigningKey (snd (Crypto.runMonadRandomWithSeed seed Crypto.keyGen)) - - deterministicSigningKeySeedSize :: AsType ByronKey -> Word - deterministicSigningKeySeedSize AsByronKey = 32 - - getVerificationKey :: SigningKey ByronKey -> VerificationKey ByronKey - getVerificationKey (ByronSigningKey sk) = - ByronVerificationKey (Crypto.toVerification sk) - - verificationKeyHash :: VerificationKey ByronKey -> Hash ByronKey - verificationKeyHash (ByronVerificationKey vkey) = - ByronKeyHash (Crypto.hashKey vkey) - -instance HasTypeProxy ByronKey where - data AsType ByronKey = AsByronKey - proxyToAsType _ = AsByronKey - -instance HasTextEnvelope (VerificationKey ByronKey) where - textEnvelopeType _ = "PaymentVerificationKeyByron_ed25519_bip32" - -instance HasTextEnvelope (SigningKey ByronKey) where - textEnvelopeType _ = "PaymentSigningKeyByron_ed25519_bip32" - -instance SerialiseAsRawBytes (VerificationKey ByronKey) where - serialiseToRawBytes (ByronVerificationKey (Crypto.VerificationKey xvk)) = - Crypto.HD.unXPub xvk - - deserialiseFromRawBytes (AsVerificationKey AsByronKey) bs = - first (\msg -> SerialiseAsRawBytesError ("Unable to deserialise VerificationKey ByronKey" ++ msg)) $ - ByronVerificationKey . Crypto.VerificationKey <$> Crypto.HD.xpub bs - -instance SerialiseAsRawBytes (SigningKey ByronKey) where - serialiseToRawBytes (ByronSigningKey sk) = toStrictByteString $ toCBOR sk - - deserialiseFromRawBytes (AsSigningKey AsByronKey) bs = - first (\e -> SerialiseAsRawBytesError ("Unable to deserialise SigningKey ByronKey" ++ show e)) $ - ByronSigningKey . snd <$> CBOR.deserialiseFromBytes fromCBOR (LB.fromStrict bs) - -newtype instance Hash ByronKey = ByronKeyHash Crypto.KeyHash - deriving (Eq, Ord) - deriving (Show, Pretty) via UsingRawBytesHex (Hash ByronKey) - deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash ByronKey) - deriving anyclass SerialiseAsCBOR - -instance SerialiseAsRawBytes (Hash ByronKey) where - serialiseToRawBytes (ByronKeyHash (Crypto.KeyHash vkh)) = - Crypto.abstractHashToBytes vkh - - deserialiseFromRawBytes (AsHash AsByronKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash ByronKey") $ - ByronKeyHash . Crypto.KeyHash <$> Crypto.abstractHashFromBytes bs - -instance CastVerificationKeyRole ByronKey PaymentExtendedKey where - castVerificationKey (ByronVerificationKey vk) = - PaymentExtendedVerificationKey - (Crypto.unVerificationKey vk) - -instance CastVerificationKeyRole ByronKey PaymentKey where - castVerificationKey = - ( castVerificationKey - :: VerificationKey PaymentExtendedKey - -> VerificationKey PaymentKey - ) - . ( castVerificationKey - :: VerificationKey ByronKey - -> VerificationKey PaymentExtendedKey - ) - -instance IsByronKey ByronKey where - byronKeyFormat = ByronModernKeyFormat - --- --- Legacy Byron key --- - -instance Key ByronKeyLegacy where - newtype VerificationKey ByronKeyLegacy - = ByronVerificationKeyLegacy Crypto.VerificationKey - deriving stock Eq - deriving (Show, Pretty) via UsingRawBytesHex (VerificationKey ByronKeyLegacy) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - newtype SigningKey ByronKeyLegacy - = ByronSigningKeyLegacy Crypto.SigningKey - deriving (Show, Pretty) via UsingRawBytesHex (SigningKey ByronKeyLegacy) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - deterministicSigningKey :: AsType ByronKeyLegacy -> Crypto.Seed -> SigningKey ByronKeyLegacy - deterministicSigningKey _ _ = error "Please generate a non legacy Byron key instead" - - deterministicSigningKeySeedSize :: AsType ByronKeyLegacy -> Word - deterministicSigningKeySeedSize AsByronKeyLegacy = 32 - - getVerificationKey :: SigningKey ByronKeyLegacy -> VerificationKey ByronKeyLegacy - getVerificationKey (ByronSigningKeyLegacy sk) = - ByronVerificationKeyLegacy (Crypto.toVerification sk) - - verificationKeyHash :: VerificationKey ByronKeyLegacy -> Hash ByronKeyLegacy - verificationKeyHash (ByronVerificationKeyLegacy vkey) = - ByronKeyHashLegacy (Crypto.hashKey vkey) - -instance HasTypeProxy ByronKeyLegacy where - data AsType ByronKeyLegacy = AsByronKeyLegacy - proxyToAsType _ = AsByronKeyLegacy - -instance HasTextEnvelope (VerificationKey ByronKeyLegacy) where - textEnvelopeType _ = "PaymentVerificationKeyByronLegacy_ed25519_bip32" - -instance HasTextEnvelope (SigningKey ByronKeyLegacy) where - textEnvelopeType _ = "PaymentSigningKeyByronLegacy_ed25519_bip32" - -newtype instance Hash ByronKeyLegacy = ByronKeyHashLegacy Crypto.KeyHash - deriving (Eq, Ord) - deriving (Show, Pretty) via UsingRawBytesHex (Hash ByronKeyLegacy) - deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash ByronKeyLegacy) - deriving anyclass SerialiseAsCBOR - -instance SerialiseAsRawBytes (Hash ByronKeyLegacy) where - serialiseToRawBytes (ByronKeyHashLegacy (Crypto.KeyHash vkh)) = - Crypto.abstractHashToBytes vkh - - deserialiseFromRawBytes (AsHash AsByronKeyLegacy) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash ByronKeyLegacy") $ - ByronKeyHashLegacy . Crypto.KeyHash <$> Crypto.abstractHashFromBytes bs - -instance SerialiseAsRawBytes (VerificationKey ByronKeyLegacy) where - serialiseToRawBytes (ByronVerificationKeyLegacy (Crypto.VerificationKey xvk)) = - Crypto.HD.unXPub xvk - - deserialiseFromRawBytes (AsVerificationKey AsByronKeyLegacy) bs = - first - (\msg -> SerialiseAsRawBytesError ("Unable to deserialise VerificationKey ByronKeyLegacy" ++ msg)) - $ ByronVerificationKeyLegacy . Crypto.VerificationKey <$> Crypto.HD.xpub bs - -instance SerialiseAsRawBytes (SigningKey ByronKeyLegacy) where - serialiseToRawBytes (ByronSigningKeyLegacy (Crypto.SigningKey xsk)) = - Crypto.HD.unXPrv xsk - - deserialiseFromRawBytes (AsSigningKey AsByronKeyLegacy) bs = - first (\e -> SerialiseAsRawBytesError ("Unable to deserialise SigningKey ByronKeyLegacy" ++ show e)) $ - ByronSigningKeyLegacy . snd <$> CBOR.deserialiseFromBytes decodeLegacyDelegateKey (LB.fromStrict bs) - where - -- Stolen from: cardano-sl/binary/src/Pos/Binary/Class/Core.hs - -- \| Enforces that the input size is the same as the decoded one, failing in - -- case it's not. - enforceSize :: Text -> Int -> CBOR.Decoder s () - enforceSize lbl requestedSize = CBOR.decodeListLenCanonical >>= matchSize requestedSize lbl - - -- Stolen from: cardano-sl/binary/src/Pos/Binary/Class/Core.hs - -- \| Compare two sizes, failing if they are not equal. - matchSize :: Int -> Text -> Int -> CBOR.Decoder s () - matchSize requestedSize lbl actualSize = - when (actualSize /= requestedSize) $ - cborError - ( lbl - <> " failed the size check. Expected " - <> Text.pack (show requestedSize) - <> ", found " - <> Text.pack (show actualSize) - ) - - decodeXPrv :: CBOR.Decoder s Wallet.XPrv - decodeXPrv = CBOR.decodeBytesCanonical >>= either (fail . formatToString build) pure . Wallet.xprv - - -- \| Decoder for a Byron/Classic signing key. - -- Lifted from cardano-sl legacy codebase. - decodeLegacyDelegateKey :: CBOR.Decoder s Crypto.SigningKey - decodeLegacyDelegateKey = do - enforceSize "UserSecret" 4 - _ <- do - enforceSize "vss" 1 - CBOR.decodeBytes - pkey <- do - enforceSize "pkey" 1 - Crypto.SigningKey <$> decodeXPrv - _ <- do - CBOR.decodeListLenIndef - CBOR.decodeSequenceLenIndef (flip (:)) [] reverse CBOR.decodeNull - _ <- do - enforceSize "wallet" 0 - pure pkey - -instance CastVerificationKeyRole ByronKeyLegacy ByronKey where - castVerificationKey (ByronVerificationKeyLegacy vk) = - ByronVerificationKey vk - -instance IsByronKey ByronKeyLegacy where - byronKeyFormat = ByronLegacyKeyFormat +import Cardano.Keys.Byron diff --git a/cardano-api/src/Cardano/Api/Certificate/Internal/OperationalCertificate.hs b/cardano-api/src/Cardano/Api/Certificate/Internal/OperationalCertificate.hs index c614f41dd7..d297d2761c 100644 --- a/cardano-api/src/Cardano/Api/Certificate/Internal/OperationalCertificate.hs +++ b/cardano-api/src/Cardano/Api/Certificate/Internal/OperationalCertificate.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE TypeFamilies #-} - -- | Operational certificates +-- +-- The certificate types and their decoding accessors now live in the +-- cardano-keys package; re-exported here for compatibility, together with the +-- issuing function this API adds on top of them. module Cardano.Api.Certificate.Internal.OperationalCertificate ( OperationalCertificate (..) , OperationalCertificateIssueCounter (..) @@ -18,78 +18,20 @@ module Cardano.Api.Certificate.Internal.OperationalCertificate ) where -import Cardano.Api.Address -import Cardano.Api.Byron.Internal.Key import Cardano.Api.Error -import Cardano.Api.HasTypeProxy -import Cardano.Api.Internal.Orphans () import Cardano.Api.Key.Internal import Cardano.Api.Key.Internal.Class import Cardano.Api.Key.Internal.Praos -import Cardano.Api.ProtocolParameters -import Cardano.Api.Serialise.Cbor -import Cardano.Api.Serialise.TextEnvelope.Internal import Cardano.Api.Tx.Internal.Sign import Cardano.Crypto.DSIGN qualified as DSIGN +import Cardano.Keys.OperationalCertificate import Cardano.Ledger.Keys qualified as Shelley import Cardano.Protocol.Crypto (StandardCrypto) import Cardano.Protocol.TPraos.OCert qualified as Shelley -import Data.Word import GHC.Stack (HasCallStack) --- ---------------------------------------------------------------------------- --- Operational certificates --- - -data OperationalCertificate - = OperationalCertificate - !(Shelley.OCert StandardCrypto) - !(VerificationKey StakePoolKey) - deriving (Eq, Show) - deriving anyclass SerialiseAsCBOR - -data OperationalCertificateIssueCounter - = OperationalCertificateIssueCounter - { opCertIssueCount :: !Word64 - , opCertIssueColdKey :: !(VerificationKey StakePoolKey) -- For consistency checking - } - deriving (Eq, Show) - deriving anyclass SerialiseAsCBOR - -instance ToCBOR OperationalCertificate where - toCBOR (OperationalCertificate ocert vkey) = - toCBOR (ocert, vkey) - -instance FromCBOR OperationalCertificate where - fromCBOR = do - (ocert, vkey) <- fromCBOR - return (OperationalCertificate ocert vkey) - -instance ToCBOR OperationalCertificateIssueCounter where - toCBOR (OperationalCertificateIssueCounter counter vkey) = - toCBOR (counter, vkey) - -instance FromCBOR OperationalCertificateIssueCounter where - fromCBOR = do - (counter, vkey) <- fromCBOR - return (OperationalCertificateIssueCounter counter vkey) - -instance HasTypeProxy OperationalCertificate where - data AsType OperationalCertificate = AsOperationalCertificate - proxyToAsType _ = AsOperationalCertificate - -instance HasTypeProxy OperationalCertificateIssueCounter where - data AsType OperationalCertificateIssueCounter = AsOperationalCertificateIssueCounter - proxyToAsType _ = AsOperationalCertificateIssueCounter - -instance HasTextEnvelope OperationalCertificate where - textEnvelopeType _ = "NodeOperationalCertificate" - -instance HasTextEnvelope OperationalCertificateIssueCounter where - textEnvelopeType _ = "NodeOperationalCertificateIssueCounter" - data OperationalCertIssueError = -- | The stake pool verification key expected for the -- 'OperationalCertificateIssueCounter' does not match the signing key @@ -188,12 +130,3 @@ issueOperationalCertificate ShelleyExtendedSigningKey poolExtendedSKey Right (GenesisDelegateExtendedSigningKey delegSKey) -> ShelleyExtendedSigningKey delegSKey - -getHotKey :: OperationalCertificate -> VerificationKey KesKey -getHotKey (OperationalCertificate cert _) = KesVerificationKey $ Shelley.ocertVkHot cert - -getKesPeriod :: OperationalCertificate -> Word -getKesPeriod (OperationalCertificate cert _) = Shelley.unKESPeriod $ Shelley.ocertKESPeriod cert - -getOpCertCount :: OperationalCertificate -> Word64 -getOpCertCount (OperationalCertificate cert _) = Shelley.ocertN cert diff --git a/cardano-api/src/Cardano/Api/HasTypeProxy.hs b/cardano-api/src/Cardano/Api/HasTypeProxy.hs index 3f46c20d38..25fefc2805 100644 --- a/cardano-api/src/Cardano/Api/HasTypeProxy.hs +++ b/cardano-api/src/Cardano/Api/HasTypeProxy.hs @@ -1,68 +1,7 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE TypeFamilies #-} -{-# OPTIONS_GHC -Wno-duplicate-exports #-} - +-- | This module now lives in the cardano-keys package; re-exported here for compatibility. module Cardano.Api.HasTypeProxy - ( HasTypeProxy (AsType, proxyToAsType) - , asType - , AsType (..) - , Proxy (..) - , FromSomeType (..) + ( module Cardano.Keys.HasTypeProxy ) where -import Data.ByteString qualified as BS -import Data.ByteString.Lazy qualified as BSL -import Data.Kind (Constraint, Type) -import Data.Typeable -import Data.Word (Word16, Word32, Word64, Word8) -import Numeric.Natural (Natural) - -class Typeable t => HasTypeProxy t where - -- | A family of singleton types used in this API to indicate which type to - -- use where it would otherwise be ambiguous or merely unclear. - -- - -- Values of this type are passed to deserialisation functions for example. - data AsType t - - proxyToAsType :: Proxy t -> AsType t - --- | Generalised show instance for all singletons of 'AsType' displaying the type. -instance Typeable t => Show (AsType t) where - show = show . typeOf - -instance HasTypeProxy Word8 where - data AsType Word8 = AsWord8 - proxyToAsType _ = AsWord8 - -instance HasTypeProxy Word16 where - data AsType Word16 = AsWord16 - proxyToAsType _ = AsWord16 - -instance HasTypeProxy Word32 where - data AsType Word32 = AsWord32 - proxyToAsType _ = AsWord32 - -instance HasTypeProxy Word64 where - data AsType Word64 = AsWord64 - proxyToAsType _ = AsWord64 - -instance HasTypeProxy Natural where - data AsType Natural = AsNatural - proxyToAsType _ = AsNatural - -instance HasTypeProxy BS.ByteString where - data AsType BS.ByteString = AsByteString - proxyToAsType _ = AsByteString - -instance HasTypeProxy BSL.ByteString where - data AsType BSL.ByteString = AsByteStringLazy - proxyToAsType _ = AsByteStringLazy - -data FromSomeType (c :: Type -> Constraint) b where - FromSomeType :: c a => AsType a -> (a -> b) -> FromSomeType c b - --- | Provide type proxy from the already existing 'HasTypeProxy' instance -asType :: HasTypeProxy t => AsType t -asType = proxyToAsType Proxy +import Cardano.Keys.HasTypeProxy diff --git a/cardano-api/src/Cardano/Api/Hash.hs b/cardano-api/src/Cardano/Api/Hash.hs index d3184170be..7f9885c147 100644 --- a/cardano-api/src/Cardano/Api/Hash.hs +++ b/cardano-api/src/Cardano/Api/Hash.hs @@ -1,37 +1,7 @@ -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeFamilies #-} - +-- | This module now lives in the cardano-keys package; re-exported here for compatibility. module Cardano.Api.Hash - ( -- * Hash - Hash - , CastHash (..) - , AsType (AsHash) - , renderSafeHashAsHex - - -- * HasTypeProxy - , HasTypeProxy (proxyToAsType) - , asType - , Proxy (..) - , FromSomeType (..) + ( module Cardano.Keys.Hash ) where -import Cardano.Api.HasTypeProxy - -import Cardano.Crypto.Hash qualified as Hash -import Cardano.Ledger.Hashes qualified as Ledger - -import Data.Kind (Type) -import Data.Text qualified as Text - -data family Hash keyrole :: Type - -class CastHash roleA roleB where - castHash :: Hash roleA -> Hash roleB - -instance HasTypeProxy a => HasTypeProxy (Hash a) where - data AsType (Hash a) = AsHash (AsType a) - proxyToAsType _ = AsHash (proxyToAsType (Proxy :: Proxy a)) - -renderSafeHashAsHex :: Ledger.SafeHash tag -> Text.Text -renderSafeHashAsHex = Hash.hashToTextAsHex . Ledger.extractHash +import Cardano.Keys.Hash diff --git a/cardano-api/src/Cardano/Api/Key/Internal.hs b/cardano-api/src/Cardano/Api/Key/Internal.hs index 0a6e2619f4..c0d588a8ac 100644 --- a/cardano-api/src/Cardano/Api/Key/Internal.hs +++ b/cardano-api/src/Cardano/Api/Key/Internal.hs @@ -1,2242 +1,20 @@ -{-# 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 #-} -- | Shelley key types and their 'Key' class instances +-- +-- The key types of this module now live in the cardano-keys package; +-- re-exported here for compatibility, together with the parser this API adds +-- on top of them. module Cardano.Api.Key.Internal - ( -- * Key types - CommitteeColdKey - , CommitteeColdExtendedKey - , CommitteeHotKey - , CommitteeHotExtendedKey - , DRepKey - , DRepExtendedKey - , PaymentKey - , PaymentExtendedKey - , StakeKey - , StakeExtendedKey - , StakePoolExtendedKey - , StakePoolKey - , GenesisKey - , GenesisExtendedKey - , GenesisDelegateKey - , GenesisDelegateExtendedKey - , GenesisUTxOKey - - -- * Data family instances - , AsType (..) - , VerificationKey (..) - , SigningKey (..) - , Hash (..) - , AnyStakePoolVerificationKey (..) - , anyStakePoolVerificationKeyHash - , AnyStakePoolSigningKey (..) - , anyStakePoolSigningKeyToVerificationKey + ( module Cardano.Keys.Shelley , parseHexHash ) where -import Cardano.Api.Error -import Cardano.Api.HasTypeProxy -import Cardano.Api.Hash -import Cardano.Api.Internal.Orphans () -import Cardano.Api.Key.Internal.Class import Cardano.Api.Parser.Text qualified as P -import Cardano.Api.Pretty -import Cardano.Api.Serialise.Bech32 -import Cardano.Api.Serialise.Cbor -import Cardano.Api.Serialise.Json -import Cardano.Api.Serialise.Raw -import Cardano.Api.Serialise.SerialiseUsing -import Cardano.Api.Serialise.TextEnvelope.Internal - -import Cardano.Binary.FixedSizeCodec qualified as Crypto -import Cardano.Crypto.DSIGN qualified as DSIGN -import Cardano.Crypto.DSIGN.Class qualified as Crypto -import Cardano.Crypto.Hash.Class qualified as Crypto -import Cardano.Crypto.Seed qualified as Crypto -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.Bifunctor (first) -import Data.ByteString (ByteString) -import Data.ByteString qualified as BS -import Data.Either.Combinators (maybeToRight) -import Data.Maybe -import Data.String (IsString (..)) - --- --- Shelley payment keys --- - --- | Shelley-era payment keys. Used for Shelley payment addresses and witnessing --- transactions that spend from these addresses. --- --- This is a type level tag, used with other interfaces like 'Key'. -data PaymentKey - -instance HasTypeProxy PaymentKey where - data AsType PaymentKey = AsPaymentKey - proxyToAsType _ = AsPaymentKey - -instance Key PaymentKey where - newtype VerificationKey PaymentKey - = PaymentVerificationKey (Shelley.VKey Shelley.Payment) - deriving stock Eq - deriving (Show, Pretty) via UsingRawBytesHex (VerificationKey PaymentKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - newtype SigningKey PaymentKey - = PaymentSigningKey (DSIGN.SignKeyDSIGN DSIGN) - deriving (Show, Pretty) via UsingRawBytesHex (SigningKey PaymentKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - deterministicSigningKey :: AsType PaymentKey -> Crypto.Seed -> SigningKey PaymentKey - deterministicSigningKey AsPaymentKey seed = - PaymentSigningKey (Crypto.genKeyDSIGN seed) - - deterministicSigningKeySeedSize :: AsType PaymentKey -> Word - deterministicSigningKeySeedSize AsPaymentKey = - Crypto.seedSizeDSIGN proxy - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - - getVerificationKey :: SigningKey PaymentKey -> VerificationKey PaymentKey - getVerificationKey (PaymentSigningKey sk) = - PaymentVerificationKey (Shelley.VKey (Crypto.deriveVerKeyDSIGN sk)) - - verificationKeyHash :: VerificationKey PaymentKey -> Hash PaymentKey - verificationKeyHash (PaymentVerificationKey vkey) = - PaymentKeyHash (Shelley.hashKey vkey) - -instance SerialiseAsRawBytes (VerificationKey PaymentKey) where - serialiseToRawBytes (PaymentVerificationKey (Shelley.VKey vk)) = - Crypto.rawEncodeFixedSized vk - - deserialiseFromRawBytes (AsVerificationKey AsPaymentKey) bs = - maybe - (Left (SerialiseAsRawBytesError "Unable to deserialise VerificationKey PaymentKey")) - (Right . PaymentVerificationKey . Shelley.VKey) - (Crypto.rawDecodeFixedSized bs) - -instance SerialiseAsRawBytes (SigningKey PaymentKey) where - serialiseToRawBytes (PaymentSigningKey sk) = - Crypto.rawEncodeFixedSized sk - - deserialiseFromRawBytes (AsSigningKey AsPaymentKey) bs = - maybe - (Left (SerialiseAsRawBytesError "Unable to serialise AsSigningKey AsPaymentKey")) - (Right . PaymentSigningKey) - (Crypto.rawDecodeFixedSized bs) - -instance SerialiseAsBech32 (VerificationKey PaymentKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "addr_vk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["addr_vk"] - -instance SerialiseAsBech32 (SigningKey PaymentKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "addr_sk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["addr_sk"] - -newtype instance Hash PaymentKey - = PaymentKeyHash {unPaymentKeyHash :: Shelley.KeyHash Shelley.Payment} - deriving stock (Eq, Ord) - deriving (Show, Pretty) via UsingRawBytesHex (Hash PaymentKey) - deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash PaymentKey) - deriving (ToJSONKey, ToJSON, FromJSON) via UsingRawBytesHex (Hash PaymentKey) - deriving anyclass SerialiseAsCBOR - -instance SerialiseAsRawBytes (Hash PaymentKey) where - serialiseToRawBytes (PaymentKeyHash (Shelley.KeyHash vkh)) = - Crypto.hashToBytes vkh - - deserialiseFromRawBytes (AsHash AsPaymentKey) bs = - maybeToRight - (SerialiseAsRawBytesError "Unable to deserialise Hash PaymentKey") - (PaymentKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs) - -instance HasTextEnvelope (VerificationKey PaymentKey) where - textEnvelopeType _ = - "PaymentVerificationKeyShelley_" - <> fromString (Crypto.algorithmNameDSIGN proxy) - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - -instance HasTextEnvelope (SigningKey PaymentKey) where - textEnvelopeType _ = - "PaymentSigningKeyShelley_" - <> fromString (Crypto.algorithmNameDSIGN proxy) - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - --- --- Shelley payment extended ed25519 keys --- - --- | Shelley-era payment keys using extended ed25519 cryptographic keys. --- --- They can be used for Shelley payment addresses and witnessing --- transactions that spend from these addresses. --- --- These extended keys are used by HD wallets. So this type provides --- interoperability with HD wallets. The ITN CLI also supported this key type. --- --- The extended verification keys can be converted (via 'castVerificationKey') --- to ordinary keys (i.e. 'VerificationKey' 'PaymentKey') but this is /not/ the --- case for the signing keys. The signing keys can be used to witness --- transactions directly, with verification via their non-extended verification --- key ('VerificationKey' 'PaymentKey'). --- --- This is a type level tag, used with other interfaces like 'Key'. -data PaymentExtendedKey - -instance HasTypeProxy PaymentExtendedKey where - data AsType PaymentExtendedKey = AsPaymentExtendedKey - proxyToAsType _ = AsPaymentExtendedKey - -instance Key PaymentExtendedKey where - newtype VerificationKey PaymentExtendedKey - = PaymentExtendedVerificationKey Crypto.HD.XPub - deriving stock Eq - deriving anyclass SerialiseAsCBOR - deriving (Show, Pretty) via UsingRawBytesHex (VerificationKey PaymentExtendedKey) - - newtype SigningKey PaymentExtendedKey - = PaymentExtendedSigningKey Crypto.HD.XPrv - deriving anyclass SerialiseAsCBOR - deriving (Show, Pretty) via UsingRawBytesHex (SigningKey PaymentExtendedKey) - - deterministicSigningKey - :: AsType PaymentExtendedKey - -> Crypto.Seed - -> SigningKey PaymentExtendedKey - deterministicSigningKey AsPaymentExtendedKey seed = - PaymentExtendedSigningKey - (Crypto.HD.generate seedbs BS.empty) - where - (seedbs, _) = Crypto.getBytesFromSeedT 32 seed - - deterministicSigningKeySeedSize :: AsType PaymentExtendedKey -> Word - deterministicSigningKeySeedSize AsPaymentExtendedKey = 32 - - getVerificationKey - :: SigningKey PaymentExtendedKey - -> VerificationKey PaymentExtendedKey - getVerificationKey (PaymentExtendedSigningKey sk) = - PaymentExtendedVerificationKey (Crypto.HD.toXPub sk) - - -- We use the hash of the normal non-extended pub key so that it is - -- consistent with the one used in addresses and signatures. - verificationKeyHash - :: VerificationKey PaymentExtendedKey - -> Hash PaymentExtendedKey - verificationKeyHash (PaymentExtendedVerificationKey vk) = - PaymentExtendedKeyHash - . Shelley.KeyHash - . Crypto.castHash - $ Crypto.hashWith Crypto.HD.xpubPublicKey vk - -instance ToCBOR (VerificationKey PaymentExtendedKey) where - toCBOR (PaymentExtendedVerificationKey xpub) = - toCBOR (Crypto.HD.unXPub xpub) - -instance FromCBOR (VerificationKey PaymentExtendedKey) where - fromCBOR = do - bs <- fromCBOR - either - fail - (return . PaymentExtendedVerificationKey) - (Crypto.HD.xpub (bs :: ByteString)) - -instance ToCBOR (SigningKey PaymentExtendedKey) where - toCBOR (PaymentExtendedSigningKey xprv) = - toCBOR (Crypto.HD.unXPrv xprv) - -instance FromCBOR (SigningKey PaymentExtendedKey) where - fromCBOR = do - bs <- fromCBOR - either - fail - (return . PaymentExtendedSigningKey) - (Crypto.HD.xprv (bs :: ByteString)) - -instance SerialiseAsRawBytes (VerificationKey PaymentExtendedKey) where - serialiseToRawBytes (PaymentExtendedVerificationKey xpub) = - Crypto.HD.unXPub xpub - - deserialiseFromRawBytes (AsVerificationKey AsPaymentExtendedKey) bs = - first - (const (SerialiseAsRawBytesError "Unable to deserialise VerificationKey PaymentExtendedKey")) - (PaymentExtendedVerificationKey <$> Crypto.HD.xpub bs) - -instance SerialiseAsRawBytes (SigningKey PaymentExtendedKey) where - serialiseToRawBytes (PaymentExtendedSigningKey xprv) = - Crypto.HD.unXPrv xprv - - deserialiseFromRawBytes (AsSigningKey AsPaymentExtendedKey) bs = - first - (const (SerialiseAsRawBytesError "Unable to deserialise SigningKey PaymentExtendedKey")) - (PaymentExtendedSigningKey <$> Crypto.HD.xprv bs) - -instance SerialiseAsBech32 (VerificationKey PaymentExtendedKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "addr_xvk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["addr_xvk"] - -instance SerialiseAsBech32 (SigningKey PaymentExtendedKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "addr_xsk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["addr_xsk"] - -newtype instance Hash PaymentExtendedKey - = PaymentExtendedKeyHash - {unPaymentExtendedKeyHash :: Shelley.KeyHash Shelley.Payment} - deriving stock (Eq, Ord) - deriving (Show, Pretty) via UsingRawBytesHex (Hash PaymentExtendedKey) - deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash PaymentExtendedKey) - deriving anyclass SerialiseAsCBOR - -instance SerialiseAsRawBytes (Hash PaymentExtendedKey) where - serialiseToRawBytes (PaymentExtendedKeyHash (Shelley.KeyHash vkh)) = - Crypto.hashToBytes vkh - - deserialiseFromRawBytes (AsHash AsPaymentExtendedKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash PaymentExtendedKey") $ - PaymentExtendedKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs - -instance HasTextEnvelope (VerificationKey PaymentExtendedKey) where - textEnvelopeType _ = "PaymentExtendedVerificationKeyShelley_ed25519_bip32" - -instance HasTextEnvelope (SigningKey PaymentExtendedKey) where - textEnvelopeType _ = "PaymentExtendedSigningKeyShelley_ed25519_bip32" - -instance CastVerificationKeyRole PaymentExtendedKey PaymentKey where - castVerificationKey (PaymentExtendedVerificationKey vk) = - PaymentVerificationKey - . Shelley.VKey - . fromMaybe impossible - . Crypto.rawDecodeFixedSized - . Crypto.HD.xpubPublicKey - $ vk - where - impossible = - error "castVerificationKey: byron and shelley key sizes do not match!" - --- --- Stake keys --- - -data StakeKey - -instance HasTypeProxy StakeKey where - data AsType StakeKey = AsStakeKey - proxyToAsType _ = AsStakeKey - -instance Key StakeKey where - newtype VerificationKey StakeKey = StakeVerificationKey - { unStakeVerificationKey :: Shelley.VKey Shelley.Staking - } - deriving stock Eq - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - deriving (Show, Pretty) via UsingRawBytesHex (VerificationKey StakeKey) - - newtype SigningKey StakeKey - = StakeSigningKey (DSIGN.SignKeyDSIGN DSIGN) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - deriving (Show, Pretty) via UsingRawBytesHex (SigningKey StakeKey) - - deterministicSigningKey :: AsType StakeKey -> Crypto.Seed -> SigningKey StakeKey - deterministicSigningKey AsStakeKey seed = - StakeSigningKey (Crypto.genKeyDSIGN seed) - - deterministicSigningKeySeedSize :: AsType StakeKey -> Word - deterministicSigningKeySeedSize AsStakeKey = - Crypto.seedSizeDSIGN proxy - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - - getVerificationKey :: SigningKey StakeKey -> VerificationKey StakeKey - getVerificationKey (StakeSigningKey sk) = - StakeVerificationKey (Shelley.VKey (Crypto.deriveVerKeyDSIGN sk)) - - verificationKeyHash :: VerificationKey StakeKey -> Hash StakeKey - verificationKeyHash (StakeVerificationKey vkey) = - StakeKeyHash (Shelley.hashKey vkey) - -instance SerialiseAsRawBytes (VerificationKey StakeKey) where - serialiseToRawBytes (StakeVerificationKey (Shelley.VKey vk)) = - Crypto.rawEncodeFixedSized vk - - deserialiseFromRawBytes (AsVerificationKey AsStakeKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise VerificationKey StakeKey") $ - StakeVerificationKey . Shelley.VKey - <$> Crypto.rawDecodeFixedSized bs - -instance SerialiseAsRawBytes (SigningKey StakeKey) where - serialiseToRawBytes (StakeSigningKey sk) = - Crypto.rawEncodeFixedSized sk - - deserialiseFromRawBytes (AsSigningKey AsStakeKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise SigningKey StakeKey") $ - StakeSigningKey <$> Crypto.rawDecodeFixedSized bs - -instance SerialiseAsBech32 (VerificationKey StakeKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "stake_vk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["stake_vk"] - -instance SerialiseAsBech32 (SigningKey StakeKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "stake_sk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["stake_sk"] - -newtype instance Hash StakeKey - = StakeKeyHash {unStakeKeyHash :: Shelley.KeyHash Shelley.Staking} - deriving stock (Eq, Ord) - deriving (Show, Pretty) via UsingRawBytesHex (Hash StakeKey) - deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash StakeKey) - deriving anyclass SerialiseAsCBOR - -instance SerialiseAsRawBytes (Hash StakeKey) where - serialiseToRawBytes (StakeKeyHash (Shelley.KeyHash vkh)) = - Crypto.hashToBytes vkh - - deserialiseFromRawBytes (AsHash AsStakeKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash StakeKey") $ - StakeKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs - -instance HasTextEnvelope (VerificationKey StakeKey) where - textEnvelopeType _ = - "StakeVerificationKeyShelley_" - <> fromString (Crypto.algorithmNameDSIGN proxy) - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - -instance HasTextEnvelope (SigningKey StakeKey) where - textEnvelopeType _ = - "StakeSigningKeyShelley_" - <> fromString (Crypto.algorithmNameDSIGN proxy) - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - --- --- Shelley stake extended ed25519 keys --- - --- | Shelley-era stake keys using extended ed25519 cryptographic keys. --- --- They can be used for Shelley stake addresses and witnessing transactions --- that use stake addresses. --- --- These extended keys are used by HD wallets. So this type provides --- interoperability with HD wallets. The ITN CLI also supported this key type. --- --- The extended verification keys can be converted (via 'castVerificationKey') --- to ordinary keys (i.e. 'VerificationKey' 'StakeKey') but this is /not/ the --- case for the signing keys. The signing keys can be used to witness --- transactions directly, with verification via their non-extended verification --- key ('VerificationKey' 'StakeKey'). --- --- This is a type level tag, used with other interfaces like 'Key'. -data StakeExtendedKey - -instance HasTypeProxy StakeExtendedKey where - data AsType StakeExtendedKey = AsStakeExtendedKey - proxyToAsType _ = AsStakeExtendedKey - -instance Key StakeExtendedKey where - newtype VerificationKey StakeExtendedKey - = StakeExtendedVerificationKey Crypto.HD.XPub - deriving stock Eq - deriving anyclass SerialiseAsCBOR - deriving (Show, Pretty) via UsingRawBytesHex (VerificationKey StakeExtendedKey) - - newtype SigningKey StakeExtendedKey - = StakeExtendedSigningKey Crypto.HD.XPrv - deriving anyclass SerialiseAsCBOR - deriving (Show, Pretty) via UsingRawBytesHex (SigningKey StakeExtendedKey) - - deterministicSigningKey - :: AsType StakeExtendedKey - -> Crypto.Seed - -> SigningKey StakeExtendedKey - deterministicSigningKey AsStakeExtendedKey seed = - StakeExtendedSigningKey - (Crypto.HD.generate seedbs BS.empty) - where - (seedbs, _) = Crypto.getBytesFromSeedT 32 seed - - deterministicSigningKeySeedSize :: AsType StakeExtendedKey -> Word - deterministicSigningKeySeedSize AsStakeExtendedKey = 32 - - getVerificationKey - :: SigningKey StakeExtendedKey - -> VerificationKey StakeExtendedKey - getVerificationKey (StakeExtendedSigningKey sk) = - StakeExtendedVerificationKey (Crypto.HD.toXPub sk) - - -- We use the hash of the normal non-extended pub key so that it is - -- consistent with the one used in addresses and signatures. - verificationKeyHash - :: VerificationKey StakeExtendedKey - -> Hash StakeExtendedKey - verificationKeyHash (StakeExtendedVerificationKey vk) = - StakeExtendedKeyHash - . Shelley.KeyHash - . Crypto.castHash - $ Crypto.hashWith Crypto.HD.xpubPublicKey vk - -instance ToCBOR (VerificationKey StakeExtendedKey) where - toCBOR (StakeExtendedVerificationKey xpub) = - toCBOR (Crypto.HD.unXPub xpub) - -instance FromCBOR (VerificationKey StakeExtendedKey) where - fromCBOR = do - bs <- fromCBOR - either - fail - (return . StakeExtendedVerificationKey) - (Crypto.HD.xpub (bs :: ByteString)) - -instance ToCBOR (SigningKey StakeExtendedKey) where - toCBOR (StakeExtendedSigningKey xprv) = - toCBOR (Crypto.HD.unXPrv xprv) - -instance FromCBOR (SigningKey StakeExtendedKey) where - fromCBOR = do - bs <- fromCBOR - either - fail - (return . StakeExtendedSigningKey) - (Crypto.HD.xprv (bs :: ByteString)) - -instance SerialiseAsRawBytes (VerificationKey StakeExtendedKey) where - serialiseToRawBytes (StakeExtendedVerificationKey xpub) = - Crypto.HD.unXPub xpub - - deserialiseFromRawBytes (AsVerificationKey AsStakeExtendedKey) bs = - first - (\msg -> SerialiseAsRawBytesError ("Unable to deserialise VerificationKey StakeExtendedKey: " ++ msg)) - $ StakeExtendedVerificationKey <$> Crypto.HD.xpub bs - -instance SerialiseAsRawBytes (SigningKey StakeExtendedKey) where - serialiseToRawBytes (StakeExtendedSigningKey xprv) = - Crypto.HD.unXPrv xprv - - deserialiseFromRawBytes (AsSigningKey AsStakeExtendedKey) bs = - first - (\msg -> SerialiseAsRawBytesError ("Unable to deserialise SigningKey StakeExtendedKey: " ++ msg)) - $ StakeExtendedSigningKey <$> Crypto.HD.xprv bs - -instance SerialiseAsBech32 (VerificationKey StakeExtendedKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "stake_xvk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["stake_xvk"] - -instance SerialiseAsBech32 (SigningKey StakeExtendedKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "stake_xsk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["stake_xsk"] - -newtype instance Hash StakeExtendedKey - = StakeExtendedKeyHash {unStakeExtendedKeyHash :: Shelley.KeyHash Shelley.Staking} - deriving stock (Eq, Ord) - deriving (Show, Pretty) via UsingRawBytesHex (Hash StakeExtendedKey) - deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash StakeExtendedKey) - deriving anyclass SerialiseAsCBOR - -instance SerialiseAsRawBytes (Hash StakeExtendedKey) where - serialiseToRawBytes (StakeExtendedKeyHash (Shelley.KeyHash vkh)) = - Crypto.hashToBytes vkh - - deserialiseFromRawBytes (AsHash AsStakeExtendedKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash StakeExtendedKey") $ - StakeExtendedKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs - -instance HasTextEnvelope (VerificationKey StakeExtendedKey) where - textEnvelopeType _ = "StakeExtendedVerificationKeyShelley_ed25519_bip32" - -instance HasTextEnvelope (SigningKey StakeExtendedKey) where - textEnvelopeType _ = "StakeExtendedSigningKeyShelley_ed25519_bip32" - -instance CastVerificationKeyRole StakeExtendedKey StakeKey where - castVerificationKey (StakeExtendedVerificationKey vk) = - StakeVerificationKey - . Shelley.VKey - . fromMaybe impossible - . Crypto.rawDecodeFixedSized - . Crypto.HD.xpubPublicKey - $ vk - where - impossible = - error "castVerificationKey: byron and shelley key sizes do not match!" - --- --- Genesis keys --- - -data GenesisKey - -instance HasTypeProxy GenesisKey where - data AsType GenesisKey = AsGenesisKey - proxyToAsType _ = AsGenesisKey - -instance Key GenesisKey where - newtype VerificationKey GenesisKey - = GenesisVerificationKey (Shelley.VKey Shelley.GenesisRole) - deriving stock Eq - deriving (Show, Pretty) via UsingRawBytesHex (VerificationKey GenesisKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - newtype SigningKey GenesisKey - = GenesisSigningKey (DSIGN.SignKeyDSIGN DSIGN) - deriving (Show, Pretty) via UsingRawBytesHex (SigningKey GenesisKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - deterministicSigningKey :: AsType GenesisKey -> Crypto.Seed -> SigningKey GenesisKey - deterministicSigningKey AsGenesisKey seed = - GenesisSigningKey (Crypto.genKeyDSIGN seed) - - deterministicSigningKeySeedSize :: AsType GenesisKey -> Word - deterministicSigningKeySeedSize AsGenesisKey = - Crypto.seedSizeDSIGN proxy - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - - getVerificationKey :: SigningKey GenesisKey -> VerificationKey GenesisKey - getVerificationKey (GenesisSigningKey sk) = - GenesisVerificationKey (Shelley.VKey (Crypto.deriveVerKeyDSIGN sk)) - - verificationKeyHash :: VerificationKey GenesisKey -> Hash GenesisKey - verificationKeyHash (GenesisVerificationKey vkey) = - GenesisKeyHash (Shelley.hashKey vkey) - -instance SerialiseAsRawBytes (VerificationKey GenesisKey) where - serialiseToRawBytes (GenesisVerificationKey (Shelley.VKey vk)) = - Crypto.rawEncodeFixedSized vk - - deserialiseFromRawBytes (AsVerificationKey AsGenesisKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise VerificationKey GenesisKey") $ - GenesisVerificationKey . Shelley.VKey - <$> Crypto.rawDecodeFixedSized bs - -instance SerialiseAsRawBytes (SigningKey GenesisKey) where - serialiseToRawBytes (GenesisSigningKey sk) = - Crypto.rawEncodeFixedSized sk - - deserialiseFromRawBytes (AsSigningKey AsGenesisKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise SigningKey GenesisKey") $ - GenesisSigningKey <$> Crypto.rawDecodeFixedSized bs - -newtype instance Hash GenesisKey - = GenesisKeyHash {unGenesisKeyHash :: Shelley.KeyHash Shelley.GenesisRole} - deriving stock (Eq, Ord) - deriving (Show, Pretty) via UsingRawBytesHex (Hash GenesisKey) - deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash GenesisKey) - deriving (ToJSONKey, ToJSON, FromJSON) via UsingRawBytesHex (Hash GenesisKey) - deriving anyclass SerialiseAsCBOR - -instance SerialiseAsRawBytes (Hash GenesisKey) where - serialiseToRawBytes (GenesisKeyHash (Shelley.KeyHash vkh)) = - Crypto.hashToBytes vkh - - deserialiseFromRawBytes (AsHash AsGenesisKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash GenesisKey") $ - GenesisKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs - -instance HasTextEnvelope (VerificationKey GenesisKey) where - textEnvelopeType _ = - "GenesisVerificationKey_" - <> fromString (Crypto.algorithmNameDSIGN proxy) - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - -instance HasTextEnvelope (SigningKey GenesisKey) where - textEnvelopeType _ = - "GenesisSigningKey_" - <> fromString (Crypto.algorithmNameDSIGN proxy) - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - -instance CastVerificationKeyRole GenesisKey PaymentKey where - castVerificationKey (GenesisVerificationKey (Shelley.VKey vk)) = - PaymentVerificationKey (Shelley.VKey vk) - --- --- Constitutional Committee Hot Keys --- - -data CommitteeHotKey - -instance HasTypeProxy CommitteeHotKey where - data AsType CommitteeHotKey = AsCommitteeHotKey - proxyToAsType _ = AsCommitteeHotKey - -instance Key CommitteeHotKey where - newtype VerificationKey CommitteeHotKey - = CommitteeHotVerificationKey (Shelley.VKey Shelley.HotCommitteeRole) - deriving stock Eq - deriving (Show, Pretty) via UsingRawBytesHex (VerificationKey CommitteeHotKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - newtype SigningKey CommitteeHotKey - = CommitteeHotSigningKey (DSIGN.SignKeyDSIGN DSIGN) - deriving (Show, Pretty) via UsingRawBytesHex (SigningKey CommitteeHotKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - deterministicSigningKey :: AsType CommitteeHotKey -> Crypto.Seed -> SigningKey CommitteeHotKey - deterministicSigningKey AsCommitteeHotKey seed = - CommitteeHotSigningKey (Crypto.genKeyDSIGN seed) - - deterministicSigningKeySeedSize :: AsType CommitteeHotKey -> Word - deterministicSigningKeySeedSize AsCommitteeHotKey = - Crypto.seedSizeDSIGN proxy - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - - getVerificationKey :: SigningKey CommitteeHotKey -> VerificationKey CommitteeHotKey - getVerificationKey (CommitteeHotSigningKey sk) = - CommitteeHotVerificationKey (Shelley.VKey (Crypto.deriveVerKeyDSIGN sk)) - - verificationKeyHash :: VerificationKey CommitteeHotKey -> Hash CommitteeHotKey - verificationKeyHash (CommitteeHotVerificationKey vkey) = - CommitteeHotKeyHash (Shelley.hashKey vkey) - -instance SerialiseAsRawBytes (VerificationKey CommitteeHotKey) where - serialiseToRawBytes (CommitteeHotVerificationKey (Shelley.VKey vk)) = - Crypto.rawEncodeFixedSized vk - - deserialiseFromRawBytes (AsVerificationKey AsCommitteeHotKey) bs = - maybeToRight - (SerialiseAsRawBytesError "Unable to deserialise VerificationKey Constitutional Committee Hot Key") - $ CommitteeHotVerificationKey . Shelley.VKey - <$> Crypto.rawDecodeFixedSized bs - -instance SerialiseAsRawBytes (SigningKey CommitteeHotKey) where - serialiseToRawBytes (CommitteeHotSigningKey sk) = - Crypto.rawEncodeFixedSized sk - - deserialiseFromRawBytes (AsSigningKey AsCommitteeHotKey) bs = - maybeToRight - (SerialiseAsRawBytesError "Unable to deserialise SigningKey Constitutional Committee Hot Key") - $ CommitteeHotSigningKey <$> Crypto.rawDecodeFixedSized bs - -newtype instance Hash CommitteeHotKey - = CommitteeHotKeyHash - {unCommitteeHotKeyHash :: Shelley.KeyHash Shelley.HotCommitteeRole} - deriving stock (Eq, Ord) - deriving (Show, Pretty) via UsingRawBytesHex (Hash CommitteeHotKey) - deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash CommitteeHotKey) - deriving anyclass SerialiseAsCBOR - -instance SerialiseAsRawBytes (Hash CommitteeHotKey) where - serialiseToRawBytes (CommitteeHotKeyHash (Shelley.KeyHash vkh)) = - Crypto.hashToBytes vkh - - deserialiseFromRawBytes (AsHash AsCommitteeHotKey) bs = - maybeToRight - (SerialiseAsRawBytesError "Unable to deserialise Hash Constitutional Committee Hot Key") - $ CommitteeHotKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs - -instance HasTextEnvelope (VerificationKey CommitteeHotKey) where - textEnvelopeType _ = - "ConstitutionalCommitteeHotVerificationKey_" - <> fromString (Crypto.algorithmNameDSIGN proxy) - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - -instance HasTextEnvelope (SigningKey CommitteeHotKey) where - textEnvelopeType _ = - "ConstitutionalCommitteeHotSigningKey_" - <> fromString (Crypto.algorithmNameDSIGN proxy) - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - -instance CastVerificationKeyRole CommitteeHotKey PaymentKey where - castVerificationKey (CommitteeHotVerificationKey (Shelley.VKey vk)) = - PaymentVerificationKey (Shelley.VKey vk) - -instance SerialiseAsBech32 (Hash CommitteeHotKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "cc_hot" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["cc_hot"] - -instance SerialiseAsBech32 (VerificationKey CommitteeHotKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "cc_hot_vk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["cc_hot_vk"] - -instance SerialiseAsBech32 (SigningKey CommitteeHotKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "cc_hot_sk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["cc_hot_sk"] - --- --- Constitutional Committee Cold Keys --- - -data CommitteeColdKey - -instance HasTypeProxy CommitteeColdKey where - data AsType CommitteeColdKey = AsCommitteeColdKey - proxyToAsType _ = AsCommitteeColdKey - -instance Key CommitteeColdKey where - newtype VerificationKey CommitteeColdKey - = CommitteeColdVerificationKey (Shelley.VKey Shelley.ColdCommitteeRole) - deriving stock Eq - deriving (Show, Pretty) via UsingRawBytesHex (VerificationKey CommitteeColdKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - newtype SigningKey CommitteeColdKey - = CommitteeColdSigningKey (DSIGN.SignKeyDSIGN DSIGN) - deriving (Show, Pretty) via UsingRawBytesHex (SigningKey CommitteeColdKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - deterministicSigningKey :: AsType CommitteeColdKey -> Crypto.Seed -> SigningKey CommitteeColdKey - deterministicSigningKey AsCommitteeColdKey seed = - CommitteeColdSigningKey (Crypto.genKeyDSIGN seed) - - deterministicSigningKeySeedSize :: AsType CommitteeColdKey -> Word - deterministicSigningKeySeedSize AsCommitteeColdKey = - Crypto.seedSizeDSIGN proxy - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - - getVerificationKey :: SigningKey CommitteeColdKey -> VerificationKey CommitteeColdKey - getVerificationKey (CommitteeColdSigningKey sk) = - CommitteeColdVerificationKey (Shelley.VKey (Crypto.deriveVerKeyDSIGN sk)) - - verificationKeyHash :: VerificationKey CommitteeColdKey -> Hash CommitteeColdKey - verificationKeyHash (CommitteeColdVerificationKey vkey) = - CommitteeColdKeyHash (Shelley.hashKey vkey) - -instance SerialiseAsRawBytes (VerificationKey CommitteeColdKey) where - serialiseToRawBytes (CommitteeColdVerificationKey (Shelley.VKey vk)) = - Crypto.rawEncodeFixedSized vk - - deserialiseFromRawBytes (AsVerificationKey AsCommitteeColdKey) bs = - maybeToRight - (SerialiseAsRawBytesError "Unable to deserialise VerificationKey Constitutional Committee Cold Key") - $ CommitteeColdVerificationKey . Shelley.VKey - <$> Crypto.rawDecodeFixedSized bs - -instance SerialiseAsRawBytes (SigningKey CommitteeColdKey) where - serialiseToRawBytes (CommitteeColdSigningKey sk) = - Crypto.rawEncodeFixedSized sk - - deserialiseFromRawBytes (AsSigningKey AsCommitteeColdKey) bs = - maybeToRight - (SerialiseAsRawBytesError "Unable to deserialise SigningKey Constitutional Committee Cold Key") - $ CommitteeColdSigningKey <$> Crypto.rawDecodeFixedSized bs - -newtype instance Hash CommitteeColdKey - = CommitteeColdKeyHash - {unCommitteeColdKeyHash :: Shelley.KeyHash Shelley.ColdCommitteeRole} - deriving stock (Eq, Ord) - deriving (Show, Pretty) via UsingRawBytesHex (Hash CommitteeColdKey) - deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash CommitteeColdKey) - deriving anyclass SerialiseAsCBOR - -instance SerialiseAsRawBytes (Hash CommitteeColdKey) where - serialiseToRawBytes (CommitteeColdKeyHash (Shelley.KeyHash vkh)) = - Crypto.hashToBytes vkh - - deserialiseFromRawBytes (AsHash AsCommitteeColdKey) bs = - maybeToRight - (SerialiseAsRawBytesError "Unable to deserialise Hash Constitutional Committee Cold Key") - $ CommitteeColdKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs - -instance HasTextEnvelope (VerificationKey CommitteeColdKey) where - textEnvelopeType _ = - "ConstitutionalCommitteeColdVerificationKey_" - <> fromString (Crypto.algorithmNameDSIGN proxy) - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - -instance HasTextEnvelope (SigningKey CommitteeColdKey) where - textEnvelopeType _ = - "ConstitutionalCommitteeColdSigningKey_" - <> fromString (Crypto.algorithmNameDSIGN proxy) - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - -instance CastVerificationKeyRole CommitteeColdKey PaymentKey where - castVerificationKey (CommitteeColdVerificationKey (Shelley.VKey vk)) = - PaymentVerificationKey (Shelley.VKey vk) - -instance SerialiseAsBech32 (Hash CommitteeColdKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "cc_cold" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["cc_cold"] - -instance SerialiseAsBech32 (VerificationKey CommitteeColdKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "cc_cold_vk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["cc_cold_vk"] - -instance SerialiseAsBech32 (SigningKey CommitteeColdKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "cc_cold_sk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["cc_cold_sk"] - ---- ---- Committee cold extended keys ---- -data CommitteeColdExtendedKey - -instance HasTypeProxy CommitteeColdExtendedKey where - data AsType CommitteeColdExtendedKey = AsCommitteeColdExtendedKey - proxyToAsType _ = AsCommitteeColdExtendedKey - -instance Key CommitteeColdExtendedKey where - newtype VerificationKey CommitteeColdExtendedKey - = CommitteeColdExtendedVerificationKey Crypto.HD.XPub - deriving stock Eq - deriving anyclass SerialiseAsCBOR - deriving (Show, Pretty) via UsingRawBytesHex (VerificationKey PaymentExtendedKey) - - newtype SigningKey CommitteeColdExtendedKey - = CommitteeColdExtendedSigningKey Crypto.HD.XPrv - deriving anyclass SerialiseAsCBOR - deriving (Show, Pretty) via UsingRawBytesHex (SigningKey PaymentExtendedKey) - - deterministicSigningKey - :: AsType CommitteeColdExtendedKey - -> Crypto.Seed - -> SigningKey CommitteeColdExtendedKey - deterministicSigningKey AsCommitteeColdExtendedKey seed = - CommitteeColdExtendedSigningKey - (Crypto.HD.generate seedbs BS.empty) - where - (seedbs, _) = Crypto.getBytesFromSeedT 32 seed - - deterministicSigningKeySeedSize :: AsType CommitteeColdExtendedKey -> Word - deterministicSigningKeySeedSize AsCommitteeColdExtendedKey = 32 - - getVerificationKey - :: SigningKey CommitteeColdExtendedKey - -> VerificationKey CommitteeColdExtendedKey - getVerificationKey (CommitteeColdExtendedSigningKey sk) = - CommitteeColdExtendedVerificationKey (Crypto.HD.toXPub sk) - - -- We use the hash of the normal non-extended pub key so that it is - -- consistent with the one used in addresses and signatures. - verificationKeyHash - :: VerificationKey CommitteeColdExtendedKey - -> Hash CommitteeColdExtendedKey - verificationKeyHash (CommitteeColdExtendedVerificationKey vk) = - CommitteeColdExtendedKeyHash - . Shelley.KeyHash - . Crypto.castHash - $ Crypto.hashWith Crypto.HD.xpubPublicKey vk - -newtype instance Hash CommitteeColdExtendedKey - = CommitteeColdExtendedKeyHash - {unCommitteeColdExtendedKeyHash :: Shelley.KeyHash Shelley.ColdCommitteeRole} - deriving stock (Eq, Ord) - deriving (Show, Pretty) via UsingRawBytesHex (Hash CommitteeColdKey) - deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash CommitteeColdKey) - deriving anyclass SerialiseAsCBOR - -instance ToCBOR (VerificationKey CommitteeColdExtendedKey) where - toCBOR (CommitteeColdExtendedVerificationKey xpub) = - toCBOR (Crypto.HD.unXPub xpub) - -instance FromCBOR (VerificationKey CommitteeColdExtendedKey) where - fromCBOR = do - bs <- fromCBOR - either - fail - (return . CommitteeColdExtendedVerificationKey) - (Crypto.HD.xpub (bs :: ByteString)) - -instance ToCBOR (SigningKey CommitteeColdExtendedKey) where - toCBOR (CommitteeColdExtendedSigningKey xprv) = - toCBOR (Crypto.HD.unXPrv xprv) - -instance FromCBOR (SigningKey CommitteeColdExtendedKey) where - fromCBOR = do - bs <- fromCBOR - either - fail - (return . CommitteeColdExtendedSigningKey) - (Crypto.HD.xprv (bs :: ByteString)) - -instance SerialiseAsRawBytes (VerificationKey CommitteeColdExtendedKey) where - serialiseToRawBytes (CommitteeColdExtendedVerificationKey xpub) = - Crypto.HD.unXPub xpub - - deserialiseFromRawBytes (AsVerificationKey AsCommitteeColdExtendedKey) bs = - first - (const (SerialiseAsRawBytesError "Unable to deserialise VerificationKey CommitteeColdExtendedKey")) - (CommitteeColdExtendedVerificationKey <$> Crypto.HD.xpub bs) - -instance SerialiseAsRawBytes (SigningKey CommitteeColdExtendedKey) where - serialiseToRawBytes (CommitteeColdExtendedSigningKey xprv) = - Crypto.HD.unXPrv xprv - - deserialiseFromRawBytes (AsSigningKey AsCommitteeColdExtendedKey) bs = - first - (const (SerialiseAsRawBytesError "Unable to deserialise SigningKey CommitteeColdExtendedKey")) - (CommitteeColdExtendedSigningKey <$> Crypto.HD.xprv bs) - -instance SerialiseAsRawBytes (Hash CommitteeColdExtendedKey) where - serialiseToRawBytes (CommitteeColdExtendedKeyHash (Shelley.KeyHash vkh)) = - Crypto.hashToBytes vkh - - deserialiseFromRawBytes (AsHash AsCommitteeColdExtendedKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash CommitteeColdExtendedKey") $ - CommitteeColdExtendedKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs - -instance HasTextEnvelope (VerificationKey CommitteeColdExtendedKey) where - textEnvelopeType _ = "ConstitutionalCommitteeColdExtendedVerificationKey_ed25519_bip32" - -instance HasTextEnvelope (SigningKey CommitteeColdExtendedKey) where - textEnvelopeType _ = "ConstitutionalCommitteeColdExtendedSigningKey_ed25519_bip32" - -instance SerialiseAsBech32 (VerificationKey CommitteeColdExtendedKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "cc_cold_xvk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["cc_cold_xvk"] - -instance SerialiseAsBech32 (SigningKey CommitteeColdExtendedKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "cc_cold_xsk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["cc_cold_xsk"] - -instance CastVerificationKeyRole CommitteeColdExtendedKey CommitteeColdKey where - castVerificationKey (CommitteeColdExtendedVerificationKey vk) = - CommitteeColdVerificationKey - . Shelley.VKey - . fromMaybe impossible - . Crypto.rawDecodeFixedSized - . Crypto.HD.xpubPublicKey - $ vk - where - impossible = - error "castVerificationKey (CommitteeCold): byron and shelley key sizes do not match!" - ---- ---- Committee hot extended keys ---- -data CommitteeHotExtendedKey - -instance HasTypeProxy CommitteeHotExtendedKey where - data AsType CommitteeHotExtendedKey = AsCommitteeHotExtendedKey - proxyToAsType _ = AsCommitteeHotExtendedKey - -instance Key CommitteeHotExtendedKey where - newtype VerificationKey CommitteeHotExtendedKey - = CommitteeHotExtendedVerificationKey Crypto.HD.XPub - deriving stock Eq - deriving anyclass SerialiseAsCBOR - deriving (Show, Pretty) via UsingRawBytesHex (VerificationKey PaymentExtendedKey) - - newtype SigningKey CommitteeHotExtendedKey - = CommitteeHotExtendedSigningKey Crypto.HD.XPrv - deriving anyclass SerialiseAsCBOR - deriving (Show, Pretty) via UsingRawBytesHex (SigningKey PaymentExtendedKey) - - deterministicSigningKey - :: AsType CommitteeHotExtendedKey - -> Crypto.Seed - -> SigningKey CommitteeHotExtendedKey - deterministicSigningKey AsCommitteeHotExtendedKey seed = - CommitteeHotExtendedSigningKey - (Crypto.HD.generate seedbs BS.empty) - where - (seedbs, _) = Crypto.getBytesFromSeedT 32 seed - - deterministicSigningKeySeedSize :: AsType CommitteeHotExtendedKey -> Word - deterministicSigningKeySeedSize AsCommitteeHotExtendedKey = 32 - - getVerificationKey - :: SigningKey CommitteeHotExtendedKey - -> VerificationKey CommitteeHotExtendedKey - getVerificationKey (CommitteeHotExtendedSigningKey sk) = - CommitteeHotExtendedVerificationKey (Crypto.HD.toXPub sk) - - -- We use the hash of the normal non-extended pub key so that it is - -- consistent with the one used in addresses and signatures. - verificationKeyHash - :: VerificationKey CommitteeHotExtendedKey - -> Hash CommitteeHotExtendedKey - verificationKeyHash (CommitteeHotExtendedVerificationKey vk) = - CommitteeHotExtendedKeyHash - . Shelley.KeyHash - . Crypto.castHash - $ Crypto.hashWith Crypto.HD.xpubPublicKey vk - -newtype instance Hash CommitteeHotExtendedKey - = CommitteeHotExtendedKeyHash - {unCommitteeHotExtendedKeyHash :: Shelley.KeyHash Shelley.HotCommitteeRole} - deriving stock (Eq, Ord) - deriving (Show, Pretty) via UsingRawBytesHex (Hash CommitteeHotKey) - deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash CommitteeHotKey) - deriving anyclass SerialiseAsCBOR - -instance ToCBOR (VerificationKey CommitteeHotExtendedKey) where - toCBOR (CommitteeHotExtendedVerificationKey xpub) = - toCBOR (Crypto.HD.unXPub xpub) - -instance FromCBOR (VerificationKey CommitteeHotExtendedKey) where - fromCBOR = do - bs <- fromCBOR - either - fail - (return . CommitteeHotExtendedVerificationKey) - (Crypto.HD.xpub (bs :: ByteString)) - -instance ToCBOR (SigningKey CommitteeHotExtendedKey) where - toCBOR (CommitteeHotExtendedSigningKey xprv) = - toCBOR (Crypto.HD.unXPrv xprv) - -instance FromCBOR (SigningKey CommitteeHotExtendedKey) where - fromCBOR = do - bs <- fromCBOR - either - fail - (return . CommitteeHotExtendedSigningKey) - (Crypto.HD.xprv (bs :: ByteString)) - -instance SerialiseAsRawBytes (VerificationKey CommitteeHotExtendedKey) where - serialiseToRawBytes (CommitteeHotExtendedVerificationKey xpub) = - Crypto.HD.unXPub xpub - - deserialiseFromRawBytes (AsVerificationKey AsCommitteeHotExtendedKey) bs = - first - (const (SerialiseAsRawBytesError "Unable to deserialise VerificationKey CommitteeHotExtendedKey")) - (CommitteeHotExtendedVerificationKey <$> Crypto.HD.xpub bs) - -instance SerialiseAsRawBytes (SigningKey CommitteeHotExtendedKey) where - serialiseToRawBytes (CommitteeHotExtendedSigningKey xprv) = - Crypto.HD.unXPrv xprv - - deserialiseFromRawBytes (AsSigningKey AsCommitteeHotExtendedKey) bs = - first - (const (SerialiseAsRawBytesError "Unable to deserialise SigningKey CommitteeHotExtendedKey")) - (CommitteeHotExtendedSigningKey <$> Crypto.HD.xprv bs) - -instance SerialiseAsRawBytes (Hash CommitteeHotExtendedKey) where - serialiseToRawBytes (CommitteeHotExtendedKeyHash (Shelley.KeyHash vkh)) = - Crypto.hashToBytes vkh - - deserialiseFromRawBytes (AsHash AsCommitteeHotExtendedKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash CommitteeHotExtendedKey") $ - CommitteeHotExtendedKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs - -instance HasTextEnvelope (VerificationKey CommitteeHotExtendedKey) where - textEnvelopeType _ = "ConstitutionalCommitteeHotExtendedVerificationKey_ed25519_bip32" - -instance HasTextEnvelope (SigningKey CommitteeHotExtendedKey) where - textEnvelopeType _ = "ConstitutionalCommitteeHotExtendedSigningKey_ed25519_bip32" - -instance SerialiseAsBech32 (VerificationKey CommitteeHotExtendedKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "cc_hot_xvk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["cc_hot_xvk"] - -instance SerialiseAsBech32 (SigningKey CommitteeHotExtendedKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "cc_hot_xsk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["cc_hot_xsk"] - -instance CastVerificationKeyRole CommitteeHotExtendedKey CommitteeHotKey where - castVerificationKey (CommitteeHotExtendedVerificationKey vk) = - CommitteeHotVerificationKey - . Shelley.VKey - . fromMaybe impossible - . Crypto.rawDecodeFixedSized - . Crypto.HD.xpubPublicKey - $ vk - where - impossible = - error "castVerificationKey (CommitteeHot): byron and shelley key sizes do not match!" - --- --- Shelley genesis extended ed25519 keys --- - --- | Shelley-era genesis keys using extended ed25519 cryptographic keys. --- --- These serve the same role as normal genesis keys, but are here to support --- legacy Byron genesis keys which used extended keys. --- --- The extended verification keys can be converted (via 'castVerificationKey') --- to ordinary keys (i.e. 'VerificationKey' 'GenesisKey') but this is /not/ the --- case for the signing keys. The signing keys can be used to witness --- transactions directly, with verification via their non-extended verification --- key ('VerificationKey' 'GenesisKey'). --- --- This is a type level tag, used with other interfaces like 'Key'. -data GenesisExtendedKey - -instance HasTypeProxy GenesisExtendedKey where - data AsType GenesisExtendedKey = AsGenesisExtendedKey - proxyToAsType _ = AsGenesisExtendedKey - -instance Key GenesisExtendedKey where - newtype VerificationKey GenesisExtendedKey - = GenesisExtendedVerificationKey Crypto.HD.XPub - deriving stock Eq - deriving anyclass SerialiseAsCBOR - deriving (Show, Pretty) via UsingRawBytesHex (VerificationKey GenesisExtendedKey) - - newtype SigningKey GenesisExtendedKey - = GenesisExtendedSigningKey Crypto.HD.XPrv - deriving anyclass SerialiseAsCBOR - deriving (Show, Pretty) via UsingRawBytesHex (SigningKey GenesisExtendedKey) - - deterministicSigningKey - :: AsType GenesisExtendedKey - -> Crypto.Seed - -> SigningKey GenesisExtendedKey - deterministicSigningKey AsGenesisExtendedKey seed = - GenesisExtendedSigningKey - (Crypto.HD.generate seedbs BS.empty) - where - (seedbs, _) = Crypto.getBytesFromSeedT 32 seed - - deterministicSigningKeySeedSize :: AsType GenesisExtendedKey -> Word - deterministicSigningKeySeedSize AsGenesisExtendedKey = 32 - - getVerificationKey - :: SigningKey GenesisExtendedKey - -> VerificationKey GenesisExtendedKey - getVerificationKey (GenesisExtendedSigningKey sk) = - GenesisExtendedVerificationKey (Crypto.HD.toXPub sk) - - -- We use the hash of the normal non-extended pub key so that it is - -- consistent with the one used in addresses and signatures. - verificationKeyHash - :: VerificationKey GenesisExtendedKey - -> Hash GenesisExtendedKey - verificationKeyHash (GenesisExtendedVerificationKey vk) = - GenesisExtendedKeyHash - . Shelley.KeyHash - . Crypto.castHash - $ Crypto.hashWith Crypto.HD.xpubPublicKey vk - -instance ToCBOR (VerificationKey GenesisExtendedKey) where - toCBOR (GenesisExtendedVerificationKey xpub) = - toCBOR (Crypto.HD.unXPub xpub) - -instance FromCBOR (VerificationKey GenesisExtendedKey) where - fromCBOR = do - bs <- fromCBOR - either - fail - (return . GenesisExtendedVerificationKey) - (Crypto.HD.xpub (bs :: ByteString)) - -instance ToCBOR (SigningKey GenesisExtendedKey) where - toCBOR (GenesisExtendedSigningKey xprv) = - toCBOR (Crypto.HD.unXPrv xprv) - -instance FromCBOR (SigningKey GenesisExtendedKey) where - fromCBOR = do - bs <- fromCBOR - either - fail - (return . GenesisExtendedSigningKey) - (Crypto.HD.xprv (bs :: ByteString)) - -instance SerialiseAsRawBytes (VerificationKey GenesisExtendedKey) where - serialiseToRawBytes (GenesisExtendedVerificationKey xpub) = - Crypto.HD.unXPub xpub - - deserialiseFromRawBytes (AsVerificationKey AsGenesisExtendedKey) bs = - first (const (SerialiseAsRawBytesError "Unable to deserialise VerificationKey GenesisExtendedKey")) $ - GenesisExtendedVerificationKey <$> Crypto.HD.xpub bs - -instance SerialiseAsRawBytes (SigningKey GenesisExtendedKey) where - serialiseToRawBytes (GenesisExtendedSigningKey xprv) = - Crypto.HD.unXPrv xprv - - deserialiseFromRawBytes (AsSigningKey AsGenesisExtendedKey) bs = - first - (\msg -> SerialiseAsRawBytesError ("Unable to deserialise SigningKey GenesisExtendedKey" ++ msg)) - $ GenesisExtendedSigningKey <$> Crypto.HD.xprv bs - -newtype instance Hash GenesisExtendedKey - = GenesisExtendedKeyHash - {unGenesisExtendedKeyHash :: Shelley.KeyHash Shelley.Staking} - deriving stock (Eq, Ord) - deriving (Show, Pretty) via UsingRawBytesHex (Hash GenesisExtendedKey) - deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash GenesisExtendedKey) - deriving anyclass SerialiseAsCBOR - -instance SerialiseAsRawBytes (Hash GenesisExtendedKey) where - serialiseToRawBytes (GenesisExtendedKeyHash (Shelley.KeyHash vkh)) = - Crypto.hashToBytes vkh - - deserialiseFromRawBytes (AsHash AsGenesisExtendedKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash GenesisExtendedKey") $ - GenesisExtendedKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs - -instance HasTextEnvelope (VerificationKey GenesisExtendedKey) where - textEnvelopeType _ = "GenesisExtendedVerificationKey_ed25519_bip32" - -instance HasTextEnvelope (SigningKey GenesisExtendedKey) where - textEnvelopeType _ = "GenesisExtendedSigningKey_ed25519_bip32" - -instance CastVerificationKeyRole GenesisExtendedKey GenesisKey where - castVerificationKey (GenesisExtendedVerificationKey vk) = - GenesisVerificationKey - . Shelley.VKey - . fromMaybe impossible - . Crypto.rawDecodeFixedSized - . Crypto.HD.xpubPublicKey - $ vk - where - impossible = - error "castVerificationKey: byron and shelley key sizes do not match!" - --- --- Genesis delegate keys --- - -data GenesisDelegateKey - -instance HasTypeProxy GenesisDelegateKey where - data AsType GenesisDelegateKey = AsGenesisDelegateKey - proxyToAsType _ = AsGenesisDelegateKey - -instance Key GenesisDelegateKey where - newtype VerificationKey GenesisDelegateKey - = GenesisDelegateVerificationKey (Shelley.VKey Shelley.GenesisDelegate) - deriving stock Eq - deriving (Show, Pretty) via UsingRawBytesHex (VerificationKey GenesisDelegateKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - newtype SigningKey GenesisDelegateKey - = GenesisDelegateSigningKey (DSIGN.SignKeyDSIGN DSIGN) - deriving (Show, Pretty) via UsingRawBytesHex (SigningKey GenesisDelegateKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - deterministicSigningKey :: AsType GenesisDelegateKey -> Crypto.Seed -> SigningKey GenesisDelegateKey - deterministicSigningKey AsGenesisDelegateKey seed = - GenesisDelegateSigningKey (Crypto.genKeyDSIGN seed) - - deterministicSigningKeySeedSize :: AsType GenesisDelegateKey -> Word - deterministicSigningKeySeedSize AsGenesisDelegateKey = - Crypto.seedSizeDSIGN proxy - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - - getVerificationKey :: SigningKey GenesisDelegateKey -> VerificationKey GenesisDelegateKey - getVerificationKey (GenesisDelegateSigningKey sk) = - GenesisDelegateVerificationKey (Shelley.VKey (Crypto.deriveVerKeyDSIGN sk)) - - verificationKeyHash :: VerificationKey GenesisDelegateKey -> Hash GenesisDelegateKey - verificationKeyHash (GenesisDelegateVerificationKey vkey) = - GenesisDelegateKeyHash (Shelley.hashKey vkey) - -instance SerialiseAsRawBytes (VerificationKey GenesisDelegateKey) where - serialiseToRawBytes (GenesisDelegateVerificationKey (Shelley.VKey vk)) = - Crypto.rawEncodeFixedSized vk - - deserialiseFromRawBytes (AsVerificationKey AsGenesisDelegateKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise VerificationKey GenesisDelegateKey") $ - GenesisDelegateVerificationKey . Shelley.VKey - <$> Crypto.rawDecodeFixedSized bs - -instance SerialiseAsRawBytes (SigningKey GenesisDelegateKey) where - serialiseToRawBytes (GenesisDelegateSigningKey sk) = - Crypto.rawEncodeFixedSized sk - - deserialiseFromRawBytes (AsSigningKey AsGenesisDelegateKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise SigningKey GenesisDelegateKey") $ - GenesisDelegateSigningKey <$> Crypto.rawDecodeFixedSized bs - -newtype instance Hash GenesisDelegateKey - = GenesisDelegateKeyHash - {unGenesisDelegateKeyHash :: Shelley.KeyHash Shelley.GenesisDelegate} - deriving stock (Eq, Ord) - deriving (Show, Pretty) via UsingRawBytesHex (Hash GenesisDelegateKey) - deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash GenesisDelegateKey) - deriving anyclass SerialiseAsCBOR - -instance SerialiseAsRawBytes (Hash GenesisDelegateKey) where - serialiseToRawBytes (GenesisDelegateKeyHash (Shelley.KeyHash vkh)) = - Crypto.hashToBytes vkh - - deserialiseFromRawBytes (AsHash AsGenesisDelegateKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash GenesisDelegateKey") $ - GenesisDelegateKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs - -instance HasTextEnvelope (VerificationKey GenesisDelegateKey) where - textEnvelopeType _ = - "GenesisDelegateVerificationKey_" - <> fromString (Crypto.algorithmNameDSIGN proxy) - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - -instance HasTextEnvelope (SigningKey GenesisDelegateKey) where - textEnvelopeType _ = - "GenesisDelegateSigningKey_" - <> fromString (Crypto.algorithmNameDSIGN proxy) - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - -instance CastVerificationKeyRole GenesisDelegateKey StakePoolKey where - castVerificationKey (GenesisDelegateVerificationKey (Shelley.VKey vkey)) = - StakePoolVerificationKey (Shelley.VKey vkey) - -instance CastSigningKeyRole GenesisDelegateKey StakePoolKey where - castSigningKey (GenesisDelegateSigningKey skey) = - StakePoolSigningKey skey - -instance CastVerificationKeyRole StakePoolKey StakeKey where - castVerificationKey (StakePoolVerificationKey (Shelley.VKey vkey)) = - StakeVerificationKey (Shelley.VKey vkey) - --- --- Shelley genesis delegate extended ed25519 keys --- - --- | Shelley-era genesis keys using extended ed25519 cryptographic keys. --- --- These serve the same role as normal genesis keys, but are here to support --- legacy Byron genesis keys which used extended keys. --- --- The extended verification keys can be converted (via 'castVerificationKey') --- to ordinary keys (i.e. 'VerificationKey' 'GenesisKey') but this is /not/ the --- case for the signing keys. The signing keys can be used to witness --- transactions directly, with verification via their non-extended verification --- key ('VerificationKey' 'GenesisKey'). --- --- This is a type level tag, used with other interfaces like 'Key'. -data GenesisDelegateExtendedKey - -instance HasTypeProxy GenesisDelegateExtendedKey where - data AsType GenesisDelegateExtendedKey = AsGenesisDelegateExtendedKey - proxyToAsType _ = AsGenesisDelegateExtendedKey - -instance Key GenesisDelegateExtendedKey where - newtype VerificationKey GenesisDelegateExtendedKey - = GenesisDelegateExtendedVerificationKey Crypto.HD.XPub - deriving stock Eq - deriving anyclass SerialiseAsCBOR - deriving (Show, Pretty) via UsingRawBytesHex (VerificationKey GenesisDelegateExtendedKey) - - newtype SigningKey GenesisDelegateExtendedKey - = GenesisDelegateExtendedSigningKey Crypto.HD.XPrv - deriving anyclass SerialiseAsCBOR - deriving (Show, Pretty) via UsingRawBytesHex (SigningKey GenesisDelegateExtendedKey) - - deterministicSigningKey - :: AsType GenesisDelegateExtendedKey - -> Crypto.Seed - -> SigningKey GenesisDelegateExtendedKey - deterministicSigningKey AsGenesisDelegateExtendedKey seed = - GenesisDelegateExtendedSigningKey - (Crypto.HD.generate seedbs BS.empty) - where - (seedbs, _) = Crypto.getBytesFromSeedT 32 seed - - deterministicSigningKeySeedSize :: AsType GenesisDelegateExtendedKey -> Word - deterministicSigningKeySeedSize AsGenesisDelegateExtendedKey = 32 - - getVerificationKey - :: SigningKey GenesisDelegateExtendedKey - -> VerificationKey GenesisDelegateExtendedKey - getVerificationKey (GenesisDelegateExtendedSigningKey sk) = - GenesisDelegateExtendedVerificationKey (Crypto.HD.toXPub sk) - - -- We use the hash of the normal non-extended pub key so that it is - -- consistent with the one used in addresses and signatures. - verificationKeyHash - :: VerificationKey GenesisDelegateExtendedKey - -> Hash GenesisDelegateExtendedKey - verificationKeyHash (GenesisDelegateExtendedVerificationKey vk) = - GenesisDelegateExtendedKeyHash - . Shelley.KeyHash - . Crypto.castHash - $ Crypto.hashWith Crypto.HD.xpubPublicKey vk - -instance ToCBOR (VerificationKey GenesisDelegateExtendedKey) where - toCBOR (GenesisDelegateExtendedVerificationKey xpub) = - toCBOR (Crypto.HD.unXPub xpub) - -instance FromCBOR (VerificationKey GenesisDelegateExtendedKey) where - fromCBOR = do - bs <- fromCBOR - either - fail - (return . GenesisDelegateExtendedVerificationKey) - (Crypto.HD.xpub (bs :: ByteString)) - -instance ToCBOR (SigningKey GenesisDelegateExtendedKey) where - toCBOR (GenesisDelegateExtendedSigningKey xprv) = - toCBOR (Crypto.HD.unXPrv xprv) - -instance FromCBOR (SigningKey GenesisDelegateExtendedKey) where - fromCBOR = do - bs <- fromCBOR - either - fail - (return . GenesisDelegateExtendedSigningKey) - (Crypto.HD.xprv (bs :: ByteString)) - -instance SerialiseAsRawBytes (VerificationKey GenesisDelegateExtendedKey) where - serialiseToRawBytes (GenesisDelegateExtendedVerificationKey xpub) = - Crypto.HD.unXPub xpub - - deserialiseFromRawBytes (AsVerificationKey AsGenesisDelegateExtendedKey) bs = - first - ( \msg -> - SerialiseAsRawBytesError - ("Unable to deserialise VerificationKey GenesisDelegateExtendedKey: " ++ msg) - ) - $ GenesisDelegateExtendedVerificationKey <$> Crypto.HD.xpub bs - -instance SerialiseAsRawBytes (SigningKey GenesisDelegateExtendedKey) where - serialiseToRawBytes (GenesisDelegateExtendedSigningKey xprv) = - Crypto.HD.unXPrv xprv - - deserialiseFromRawBytes (AsSigningKey AsGenesisDelegateExtendedKey) bs = - first - ( \msg -> - SerialiseAsRawBytesError ("Unable to deserialise SigningKey GenesisDelegateExtendedKey: " ++ msg) - ) - $ GenesisDelegateExtendedSigningKey <$> Crypto.HD.xprv bs - -newtype instance Hash GenesisDelegateExtendedKey - = GenesisDelegateExtendedKeyHash - {unGenesisDelegateExtendedKeyHash :: Shelley.KeyHash Shelley.Staking} - deriving stock (Eq, Ord) - deriving (Show, Pretty) via UsingRawBytesHex (Hash GenesisDelegateExtendedKey) - deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash GenesisDelegateExtendedKey) - deriving anyclass SerialiseAsCBOR - -instance SerialiseAsRawBytes (Hash GenesisDelegateExtendedKey) where - serialiseToRawBytes (GenesisDelegateExtendedKeyHash (Shelley.KeyHash vkh)) = - Crypto.hashToBytes vkh - - deserialiseFromRawBytes (AsHash AsGenesisDelegateExtendedKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash GenesisDelegateExtendedKey: ") $ - GenesisDelegateExtendedKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs - -instance HasTextEnvelope (VerificationKey GenesisDelegateExtendedKey) where - textEnvelopeType _ = "GenesisDelegateExtendedVerificationKey_ed25519_bip32" - -instance HasTextEnvelope (SigningKey GenesisDelegateExtendedKey) where - textEnvelopeType _ = "GenesisDelegateExtendedSigningKey_ed25519_bip32" - -instance CastVerificationKeyRole GenesisDelegateExtendedKey GenesisDelegateKey where - castVerificationKey (GenesisDelegateExtendedVerificationKey vk) = - GenesisDelegateVerificationKey - . Shelley.VKey - . fromMaybe impossible - . Crypto.rawDecodeFixedSized - . Crypto.HD.xpubPublicKey - $ vk - where - impossible = - error "castVerificationKey: byron and shelley key sizes do not match!" - --- --- Genesis UTxO keys --- - -data GenesisUTxOKey - -instance HasTypeProxy GenesisUTxOKey where - data AsType GenesisUTxOKey = AsGenesisUTxOKey - proxyToAsType _ = AsGenesisUTxOKey - -instance Key GenesisUTxOKey where - newtype VerificationKey GenesisUTxOKey - = GenesisUTxOVerificationKey (Shelley.VKey Shelley.Payment) - deriving stock Eq - deriving (Show, Pretty) via UsingRawBytesHex (VerificationKey GenesisUTxOKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - newtype SigningKey GenesisUTxOKey - = GenesisUTxOSigningKey (DSIGN.SignKeyDSIGN DSIGN) - deriving (Show, Pretty) via UsingRawBytesHex (SigningKey GenesisUTxOKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - deterministicSigningKey :: AsType GenesisUTxOKey -> Crypto.Seed -> SigningKey GenesisUTxOKey - deterministicSigningKey AsGenesisUTxOKey seed = - GenesisUTxOSigningKey (Crypto.genKeyDSIGN seed) - - deterministicSigningKeySeedSize :: AsType GenesisUTxOKey -> Word - deterministicSigningKeySeedSize AsGenesisUTxOKey = - Crypto.seedSizeDSIGN proxy - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - - getVerificationKey :: SigningKey GenesisUTxOKey -> VerificationKey GenesisUTxOKey - getVerificationKey (GenesisUTxOSigningKey sk) = - GenesisUTxOVerificationKey (Shelley.VKey (Crypto.deriveVerKeyDSIGN sk)) - - verificationKeyHash :: VerificationKey GenesisUTxOKey -> Hash GenesisUTxOKey - verificationKeyHash (GenesisUTxOVerificationKey vkey) = - GenesisUTxOKeyHash (Shelley.hashKey vkey) - -instance SerialiseAsRawBytes (VerificationKey GenesisUTxOKey) where - serialiseToRawBytes (GenesisUTxOVerificationKey (Shelley.VKey vk)) = - Crypto.rawEncodeFixedSized vk - - deserialiseFromRawBytes (AsVerificationKey AsGenesisUTxOKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise VerificationKey GenesisUTxOKey") $ - GenesisUTxOVerificationKey . Shelley.VKey <$> Crypto.rawDecodeFixedSized bs - -instance SerialiseAsRawBytes (SigningKey GenesisUTxOKey) where - serialiseToRawBytes (GenesisUTxOSigningKey sk) = - Crypto.rawEncodeFixedSized sk - - deserialiseFromRawBytes (AsSigningKey AsGenesisUTxOKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise SigningKey GenesisUTxOKey") $ - GenesisUTxOSigningKey <$> Crypto.rawDecodeFixedSized bs - -newtype instance Hash GenesisUTxOKey - = GenesisUTxOKeyHash {unGenesisUTxOKeyHash :: Shelley.KeyHash Shelley.Payment} - deriving stock (Eq, Ord) - deriving (Show, Pretty) via UsingRawBytesHex (Hash GenesisUTxOKey) - deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash GenesisUTxOKey) - deriving anyclass SerialiseAsCBOR - -instance SerialiseAsRawBytes (Hash GenesisUTxOKey) where - serialiseToRawBytes (GenesisUTxOKeyHash (Shelley.KeyHash vkh)) = - Crypto.hashToBytes vkh - - deserialiseFromRawBytes (AsHash AsGenesisUTxOKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash GenesisUTxOKey") $ - GenesisUTxOKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs - -instance HasTextEnvelope (VerificationKey GenesisUTxOKey) where - textEnvelopeType _ = - "GenesisUTxOVerificationKey_" - <> fromString (Crypto.algorithmNameDSIGN proxy) - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - -instance HasTextEnvelope (SigningKey GenesisUTxOKey) where - textEnvelopeType _ = - "GenesisUTxOSigningKey_" - <> fromString (Crypto.algorithmNameDSIGN proxy) - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - --- TODO: use a different type from the stake pool key, since some operations --- need a genesis key specifically - -instance CastVerificationKeyRole GenesisUTxOKey PaymentKey where - castVerificationKey (GenesisUTxOVerificationKey (Shelley.VKey vkey)) = - PaymentVerificationKey (Shelley.VKey vkey) - -instance CastSigningKeyRole GenesisUTxOKey PaymentKey where - castSigningKey (GenesisUTxOSigningKey skey) = - PaymentSigningKey skey - --- --- 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 - data AsType StakePoolKey = AsStakePoolKey - proxyToAsType _ = AsStakePoolKey - -instance Key StakePoolKey where - newtype VerificationKey StakePoolKey - = StakePoolVerificationKey (Shelley.VKey Shelley.StakePool) - deriving stock Eq - deriving (Show, Pretty) via UsingRawBytesHex (VerificationKey StakePoolKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - newtype SigningKey StakePoolKey - = StakePoolSigningKey (DSIGN.SignKeyDSIGN DSIGN) - deriving (Show, Pretty) via UsingRawBytesHex (SigningKey StakePoolKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - deterministicSigningKey :: AsType StakePoolKey -> Crypto.Seed -> SigningKey StakePoolKey - deterministicSigningKey AsStakePoolKey seed = - StakePoolSigningKey (Crypto.genKeyDSIGN seed) - - deterministicSigningKeySeedSize :: AsType StakePoolKey -> Word - deterministicSigningKeySeedSize AsStakePoolKey = - Crypto.seedSizeDSIGN proxy - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - - getVerificationKey :: SigningKey StakePoolKey -> VerificationKey StakePoolKey - getVerificationKey (StakePoolSigningKey sk) = - StakePoolVerificationKey (Shelley.VKey (Crypto.deriveVerKeyDSIGN sk)) - - verificationKeyHash :: VerificationKey StakePoolKey -> Hash StakePoolKey - verificationKeyHash (StakePoolVerificationKey vkey) = - StakePoolKeyHash (Shelley.hashKey vkey) - -instance SerialiseAsRawBytes (VerificationKey StakePoolKey) where - serialiseToRawBytes (StakePoolVerificationKey (Shelley.VKey vk)) = - Crypto.rawEncodeFixedSized vk - - deserialiseFromRawBytes (AsVerificationKey AsStakePoolKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise VerificationKey StakePoolKey") $ - StakePoolVerificationKey . Shelley.VKey - <$> Crypto.rawDecodeFixedSized bs - -instance SerialiseAsRawBytes (SigningKey StakePoolKey) where - serialiseToRawBytes (StakePoolSigningKey sk) = - Crypto.rawEncodeFixedSized sk - - deserialiseFromRawBytes (AsSigningKey AsStakePoolKey) bs = - maybe - (Left (SerialiseAsRawBytesError "Unable to deserialise SigningKey StakePoolKey")) - (Right . StakePoolSigningKey) - (Crypto.rawDecodeFixedSized bs) - -instance SerialiseAsBech32 (VerificationKey StakePoolKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "pool_vk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["pool_vk"] - -instance SerialiseAsBech32 (SigningKey StakePoolKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "pool_sk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["pool_sk"] - -newtype instance Hash StakePoolKey - = StakePoolKeyHash {unStakePoolKeyHash :: Shelley.KeyHash Shelley.StakePool} - deriving stock (Eq, Ord) - deriving (Show, Pretty) via UsingRawBytesHex (Hash StakePoolKey) - deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash StakePoolKey) - deriving anyclass SerialiseAsCBOR - -instance SerialiseAsRawBytes (Hash StakePoolKey) where - serialiseToRawBytes (StakePoolKeyHash (Shelley.KeyHash vkh)) = - Crypto.hashToBytes vkh - - deserialiseFromRawBytes (AsHash AsStakePoolKey) bs = - maybeToRight - (SerialiseAsRawBytesError "Unable to deserialise Hash StakePoolKey") - (StakePoolKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs) - -instance SerialiseAsBech32 (Hash StakePoolKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "pool" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["pool"] - -instance ToJSON (Hash StakePoolKey) where - toJSON = toJSON . serialiseToBech32 - -instance ToJSONKey (Hash StakePoolKey) where - toJSONKey = toJSONKeyText serialiseToBech32 - -instance FromJSON (Hash StakePoolKey) where - parseJSON = withText "PoolId" $ \str -> - case deserialiseFromBech32 str of - Left err -> - fail $ - docToString $ - mconcat - [ "Error deserialising Hash StakePoolKey: " <> pretty str - , " Error: " <> prettyError err - ] - Right h -> pure h - -instance HasTextEnvelope (VerificationKey StakePoolKey) where - textEnvelopeType _ = - "StakePoolVerificationKey_" - <> fromString (Crypto.algorithmNameDSIGN proxy) - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - -instance HasTextEnvelope (SigningKey StakePoolKey) where - textEnvelopeType _ = - "StakePoolSigningKey_" - <> fromString (Crypto.algorithmNameDSIGN proxy) - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - ---- ---- Stake pool extended keys ---- - -data StakePoolExtendedKey - -instance HasTypeProxy StakePoolExtendedKey where - data AsType StakePoolExtendedKey = AsStakePoolExtendedKey - proxyToAsType _ = AsStakePoolExtendedKey - -instance Key StakePoolExtendedKey where - newtype VerificationKey StakePoolExtendedKey - = StakePoolExtendedVerificationKey Crypto.HD.XPub - deriving stock Eq - deriving (Show, Pretty) via UsingRawBytesHex (VerificationKey StakePoolExtendedKey) - deriving anyclass SerialiseAsCBOR - - newtype SigningKey StakePoolExtendedKey - = StakePoolExtendedSigningKey Crypto.HD.XPrv - deriving (Show, Pretty) via UsingRawBytesHex (SigningKey StakePoolExtendedKey) - deriving anyclass SerialiseAsCBOR - - deterministicSigningKey - :: AsType StakePoolExtendedKey - -> Crypto.Seed - -> SigningKey StakePoolExtendedKey - deterministicSigningKey AsStakePoolExtendedKey seed = - StakePoolExtendedSigningKey - (Crypto.HD.generate seedbs BS.empty) - where - (seedbs, _) = Crypto.getBytesFromSeedT 32 seed - - deterministicSigningKeySeedSize :: AsType StakePoolExtendedKey -> Word - deterministicSigningKeySeedSize AsStakePoolExtendedKey = 32 - - getVerificationKey - :: SigningKey StakePoolExtendedKey - -> VerificationKey StakePoolExtendedKey - getVerificationKey (StakePoolExtendedSigningKey sk) = - StakePoolExtendedVerificationKey (Crypto.HD.toXPub sk) - - -- We use the hash of the normal non-extended pub key so that it is - -- consistent with the one used in addresses and signatures. - verificationKeyHash - :: VerificationKey StakePoolExtendedKey - -> Hash StakePoolExtendedKey - verificationKeyHash (StakePoolExtendedVerificationKey vk) = - StakePoolExtendedKeyHash - . Shelley.KeyHash - . Crypto.castHash - $ Crypto.hashWith Crypto.HD.xpubPublicKey vk - -instance ToCBOR (VerificationKey StakePoolExtendedKey) where - toCBOR (StakePoolExtendedVerificationKey xpub) = - toCBOR (Crypto.HD.unXPub xpub) - -instance FromCBOR (VerificationKey StakePoolExtendedKey) where - fromCBOR = do - bs <- fromCBOR - either - fail - (return . StakePoolExtendedVerificationKey) - (Crypto.HD.xpub (bs :: ByteString)) - -instance ToCBOR (SigningKey StakePoolExtendedKey) where - toCBOR (StakePoolExtendedSigningKey xprv) = - toCBOR (Crypto.HD.unXPrv xprv) - -instance FromCBOR (SigningKey StakePoolExtendedKey) where - fromCBOR = do - bs <- fromCBOR - either - fail - (return . StakePoolExtendedSigningKey) - (Crypto.HD.xprv (bs :: ByteString)) - -instance SerialiseAsRawBytes (VerificationKey StakePoolExtendedKey) where - serialiseToRawBytes (StakePoolExtendedVerificationKey xpub) = - Crypto.HD.unXPub xpub - - deserialiseFromRawBytes (AsVerificationKey AsStakePoolExtendedKey) bs = - first - ( \msg -> - SerialiseAsRawBytesError - ("Unable to deserialise VerificationKey StakePoolExtendedKey: " ++ msg) - ) - $ StakePoolExtendedVerificationKey <$> Crypto.HD.xpub bs - -instance SerialiseAsRawBytes (SigningKey StakePoolExtendedKey) where - serialiseToRawBytes (StakePoolExtendedSigningKey xprv) = - Crypto.HD.unXPrv xprv - - deserialiseFromRawBytes (AsSigningKey AsStakePoolExtendedKey) bs = - first - ( \msg -> - SerialiseAsRawBytesError - ("Unable to deserialise SigningKey StakePoolExtendedKey: " ++ msg) - ) - $ StakePoolExtendedSigningKey <$> Crypto.HD.xprv bs - -newtype instance Hash StakePoolExtendedKey - = StakePoolExtendedKeyHash - {unStakePoolExtendedKeyHash :: Shelley.KeyHash Shelley.StakePool} - deriving stock (Eq, Ord, Show) - -instance SerialiseAsRawBytes (Hash StakePoolExtendedKey) where - serialiseToRawBytes (StakePoolExtendedKeyHash (Shelley.KeyHash vkh)) = - Crypto.hashToBytes vkh - - deserialiseFromRawBytes (AsHash AsStakePoolExtendedKey) bs = - maybeToRight - (SerialiseAsRawBytesError "Unable to deserialise Hash StakePoolExtendedKey") - (StakePoolExtendedKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs) - -instance SerialiseAsBech32 (Hash StakePoolExtendedKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "pool_xvkh" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["pool_xvkh"] - -instance HasTextEnvelope (VerificationKey StakePoolExtendedKey) where - textEnvelopeType _ = "StakePoolExtendedVerificationKey_ed25519_bip32" - -instance HasTextEnvelope (SigningKey StakePoolExtendedKey) where - textEnvelopeType _ = "StakePoolExtendedSigningKey_ed25519_bip32" - -instance SerialiseAsBech32 (VerificationKey StakePoolExtendedKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "pool_xvk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["pool_xvk"] - -instance SerialiseAsBech32 (SigningKey StakePoolExtendedKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "pool_xsk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["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 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 - . Shelley.VKey - . fromMaybe impossible - . Crypto.rawDecodeFixedSized - . Crypto.HD.xpubPublicKey - $ vk - where - impossible = - error "castVerificationKey (StakePoolKey): byron and shelley key sizes do not match!" - --- --- DRep keys --- - -data DRepKey - -instance HasTypeProxy DRepKey where - data AsType DRepKey = AsDRepKey - proxyToAsType _ = AsDRepKey - -instance Key DRepKey where - newtype VerificationKey DRepKey - = DRepVerificationKey (Shelley.VKey Shelley.DRepRole) - deriving stock Eq - deriving (Show, Pretty) via UsingRawBytesHex (VerificationKey DRepKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - newtype SigningKey DRepKey - = DRepSigningKey (DSIGN.SignKeyDSIGN DSIGN) - deriving (Show, Pretty) via UsingRawBytesHex (SigningKey DRepKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - deterministicSigningKey :: AsType DRepKey -> Crypto.Seed -> SigningKey DRepKey - deterministicSigningKey AsDRepKey seed = - DRepSigningKey (Crypto.genKeyDSIGN seed) - - deterministicSigningKeySeedSize :: AsType DRepKey -> Word - deterministicSigningKeySeedSize AsDRepKey = - Crypto.seedSizeDSIGN proxy - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - - getVerificationKey :: SigningKey DRepKey -> VerificationKey DRepKey - getVerificationKey (DRepSigningKey sk) = - DRepVerificationKey (Shelley.VKey (Crypto.deriveVerKeyDSIGN sk)) - - verificationKeyHash :: VerificationKey DRepKey -> Hash DRepKey - verificationKeyHash (DRepVerificationKey vkey) = - DRepKeyHash (Shelley.hashKey vkey) - -instance SerialiseAsRawBytes (VerificationKey DRepKey) where - serialiseToRawBytes (DRepVerificationKey (Shelley.VKey vk)) = - Crypto.rawEncodeFixedSized vk - - deserialiseFromRawBytes (AsVerificationKey AsDRepKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise VerificationKey DRepKey") $ - DRepVerificationKey . Shelley.VKey - <$> Crypto.rawDecodeFixedSized bs - -instance SerialiseAsRawBytes (SigningKey DRepKey) where - serialiseToRawBytes (DRepSigningKey sk) = - Crypto.rawEncodeFixedSized sk - - deserialiseFromRawBytes (AsSigningKey AsDRepKey) bs = - maybe - (Left (SerialiseAsRawBytesError "Unable to deserialise SigningKey DRepKey")) - (Right . DRepSigningKey) - (Crypto.rawDecodeFixedSized bs) - -instance SerialiseAsBech32 (VerificationKey DRepKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "drep_vk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["drep_vk"] - -instance SerialiseAsBech32 (SigningKey DRepKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "drep_sk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["drep_sk"] - -newtype instance Hash DRepKey - = DRepKeyHash {unDRepKeyHash :: Shelley.KeyHash Shelley.DRepRole} - deriving stock (Eq, Ord) - deriving (Show, Pretty) via UsingRawBytesHex (Hash DRepKey) - deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash DRepKey) - deriving anyclass SerialiseAsCBOR - -instance SerialiseAsRawBytes (Hash DRepKey) where - serialiseToRawBytes (DRepKeyHash (Shelley.KeyHash vkh)) = - Crypto.hashToBytes vkh - - deserialiseFromRawBytes (AsHash AsDRepKey) bs = - maybeToRight - (SerialiseAsRawBytesError "Unable to deserialise Hash DRepKey") - (DRepKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs) - -instance SerialiseAsBech32 (Hash DRepKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "drep" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["drep"] - -instance ToJSON (Hash DRepKey) where - toJSON = toJSON . serialiseToBech32 - -instance ToJSONKey (Hash DRepKey) where - toJSONKey = toJSONKeyText serialiseToBech32 - -instance FromJSON (Hash DRepKey) where - parseJSON = withText "DRepId" $ \str -> - case deserialiseFromBech32 str of - Left err -> - fail $ - docToString $ - mconcat - [ "Error deserialising Hash DRepKey: " <> pretty str - , " Error: " <> prettyError err - ] - Right h -> pure h - -instance HasTextEnvelope (VerificationKey DRepKey) where - textEnvelopeType _ = - "DRepVerificationKey_" - <> fromString (Crypto.algorithmNameDSIGN proxy) - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - -instance HasTextEnvelope (SigningKey DRepKey) where - textEnvelopeType _ = - "DRepSigningKey_" - <> fromString (Crypto.algorithmNameDSIGN proxy) - where - proxy :: Proxy Shelley.DSIGN - proxy = Proxy - ---- ---- Drep extended keys ---- - -data DRepExtendedKey - -instance HasTypeProxy DRepExtendedKey where - data AsType DRepExtendedKey = AsDRepExtendedKey - proxyToAsType _ = AsDRepExtendedKey - -instance Key DRepExtendedKey where - newtype VerificationKey DRepExtendedKey - = DRepExtendedVerificationKey Crypto.HD.XPub - deriving stock Eq - deriving anyclass SerialiseAsCBOR - deriving (Show, Pretty) via UsingRawBytesHex (VerificationKey PaymentExtendedKey) - - newtype SigningKey DRepExtendedKey - = DRepExtendedSigningKey Crypto.HD.XPrv - deriving anyclass SerialiseAsCBOR - deriving (Show, Pretty) via UsingRawBytesHex (SigningKey PaymentExtendedKey) - - deterministicSigningKey - :: AsType DRepExtendedKey - -> Crypto.Seed - -> SigningKey DRepExtendedKey - deterministicSigningKey AsDRepExtendedKey seed = - DRepExtendedSigningKey - (Crypto.HD.generate seedbs BS.empty) - where - (seedbs, _) = Crypto.getBytesFromSeedT 32 seed - - deterministicSigningKeySeedSize :: AsType DRepExtendedKey -> Word - deterministicSigningKeySeedSize AsDRepExtendedKey = 32 - - getVerificationKey - :: SigningKey DRepExtendedKey - -> VerificationKey DRepExtendedKey - getVerificationKey (DRepExtendedSigningKey sk) = - DRepExtendedVerificationKey (Crypto.HD.toXPub sk) - - -- We use the hash of the normal non-extended pub key so that it is - -- consistent with the one used in addresses and signatures. - verificationKeyHash - :: VerificationKey DRepExtendedKey - -> Hash DRepExtendedKey - verificationKeyHash (DRepExtendedVerificationKey vk) = - DRepExtendedKeyHash - . Shelley.KeyHash - . Crypto.castHash - $ Crypto.hashWith Crypto.HD.xpubPublicKey vk - -newtype instance Hash DRepExtendedKey - = DRepExtendedKeyHash {unDRepExtendedKeyHash :: Shelley.KeyHash Shelley.DRepRole} - deriving stock (Eq, Ord) - deriving (Show, Pretty) via UsingRawBytesHex (Hash DRepKey) - deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash DRepKey) - deriving anyclass SerialiseAsCBOR - -instance ToCBOR (VerificationKey DRepExtendedKey) where - toCBOR (DRepExtendedVerificationKey xpub) = - toCBOR (Crypto.HD.unXPub xpub) - -instance FromCBOR (VerificationKey DRepExtendedKey) where - fromCBOR = do - bs <- fromCBOR - either - fail - (return . DRepExtendedVerificationKey) - (Crypto.HD.xpub (bs :: ByteString)) - -instance ToCBOR (SigningKey DRepExtendedKey) where - toCBOR (DRepExtendedSigningKey xprv) = - toCBOR (Crypto.HD.unXPrv xprv) - -instance FromCBOR (SigningKey DRepExtendedKey) where - fromCBOR = do - bs <- fromCBOR - either - fail - (return . DRepExtendedSigningKey) - (Crypto.HD.xprv (bs :: ByteString)) - -instance SerialiseAsRawBytes (VerificationKey DRepExtendedKey) where - serialiseToRawBytes (DRepExtendedVerificationKey xpub) = - Crypto.HD.unXPub xpub - - deserialiseFromRawBytes (AsVerificationKey AsDRepExtendedKey) bs = - first - (const (SerialiseAsRawBytesError "Unable to deserialise VerificationKey DRepExtendedKey")) - (DRepExtendedVerificationKey <$> Crypto.HD.xpub bs) - -instance SerialiseAsRawBytes (SigningKey DRepExtendedKey) where - serialiseToRawBytes (DRepExtendedSigningKey xprv) = - Crypto.HD.unXPrv xprv - - deserialiseFromRawBytes (AsSigningKey AsDRepExtendedKey) bs = - first - (const (SerialiseAsRawBytesError "Unable to deserialise SigningKey DRepExtendedKey")) - (DRepExtendedSigningKey <$> Crypto.HD.xprv bs) - -instance SerialiseAsRawBytes (Hash DRepExtendedKey) where - serialiseToRawBytes (DRepExtendedKeyHash (Shelley.KeyHash vkh)) = - Crypto.hashToBytes vkh - - deserialiseFromRawBytes (AsHash AsDRepExtendedKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash DRepExtendedKey") $ - DRepExtendedKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs - -instance HasTextEnvelope (VerificationKey DRepExtendedKey) where - textEnvelopeType _ = "DRepExtendedVerificationKey_ed25519_bip32" - -instance HasTextEnvelope (SigningKey DRepExtendedKey) where - textEnvelopeType _ = "DRepExtendedSigningKey_ed25519_bip32" - -instance SerialiseAsBech32 (VerificationKey DRepExtendedKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "drep_xvk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["drep_xvk"] - -instance SerialiseAsBech32 (SigningKey DRepExtendedKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "drep_xsk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["drep_xsk"] +import Cardano.Api.Serialise.Raw (SerialiseAsRawBytes, parseRawBytesHex) -instance CastVerificationKeyRole DRepExtendedKey DRepKey where - castVerificationKey (DRepExtendedVerificationKey vk) = - DRepVerificationKey - . Shelley.VKey - . fromMaybe impossible - . Crypto.rawDecodeFixedSized - . Crypto.HD.xpubPublicKey - $ vk - where - impossible = - error "castVerificationKey (DRep): byron and shelley key sizes do not match!" +import Cardano.Keys.Shelley -- | Parse hex representation of any 'Hash' parseHexHash :: SerialiseAsRawBytes (Hash a) => P.Parser (Hash a) diff --git a/cardano-api/src/Cardano/Api/Key/Internal/Class.hs b/cardano-api/src/Cardano/Api/Key/Internal/Class.hs index 509b555d78..dc3994abe1 100644 --- a/cardano-api/src/Cardano/Api/Key/Internal/Class.hs +++ b/cardano-api/src/Cardano/Api/Key/Internal/Class.hs @@ -1,110 +1,7 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeFamilies #-} - +-- | This module now lives in the cardano-keys package; re-exported here for compatibility. module Cardano.Api.Key.Internal.Class - ( Key (..) - , generateSigningKey - , generateInsecureSigningKey - , CastVerificationKeyRole (..) - , CastSigningKeyRole (..) - , AsType (AsVerificationKey, AsSigningKey) + ( module Cardano.Keys.Class ) where -import Cardano.Api.HasTypeProxy -import Cardano.Api.Hash -import Cardano.Api.Serialise.Raw -import Cardano.Api.Serialise.TextEnvelope.Internal - -import Cardano.Crypto.DSIGN.Class qualified as Crypto -import Cardano.Crypto.Seed qualified as Crypto - -import Control.Monad.IO.Class -import Data.Kind (Type) -import GHC.Stack (HasCallStack) -import System.Random (StdGen) -import System.Random qualified as Random - --- | An interface for cryptographic keys used for signatures with a 'SigningKey' --- and a 'VerificationKey' key. --- --- This interface does not provide actual signing or verifying functions since --- this API is concerned with the management of keys: generating and --- serialising. -class - ( Eq (VerificationKey keyrole) - , Show (VerificationKey keyrole) - , SerialiseAsRawBytes (Hash keyrole) - , HasTextEnvelope (VerificationKey keyrole) - , HasTextEnvelope (SigningKey keyrole) - ) => - Key keyrole - where - -- | The type of cryptographic verification key, for each key role. - data VerificationKey keyrole :: Type - - -- | The type of cryptographic signing key, for each key role. - data SigningKey keyrole :: Type - - -- | Get the corresponding verification key from a signing key. - getVerificationKey - :: () - => HasTypeProxy keyrole - => SigningKey keyrole - -> VerificationKey keyrole - - -- | Generate a 'SigningKey' deterministically, given a 'Crypto.Seed'. The - -- required size of the seed is given by 'deterministicSigningKeySeedSize'. - deterministicSigningKey :: AsType keyrole -> Crypto.Seed -> SigningKey keyrole - - deterministicSigningKeySeedSize :: AsType keyrole -> Word - - verificationKeyHash :: VerificationKey keyrole -> Hash keyrole - --- TODO: We should move this into the Key type class, with the existing impl as the default impl. --- For KES we can then override it to keep the seed and key in mlocked memory at all times. - --- | Generate a 'SigningKey' using a seed from operating system entropy. -generateSigningKey - :: MonadIO m - => Key keyrole - => AsType keyrole - -> m (SigningKey keyrole) -generateSigningKey keytype = do - seed <- liftIO $ Crypto.readSeedFromSystemEntropy seedSize - return $! deterministicSigningKey keytype seed - where - seedSize = deterministicSigningKeySeedSize keytype - -generateInsecureSigningKey - :: HasCallStack - => MonadIO m - => Key keyrole - => SerialiseAsRawBytes (SigningKey keyrole) - => StdGen - -> AsType keyrole - -> m (SigningKey keyrole, StdGen) -generateInsecureSigningKey g keytype = do - let (bs, g') = Random.uniformByteString (fromIntegral $ deterministicSigningKeySeedSize keytype) g - case deserialiseFromRawBytes (AsSigningKey keytype) bs of - Right key -> return (key, g') - Left (SerialiseAsRawBytesError msg) -> error $ "generateInsecureSigningKey: Unable to generate insecure key: " <> msg - -instance HasTypeProxy a => HasTypeProxy (VerificationKey a) where - data AsType (VerificationKey a) = AsVerificationKey (AsType a) - proxyToAsType _ = AsVerificationKey (proxyToAsType (Proxy :: Proxy a)) - -instance HasTypeProxy a => HasTypeProxy (SigningKey a) where - data AsType (SigningKey a) = AsSigningKey (AsType a) - proxyToAsType _ = AsSigningKey (proxyToAsType (Proxy :: Proxy a)) - --- | Some key roles share the same representation and it is sometimes --- legitimate to change the role of a key. -class CastVerificationKeyRole keyroleA keyroleB where - -- | Change the role of a 'VerificationKey', if the representation permits. - castVerificationKey :: VerificationKey keyroleA -> VerificationKey keyroleB - -class CastSigningKeyRole keyroleA keyroleB where - -- | Change the role of a 'SigningKey', if the representation permits. - castSigningKey :: SigningKey keyroleA -> SigningKey keyroleB +import Cardano.Keys.Class diff --git a/cardano-api/src/Cardano/Api/Key/Internal/Leios.hs b/cardano-api/src/Cardano/Api/Key/Internal/Leios.hs index dd7cc93f48..7775c48b53 100644 --- a/cardano-api/src/Cardano/Api/Key/Internal/Leios.hs +++ b/cardano-api/src/Cardano/Api/Key/Internal/Leios.hs @@ -1,218 +1,9 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DerivingVia #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} - -- | Leios specific key types and their 'Key' class instances +-- +-- This module now lives in the cardano-keys package; re-exported here for compatibility. module Cardano.Api.Key.Internal.Leios - ( -- * Key types - BlsKey - - -- * Data family instances - , AsType (..) - , Hash (..) - , VerificationKey (..) - , SigningKey (..) - - -- * Possession proof - , BlsPossessionProof - , blsPossessionProof - , createBlsPossessionProof + ( module Cardano.Keys.Leios ) where -import Cardano.Api.HasTypeProxy -import Cardano.Api.Hash -import Cardano.Api.Key.Internal.Class -import Cardano.Api.Pretty -import Cardano.Api.Serialise.Bech32 -import Cardano.Api.Serialise.Cbor -import Cardano.Api.Serialise.Raw -import Cardano.Api.Serialise.SerialiseUsing -import Cardano.Api.Serialise.TextEnvelope.Internal - -import Cardano.Binary.FixedSizeCodec qualified as Crypto -import Cardano.Crypto.DSIGN.BLS12381 qualified as Crypto -import Cardano.Crypto.DSIGN.Class qualified as Crypto -import Cardano.Crypto.Hash.Class qualified as Crypto -import Cardano.Ledger.Hashes (HASH) - -import Data.ByteString (ByteString) -import Data.Either.Combinators (maybeToRight) -import Data.String (IsString (..)) - --- | BLS keys. To participate in the Leios protocol as voting member/block producing node, stake pool operators must --- register one additional cryptographic key for the voting scheme alongside their existing VRF and KES keys. --- In this implementation, the BLS key is over the BLS12-381 elliptic curve. --- --- The reason we use BLS keys for the voting scheme of Leios is that they support signature aggregation, which allows --- multiple signature to be combined resulting in a single signature that is compact. -data BlsKey - -instance HasTypeProxy BlsKey where - data AsType BlsKey = AsBlsKey - proxyToAsType _ = AsBlsKey - -instance Key BlsKey where - newtype VerificationKey BlsKey - = BlsVerificationKey (Crypto.VerKeyDSIGN Crypto.BLS12381MinSigDSIGN) - deriving stock Eq - deriving (Show, Pretty) via UsingRawBytesHex (VerificationKey BlsKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - newtype SigningKey BlsKey - = BlsSigningKey (Crypto.SignKeyDSIGN Crypto.BLS12381MinSigDSIGN) - deriving (Show, Pretty) via UsingRawBytesHex (SigningKey BlsKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - deterministicSigningKey :: AsType BlsKey -> Crypto.Seed -> SigningKey BlsKey - deterministicSigningKey AsBlsKey = - BlsSigningKey . Crypto.genKeyDSIGN - - deterministicSigningKeySeedSize :: AsType BlsKey -> Word - deterministicSigningKeySeedSize AsBlsKey = - Crypto.seedSizeDSIGN proxy - where - proxy :: Proxy Crypto.BLS12381MinSigDSIGN - proxy = Proxy - - getVerificationKey :: SigningKey BlsKey -> VerificationKey BlsKey - getVerificationKey (BlsSigningKey sk) = - BlsVerificationKey (Crypto.deriveVerKeyDSIGN sk) - - verificationKeyHash :: VerificationKey BlsKey -> Hash BlsKey - verificationKeyHash (BlsVerificationKey vkey) = - BlsKeyHash (Crypto.hashVerKeyDSIGN vkey) - -instance SerialiseAsRawBytes (VerificationKey BlsKey) where - serialiseToRawBytes (BlsVerificationKey vk) = - Crypto.rawEncodeFixedSized vk - - deserialiseFromRawBytes (AsVerificationKey AsBlsKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise VerificationKey BlsKey") $ - BlsVerificationKey <$> Crypto.rawDecodeFixedSized bs - -instance SerialiseAsRawBytes (SigningKey BlsKey) where - serialiseToRawBytes (BlsSigningKey sk) = - Crypto.rawEncodeFixedSized sk - - deserialiseFromRawBytes (AsSigningKey AsBlsKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise SigningKey BlsKey") $ - BlsSigningKey <$> Crypto.rawDecodeFixedSized bs - -instance SerialiseAsBech32 (VerificationKey BlsKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "bls_vk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["bls_vk"] - -instance SerialiseAsBech32 (SigningKey BlsKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "bls_sk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["bls_sk"] - -newtype instance Hash BlsKey - = BlsKeyHash - ( Crypto.Hash - HASH - (Crypto.VerKeyDSIGN Crypto.BLS12381MinSigDSIGN) - ) - deriving stock (Eq, Ord) - deriving (Show, Pretty) via UsingRawBytesHex (Hash BlsKey) - deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash BlsKey) - deriving anyclass SerialiseAsCBOR - -instance SerialiseAsRawBytes (Hash BlsKey) where - serialiseToRawBytes (BlsKeyHash vkh) = - Crypto.hashToBytes vkh - - deserialiseFromRawBytes (AsHash AsBlsKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash BlsKey") $ - BlsKeyHash <$> Crypto.hashFromBytes bs - -instance HasTextEnvelope (VerificationKey BlsKey) where - textEnvelopeType :: AsType (VerificationKey BlsKey) -> TextEnvelopeType - textEnvelopeType _ = - "BlsVerificationKey_" - <> fromString (Crypto.algorithmNameDSIGN proxy) - where - proxy :: Proxy Crypto.BLS12381MinSigDSIGN - proxy = Proxy - - textEnvelopeDefaultDescr :: VerificationKey BlsKey -> TextEnvelopeDescr - textEnvelopeDefaultDescr _ = "BLS12-381 verification key" - -instance HasTextEnvelope (SigningKey BlsKey) where - textEnvelopeType :: AsType (SigningKey BlsKey) -> TextEnvelopeType - textEnvelopeType _ = - "BlsSigningKey_" - <> fromString (Crypto.algorithmNameDSIGN proxy) - where - proxy :: Proxy Crypto.BLS12381MinSigDSIGN - proxy = Proxy - - textEnvelopeDefaultDescr :: SigningKey BlsKey -> TextEnvelopeDescr - textEnvelopeDefaultDescr _ = "BLS12-381 signing key" - --- | BlsPossessionProof is used in the Leios protocol to prove ownership of a BLS signing key --- when registering a BLS verification key for a stake pool. This is required to prevent malicious --- actors from registering a BLS verification key for a stake pool without actually owning the --- corresponding signing key. -newtype BlsPossessionProof = BlsPossessionProof (Crypto.PossessionProofDSIGN Crypto.BLS12381MinSigDSIGN) - deriving stock Eq - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - -instance Show BlsPossessionProof where - show p = "blsPossessionProof " ++ show (serialiseToRawBytesHex p) - -instance Pretty BlsPossessionProof where - pretty p = "blsPossessionProof" <+> pretty (serialiseToRawBytesHexText p) - -instance SerialiseAsRawBytes BlsPossessionProof where - serialiseToRawBytes (BlsPossessionProof proof) = - Crypto.rawEncodeFixedSized proof - - deserialiseFromRawBytes AsBlsPossessionProof bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise BlsPossessionProof") $ - BlsPossessionProof <$> Crypto.rawDecodeFixedSized bs - --- | Construct a 'BlsPossessionProof' from a hex-encoded raw 'ByteString'. --- --- This is a partial function that calls 'error' if the input is not valid. --- It is intended to be used with the output of 'show' or 'pretty' to --- reconstruct a 'BlsPossessionProof' value. -blsPossessionProof :: ByteString -> BlsPossessionProof -blsPossessionProof hexBs = - case deserialiseFromRawBytesHex hexBs of - Left e -> error $ "blsPossessionProof: " ++ show e - Right p -> p - --- | Create a proof of possession for a BLS signing key. --- --- This proof demonstrates that the holder of a BLS verification key knows the corresponding --- secret key, which is required before the key can safely participate in signature aggregation. --- Without this proof, an attacker could register a crafted verification key that cancels out --- honest participants' keys during aggregation (a rogue key attack). -createBlsPossessionProof :: SigningKey BlsKey -> BlsPossessionProof -createBlsPossessionProof (BlsSigningKey sk) = - BlsPossessionProof (Crypto.createPossessionProofDSIGN Crypto.minSigPoPDST sk) - -instance HasTypeProxy BlsPossessionProof where - data AsType BlsPossessionProof = AsBlsPossessionProof - proxyToAsType _ = AsBlsPossessionProof - -instance HasTextEnvelope BlsPossessionProof where - textEnvelopeType :: AsType BlsPossessionProof -> TextEnvelopeType - textEnvelopeType _ = - "BlsPossessionProof_" - <> fromString (Crypto.algorithmNameDSIGN proxy) - where - proxy :: Proxy Crypto.BLS12381MinSigDSIGN - proxy = Proxy - - textEnvelopeDefaultDescr :: BlsPossessionProof -> TextEnvelopeDescr - textEnvelopeDefaultDescr _ = "BLS12-381 possession proof" +import Cardano.Keys.Leios diff --git a/cardano-api/src/Cardano/Api/Key/Internal/Praos.hs b/cardano-api/src/Cardano/Api/Key/Internal/Praos.hs index f918f8f0e2..adb8d6f33f 100644 --- a/cardano-api/src/Cardano/Api/Key/Internal/Praos.hs +++ b/cardano-api/src/Cardano/Api/Key/Internal/Praos.hs @@ -1,257 +1,9 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DerivingVia #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} - -- | Praos consensus key types and their 'Key' class instances +-- +-- This module now lives in the cardano-keys package; re-exported here for compatibility. module Cardano.Api.Key.Internal.Praos - ( -- * Key types - KesKey - , VrfKey - - -- * Data family instances - , AsType (..) - , Hash (..) - , VerificationKey (..) - , SigningKey (..) - - -- * Signing - , signArbitraryBytesKes + ( module Cardano.Keys.Praos ) where -import Cardano.Api.HasTypeProxy -import Cardano.Api.Hash -import Cardano.Api.Key.Internal.Class -import Cardano.Api.Pretty -import Cardano.Api.Serialise.Bech32 -import Cardano.Api.Serialise.Cbor -import Cardano.Api.Serialise.Raw -import Cardano.Api.Serialise.SerialiseUsing -import Cardano.Api.Serialise.TextEnvelope.Internal - -import Cardano.Binary.FixedSizeCodec qualified as Crypto -import Cardano.Crypto.DSIGN.Class qualified as Crypto -import Cardano.Crypto.Hash.Class qualified as Crypto -import Cardano.Crypto.KES.Class qualified as Crypto -import Cardano.Crypto.VRF.Class qualified as Crypto -import Cardano.Ledger.Hashes (HASH) -import Cardano.Protocol.Crypto (KES, StandardCrypto, VRF) - -import Data.ByteString (ByteString) -import Data.Either.Combinators (maybeToRight) -import Data.String (IsString (..)) - --- --- KES keys --- - -data KesKey - -instance HasTypeProxy KesKey where - data AsType KesKey = AsKesKey - proxyToAsType _ = AsKesKey - -instance Key KesKey where - newtype VerificationKey KesKey - = KesVerificationKey (Crypto.VerKeyKES (KES StandardCrypto)) - deriving stock Eq - deriving (Show, Pretty) via UsingRawBytesHex (VerificationKey KesKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - newtype SigningKey KesKey - = KesSigningKey (Crypto.UnsoundPureSignKeyKES (KES StandardCrypto)) - deriving (Show, Pretty) via UsingRawBytesHex (SigningKey KesKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - -- This loses the mlock safety of the seed, since it starts from a normal in-memory seed. - deterministicSigningKey :: AsType KesKey -> Crypto.Seed -> SigningKey KesKey - deterministicSigningKey AsKesKey = - KesSigningKey . Crypto.unsoundPureGenKeyKES - - deterministicSigningKeySeedSize :: AsType KesKey -> Word - deterministicSigningKeySeedSize AsKesKey = - Crypto.seedSizeKES proxy - where - proxy :: Proxy (KES StandardCrypto) - proxy = Proxy - - getVerificationKey :: SigningKey KesKey -> VerificationKey KesKey - getVerificationKey (KesSigningKey sk) = - KesVerificationKey (Crypto.unsoundPureDeriveVerKeyKES sk) - - verificationKeyHash :: VerificationKey KesKey -> Hash KesKey - verificationKeyHash (KesVerificationKey vkey) = - KesKeyHash (Crypto.hashVerKeyKES vkey) - -instance SerialiseAsRawBytes (VerificationKey KesKey) where - serialiseToRawBytes (KesVerificationKey vk) = - Crypto.rawEncodeFixedSized vk - - deserialiseFromRawBytes (AsVerificationKey AsKesKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise VerificationKey KesKey") $ - KesVerificationKey <$> Crypto.rawDecodeFixedSized bs - -instance SerialiseAsRawBytes (SigningKey KesKey) where - serialiseToRawBytes (KesSigningKey sk) = - Crypto.rawEncodeFixedSized sk - - deserialiseFromRawBytes (AsSigningKey AsKesKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise SigningKey KesKey") $ - KesSigningKey <$> Crypto.rawDecodeFixedSized bs - -instance SerialiseAsBech32 (VerificationKey KesKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "kes_vk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["kes_vk"] - -instance SerialiseAsBech32 (SigningKey KesKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "kes_sk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["kes_sk"] - -newtype instance Hash KesKey - = KesKeyHash - ( Crypto.Hash - HASH - (Crypto.VerKeyKES (KES StandardCrypto)) - ) - deriving stock (Eq, Ord) - deriving (Show, Pretty) via UsingRawBytesHex (Hash KesKey) - deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash KesKey) - deriving anyclass SerialiseAsCBOR - -instance SerialiseAsRawBytes (Hash KesKey) where - serialiseToRawBytes (KesKeyHash vkh) = - Crypto.hashToBytes vkh - - deserialiseFromRawBytes (AsHash AsKesKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash KesKey") $ - KesKeyHash <$> Crypto.hashFromBytes bs - -instance HasTextEnvelope (VerificationKey KesKey) where - textEnvelopeType _ = - "KesVerificationKey_" - <> fromString (Crypto.algorithmNameKES proxy) - where - proxy :: Proxy (KES StandardCrypto) - proxy = Proxy - -instance HasTextEnvelope (SigningKey KesKey) where - textEnvelopeType _ = - "KesSigningKey_" - <> fromString (Crypto.algorithmNameKES proxy) - where - proxy :: Proxy (KES StandardCrypto) - proxy = Proxy - -signArbitraryBytesKes - :: SigningKey KesKey - -> Crypto.Period - -- ^ Desired Kes period - -> ByteString - -- ^ Message to sign - -> Crypto.SignedKES (KES StandardCrypto) ByteString -signArbitraryBytesKes (KesSigningKey kesKey) period message = - Crypto.unsoundPureSignedKES @(KES StandardCrypto) () period message kesKey - --- --- VRF keys --- - -data VrfKey - -instance HasTypeProxy VrfKey where - data AsType VrfKey = AsVrfKey - proxyToAsType _ = AsVrfKey - -instance Key VrfKey where - newtype VerificationKey VrfKey - = VrfVerificationKey (Crypto.VerKeyVRF (VRF StandardCrypto)) - deriving stock Eq - deriving (Show, Pretty) via UsingRawBytesHex (VerificationKey VrfKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - newtype SigningKey VrfKey - = VrfSigningKey (Crypto.SignKeyVRF (VRF StandardCrypto)) - deriving (Show, Pretty) via UsingRawBytesHex (SigningKey VrfKey) - deriving newtype (ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR - - deterministicSigningKey :: AsType VrfKey -> Crypto.Seed -> SigningKey VrfKey - deterministicSigningKey AsVrfKey seed = - VrfSigningKey (Crypto.genKeyVRF seed) - - deterministicSigningKeySeedSize :: AsType VrfKey -> Word - deterministicSigningKeySeedSize AsVrfKey = - Crypto.seedSizeVRF proxy - where - proxy :: Proxy (VRF StandardCrypto) - proxy = Proxy - - getVerificationKey :: SigningKey VrfKey -> VerificationKey VrfKey - getVerificationKey (VrfSigningKey sk) = - VrfVerificationKey (Crypto.deriveVerKeyVRF sk) - - verificationKeyHash :: VerificationKey VrfKey -> Hash VrfKey - verificationKeyHash (VrfVerificationKey vkey) = - VrfKeyHash (Crypto.hashVerKeyVRF vkey) - -instance SerialiseAsRawBytes (VerificationKey VrfKey) where - serialiseToRawBytes (VrfVerificationKey vk) = - Crypto.rawEncodeFixedSized vk - - deserialiseFromRawBytes (AsVerificationKey AsVrfKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise VerificationKey VrfKey") $ - VrfVerificationKey <$> Crypto.rawDecodeFixedSized bs - -instance SerialiseAsRawBytes (SigningKey VrfKey) where - serialiseToRawBytes (VrfSigningKey sk) = - Crypto.rawEncodeFixedSized sk - - deserialiseFromRawBytes (AsSigningKey AsVrfKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise SigningKey VrfKey") $ - VrfSigningKey <$> Crypto.rawDecodeFixedSized bs - -instance SerialiseAsBech32 (VerificationKey VrfKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "vrf_vk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["vrf_vk"] - -instance SerialiseAsBech32 (SigningKey VrfKey) where - bech32PrefixFor _ = unsafeHumanReadablePartFromText "vrf_sk" - bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["vrf_sk"] - -newtype instance Hash VrfKey - = VrfKeyHash - { unVrfKeyHash :: Crypto.Hash HASH (Crypto.VerKeyVRF (VRF StandardCrypto)) - } - deriving stock (Eq, Ord) - deriving (Show, Pretty) via UsingRawBytesHex (Hash VrfKey) - deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash VrfKey) - deriving anyclass SerialiseAsCBOR - -instance SerialiseAsRawBytes (Hash VrfKey) where - serialiseToRawBytes (VrfKeyHash vkh) = - Crypto.hashToBytes vkh - - deserialiseFromRawBytes (AsHash AsVrfKey) bs = - maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash VrfKey") $ - VrfKeyHash <$> Crypto.hashFromBytes bs - -instance HasTextEnvelope (VerificationKey VrfKey) where - textEnvelopeType _ = "VrfVerificationKey_" <> fromString (Crypto.algorithmNameVRF proxy) - where - proxy :: Proxy (VRF StandardCrypto) - proxy = Proxy - -instance HasTextEnvelope (SigningKey VrfKey) where - textEnvelopeType _ = "VrfSigningKey_" <> fromString (Crypto.algorithmNameVRF proxy) - where - proxy :: Proxy (VRF StandardCrypto) - proxy = Proxy +import Cardano.Keys.Praos diff --git a/cardano-api/src/Cardano/Api/Serialise/Bech32.hs b/cardano-api/src/Cardano/Api/Serialise/Bech32.hs index 299b0f5112..0fe9c52c19 100644 --- a/cardano-api/src/Cardano/Api/Serialise/Bech32.hs +++ b/cardano-api/src/Cardano/Api/Serialise/Bech32.hs @@ -1,189 +1,18 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-orphans #-} -- | Bech32 Serialisation +-- +-- The types and functions of this module now live in the cardano-keys package; +-- re-exported here for compatibility, together with the 'Error' instance this +-- API adds on top of them. module Cardano.Api.Serialise.Bech32 - ( SerialiseAsBech32 (..) - , serialiseToBech32 - , Bech32DecodeError (..) - , deserialiseFromBech32 - , deserialiseAnyOfFromBech32 - , unsafeHumanReadablePartFromText + ( module Cardano.Keys.Serialise.Bech32 ) where -import Cardano.Api.Error -import Cardano.Api.HasTypeProxy -import Cardano.Api.Internal.Orphans.Misc () -import Cardano.Api.Monad.Error -import Cardano.Api.Pretty -import Cardano.Api.Serialise.Raw +import Cardano.Api.Error (Error (..)) -import Codec.Binary.Bech32 qualified as Bech32 -import Control.Monad (guard) -import Data.ByteString (ByteString) -import Data.Data (Data) -import Data.List qualified as List -import Data.Set (Set) -import Data.Text.Encoding.Error (UnicodeException) -import GHC.Exts (IsList (..)) -import GHC.Stack - -class (HasTypeProxy a, SerialiseAsRawBytes a) => SerialiseAsBech32 a where - -- | The human readable prefix to use when encoding this value to Bech32. - bech32PrefixFor :: a -> Bech32.HumanReadablePart - - -- | The set of human readable prefixes that can be used for this type. - bech32PrefixesPermitted :: AsType a -> [Bech32.HumanReadablePart] - -serialiseToBech32 :: SerialiseAsBech32 a => a -> Text -serialiseToBech32 a = - Bech32.encodeLenient - (bech32PrefixFor a) - (Bech32.dataPartFromBytes (serialiseToRawBytes a)) - -deserialiseFromBech32 - :: forall a - . SerialiseAsBech32 a - => Text -> Either Bech32DecodeError a -deserialiseFromBech32 bech32Str = do - (prefix, dataPart) <- - Bech32.decodeLenient bech32Str - ?!& Bech32DecodingError - - let actualPrefix = Bech32.humanReadablePartToText prefix - permittedPrefixes = bech32PrefixesPermitted (asType @a) - guard (prefix `elem` permittedPrefixes) - ?! Bech32UnexpectedPrefix - actualPrefix - (fromList $ Bech32.humanReadablePartToText <$> permittedPrefixes) - - payload <- - Bech32.dataPartToBytes dataPart - ?! Bech32DataPartToBytesError (Bech32.dataPartToText dataPart) - - value <- case deserialiseFromRawBytes asType payload of - Right a -> Right a - Left _ -> Left $ Bech32DeserialiseFromBytesError payload - - let expectedPrefix = Bech32.humanReadablePartToText $ bech32PrefixFor value - guard (actualPrefix == expectedPrefix) - ?! Bech32WrongPrefix actualPrefix expectedPrefix - - return value - -deserialiseAnyOfFromBech32 - :: forall b - . [FromSomeType SerialiseAsBech32 b] - -> Text - -> Either Bech32DecodeError b -deserialiseAnyOfFromBech32 types bech32Str = do - (prefix, dataPart) <- - Bech32.decodeLenient bech32Str - ?!& Bech32DecodingError - - let actualPrefix = Bech32.humanReadablePartToText prefix - - FromSomeType actualType fromType <- - findForPrefix prefix - ?! Bech32UnexpectedPrefix - actualPrefix - (fromList $ Bech32.humanReadablePartToText <$> permittedPrefixes) - - payload <- - Bech32.dataPartToBytes dataPart - ?! Bech32DataPartToBytesError (Bech32.dataPartToText dataPart) - - value <- case deserialiseFromRawBytes actualType payload of - Right a -> Right a - Left _ -> Left $ Bech32DeserialiseFromBytesError payload - - let expectedPrefix = Bech32.humanReadablePartToText $ bech32PrefixFor value - guard (actualPrefix == expectedPrefix) - ?! Bech32WrongPrefix actualPrefix expectedPrefix - - return (fromType value) - where - findForPrefix - :: Bech32.HumanReadablePart - -> Maybe (FromSomeType SerialiseAsBech32 b) - findForPrefix prefix = - List.find - (\(FromSomeType t _) -> prefix `elem` bech32PrefixesPermitted t) - types - - permittedPrefixes :: [Bech32.HumanReadablePart] - permittedPrefixes = - concat - [ bech32PrefixesPermitted ttoken - | FromSomeType ttoken _f <- types - ] - --- | The human readable part of the Bech32 encoding for the credential. This will --- error if the prefix is not valid. -unsafeHumanReadablePartFromText :: HasCallStack => Text -> Bech32.HumanReadablePart -unsafeHumanReadablePartFromText = - either (error . ("unsafeHumanReadablePartFromText: Error while parsing Bech32: " <>) . show) id - . Bech32.humanReadablePartFromText - --- | Bech32 decoding error. -data Bech32DecodeError - = -- | There was an error decoding the string as Bech32. - Bech32DecodingError !Bech32.DecodingError - | -- | The human-readable prefix in the Bech32-encoded string is not one - -- of the ones expected. - Bech32UnexpectedPrefix !Text !(Set Text) - | -- | There was an error in extracting a 'ByteString' from the data part of - -- the Bech32-encoded string. - Bech32DataPartToBytesError !Text - | -- | There was an error in deserialising the bytes into a value of the - -- expected type. - Bech32DeserialiseFromBytesError !ByteString - | -- | The human-readable prefix in the Bech32-encoded string does not - -- correspond to the prefix that should be used for the payload value. - Bech32WrongPrefix !Text !Text - | Bech32UnexpectedHeader - !Text - -- ^ Expected header - !Text - -- ^ Unexpected header - | -- | The input is not valid UTF-8, so it cannot be a Bech32-encoded - -- string. The field contains the UTF-8 decoding error. - Bech32InvalidUtf8 !UnicodeException - deriving (Eq, Show, Data) +import Cardano.Keys.Serialise.Bech32 instance Error Bech32DecodeError where - prettyError = \case - Bech32DecodingError decErr -> - pshow decErr -- TODO - Bech32UnexpectedPrefix actual permitted -> - mconcat - [ "Unexpected Bech32 prefix: the actual prefix is " <> pshow actual - , ", but it was expected to be " - , mconcat $ List.intersperse " or " (map pshow (toList permitted)) - ] - Bech32DataPartToBytesError _dataPart -> - mconcat - [ "There was an error in extracting the bytes from the data part of the " - , "Bech32-encoded string." - ] - Bech32DeserialiseFromBytesError _bytes -> - mconcat - [ "There was an error in deserialising the data part of the " - , "Bech32-encoded string into a value of the expected type." - ] - Bech32WrongPrefix actual expected -> - mconcat - [ "Mismatch in the Bech32 prefix: the actual prefix is " <> pshow actual - , ", but the prefix for this payload value should be " <> pshow expected - ] - Bech32UnexpectedHeader expected actual -> - mconcat - [ "Unexpected CIP-129 Bech32 header: the actual header is " <> pshow actual - , ", but it was expected to be " <> pshow expected - ] - Bech32InvalidUtf8 decodeErr -> - "The Bech32-encoded string is not valid UTF-8: " <> prettyError decodeErr + prettyError = renderBech32DecodeError diff --git a/cardano-api/src/Cardano/Api/Serialise/Cbor.hs b/cardano-api/src/Cardano/Api/Serialise/Cbor.hs index 0fbe6a051d..37889c3636 100644 --- a/cardano-api/src/Cardano/Api/Serialise/Cbor.hs +++ b/cardano-api/src/Cardano/Api/Serialise/Cbor.hs @@ -1,31 +1,9 @@ -{-# LANGUAGE DefaultSignatures #-} - -- | CBOR serialisation +-- +-- This module now lives in the cardano-keys package; re-exported here for compatibility. module Cardano.Api.Serialise.Cbor - ( SerialiseAsCBOR (..) - , FromCBOR (..) - , ToCBOR (..) - , CBOR.DecoderError (..) + ( module Cardano.Keys.Serialise.Cbor ) where -import Cardano.Api.HasTypeProxy - -import Cardano.Binary (FromCBOR, ToCBOR) -import Cardano.Binary qualified as CBOR - -import Data.ByteString (ByteString) - -class HasTypeProxy a => SerialiseAsCBOR a where - serialiseToCBOR :: a -> ByteString - deserialiseFromCBOR :: AsType a -> ByteString -> Either CBOR.DecoderError a - - default serialiseToCBOR :: ToCBOR a => a -> ByteString - serialiseToCBOR = CBOR.serialize' - - default deserialiseFromCBOR - :: FromCBOR a - => AsType a - -> ByteString - -> Either CBOR.DecoderError a - deserialiseFromCBOR _proxy = CBOR.decodeFull' +import Cardano.Keys.Serialise.Cbor diff --git a/cardano-api/src/Cardano/Api/Serialise/Raw.hs b/cardano-api/src/Cardano/Api/Serialise/Raw.hs index 71d8119eba..1c281f65f4 100644 --- a/cardano-api/src/Cardano/Api/Serialise/Raw.hs +++ b/cardano-api/src/Cardano/Api/Serialise/Raw.hs @@ -1,117 +1,22 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-orphans #-} -- | Raw binary serialisation +-- +-- The types and functions of this module now live in the cardano-keys package; +-- re-exported here for compatibility, together with the 'Error' instances and +-- the parser this API adds on top of them. module Cardano.Api.Serialise.Raw - ( SerialiseAsRawBytes (..) - , serialiseToRawBytesHex - , deserialiseFromRawBytesHex - , serialiseToRawBytesHexText + ( module Cardano.Keys.Serialise.Raw , parseRawBytesHex - , RawBytesHexError (..) - , SerialiseAsRawBytesError (..) ) where -import Cardano.Api.Error (Error, failEitherError, prettyError) -import Cardano.Api.HasTypeProxy -import Cardano.Api.Monad.Error (MonadError (..)) +import Cardano.Api.Error (Error (..), failEitherError) import Cardano.Api.Parser.Text qualified as P -import Cardano.Api.Pretty -import Data.Bifunctor (Bifunctor (..)) -import Data.Bits (Bits (..), FiniteBits (finiteBitSize)) -import Data.ByteString qualified as BS -import Data.ByteString.Base16 qualified as Base16 -import Data.ByteString.Builder qualified as BSB -import Data.ByteString.Char8 (ByteString) -import Data.ByteString.Char8 qualified as BSC -import Data.ByteString.Lazy qualified as BSL -import Data.Data (typeRep) -import Data.Text qualified as Text -import Data.Text.Encoding qualified as Text -import Data.Typeable (TypeRep, Typeable) -import Data.Word (Word16, Word32, Word64, Word8) -import Numeric.Natural (Natural) - -class (HasTypeProxy a, Typeable a) => SerialiseAsRawBytes a where - serialiseToRawBytes :: a -> ByteString - - deserialiseFromRawBytes :: AsType a -> ByteString -> Either SerialiseAsRawBytesError a - -instance SerialiseAsRawBytes Word8 where - serialiseToRawBytes = BS.singleton - deserialiseFromRawBytes AsWord8 = deserialiseWord - -instance SerialiseAsRawBytes Word16 where - serialiseToRawBytes = BS.toStrict . BSB.toLazyByteString . BSB.word16BE - deserialiseFromRawBytes AsWord16 = deserialiseWord - -instance SerialiseAsRawBytes Word32 where - serialiseToRawBytes = BS.toStrict . BSB.toLazyByteString . BSB.word32BE - deserialiseFromRawBytes AsWord32 = deserialiseWord - -instance SerialiseAsRawBytes Word64 where - serialiseToRawBytes = BS.toStrict . BSB.toLazyByteString . BSB.word64BE - deserialiseFromRawBytes AsWord64 = deserialiseWord - --- | Deserialise any length number. Does not require the input to have the byte length of the target type. -deserialiseWord - :: forall a - . (FiniteBits a, Typeable a, Num a) - => ByteString - -- ^ bytes representation of the number - -> Either SerialiseAsRawBytesError a -deserialiseWord bs - | BS.null bs = - throwError $ - SerialiseAsRawBytesError $ - "Cannot deserialise empty bytes into " <> typeName - | BS.length bs > maxBytes = - throwError $ - SerialiseAsRawBytesError $ - "Cannot decode " <> typeName <> ": Value too large (hex):" <> BSC.unpack (Base16.encode bs) - | otherwise = - pure $ BS.foldl' (\acc b -> acc `shiftL` 8 .|. fromIntegral b) 0 bs - where - maxBytes = finiteBitSize (zeroBits @a) `div` 8 - typeName = show $ typeRep (Proxy @a) +import Cardano.Keys.Serialise.Raw --- | Convert the number into binary value -instance SerialiseAsRawBytes Natural where - serialiseToRawBytes 0 = BS.singleton 0x00 - serialiseToRawBytes n = BS.toStrict . BSB.toLazyByteString $ go n mempty - where - go 0 acc = acc - go x acc = go (x `shiftR` 8) (BSB.word8 (fromIntegral (x .&. 0xFF)) <> acc) - deserialiseFromRawBytes AsNatural "\x00" = pure 0 - deserialiseFromRawBytes AsNatural input = pure $ BS.foldl' (\acc byte -> acc `shiftL` 8 .|. fromIntegral byte) 0 input - -instance SerialiseAsRawBytes BS.ByteString where - serialiseToRawBytes = id - deserialiseFromRawBytes AsByteString = pure - -instance SerialiseAsRawBytes BSL.ByteString where - serialiseToRawBytes = BSL.toStrict - deserialiseFromRawBytes AsByteStringLazy = pure . BSL.fromStrict - -serialiseToRawBytesHex :: SerialiseAsRawBytes a => a -> ByteString -serialiseToRawBytesHex = Base16.encode . serialiseToRawBytes - -serialiseToRawBytesHexText :: SerialiseAsRawBytes a => a -> Text -serialiseToRawBytesHexText = Text.decodeUtf8 . serialiseToRawBytesHex - -deserialiseFromRawBytesHex - :: forall a - . SerialiseAsRawBytes a - => ByteString -> Either RawBytesHexError a -deserialiseFromRawBytesHex hex = do - let type' = typeRep $ asType @a - raw <- first (RawBytesHexErrorBase16DecodeFail hex type') $ Base16.decode hex - first (RawBytesHexErrorRawBytesDecodeFail hex type') $ - deserialiseFromRawBytes asType raw +import Data.ByteString.Char8 qualified as BSC -- | Parse hex representation of a value parseRawBytesHex :: SerialiseAsRawBytes a => P.Parser a @@ -119,45 +24,8 @@ parseRawBytesHex = do input <- P.many P.hexDigit failEitherError . deserialiseFromRawBytesHex $ BSC.pack input --- | The errors that the pure 'SerialiseAsRawBytes' parsing\/decoding functions can return. -data RawBytesHexError - = RawBytesHexErrorBase16DecodeFail - ByteString - -- ^ original input - TypeRep - -- ^ expected type - String - -- ^ error message - | RawBytesHexErrorRawBytesDecodeFail - ByteString - -- ^ original input - TypeRep - -- ^ expected type - SerialiseAsRawBytesError - -- ^ error message - deriving Show - instance Error RawBytesHexError where - prettyError = \case - RawBytesHexErrorBase16DecodeFail input typeRep' message -> - "Failed to deserialise " - <> pshow typeRep' - <> ". Expected Base16-encoded bytestring, but got " - <> pretty (toText input) - <> "; " - <> pretty message - RawBytesHexErrorRawBytesDecodeFail input typeRep' (SerialiseAsRawBytesError e) -> - "Failed to deserialise " <> pretty (toText input) <> " as " <> pshow typeRep' <> ": " <> pretty e - where - toText bs = case Text.decodeUtf8' bs of - Right t -> Text.unpack t - Left _ -> show bs - -newtype SerialiseAsRawBytesError = SerialiseAsRawBytesError - -- TODO We can do better than use String to carry the error message - { unSerialiseAsRawBytesError :: String - } - deriving (Eq, Show) + prettyError = renderRawBytesHexError instance Error SerialiseAsRawBytesError where - prettyError = pshow . unSerialiseAsRawBytesError + prettyError = renderSerialiseAsRawBytesError diff --git a/cardano-api/src/Cardano/Api/Serialise/SerialiseUsing.hs b/cardano-api/src/Cardano/Api/Serialise/SerialiseUsing.hs index 58b73576e7..20791c42fd 100644 --- a/cardano-api/src/Cardano/Api/Serialise/SerialiseUsing.hs +++ b/cardano-api/src/Cardano/Api/Serialise/SerialiseUsing.hs @@ -1,113 +1,10 @@ -{-# LANGUAGE ScopedTypeVariables #-} - -- | Raw binary serialisation +-- +-- This module now lives in the cardano-keys package, as +-- @Cardano.Keys.Serialise.Using@; re-exported here for compatibility. module Cardano.Api.Serialise.SerialiseUsing - ( UsingRawBytes (..) - , UsingRawBytesHex (..) - , UsingBech32 (..) + ( module Cardano.Keys.Serialise.Using ) where -import Cardano.Api.Error -import Cardano.Api.HasTypeProxy -import Cardano.Api.Pretty -import Cardano.Api.Serialise.Bech32 -import Cardano.Api.Serialise.Cbor -import Cardano.Api.Serialise.Json -import Cardano.Api.Serialise.Raw - -import Data.Aeson.Types qualified as Aeson -import Data.ByteString qualified as B -import Data.Text.Encoding qualified as Text -import Data.Typeable (tyConName, typeRep, typeRepTyCon) -import Numeric (showBin) - --- | For use with @deriving via@, to provide 'ToCBOR' and 'FromCBOR' instances, --- based on the 'SerialiseAsRawBytes' instance. --- --- > deriving (ToCBOR, FromCBOR) via (UsingRawBytes Blah) -newtype UsingRawBytes a = UsingRawBytes a - -instance SerialiseAsRawBytes a => ToCBOR (UsingRawBytes a) where - toCBOR (UsingRawBytes x) = toCBOR (serialiseToRawBytes x) - -instance SerialiseAsRawBytes a => FromCBOR (UsingRawBytes a) where - fromCBOR = do - bs <- fromCBOR - case deserialiseFromRawBytes ttoken bs of - Right x -> return (UsingRawBytes x) - Left (SerialiseAsRawBytesError msg) -> fail ("cannot deserialise as a " ++ tname ++ ". The error was: " ++ msg) - where - ttoken = proxyToAsType (Proxy :: Proxy a) - tname = (tyConName . typeRepTyCon . typeRep) (Proxy :: Proxy a) - --- | Prints the representation in binary format, quoted -instance SerialiseAsRawBytes a => Show (UsingRawBytes a) where - showsPrec _ (UsingRawBytes x) = showChar '"' . mconcat (map showBin . B.unpack $ serialiseToRawBytes x) . showChar '"' - --- | For use with @deriving via@, to provide instances for any\/all of 'Show', --- 'ToJSON', 'FromJSON', 'ToJSONKey', FromJSONKey' using a hex --- encoding, based on the 'SerialiseAsRawBytes' instance. --- --- > deriving (Show, Pretty) via (UsingRawBytesHex Blah) --- > deriving (ToJSON, FromJSON) via (UsingRawBytesHex Blah) --- > deriving (ToJSONKey, FromJSONKey) via (UsingRawBytesHex Blah) -newtype UsingRawBytesHex a = UsingRawBytesHex a - --- | Quotes the representation -instance SerialiseAsRawBytes a => Show (UsingRawBytesHex a) where - show (UsingRawBytesHex x) = show $ serialiseToRawBytesHex x - -instance SerialiseAsRawBytes a => Pretty (UsingRawBytesHex a) where - pretty (UsingRawBytesHex a) = pretty $ serialiseToRawBytesHexText a - -instance SerialiseAsRawBytes a => ToJSON (UsingRawBytesHex a) where - toJSON (UsingRawBytesHex x) = toJSON (serialiseToRawBytesHexText x) - -instance SerialiseAsRawBytes a => FromJSON (UsingRawBytesHex a) where - parseJSON = - fmap (fmap UsingRawBytesHex) . Aeson.withText tname $ - failEitherError . deserialiseFromRawBytesHex . Text.encodeUtf8 - where - tname = (tyConName . typeRepTyCon . typeRep) (Proxy :: Proxy a) - -instance SerialiseAsRawBytes a => ToJSONKey (UsingRawBytesHex a) where - toJSONKey = - Aeson.toJSONKeyText $ \(UsingRawBytesHex x) -> serialiseToRawBytesHexText x - -instance SerialiseAsRawBytes a => FromJSONKey (UsingRawBytesHex a) where - fromJSONKey = - fmap UsingRawBytesHex . Aeson.FromJSONKeyTextParser $ - failEitherError . deserialiseFromRawBytesHex . Text.encodeUtf8 - --- | For use with @deriving via@, to provide instances for any\/all of 'Show', --- 'IsString', 'ToJSON', 'FromJSON', 'ToJSONKey', FromJSONKey' using a bech32 --- encoding, based on the 'SerialiseAsBech32' instance. --- --- > deriving (Show, Pretty) via (UsingBech32 Blah) --- > deriving (ToJSON, FromJSON) via (UsingBech32 Blah) --- > deriving (ToJSONKey, FromJSONKey) via (UsingBech32 Blah) -newtype UsingBech32 a = UsingBech32 a - --- | Quotes the representation -instance SerialiseAsBech32 a => Show (UsingBech32 a) where - show (UsingBech32 x) = show $ serialiseToBech32 x - -instance SerialiseAsBech32 a => Pretty (UsingBech32 a) where - pretty (UsingBech32 a) = pretty $ serialiseToBech32 a - -instance SerialiseAsBech32 a => ToJSON (UsingBech32 a) where - toJSON (UsingBech32 x) = toJSON (serialiseToBech32 x) - -instance SerialiseAsBech32 a => FromJSON (UsingBech32 a) where - parseJSON = - Aeson.withText tname $ \str -> - case deserialiseFromBech32 str of - Right x -> return (UsingBech32 x) - Left e -> fail $ docToString $ pretty str <> ": " <> prettyError e - where - tname = (tyConName . typeRepTyCon . typeRep) (Proxy :: Proxy a) - -instance SerialiseAsBech32 a => ToJSONKey (UsingBech32 a) - -instance SerialiseAsBech32 a => FromJSONKey (UsingBech32 a) +import Cardano.Keys.Serialise.Using diff --git a/cardano-api/src/Cardano/Api/Serialise/TextEnvelope/Internal.hs b/cardano-api/src/Cardano/Api/Serialise/TextEnvelope/Internal.hs index 06e7082fa9..a79ae3b6d1 100644 --- a/cardano-api/src/Cardano/Api/Serialise/TextEnvelope/Internal.hs +++ b/cardano-api/src/Cardano/Api/Serialise/TextEnvelope/Internal.hs @@ -1,17 +1,16 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wno-orphans #-} -- | TextEnvelope Serialisation +-- +-- The envelope type, its JSON codec and the pure decoders now live in the +-- cardano-keys package; re-exported here for compatibility, together with the +-- era-coupled and file-based functions this API adds on top of them. module Cardano.Api.Serialise.TextEnvelope.Internal ( HasTextEnvelope (..) + , textEnvelopeType , textEnvelopeTypeInEra , TextEnvelope (..) , TextEnvelopeType (..) @@ -47,161 +46,17 @@ import Cardano.Api.Era import Cardano.Api.Error import Cardano.Api.HasTypeProxy import Cardano.Api.IO -import Cardano.Api.Internal.Orphans () -import Cardano.Api.Pretty -import Cardano.Api.Serialise.Cbor -import Control.Monad (unless) +import Cardano.Keys.Serialise.TextEnvelope + import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither) -import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.:), (.=)) import Data.Aeson qualified as Aeson -import Data.Aeson.Encode.Pretty (Config (..), defConfig, encodePretty', keyOrder) -import Data.Bifunctor (first) -import Data.ByteString (ByteString) -import Data.ByteString.Base16 qualified as Base16 -import Data.ByteString.Lazy qualified as LBS -import Data.Data (Data) -import Data.List qualified as List -import Data.Maybe (fromMaybe) -import Data.String (IsString) -import Data.Text.Encoding qualified as Text - --- ---------------------------------------------------------------------------- --- Text envelopes --- - -newtype TextEnvelopeType = TextEnvelopeType String - deriving (Eq, Show, Data) - deriving newtype (IsString, Semigroup, ToJSON, FromJSON) - -newtype TextEnvelopeDescr = TextEnvelopeDescr String - deriving (Eq, Show, Data) - deriving newtype (IsString, Semigroup, ToJSON, FromJSON) - --- | A 'TextEnvelope' is a structured envelope for serialised binary values --- with an external format with a semi-readable textual format. --- --- It contains a \"type\" field, e.g. \"PublicKeyByron\" or \"TxSignedShelley\" --- to indicate the type of the encoded data. This is used as a sanity check --- and to help readers. --- --- It also contains a \"title\" field which is free-form, and could be used --- to indicate the role or purpose to a reader. -data TextEnvelope = TextEnvelope - { teType :: !TextEnvelopeType - , teDescription :: !TextEnvelopeDescr - , teRawCBOR :: !ByteString - } - deriving (Eq, Show) - -instance HasTypeProxy TextEnvelope where - data AsType TextEnvelope = AsTextEnvelope - proxyToAsType _ = AsTextEnvelope - -instance ToJSON TextEnvelope where - toJSON TextEnvelope{teType, teDescription, teRawCBOR} = - object - [ "type" .= teType - , "description" .= teDescription - , "cborHex" .= Text.decodeUtf8 (Base16.encode teRawCBOR) - ] - -instance FromJSON TextEnvelope where - parseJSON = withObject "TextEnvelope" $ \v -> - TextEnvelope - <$> (v .: "type") - <*> (v .: "description") - <*> (parseJSONBase16 =<< v .: "cborHex") - where - parseJSONBase16 v = - either fail return . Base16.decode . Text.encodeUtf8 =<< parseJSON v - -textEnvelopeJsonConfig :: Config -textEnvelopeJsonConfig = defConfig{confCompare = textEnvelopeJsonKeyOrder} - -textEnvelopeJsonKeyOrder :: Text -> Text -> Ordering -textEnvelopeJsonKeyOrder = keyOrder ["type", "description", "cborHex"] - -textEnvelopeRawCBOR :: TextEnvelope -> ByteString -textEnvelopeRawCBOR = teRawCBOR - --- | The errors that the pure 'TextEnvelope' parsing\/decoding functions can return. -data TextEnvelopeError - = -- | expected, actual - TextEnvelopeTypeError ![TextEnvelopeType] !TextEnvelopeType - | TextEnvelopeDecodeError !DecoderError - | TextEnvelopeAesonDecodeError !String - | TextEnvelopeUnknownKeyWitness !TextEnvelopeDescr - | TextEnvelopeUnknownType !Text - deriving (Eq, Show, Data) +import Data.Text (Text) instance Error TextEnvelopeError where - prettyError = \case - TextEnvelopeTypeError [TextEnvelopeType expType] (TextEnvelopeType actType) -> - mconcat - [ "TextEnvelope type error: " - , " Expected: " <> pretty expType - , " Actual: " <> pretty actType - ] - TextEnvelopeTypeError expTypes (TextEnvelopeType actType) -> - mconcat - [ "TextEnvelope type error: " - , " Expected one of: " - , mconcat $ List.intersperse ", " [pretty expType | TextEnvelopeType expType <- expTypes] - , " Actual: " <> pretty actType - ] - TextEnvelopeAesonDecodeError decErr -> - "TextEnvelope aeson decode error: " <> pretty decErr - TextEnvelopeDecodeError decErr -> - "TextEnvelope decode error: " <> pshow decErr - TextEnvelopeUnknownKeyWitness desc -> - "Unknown key witness specified: " <> pshow desc - TextEnvelopeUnknownType unknownType -> - "Unknown TextEnvelope type: " <> pretty unknownType - --- | Check that the \"type\" of the 'TextEnvelope' is as expected. --- --- For example, one might check that the type is \"TxSignedShelley\". -expectTextEnvelopeOfType :: TextEnvelopeType -> TextEnvelope -> Either TextEnvelopeError () -expectTextEnvelopeOfType expectedType TextEnvelope{teType = actualType} = - unless (expectedType `legacyComparison` actualType) $ - Left (TextEnvelopeTypeError [expectedType] actualType) - --- | This is a backwards-compatibility patch to ensure that old envelopes --- generated by 'serialiseTxLedgerCddl' can be deserialised after switching --- to the 'serialiseToTextEnvelope'. -legacyComparison :: TextEnvelopeType -> TextEnvelopeType -> Bool -legacyComparison (TextEnvelopeType expectedType) (TextEnvelopeType actualType) = - case (expectedType, actualType) of - ("TxSignedShelley", "Witnessed Tx ShelleyEra") -> True - ("Tx AllegraEra", "Witnessed Tx AllegraEra") -> True - ("Tx MaryEra", "Witnessed Tx MaryEra") -> True - ("Tx AlonzoEra", "Witnessed Tx AlonzoEra") -> True - ("Tx BabbageEra", "Witnessed Tx BabbageEra") -> True - ("Tx ConwayEra", "Witnessed Tx ConwayEra") -> True - ("Tx DijkstraEra", "Witnessed Tx DijkstraEra") -> True - ("TxSignedShelley", "Unwitnessed Tx ShelleyEra") -> True - ("Tx AllegraEra", "Unwitnessed Tx AllegraEra") -> True - ("Tx MaryEra", "Unwitnessed Tx MaryEra") -> True - ("Tx AlonzoEra", "Unwitnessed Tx AlonzoEra") -> True - ("Tx BabbageEra", "Unwitnessed Tx BabbageEra") -> True - ("Tx ConwayEra", "Unwitnessed Tx ConwayEra") -> True - ("Tx DijkstraEra", "Unwitnessed Tx DijkstraEra") -> True - ("Certificate", "CertificateConway") -> True - ("Certificate", "CertificateShelley") -> True - (expectedOther, expectedActual) -> expectedOther == expectedActual - --- ---------------------------------------------------------------------------- --- Serialisation in text envelope format --- - -class SerialiseAsCBOR a => HasTextEnvelope a where - textEnvelopeType :: AsType a -> TextEnvelopeType - - textEnvelopeDefaultDescr :: a -> TextEnvelopeDescr - textEnvelopeDefaultDescr _ = "" + prettyError = renderTextEnvelopeError textEnvelopeTypeInEra :: () @@ -212,78 +67,6 @@ textEnvelopeTypeInEra textEnvelopeTypeInEra _ = textEnvelopeType -serialiseToTextEnvelope - :: forall a - . HasTextEnvelope a - => Maybe TextEnvelopeDescr -> a -> TextEnvelope -serialiseToTextEnvelope mbDescr a = - TextEnvelope - { teType = textEnvelopeType ttoken - , teDescription = fromMaybe (textEnvelopeDefaultDescr a) mbDescr - , teRawCBOR = serialiseToCBOR a - } - where - ttoken = asType :: AsType a - -deserialiseFromTextEnvelope - :: forall a - . HasTextEnvelope a - => TextEnvelope - -> Either TextEnvelopeError a -deserialiseFromTextEnvelope te = do - expectTextEnvelopeOfType (textEnvelopeType ttoken) te - first TextEnvelopeDecodeError $ - deserialiseFromCBOR ttoken (teRawCBOR te) -- TODO: You have switched from CBOR to JSON - where - ttoken = asType :: AsType a - -deserialiseFromTextEnvelopeAnyOf - :: [FromSomeType HasTextEnvelope b] - -> TextEnvelope - -> Either TextEnvelopeError b -deserialiseFromTextEnvelopeAnyOf types te = - case List.find matching types of - Nothing -> - Left (TextEnvelopeTypeError expectedTypes actualType) - Just (FromSomeType ttoken f) -> - first TextEnvelopeDecodeError $ - f <$> deserialiseFromCBOR ttoken (teRawCBOR te) - where - actualType = teType te - expectedTypes = - [ textEnvelopeType ttoken - | FromSomeType ttoken _f <- types - ] - - matching (FromSomeType ttoken _f) = textEnvelopeType ttoken `legacyComparison` actualType - --- | Decode a JSON-encoded 'TextEnvelope' from a strict 'ByteString' (UTF-8). --- Returns 'TextEnvelopeAesonDecodeError' if the JSON parsing fails. -decodeTextEnvelopeJSON :: ByteString -> Either TextEnvelopeError TextEnvelope -decodeTextEnvelopeJSON bs = - first TextEnvelopeAesonDecodeError $ Aeson.eitherDecodeStrict' bs - --- | Deserialise a value from a JSON-encoded text envelope 'ByteString' (UTF-8). --- This performs no file I\/O. Returns 'TextEnvelopeAesonDecodeError' for JSON --- parse failures, or downstream errors from 'deserialiseFromTextEnvelope' for --- type mismatches and CBOR decoding failures. -deserialiseFromTextEnvelopeJSON - :: HasTextEnvelope a - => ByteString -> Either TextEnvelopeError a -deserialiseFromTextEnvelopeJSON bs = - decodeTextEnvelopeJSON bs >>= deserialiseFromTextEnvelope - --- | Like 'deserialiseFromTextEnvelopeJSON' but accepts multiple target types. --- This performs no file I\/O. Returns 'TextEnvelopeAesonDecodeError' for JSON --- parse failures, or downstream errors from 'deserialiseFromTextEnvelopeAnyOf' --- for type mismatches and CBOR decoding failures. -deserialiseFromTextEnvelopeJSONAnyOf - :: [FromSomeType HasTextEnvelope b] - -> ByteString - -> Either TextEnvelopeError b -deserialiseFromTextEnvelopeJSONAnyOf types bs = - decodeTextEnvelopeJSON bs >>= deserialiseFromTextEnvelopeAnyOf types - -- | Write a value to a file in the text envelope format. -- -- Note that this does /not/ set conservative file permissions: the file is @@ -335,14 +118,6 @@ writeFileTextEnvelopeWithOwnerPermissions writeFileTextEnvelopeWithOwnerPermissions outputFile mbDescr a = writeLazyByteStringFileWithOwnerPermissions outputFile (textEnvelopeToJSON mbDescr a) -textEnvelopeToJSON :: HasTextEnvelope a => Maybe TextEnvelopeDescr -> a -> LBS.ByteString -textEnvelopeToJSON mbDescr a = - serialiseTextEnvelope $ serialiseToTextEnvelope mbDescr a - --- | Serialise text envelope to pretty JSON -serialiseTextEnvelope :: TextEnvelope -> LBS.ByteString -serialiseTextEnvelope te = encodePretty' textEnvelopeJsonConfig te <> "\n" - readFileTextEnvelope :: HasTextEnvelope a => File content In @@ -384,7 +159,7 @@ readTextEnvelopeOfTypeFromFile expectedType path = te <- ExceptT (readTextEnvelopeFromFile path) firstExceptT (FileError path) $ hoistEither $ - expectTextEnvelopeOfType expectedType te + expectTextEnvelopeOfType (pure expectedType) te return te textEnvelopeTypeToEra :: Text -> Either TextEnvelopeError AnyShelleyBasedEra diff --git a/cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.Bech32.Bech32DecodeError/Bech32DataPartToBytesError.txt b/cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.Bech32.Bech32DecodeError/Bech32DataPartToBytesError.txt similarity index 100% rename from cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.Bech32.Bech32DecodeError/Bech32DataPartToBytesError.txt rename to cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.Bech32.Bech32DecodeError/Bech32DataPartToBytesError.txt diff --git a/cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.Bech32.Bech32DecodeError/Bech32DecodingError.txt b/cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.Bech32.Bech32DecodeError/Bech32DecodingError.txt similarity index 100% rename from cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.Bech32.Bech32DecodeError/Bech32DecodingError.txt rename to cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.Bech32.Bech32DecodeError/Bech32DecodingError.txt diff --git a/cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.Bech32.Bech32DecodeError/Bech32DeserialiseFromBytesError.txt b/cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.Bech32.Bech32DecodeError/Bech32DeserialiseFromBytesError.txt similarity index 100% rename from cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.Bech32.Bech32DecodeError/Bech32DeserialiseFromBytesError.txt rename to cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.Bech32.Bech32DecodeError/Bech32DeserialiseFromBytesError.txt diff --git a/cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.Bech32.Bech32DecodeError/Bech32InvalidUtf8.txt b/cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.Bech32.Bech32DecodeError/Bech32InvalidUtf8.txt similarity index 100% rename from cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.Bech32.Bech32DecodeError/Bech32InvalidUtf8.txt rename to cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.Bech32.Bech32DecodeError/Bech32InvalidUtf8.txt diff --git a/cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.Bech32.Bech32DecodeError/Bech32UnexpectedHeader.txt b/cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.Bech32.Bech32DecodeError/Bech32UnexpectedHeader.txt similarity index 100% rename from cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.Bech32.Bech32DecodeError/Bech32UnexpectedHeader.txt rename to cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.Bech32.Bech32DecodeError/Bech32UnexpectedHeader.txt diff --git a/cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.Bech32.Bech32DecodeError/Bech32UnexpectedPrefix.txt b/cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.Bech32.Bech32DecodeError/Bech32UnexpectedPrefix.txt similarity index 100% rename from cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.Bech32.Bech32DecodeError/Bech32UnexpectedPrefix.txt rename to cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.Bech32.Bech32DecodeError/Bech32UnexpectedPrefix.txt diff --git a/cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.Bech32.Bech32DecodeError/Bech32WrongPrefix.txt b/cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.Bech32.Bech32DecodeError/Bech32WrongPrefix.txt similarity index 100% rename from cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.Bech32.Bech32DecodeError/Bech32WrongPrefix.txt rename to cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.Bech32.Bech32DecodeError/Bech32WrongPrefix.txt diff --git a/cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.TextEnvelope.Internal.TextEnvelopeError/TextEnvelopeAesonDecodeError.txt b/cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.TextEnvelope.TextEnvelopeError/TextEnvelopeAesonDecodeError.txt similarity index 100% rename from cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.TextEnvelope.Internal.TextEnvelopeError/TextEnvelopeAesonDecodeError.txt rename to cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.TextEnvelope.TextEnvelopeError/TextEnvelopeAesonDecodeError.txt diff --git a/cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.TextEnvelope.Internal.TextEnvelopeError/TextEnvelopeDecodeError.txt b/cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.TextEnvelope.TextEnvelopeError/TextEnvelopeDecodeError.txt similarity index 100% rename from cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.TextEnvelope.Internal.TextEnvelopeError/TextEnvelopeDecodeError.txt rename to cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.TextEnvelope.TextEnvelopeError/TextEnvelopeDecodeError.txt diff --git a/cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.TextEnvelope.Internal.TextEnvelopeError/TextEnvelopeTypeError.txt b/cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.TextEnvelope.TextEnvelopeError/TextEnvelopeTypeError.txt similarity index 100% rename from cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.TextEnvelope.Internal.TextEnvelopeError/TextEnvelopeTypeError.txt rename to cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.TextEnvelope.TextEnvelopeError/TextEnvelopeTypeError.txt diff --git a/cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.TextEnvelope.Internal.TextEnvelopeError/TextEnvelopeUnknownKeyWitness.txt b/cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.TextEnvelope.TextEnvelopeError/TextEnvelopeUnknownKeyWitness.txt similarity index 100% rename from cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.TextEnvelope.Internal.TextEnvelopeError/TextEnvelopeUnknownKeyWitness.txt rename to cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.TextEnvelope.TextEnvelopeError/TextEnvelopeUnknownKeyWitness.txt diff --git a/cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.TextEnvelope.Internal.TextEnvelopeError/TextEnvelopeUnknownType.txt b/cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.TextEnvelope.TextEnvelopeError/TextEnvelopeUnknownType.txt similarity index 100% rename from cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Serialise.TextEnvelope.Internal.TextEnvelopeError/TextEnvelopeUnknownType.txt rename to cardano-api/test/cardano-api-golden/files/errors/Cardano.Keys.Serialise.TextEnvelope.TextEnvelopeError/TextEnvelopeUnknownType.txt From 72c44146517b26538d08ed7f6ad99f5abb8daaa3 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 8 Sep 2026 10:29:22 +0000 Subject: [PATCH 3/7] Adopt the multi-string text envelope class Every HasTextEnvelope instance defines textEnvelopeTypes now. Call sites that want the single type to write keep using textEnvelopeType, which is a free function over the head of that list. --- .../Api/Compatible/ProtocolParametersUpdate.hs | 2 +- .../Api/Experimental/Plutus/Internal/Script.hs | 4 ++-- .../Api/Experimental/Tx/Internal/Certificate/Type.hs | 2 +- .../Governance/Internal/Action/ProposalProcedure.hs | 2 +- .../Governance/Internal/Action/VotingProcedure.hs | 4 ++-- .../src/Cardano/Api/Governance/Internal/Poll.hs | 2 +- .../src/Cardano/Api/Plutus/Internal/Script.hs | 8 ++++---- .../Cardano/Api/Query/Internal/Type/QueryInMode.hs | 7 ++++--- .../src/Cardano/Api/Serialise/TextEnvelope.hs | 1 + cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs | 12 ++++++------ 10 files changed, 23 insertions(+), 21 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Compatible/ProtocolParametersUpdate.hs b/cardano-api/src/Cardano/Api/Compatible/ProtocolParametersUpdate.hs index 18913d4e92..9d49c8f16c 100644 --- a/cardano-api/src/Cardano/Api/Compatible/ProtocolParametersUpdate.hs +++ b/cardano-api/src/Cardano/Api/Compatible/ProtocolParametersUpdate.hs @@ -506,7 +506,7 @@ instance Typeable era => HasTypeProxy (UpdateProposal era) where proxyToAsType _ = AsUpdateProposal instance IsShelleyBasedEra era => HasTextEnvelope (UpdateProposal era) where - textEnvelopeType _ = "UpdateProposalShelley" + textEnvelopeTypes _ = pure "UpdateProposalShelley" instance IsShelleyBasedEra era => ToCBOR (UpdateProposal era) where toCBOR (UpdateProposal ppup epochno) = diff --git a/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/Script.hs b/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/Script.hs index 712d466d12..a0c942507c 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/Script.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/Script.hs @@ -86,8 +86,8 @@ instance (Plutus.PlutusLanguage lang, L.Era era, HasTypeProxy (Plutus.SLanguage lang)) => HasTextEnvelope (PlutusScriptInEra lang era) where - textEnvelopeType _ = - fromString . Text.unpack . plutusLanguageToText $ + textEnvelopeTypes _ = + pure . fromString . Text.unpack . plutusLanguageToText $ AnyPlutusScriptLanguage $ L.plutusSLanguage (Proxy @lang) diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate/Type.hs b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate/Type.hs index 38c85e8993..eb43598ff7 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate/Type.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate/Type.hs @@ -37,7 +37,7 @@ instance ) => HasTextEnvelope (Certificate ledgerera) where - textEnvelopeType _ = "Certificate" + textEnvelopeTypes _ = pure "Certificate" instance Typeable era => HasTypeProxy (Certificate era) where data AsType (Certificate era) = AsCertificate diff --git a/cardano-api/src/Cardano/Api/Governance/Internal/Action/ProposalProcedure.hs b/cardano-api/src/Cardano/Api/Governance/Internal/Action/ProposalProcedure.hs index c75862db5a..7ed1638bbc 100644 --- a/cardano-api/src/Cardano/Api/Governance/Internal/Action/ProposalProcedure.hs +++ b/cardano-api/src/Cardano/Api/Governance/Internal/Action/ProposalProcedure.hs @@ -183,7 +183,7 @@ instance IsShelleyBasedEra era => SerialiseAsCBOR (Proposal era) where deserialiseFromCBOR _proxy = shelleyBasedEraConstraints (shelleyBasedEra @era) CBOR.decodeFull' instance IsShelleyBasedEra era => HasTextEnvelope (Proposal era) where - textEnvelopeType _ = "Governance proposal" + textEnvelopeTypes _ = pure "Governance proposal" instance HasTypeProxy era => HasTypeProxy (Proposal era) where data AsType (Proposal era) = AsProposal diff --git a/cardano-api/src/Cardano/Api/Governance/Internal/Action/VotingProcedure.hs b/cardano-api/src/Cardano/Api/Governance/Internal/Action/VotingProcedure.hs index 0c8c3ef5e6..1766a03008 100644 --- a/cardano-api/src/Cardano/Api/Governance/Internal/Action/VotingProcedure.hs +++ b/cardano-api/src/Cardano/Api/Governance/Internal/Action/VotingProcedure.hs @@ -84,7 +84,7 @@ instance IsShelleyBasedEra era => SerialiseAsCBOR (VotingProcedure era) where deserialiseFromCBOR _proxy = shelleyBasedEraConstraints (shelleyBasedEra @era) CBOR.decodeFull' instance IsShelleyBasedEra era => HasTextEnvelope (VotingProcedure era) where - textEnvelopeType _ = "Governance vote" + textEnvelopeTypes _ = pure "Governance vote" instance HasTypeProxy era => HasTypeProxy (VotingProcedure era) where data AsType (VotingProcedure era) = AsVote @@ -116,7 +116,7 @@ instance IsShelleyBasedEra era => SerialiseAsCBOR (VotingProcedures era) where deserialiseFromCBOR _proxy = shelleyBasedEraConstraints (shelleyBasedEra @era) CBOR.decodeFull' instance IsShelleyBasedEra era => HasTextEnvelope (VotingProcedures era) where - textEnvelopeType _ = "Governance voting procedures" + textEnvelopeTypes _ = pure "Governance voting procedures" instance HasTypeProxy era => HasTypeProxy (VotingProcedures era) where data AsType (VotingProcedures era) = AsVotingProcedures diff --git a/cardano-api/src/Cardano/Api/Governance/Internal/Poll.hs b/cardano-api/src/Cardano/Api/Governance/Internal/Poll.hs index b055d4bb51..cdfae0a82e 100644 --- a/cardano-api/src/Cardano/Api/Governance/Internal/Poll.hs +++ b/cardano-api/src/Cardano/Api/Governance/Internal/Poll.hs @@ -113,7 +113,7 @@ data GovernancePoll = GovernancePoll deriving (Show, Eq) instance HasTextEnvelope GovernancePoll where - textEnvelopeType _ = "GovernancePoll" + textEnvelopeTypes _ = pure "GovernancePoll" instance HasTypeProxy GovernancePoll where data AsType GovernancePoll = AsGovernancePoll diff --git a/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs b/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs index ce7944f2ed..450971284a 100644 --- a/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs +++ b/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs @@ -507,8 +507,8 @@ removePlutusScriptDoubleEncoding plutusScriptBytes = Right{} -> unwrapped instance IsScriptLanguage lang => HasTextEnvelope (Script lang) where - textEnvelopeType _ = - case scriptLanguage :: ScriptLanguage lang of + textEnvelopeTypes _ = + pure $ case scriptLanguage :: ScriptLanguage lang of SimpleScriptLanguage -> "SimpleScript" PlutusScriptLanguage PlutusScriptV1 -> "PlutusScriptV1" PlutusScriptLanguage PlutusScriptV2 -> "PlutusScriptV2" @@ -1129,8 +1129,8 @@ instance HasTypeProxy lang => SerialiseAsRawBytes (PlutusScript lang) where deserialiseFromCBOR asType' bs instance IsPlutusScriptLanguage lang => HasTextEnvelope (PlutusScript lang) where - textEnvelopeType _ = - case plutusScriptVersion :: PlutusScriptVersion lang of + textEnvelopeTypes _ = + pure $ case plutusScriptVersion :: PlutusScriptVersion lang of PlutusScriptV1 -> "PlutusScriptV1" PlutusScriptV2 -> "PlutusScriptV2" PlutusScriptV3 -> "PlutusScriptV3" diff --git a/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs b/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs index c7c714b765..bf5a2629f4 100644 --- a/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs +++ b/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs @@ -85,7 +85,7 @@ import Cardano.Api.Network.Internal.NetworkId import Cardano.Api.Query.Internal.Type.DebugLedgerState import Cardano.Api.Serialise.Cbor (SerialiseAsCBOR (deserialiseFromCBOR, serialiseToCBOR)) import Cardano.Api.Serialise.TextEnvelope.Internal - ( HasTextEnvelope (textEnvelopeType) + ( HasTextEnvelope (textEnvelopeTypes) , TextEnvelopeType ) import Cardano.Api.Tx.Internal.Body @@ -132,6 +132,7 @@ import Data.Bifunctor (bimap, first) import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as LBS import Data.Either.Combinators (rightToMaybe) +import Data.List.NonEmpty (NonEmpty) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Maybe (mapMaybe) @@ -194,8 +195,8 @@ instance SerialiseAsCBOR EraHistory where -- @transaction calculate-plutus-script-cost@ command in @cartdano-cli and it -- can be obtained through the @query era-history@ command. instance HasTextEnvelope EraHistory where - textEnvelopeType :: AsType EraHistory -> TextEnvelopeType - textEnvelopeType _ = "EraHistory" + textEnvelopeTypes :: AsType EraHistory -> NonEmpty TextEnvelopeType + textEnvelopeTypes _ = pure "EraHistory" getProgress :: () diff --git a/cardano-api/src/Cardano/Api/Serialise/TextEnvelope.hs b/cardano-api/src/Cardano/Api/Serialise/TextEnvelope.hs index dec5c921b1..69ebf44348 100644 --- a/cardano-api/src/Cardano/Api/Serialise/TextEnvelope.hs +++ b/cardano-api/src/Cardano/Api/Serialise/TextEnvelope.hs @@ -1,6 +1,7 @@ module Cardano.Api.Serialise.TextEnvelope ( -- * TextEnvelope Serialisation HasTextEnvelope (..) + , textEnvelopeType , textEnvelopeTypeInEra , TextEnvelope (..) , TextEnvelopeType (..) diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs index 2ac9770d75..4e4044a90a 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs @@ -284,8 +284,8 @@ getTxBody (ShelleyTx sbe tx) = ) instance IsShelleyBasedEra era => HasTextEnvelope (Tx era) where - textEnvelopeType _ = - case shelleyBasedEra :: ShelleyBasedEra era of + textEnvelopeTypes _ = + pure $ case shelleyBasedEra :: ShelleyBasedEra era of ShelleyBasedEraShelley -> "TxSignedShelley" ShelleyBasedEraAllegra -> "Tx AllegraEra" ShelleyBasedEraMary -> "Tx MaryEra" @@ -549,8 +549,8 @@ instance IsShelleyBasedEra era => SerialiseAsCBOR (TxBody era) where (deserialiseShelleyBasedTx (ShelleyTx shelleyBasedEra) bs) instance IsShelleyBasedEra era => HasTextEnvelope (TxBody era) where - textEnvelopeType _ = - case shelleyBasedEra :: ShelleyBasedEra era of + textEnvelopeTypes _ = + pure $ case shelleyBasedEra :: ShelleyBasedEra era of ShelleyBasedEraShelley -> "TxUnsignedShelley" ShelleyBasedEraAllegra -> "TxBodyAllegra" ShelleyBasedEraMary -> "TxBodyMary" @@ -835,8 +835,8 @@ decodeShelleyBasedWitness sbe bs = (fromIntegral t) instance IsCardanoEra era => HasTextEnvelope (KeyWitness era) where - textEnvelopeType _ = - case cardanoEra :: CardanoEra era of + textEnvelopeTypes _ = + pure $ case cardanoEra :: CardanoEra era of ByronEra -> "TxWitnessByron" ShelleyEra -> "TxWitness ShelleyEra" AllegraEra -> "TxWitness AllegraEra" From 5d57454f451d406d91b78b98686c88259bd4de71 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 8 Sep 2026 10:29:29 +0000 Subject: [PATCH 4/7] Drop the orphan instances cardano-keys now provides Cardano.Keys.Serialise.Orphans carries these, and a second definition in the same dependency graph is a duplicate-instance error. --- .../src/Cardano/Api/Internal/Orphans/Misc.hs | 14 ------------- .../Api/Internal/Orphans/Serialisation.hs | 21 ------------------- 2 files changed, 35 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Internal/Orphans/Misc.hs b/cardano-api/src/Cardano/Api/Internal/Orphans/Misc.hs index 4f5154577e..6ef557f3f7 100644 --- a/cardano-api/src/Cardano/Api/Internal/Orphans/Misc.hs +++ b/cardano-api/src/Cardano/Api/Internal/Orphans/Misc.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -23,7 +22,6 @@ import Cardano.Ledger.Alonzo.PParams qualified as Ledger import Cardano.Ledger.Babbage.PParams qualified as Ledger import Cardano.Ledger.BaseTypes (strictMaybeToMaybe) import Cardano.Ledger.BaseTypes qualified as Ledger -import Cardano.Ledger.Binary import Cardano.Ledger.Binary qualified as CBOR import Cardano.Ledger.Coin qualified as L import Cardano.Ledger.Conway.PParams qualified as Ledger @@ -40,9 +38,7 @@ import Ouroboros.Consensus.HardFork.History.Summary ) import PlutusLedgerApi.Common qualified as P -import Codec.Binary.Bech32 qualified as Bech32 import Data.Bits (Bits) -import Data.Data (Data) import Data.ListMap (ListMap) import Data.ListMap qualified as ListMap import Data.Maybe.Strict (StrictMaybe (..)) @@ -56,16 +52,6 @@ import Network.Mux qualified as Mux import Prettyprinter (indent) import Text.Parsec.Error qualified as P -deriving instance Data DecoderError - -deriving instance Data CBOR.DeserialiseFailure - -deriving instance Data Bech32.DecodingError - -deriving instance Data Bech32.CharPosition - -deriving instance Data T.UnicodeException - -- | These instances originally existed on the Lovelace type. -- As the Lovelace type is deleted and we use L.Coin instead, -- these instances are added to L.Coin. The instances are diff --git a/cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs b/cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs index 9507cce3a5..d818a3d882 100644 --- a/cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs +++ b/cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs @@ -7,7 +7,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans -Wno-unused-imports #-} @@ -31,9 +30,7 @@ import Cardano.Api.Pretty.Internal.ShowOf import Cardano.Api.Serialise.Raw import Cardano.Api.Tx.Internal.TxIn -import Cardano.Binary (DecoderError (..)) import Cardano.Binary qualified as CBOR -import Cardano.Binary.FixedSizeCodec qualified as Crypto import Cardano.Chain.Byron.API qualified as L import Cardano.Chain.Common qualified as L import Cardano.Chain.Delegation.Validation.Scheduling qualified as L.Scheduling @@ -60,7 +57,6 @@ import Cardano.Ledger.Babbage.Rules qualified as L import Cardano.Ledger.BaseTypes (strictMaybeToMaybe) import Cardano.Ledger.BaseTypes qualified as L import Cardano.Ledger.BaseTypes qualified as Ledger -import Cardano.Ledger.Binary import Cardano.Ledger.Binary.Plain qualified as Plain import Cardano.Ledger.Coin qualified as L import Cardano.Ledger.Conway qualified as Conway (ApplyTxError (..)) @@ -85,7 +81,6 @@ import Cardano.Ledger.Shelley.TxCert qualified as L import Cardano.Protocol.Crypto qualified as P import Cardano.Protocol.TPraos.API qualified as Ledger import Cardano.Protocol.TPraos.BlockHeader (HashHeader (..)) -import Cardano.Protocol.TPraos.OCert qualified as Ledger import Cardano.Protocol.TPraos.Rules.Prtcl qualified as L import Cardano.Protocol.TPraos.Rules.Prtcl qualified as Ledger import Cardano.Protocol.TPraos.Rules.Tickn qualified as Ledger @@ -103,8 +98,6 @@ import Ouroboros.Network.Protocol.LocalTxSubmission.Type qualified as Net.Tx import PlutusLedgerApi.Common qualified as P import PlutusLedgerApi.V2 qualified as V2 -import Codec.Binary.Bech32 qualified as Bech32 -import Codec.CBOR.Read qualified as CBOR import Data.Aeson ( KeyValue ((.=)) , ToJSON (..) @@ -135,7 +128,6 @@ import Data.Monoid import Data.Text qualified as T import Data.Text qualified as Text import Data.Text.Encoding qualified as Text -import Data.Typeable (Typeable) import Data.Word (Word16) import GHC.Exts (IsList (..), IsString (..)) import GHC.Generics @@ -478,16 +470,3 @@ instance HasTypeProxy (L.SLanguage L.PlutusV3) where instance HasTypeProxy (L.SLanguage L.PlutusV4) where data AsType (L.SLanguage L.PlutusV4) = AsPlutusScriptV4 proxyToAsType _ = AsPlutusScriptV4 - --- TODO: drop these and use EncCBOR/DecCBOR -instance ToCBOR (Ledger.OCert P.StandardCrypto) where - toCBOR = L.toEraCBOR @L.ShelleyEra - -instance FromCBOR (Ledger.OCert P.StandardCrypto) where - fromCBOR = L.fromEraCBOR @L.ShelleyEra - -instance Typeable kd => ToCBOR (L.Keys.VKey kd) where - toCBOR (L.Keys.VKey vk) = Crypto.encodeFixedSized vk - -instance Typeable kd => FromCBOR (L.Keys.VKey kd) where - fromCBOR = L.Keys.VKey <$> Crypto.decodeFixedSized From ebefcff2e1c0b3a28192f15548748ad7c98d5f61 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 8 Sep 2026 10:29:30 +0000 Subject: [PATCH 5/7] Add the changelog fragment --- .changes/depend-on-cardano-keys.yml | 7 +++++++ 1 file changed, 7 insertions(+) create mode 100644 .changes/depend-on-cardano-keys.yml diff --git a/.changes/depend-on-cardano-keys.yml b/.changes/depend-on-cardano-keys.yml new file mode 100644 index 0000000000..215b2bd96c --- /dev/null +++ b/.changes/depend-on-cardano-keys.yml @@ -0,0 +1,7 @@ +project: cardano-api +pr: 1332 +kind: + - breaking + - refactoring +description: | + The key types, their hashes and the raw-bytes, hex, CBOR, bech32 and text-envelope serialisations now come from the `cardano-keys` package. The module names, the exported names and `Cardano.Api`'s re-exports are unchanged, so most code needs no edit. Three things did change: `HasTextEnvelope` instances now define `textEnvelopeTypes :: AsType a -> NonEmpty TextEnvelopeType` instead of `textEnvelopeType` (the head of that list is the type written when serialising, the whole list is accepted when reading, and `textEnvelopeType` remains available as a free function); `getKesPeriod` returns a `KESPeriod` rather than a `Word`; and the error types that moved carry `render...` functions in `cardano-keys`, with the `Error` instances kept here. From 6023386709a3f2681ffeedd410cfc2c99376ad5c Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 8 Sep 2026 14:07:01 +0000 Subject: [PATCH 6/7] Constrain crypton below 1.1 for the GHC 9.14 solver With the cardano-keys dependency added, the GHC 9.14 plan greedily selects crypton 1.1.4, which cardano-crypto-class rejects, so the x86_64 evaluation fails. Both packages already require crypton < 1.1; stating it as a constraint keeps the solver on that version. --- cabal.project | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/cabal.project b/cabal.project index 2605743ab4..bb5b0d3406 100644 --- a/cabal.project +++ b/cabal.project @@ -51,6 +51,10 @@ semaphore: True constraints: -- haskell.nix patch does not work for 1.6.8 , any.crypton-x509-system < 1.6.8 + -- cardano-crypto-class (in cardano-api and in the cardano-keys dependency) + -- requires crypton < 1.1; without this the GHC 9.14 solver greedily picks + -- crypton 1.1.4 and then cannot resolve cardano-crypto-class. + , crypton < 1.1 -- WASM compilation specific From 9c1efdd9dc4f63ac6848b6649012da68aef74740 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 15 Sep 2026 19:52:07 +0000 Subject: [PATCH 7/7] Gate the crypton constraint to GHC 9.14 --- cabal.project | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/cabal.project b/cabal.project index bb5b0d3406..7bb5c96f66 100644 --- a/cabal.project +++ b/cabal.project @@ -51,10 +51,14 @@ semaphore: True constraints: -- haskell.nix patch does not work for 1.6.8 , any.crypton-x509-system < 1.6.8 - -- cardano-crypto-class (in cardano-api and in the cardano-keys dependency) - -- requires crypton < 1.1; without this the GHC 9.14 solver greedily picks - -- crypton 1.1.4 and then cannot resolve cardano-crypto-class. - , crypton < 1.1 + +-- cardano-crypto-class (in cardano-api and in the cardano-keys dependency) +-- requires crypton < 1.1. The GHC 9.14 solver otherwise greedily picks +-- crypton 1.1.4 and then cannot resolve cardano-crypto-class; older +-- compilers settle on 1.0.x by themselves. +if impl(ghc >= 9.14) + constraints: + , crypton < 1.1 -- WASM compilation specific