{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Cardano.Chain.Delegation.Certificate (
Certificate,
ACertificate (..),
CertificateId,
signCertificate,
unsafeCertificate,
epoch,
recoverCertificateId,
isValid,
)
where
import Cardano.Chain.Slotting (EpochNumber)
import Cardano.Crypto (
Hash,
ProtocolMagicId,
SafeSigner,
SignTag (SignCertificate),
Signature,
VerificationKey (unVerificationKey),
hashDecoded,
safeSign,
safeToVerification,
verifySignatureDecoded,
)
import qualified Cardano.Crypto.Wallet as CC
import Cardano.Ledger.Binary (
Annotated (Annotated, unAnnotated),
ByteSpan,
DecCBOR (..),
Decoded (..),
EncCBOR (..),
FromCBOR (..),
ToCBOR (..),
annotatedDecoder,
byronProtVer,
decCBORAnnotated,
encodeListLen,
enforceSize,
fromByronCBOR,
serialize',
toByronCBOR,
)
import Cardano.Prelude
import qualified Data.Aeson as Aeson
import Data.Coerce (coerce)
import Formatting (bprint, build)
import qualified Formatting.Buildable as B
import NoThunks.Class (NoThunks (..))
import Text.JSON.Canonical (
FromJSON (..),
Int54,
JSValue (..),
ToJSON (..),
fromJSField,
mkObject,
)
type CertificateId = Hash Certificate
type Certificate = ACertificate ()
data ACertificate a = UnsafeACertificate
{ forall a. ACertificate a -> Annotated EpochNumber a
aEpoch :: !(Annotated EpochNumber a)
, forall a. ACertificate a -> VerificationKey
issuerVK :: !VerificationKey
, forall a. ACertificate a -> VerificationKey
delegateVK :: !VerificationKey
, forall a. ACertificate a -> Signature EpochNumber
signature :: !(Signature EpochNumber)
, forall a. ACertificate a -> a
annotation :: !a
}
deriving (ACertificate a -> ACertificate a -> Bool
forall a. Eq a => ACertificate a -> ACertificate a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ACertificate a -> ACertificate a -> Bool
$c/= :: forall a. Eq a => ACertificate a -> ACertificate a -> Bool
== :: ACertificate a -> ACertificate a -> Bool
$c== :: forall a. Eq a => ACertificate a -> ACertificate a -> Bool
Eq, ACertificate a -> ACertificate a -> Bool
ACertificate a -> ACertificate a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (ACertificate a)
forall a. Ord a => ACertificate a -> ACertificate a -> Bool
forall a. Ord a => ACertificate a -> ACertificate a -> Ordering
forall a.
Ord a =>
ACertificate a -> ACertificate a -> ACertificate a
min :: ACertificate a -> ACertificate a -> ACertificate a
$cmin :: forall a.
Ord a =>
ACertificate a -> ACertificate a -> ACertificate a
max :: ACertificate a -> ACertificate a -> ACertificate a
$cmax :: forall a.
Ord a =>
ACertificate a -> ACertificate a -> ACertificate a
>= :: ACertificate a -> ACertificate a -> Bool
$c>= :: forall a. Ord a => ACertificate a -> ACertificate a -> Bool
> :: ACertificate a -> ACertificate a -> Bool
$c> :: forall a. Ord a => ACertificate a -> ACertificate a -> Bool
<= :: ACertificate a -> ACertificate a -> Bool
$c<= :: forall a. Ord a => ACertificate a -> ACertificate a -> Bool
< :: ACertificate a -> ACertificate a -> Bool
$c< :: forall a. Ord a => ACertificate a -> ACertificate a -> Bool
compare :: ACertificate a -> ACertificate a -> Ordering
$ccompare :: forall a. Ord a => ACertificate a -> ACertificate a -> Ordering
Ord, Int -> ACertificate a -> ShowS
forall a. Show a => Int -> ACertificate a -> ShowS
forall a. Show a => [ACertificate a] -> ShowS
forall a. Show a => ACertificate a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ACertificate a] -> ShowS
$cshowList :: forall a. Show a => [ACertificate a] -> ShowS
show :: ACertificate a -> String
$cshow :: forall a. Show a => ACertificate a -> String
showsPrec :: Int -> ACertificate a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ACertificate a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ACertificate a) x -> ACertificate a
forall a x. ACertificate a -> Rep (ACertificate a) x
$cto :: forall a x. Rep (ACertificate a) x -> ACertificate a
$cfrom :: forall a x. ACertificate a -> Rep (ACertificate a) x
Generic, forall a b. a -> ACertificate b -> ACertificate a
forall a b. (a -> b) -> ACertificate a -> ACertificate b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ACertificate b -> ACertificate a
$c<$ :: forall a b. a -> ACertificate b -> ACertificate a
fmap :: forall a b. (a -> b) -> ACertificate a -> ACertificate b
$cfmap :: forall a b. (a -> b) -> ACertificate a -> ACertificate b
Functor)
deriving anyclass (forall a. NFData a => ACertificate a -> ()
forall a. (a -> ()) -> NFData a
rnf :: ACertificate a -> ()
$crnf :: forall a. NFData a => ACertificate a -> ()
NFData, forall a.
NoThunks a =>
Context -> ACertificate a -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Proxy (ACertificate a) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (ACertificate a) -> String
$cshowTypeOf :: forall a. NoThunks a => Proxy (ACertificate a) -> String
wNoThunks :: Context -> ACertificate a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall a.
NoThunks a =>
Context -> ACertificate a -> IO (Maybe ThunkInfo)
noThunks :: Context -> ACertificate a -> IO (Maybe ThunkInfo)
$cnoThunks :: forall a.
NoThunks a =>
Context -> ACertificate a -> IO (Maybe ThunkInfo)
NoThunks)
instance Aeson.ToJSON a => Aeson.ToJSON (ACertificate a)
signCertificate ::
ProtocolMagicId ->
VerificationKey ->
EpochNumber ->
SafeSigner ->
Certificate
signCertificate :: ProtocolMagicId
-> VerificationKey -> EpochNumber -> SafeSigner -> Certificate
signCertificate ProtocolMagicId
protocolMagicId VerificationKey
delegateVK EpochNumber
epochNumber SafeSigner
safeSigner =
UnsafeACertificate
{ aEpoch :: Annotated EpochNumber ()
aEpoch = forall b a. b -> a -> Annotated b a
Annotated EpochNumber
epochNumber ()
, issuerVK :: VerificationKey
issuerVK = SafeSigner -> VerificationKey
safeToVerification SafeSigner
safeSigner
, delegateVK :: VerificationKey
delegateVK = VerificationKey
delegateVK
, signature :: Signature EpochNumber
signature = coerce :: forall a b. Coercible a b => a -> b
coerce Signature ByteString
sig
, annotation :: ()
annotation = ()
}
where
sig :: Signature ByteString
sig =
forall a.
EncCBOR a =>
ProtocolMagicId -> SignTag -> SafeSigner -> a -> Signature a
safeSign ProtocolMagicId
protocolMagicId SignTag
SignCertificate SafeSigner
safeSigner
forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
[ ByteString
"00"
, XPub -> ByteString
CC.unXPub (VerificationKey -> XPub
unVerificationKey VerificationKey
delegateVK)
, forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
byronProtVer EpochNumber
epochNumber
]
unsafeCertificate ::
EpochNumber ->
VerificationKey ->
VerificationKey ->
Signature EpochNumber ->
Certificate
unsafeCertificate :: EpochNumber
-> VerificationKey
-> VerificationKey
-> Signature EpochNumber
-> Certificate
unsafeCertificate EpochNumber
e VerificationKey
ivk VerificationKey
dvk Signature EpochNumber
sig = forall a.
Annotated EpochNumber a
-> VerificationKey
-> VerificationKey
-> Signature EpochNumber
-> a
-> ACertificate a
UnsafeACertificate (forall b a. b -> a -> Annotated b a
Annotated EpochNumber
e ()) VerificationKey
ivk VerificationKey
dvk Signature EpochNumber
sig ()
epoch :: ACertificate a -> EpochNumber
epoch :: forall a. ACertificate a -> EpochNumber
epoch = forall b a. Annotated b a -> b
unAnnotated forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. ACertificate a -> Annotated EpochNumber a
aEpoch
recoverCertificateId :: ACertificate ByteString -> CertificateId
recoverCertificateId :: ACertificate ByteString -> CertificateId
recoverCertificateId = forall t. Decoded t => t -> Hash (BaseType t)
hashDecoded
isValid ::
Annotated ProtocolMagicId ByteString ->
ACertificate ByteString ->
Bool
isValid :: Annotated ProtocolMagicId ByteString
-> ACertificate ByteString -> Bool
isValid Annotated ProtocolMagicId ByteString
pm UnsafeACertificate {Annotated EpochNumber ByteString
aEpoch :: Annotated EpochNumber ByteString
aEpoch :: forall a. ACertificate a -> Annotated EpochNumber a
aEpoch, VerificationKey
issuerVK :: VerificationKey
issuerVK :: forall a. ACertificate a -> VerificationKey
issuerVK, VerificationKey
delegateVK :: VerificationKey
delegateVK :: forall a. ACertificate a -> VerificationKey
delegateVK, Signature EpochNumber
signature :: Signature EpochNumber
signature :: forall a. ACertificate a -> Signature EpochNumber
signature} =
forall t.
Decoded t =>
Annotated ProtocolMagicId ByteString
-> SignTag
-> VerificationKey
-> t
-> Signature (BaseType t)
-> Bool
verifySignatureDecoded
Annotated ProtocolMagicId ByteString
pm
SignTag
SignCertificate
VerificationKey
issuerVK
( forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
byronProtVer
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Monoid a => a -> a -> a
mappend (ByteString
"00" forall a. Semigroup a => a -> a -> a
<> XPub -> ByteString
CC.unXPub (VerificationKey -> XPub
unVerificationKey VerificationKey
delegateVK))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotated EpochNumber ByteString
aEpoch
)
Signature EpochNumber
signature
instance ToCBOR Certificate where
toCBOR :: Certificate -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR
instance FromCBOR Certificate where
fromCBOR :: forall s. Decoder s Certificate
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR
instance EncCBOR Certificate where
encCBOR :: Certificate -> Encoding
encCBOR Certificate
cert =
Word -> Encoding
encodeListLen Word
4
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. ACertificate a -> EpochNumber
epoch Certificate
cert)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. ACertificate a -> VerificationKey
issuerVK Certificate
cert)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. ACertificate a -> VerificationKey
delegateVK Certificate
cert)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. ACertificate a -> Signature EpochNumber
signature Certificate
cert)
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy Certificate -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size Proxy Certificate
cert =
Size
1
forall a. Num a => a -> a -> a
+ forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size (forall a. ACertificate a -> EpochNumber
epoch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Certificate
cert)
forall a. Num a => a -> a -> a
+ forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size (forall a. ACertificate a -> VerificationKey
issuerVK forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Certificate
cert)
forall a. Num a => a -> a -> a
+ forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size (forall a. ACertificate a -> VerificationKey
delegateVK forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Certificate
cert)
forall a. Num a => a -> a -> a
+ forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size (forall a. ACertificate a -> Signature EpochNumber
signature forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Certificate
cert)
instance DecCBOR Certificate where
decCBOR :: forall s. Decoder s Certificate
decCBOR = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR @(ACertificate ByteSpan)
instance FromCBOR (ACertificate ByteSpan) where
fromCBOR :: forall s. Decoder s (ACertificate ByteSpan)
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR
instance DecCBOR (ACertificate ByteSpan) where
decCBOR :: forall s. Decoder s (ACertificate ByteSpan)
decCBOR = do
Annotated (Annotated EpochNumber ByteSpan
e, VerificationKey
ivk, VerificationKey
dvk, Signature EpochNumber
sig) ByteSpan
byteSpan <- forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder forall a b. (a -> b) -> a -> b
$ do
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"Delegation.Certificate" Int
4
(,,,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s (Annotated a ByteSpan)
decCBORAnnotated
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
Annotated EpochNumber a
-> VerificationKey
-> VerificationKey
-> Signature EpochNumber
-> a
-> ACertificate a
UnsafeACertificate Annotated EpochNumber ByteSpan
e VerificationKey
ivk VerificationKey
dvk Signature EpochNumber
sig ByteSpan
byteSpan
instance Decoded (ACertificate ByteString) where
type BaseType (ACertificate ByteString) = Certificate
recoverBytes :: ACertificate ByteString -> ByteString
recoverBytes = forall a. ACertificate a -> a
annotation
instance B.Buildable (ACertificate a) where
build :: ACertificate a -> Builder
build (UnsafeACertificate Annotated EpochNumber a
e VerificationKey
iVK VerificationKey
dVK Signature EpochNumber
_ a
_) =
forall a. Format Builder a -> a
bprint
( Format
(EpochNumber -> VerificationKey -> VerificationKey -> Builder)
(EpochNumber -> VerificationKey -> VerificationKey -> Builder)
"Delegation.Certificate { w = "
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
(VerificationKey -> VerificationKey -> Builder)
(VerificationKey -> VerificationKey -> Builder)
", iVK = "
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (VerificationKey -> Builder) (VerificationKey -> Builder)
", dVK = "
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder Builder
" }"
)
(forall b a. Annotated b a -> b
unAnnotated Annotated EpochNumber a
e)
VerificationKey
iVK
VerificationKey
dVK
instance Monad m => ToJSON m Certificate where
toJSON :: Certificate -> m JSValue
toJSON Certificate
cert =
forall (m :: * -> *).
Monad m =>
[(JSString, m JSValue)] -> m JSValue
mkObject
[ (JSString
"omega", forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int54 -> JSValue
JSNum forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. ACertificate a -> EpochNumber
epoch Certificate
cert))
, (JSString
"issuerPk", forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON forall a b. (a -> b) -> a -> b
$ forall a. ACertificate a -> VerificationKey
issuerVK Certificate
cert)
, (JSString
"delegatePk", forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON forall a b. (a -> b) -> a -> b
$ forall a. ACertificate a -> VerificationKey
delegateVK Certificate
cert)
, (JSString
"cert", forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON forall a b. (a -> b) -> a -> b
$ forall a. ACertificate a -> Signature EpochNumber
signature Certificate
cert)
]
instance MonadError SchemaError m => FromJSON m Certificate where
fromJSON :: JSValue -> m Certificate
fromJSON JSValue
obj =
EpochNumber
-> VerificationKey
-> VerificationKey
-> Signature EpochNumber
-> Certificate
unsafeCertificate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int54 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"omega")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"issuerPk"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"delegatePk"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"cert"