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. diff --git a/.github/master-check-exceptions.list b/.github/master-check-exceptions.list index e69de29bb2..382b426ccb 100644 --- a/.github/master-check-exceptions.list +++ b/.github/master-check-exceptions.list @@ -0,0 +1 @@ +https://github.com/IntersectMBO/cardano-keys diff --git a/cabal.project b/cabal.project index 5088d490d3..0386e74592 100644 --- a/cabal.project +++ b/cabal.project @@ -51,6 +51,18 @@ 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 + +-- Temporary, until cardano-keys has its first CHaP release. +source-repository-package + type: git + location: https://github.com/IntersectMBO/cardano-keys + tag: df20ae67e89920fdc65cd3c30a720dbcbf9e5344 + subdir: cardano-keys + --sha256: sha256-TILlrhcfUOgVkrG5vi6QL8sjTaFvBKJIrnPvURG94A4= -- WASM compilation specific diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 48b34e6263..e231bb2ab5 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -139,6 +139,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, @@ -187,7 +188,6 @@ library prettyprinter, prettyprinter-ansi-terminal, prettyprinter-configurable ^>=1.36, - random, resource-registry ^>=0.3, safe-exceptions, scientific, 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/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/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/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 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/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/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/ProtocolParameters.hs index ece4afcbb2..f485e1e121 100644 --- a/cardano-api/src/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/src/Cardano/Api/ProtocolParameters.hs @@ -947,7 +947,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/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/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.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/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/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" 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