{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Cardano.CLI.Byron.Delegation
( ByronDelegationError(..)
, checkByronGenesisDelegation
, issueByronGenesisDelegation
, renderByronDelegationError
, serialiseDelegationCert
, serialiseDelegateKey
)
where
import Cardano.Prelude hiding (option, show, trace)
import Codec.CBOR.Write (toLazyByteString)
import Control.Monad.Trans.Except.Extra (left)
import qualified Data.ByteString.Lazy as LB
import Formatting (Format, sformat)
import Cardano.Binary (Annotated (..), serialize')
import qualified Cardano.Chain.Delegation as Dlg
import Cardano.Chain.Slotting (EpochNumber)
import qualified Cardano.CLI.Byron.Legacy as Legacy
import Cardano.Crypto (ProtocolMagicId, SigningKey)
import qualified Cardano.Crypto as Crypto
import Cardano.CLI.Byron.Key (ByronKeyFailure, CardanoEra (..), renderByronKeyFailure,
serialiseSigningKey)
import Cardano.CLI.Helpers (textShow)
import Cardano.CLI.Types (CertificateFile (..))
data ByronDelegationError
= CertificateValidationErrors !FilePath ![Text]
| DlgCertificateDeserialisationFailed !FilePath !Text
| ByronDelegationKeyError !ByronKeyFailure
deriving Int -> ByronDelegationError -> ShowS
[ByronDelegationError] -> ShowS
ByronDelegationError -> String
(Int -> ByronDelegationError -> ShowS)
-> (ByronDelegationError -> String)
-> ([ByronDelegationError] -> ShowS)
-> Show ByronDelegationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ByronDelegationError] -> ShowS
$cshowList :: [ByronDelegationError] -> ShowS
show :: ByronDelegationError -> String
$cshow :: ByronDelegationError -> String
showsPrec :: Int -> ByronDelegationError -> ShowS
$cshowsPrec :: Int -> ByronDelegationError -> ShowS
Show
renderByronDelegationError :: ByronDelegationError -> Text
renderByronDelegationError :: ByronDelegationError -> Text
renderByronDelegationError ByronDelegationError
err =
case ByronDelegationError
err of
CertificateValidationErrors String
certFp [Text]
errs ->
Text
"Certificate validation error(s) at: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Show a => a -> Text
textShow String
certFp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Errors: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall a. Show a => a -> Text
textShow [Text]
errs
DlgCertificateDeserialisationFailed String
certFp Text
deSererr ->
Text
"Certificate deserialisation error at: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Show a => a -> Text
textShow String
certFp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
textShow Text
deSererr
ByronDelegationKeyError ByronKeyFailure
kerr -> ByronKeyFailure -> Text
renderByronKeyFailure ByronKeyFailure
kerr
issueByronGenesisDelegation
:: ProtocolMagicId
-> EpochNumber
-> Crypto.SigningKey
-> Crypto.VerificationKey
-> Dlg.Certificate
issueByronGenesisDelegation :: ProtocolMagicId
-> EpochNumber -> SigningKey -> VerificationKey -> Certificate
issueByronGenesisDelegation ProtocolMagicId
magic EpochNumber
epoch SigningKey
issuerSK VerificationKey
delegateVK =
ProtocolMagicId
-> VerificationKey -> EpochNumber -> SafeSigner -> Certificate
Dlg.signCertificate ProtocolMagicId
magic VerificationKey
delegateVK EpochNumber
epoch (SafeSigner -> Certificate) -> SafeSigner -> Certificate
forall a b. (a -> b) -> a -> b
$
SigningKey -> SafeSigner
Crypto.noPassSafeSigner SigningKey
issuerSK
checkByronGenesisDelegation
:: CertificateFile
-> ProtocolMagicId
-> Crypto.VerificationKey
-> Crypto.VerificationKey
-> ExceptT ByronDelegationError IO ()
checkByronGenesisDelegation :: CertificateFile
-> ProtocolMagicId
-> VerificationKey
-> VerificationKey
-> ExceptT ByronDelegationError IO ()
checkByronGenesisDelegation (CertificateFile String
certF) ProtocolMagicId
magic VerificationKey
issuer VerificationKey
delegate = do
Either Text Certificate
ecert <- IO (Either Text Certificate)
-> ExceptT ByronDelegationError IO (Either Text Certificate)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either Text Certificate)
-> ExceptT ByronDelegationError IO (Either Text Certificate))
-> IO (Either Text Certificate)
-> ExceptT ByronDelegationError IO (Either Text Certificate)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either Text Certificate
forall a.
FromJSON (Either SchemaError) a =>
ByteString -> Either Text a
canonicalDecodePretty (ByteString -> Either Text Certificate)
-> IO ByteString -> IO (Either Text Certificate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
LB.readFile String
certF
case Either Text Certificate
ecert of
Left Text
e -> ByronDelegationError -> ExceptT ByronDelegationError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ByronDelegationError -> ExceptT ByronDelegationError IO ())
-> ByronDelegationError -> ExceptT ByronDelegationError IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> ByronDelegationError
DlgCertificateDeserialisationFailed String
certF Text
e
Right (Certificate
cert :: Dlg.Certificate) -> do
let issues :: [Text]
issues = Certificate
-> ProtocolMagicId -> VerificationKey -> VerificationKey -> [Text]
forall a.
ACertificate a
-> ProtocolMagicId -> VerificationKey -> VerificationKey -> [Text]
checkDlgCert Certificate
cert ProtocolMagicId
magic VerificationKey
issuer VerificationKey
delegate
Bool
-> ExceptT ByronDelegationError IO ()
-> ExceptT ByronDelegationError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
issues) (ExceptT ByronDelegationError IO ()
-> ExceptT ByronDelegationError IO ())
-> ExceptT ByronDelegationError IO ()
-> ExceptT ByronDelegationError IO ()
forall a b. (a -> b) -> a -> b
$
ByronDelegationError -> ExceptT ByronDelegationError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ByronDelegationError -> ExceptT ByronDelegationError IO ())
-> ByronDelegationError -> ExceptT ByronDelegationError IO ()
forall a b. (a -> b) -> a -> b
$ String -> [Text] -> ByronDelegationError
CertificateValidationErrors String
certF [Text]
issues
checkDlgCert
:: Dlg.ACertificate a
-> ProtocolMagicId
-> Crypto.VerificationKey
-> Crypto.VerificationKey -> [Text]
checkDlgCert :: ACertificate a
-> ProtocolMagicId -> VerificationKey -> VerificationKey -> [Text]
checkDlgCert ACertificate a
cert ProtocolMagicId
magic VerificationKey
issuerVK' VerificationKey
delegateVK' =
[[Text]] -> [Text]
forall a. Monoid a => [a] -> a
mconcat
[ [ Format Text Text -> Text
forall a. Format Text a -> a
sformat Format Text Text
"Certificate does not have a valid signature."
| Bool -> Bool
not (Annotated ProtocolMagicId ByteString
-> ACertificate ByteString -> Bool
Dlg.isValid Annotated ProtocolMagicId ByteString
magic' ACertificate ByteString
cert')
]
, [ Format Text (VerificationKey -> VerificationKey -> Text)
-> VerificationKey -> VerificationKey -> Text
forall a. Format Text a -> a
sformat (Format
(VerificationKey -> VerificationKey -> Text)
(VerificationKey -> VerificationKey -> Text)
"Certificate issuer "Format
(VerificationKey -> VerificationKey -> Text)
(VerificationKey -> VerificationKey -> Text)
-> Format Text (VerificationKey -> VerificationKey -> Text)
-> Format Text (VerificationKey -> VerificationKey -> Text)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.Format
(VerificationKey -> Text)
(VerificationKey -> VerificationKey -> Text)
forall r. Format r (VerificationKey -> r)
vkFFormat
(VerificationKey -> Text)
(VerificationKey -> VerificationKey -> Text)
-> Format Text (VerificationKey -> Text)
-> Format Text (VerificationKey -> VerificationKey -> Text)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.Format (VerificationKey -> Text) (VerificationKey -> Text)
" doesn't match expected: "Format (VerificationKey -> Text) (VerificationKey -> Text)
-> Format Text (VerificationKey -> Text)
-> Format Text (VerificationKey -> Text)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.Format Text (VerificationKey -> Text)
forall r. Format r (VerificationKey -> r)
vkF)
( ACertificate a -> VerificationKey
forall a. ACertificate a -> VerificationKey
Dlg.issuerVK ACertificate a
cert) VerificationKey
issuerVK'
| ACertificate a -> VerificationKey
forall a. ACertificate a -> VerificationKey
Dlg.issuerVK ACertificate a
cert VerificationKey -> VerificationKey -> Bool
forall a. Eq a => a -> a -> Bool
/= VerificationKey
issuerVK'
]
, [ Format Text (VerificationKey -> VerificationKey -> Text)
-> VerificationKey -> VerificationKey -> Text
forall a. Format Text a -> a
sformat (Format
(VerificationKey -> VerificationKey -> Text)
(VerificationKey -> VerificationKey -> Text)
"Certificate delegate "Format
(VerificationKey -> VerificationKey -> Text)
(VerificationKey -> VerificationKey -> Text)
-> Format Text (VerificationKey -> VerificationKey -> Text)
-> Format Text (VerificationKey -> VerificationKey -> Text)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.Format
(VerificationKey -> Text)
(VerificationKey -> VerificationKey -> Text)
forall r. Format r (VerificationKey -> r)
vkFFormat
(VerificationKey -> Text)
(VerificationKey -> VerificationKey -> Text)
-> Format Text (VerificationKey -> Text)
-> Format Text (VerificationKey -> VerificationKey -> Text)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.Format (VerificationKey -> Text) (VerificationKey -> Text)
" doesn't match expected: "Format (VerificationKey -> Text) (VerificationKey -> Text)
-> Format Text (VerificationKey -> Text)
-> Format Text (VerificationKey -> Text)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.Format Text (VerificationKey -> Text)
forall r. Format r (VerificationKey -> r)
vkF)
( ACertificate a -> VerificationKey
forall a. ACertificate a -> VerificationKey
Dlg.delegateVK ACertificate a
cert) VerificationKey
delegateVK'
| ACertificate a -> VerificationKey
forall a. ACertificate a -> VerificationKey
Dlg.delegateVK ACertificate a
cert VerificationKey -> VerificationKey -> Bool
forall a. Eq a => a -> a -> Bool
/= VerificationKey
delegateVK'
]
]
where
magic' :: Annotated ProtocolMagicId ByteString
magic' :: Annotated ProtocolMagicId ByteString
magic' = ProtocolMagicId
-> ByteString -> Annotated ProtocolMagicId ByteString
forall b a. b -> a -> Annotated b a
Annotated ProtocolMagicId
magic (ProtocolMagicId -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize' ProtocolMagicId
magic)
epoch :: EpochNumber
epoch :: EpochNumber
epoch = Annotated EpochNumber a -> EpochNumber
forall b a. Annotated b a -> b
unAnnotated (Annotated EpochNumber a -> EpochNumber)
-> Annotated EpochNumber a -> EpochNumber
forall a b. (a -> b) -> a -> b
$ ACertificate a -> Annotated EpochNumber a
forall a. ACertificate a -> Annotated EpochNumber a
Dlg.aEpoch ACertificate a
cert
cert' :: Dlg.ACertificate ByteString
cert' :: ACertificate ByteString
cert' = ACertificate a
cert { aEpoch :: Annotated EpochNumber ByteString
Dlg.aEpoch = EpochNumber -> ByteString -> Annotated EpochNumber ByteString
forall b a. b -> a -> Annotated b a
Annotated EpochNumber
epoch (EpochNumber -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize' EpochNumber
epoch)
, annotation :: ByteString
Dlg.annotation = Certificate -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize' (ACertificate ByteString -> Certificate
forall (f :: * -> *) a. Functor f => f a -> f ()
void ACertificate ByteString
cert')
}
vkF :: forall r. Format r (Crypto.VerificationKey -> r)
vkF :: Format r (VerificationKey -> r)
vkF = Format r (VerificationKey -> r)
forall r. Format r (VerificationKey -> r)
Crypto.fullVerificationKeyF
serialiseDelegationCert :: Dlg.Certificate -> LB.ByteString
serialiseDelegationCert :: Certificate -> ByteString
serialiseDelegationCert = Certificate -> ByteString
forall a. ToJSON Identity a => a -> ByteString
canonicalEncodePretty
serialiseDelegateKey :: CardanoEra -> SigningKey -> Either ByronDelegationError LB.ByteString
serialiseDelegateKey :: CardanoEra -> SigningKey -> Either ByronDelegationError ByteString
serialiseDelegateKey CardanoEra
ByronEraLegacy SigningKey
sk = ByteString -> Either ByronDelegationError ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(ByteString -> Either ByronDelegationError ByteString)
-> (LegacyDelegateKey -> ByteString)
-> LegacyDelegateKey
-> Either ByronDelegationError ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Encoding -> ByteString
toLazyByteString
(Encoding -> ByteString)
-> (LegacyDelegateKey -> Encoding)
-> LegacyDelegateKey
-> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LegacyDelegateKey -> Encoding
Legacy.encodeLegacyDelegateKey
(LegacyDelegateKey -> Either ByronDelegationError ByteString)
-> LegacyDelegateKey -> Either ByronDelegationError ByteString
forall a b. (a -> b) -> a -> b
$ SigningKey -> LegacyDelegateKey
Legacy.LegacyDelegateKey SigningKey
sk
serialiseDelegateKey CardanoEra
ByronEra SigningKey
sk =
(ByronKeyFailure -> ByronDelegationError)
-> Either ByronKeyFailure ByteString
-> Either ByronDelegationError ByteString
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ByronKeyFailure -> ByronDelegationError
ByronDelegationKeyError (Either ByronKeyFailure ByteString
-> Either ByronDelegationError ByteString)
-> Either ByronKeyFailure ByteString
-> Either ByronDelegationError ByteString
forall a b. (a -> b) -> a -> b
$
CardanoEra -> SigningKey -> Either ByronKeyFailure ByteString
serialiseSigningKey CardanoEra
ByronEra SigningKey
sk