{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Chain.Delegation.Certificate
  ( -- * Certificate
    Certificate,
    ACertificate (..),
    CertificateId,

    -- * Certificate Constructors
    signCertificate,
    unsafeCertificate,

    -- * Certificate Accessor
    epoch,
    recoverCertificateId,

    -- * Certificate Predicate
    isValid,
  )
where

import Cardano.Binary
  ( Annotated (Annotated, unAnnotated),
    ByteSpan,
    Decoded (..),
    FromCBOR (..),
    ToCBOR (..),
    annotatedDecoder,
    encodeListLen,
    enforceSize,
    fromCBORAnnotated,
    serialize',
  )
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.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,
  )

--------------------------------------------------------------------------------
-- Certificate
--------------------------------------------------------------------------------

-- | A delegation certificate identifier (the 'Hash' of a 'Certificate').
type CertificateId = Hash Certificate

type Certificate = ACertificate ()

-- | Delegation certificate allowing the @delegateVK@ to sign blocks on behalf
--   of @issuerVK@
--
--   Each delegator can publish at most one 'Certificate' per 'EpochNumber', and
--   that 'EpochNumber' must correspond to the current or next 'EpochNumber' at
--   the time of publishing
data ACertificate a = UnsafeACertificate
  { -- | The epoch from which the delegation is valid
    ACertificate a -> Annotated EpochNumber a
aEpoch :: !(Annotated EpochNumber a),
    -- | The issuer of the certificate, who delegates their right to sign blocks
    ACertificate a -> VerificationKey
issuerVK :: !VerificationKey,
    -- | The delegate, who gains the right to sign blocks
    ACertificate a -> VerificationKey
delegateVK :: !VerificationKey,
    -- | The signature that proves the certificate was issued by @issuerVK@
    ACertificate a -> Signature EpochNumber
signature :: !(Signature EpochNumber),
    ACertificate a -> a
annotation :: !a
  }
  deriving (ACertificate a -> ACertificate a -> Bool
(ACertificate a -> ACertificate a -> Bool)
-> (ACertificate a -> ACertificate a -> Bool)
-> Eq (ACertificate a)
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, Eq (ACertificate a)
Eq (ACertificate a)
-> (ACertificate a -> ACertificate a -> Ordering)
-> (ACertificate a -> ACertificate a -> Bool)
-> (ACertificate a -> ACertificate a -> Bool)
-> (ACertificate a -> ACertificate a -> Bool)
-> (ACertificate a -> ACertificate a -> Bool)
-> (ACertificate a -> ACertificate a -> ACertificate a)
-> (ACertificate a -> ACertificate a -> ACertificate a)
-> Ord (ACertificate a)
ACertificate a -> ACertificate a -> Bool
ACertificate a -> ACertificate a -> Ordering
ACertificate a -> ACertificate a -> ACertificate a
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
$cp1Ord :: forall a. Ord a => Eq (ACertificate a)
Ord, Int -> ACertificate a -> ShowS
[ACertificate a] -> ShowS
ACertificate a -> String
(Int -> ACertificate a -> ShowS)
-> (ACertificate a -> String)
-> ([ACertificate a] -> ShowS)
-> Show (ACertificate a)
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 x. ACertificate a -> Rep (ACertificate a) x)
-> (forall x. Rep (ACertificate a) x -> ACertificate a)
-> Generic (ACertificate a)
forall x. Rep (ACertificate a) x -> ACertificate a
forall x. ACertificate a -> Rep (ACertificate a) x
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, a -> ACertificate b -> ACertificate a
(a -> b) -> ACertificate a -> ACertificate b
(forall a b. (a -> b) -> ACertificate a -> ACertificate b)
-> (forall a b. a -> ACertificate b -> ACertificate a)
-> Functor ACertificate
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
<$ :: a -> ACertificate b -> ACertificate a
$c<$ :: forall a b. a -> ACertificate b -> ACertificate a
fmap :: (a -> b) -> ACertificate a -> ACertificate b
$cfmap :: forall a b. (a -> b) -> ACertificate a -> ACertificate b
Functor)
  deriving anyclass (ACertificate a -> ()
(ACertificate a -> ()) -> NFData (ACertificate a)
forall a. NFData a => ACertificate a -> ()
forall a. (a -> ()) -> NFData a
rnf :: ACertificate a -> ()
$crnf :: forall a. NFData a => ACertificate a -> ()
NFData, Context -> ACertificate a -> IO (Maybe ThunkInfo)
Proxy (ACertificate a) -> String
(Context -> ACertificate a -> IO (Maybe ThunkInfo))
-> (Context -> ACertificate a -> IO (Maybe ThunkInfo))
-> (Proxy (ACertificate a) -> String)
-> NoThunks (ACertificate a)
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)

-- Used for debugging purposes only
instance Aeson.ToJSON a => Aeson.ToJSON (ACertificate a)

--------------------------------------------------------------------------------
-- Certificate Constructors
--------------------------------------------------------------------------------

-- | Create a 'Certificate', signing it with the provided safe signer.
signCertificate ::
  ProtocolMagicId ->
  VerificationKey ->
  EpochNumber ->
  SafeSigner ->
  Certificate
signCertificate :: ProtocolMagicId
-> VerificationKey -> EpochNumber -> SafeSigner -> Certificate
signCertificate ProtocolMagicId
protocolMagicId VerificationKey
delegateVK EpochNumber
epochNumber SafeSigner
safeSigner =
  UnsafeACertificate :: forall a.
Annotated EpochNumber a
-> VerificationKey
-> VerificationKey
-> Signature EpochNumber
-> a
-> ACertificate a
UnsafeACertificate
    { aEpoch :: Annotated EpochNumber ()
aEpoch = EpochNumber -> () -> Annotated EpochNumber ()
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 = Signature ByteString -> Signature EpochNumber
coerce Signature ByteString
sig,
      annotation :: ()
annotation = ()
    }
  where
    sig :: Signature ByteString
sig =
      ProtocolMagicId
-> SignTag -> SafeSigner -> ByteString -> Signature ByteString
forall a.
ToCBOR a =>
ProtocolMagicId -> SignTag -> SafeSigner -> a -> Signature a
safeSign ProtocolMagicId
protocolMagicId SignTag
SignCertificate SafeSigner
safeSigner (ByteString -> Signature ByteString)
-> ByteString -> Signature ByteString
forall a b. (a -> b) -> a -> b
$
        [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
          [ ByteString
"00",
            XPub -> ByteString
CC.unXPub (VerificationKey -> XPub
unVerificationKey VerificationKey
delegateVK),
            EpochNumber -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize' EpochNumber
epochNumber
          ]

-- | Create a certificate using the provided signature.
unsafeCertificate ::
  EpochNumber ->
  -- | The issuer of the certificate. See 'UnsafeACertificate'.
  VerificationKey ->
  -- | The delegate of the certificate. See 'UnsafeACertificate'.
  VerificationKey ->
  Signature EpochNumber ->
  Certificate
unsafeCertificate :: EpochNumber
-> VerificationKey
-> VerificationKey
-> Signature EpochNumber
-> Certificate
unsafeCertificate EpochNumber
e VerificationKey
ivk VerificationKey
dvk Signature EpochNumber
sig = Annotated EpochNumber ()
-> VerificationKey
-> VerificationKey
-> Signature EpochNumber
-> ()
-> Certificate
forall a.
Annotated EpochNumber a
-> VerificationKey
-> VerificationKey
-> Signature EpochNumber
-> a
-> ACertificate a
UnsafeACertificate (EpochNumber -> () -> Annotated EpochNumber ()
forall b a. b -> a -> Annotated b a
Annotated EpochNumber
e ()) VerificationKey
ivk VerificationKey
dvk Signature EpochNumber
sig ()

--------------------------------------------------------------------------------
-- Certificate Accessor
--------------------------------------------------------------------------------

epoch :: ACertificate a -> EpochNumber
epoch :: ACertificate a -> EpochNumber
epoch = Annotated EpochNumber a -> EpochNumber
forall b a. Annotated b a -> b
unAnnotated (Annotated EpochNumber a -> EpochNumber)
-> (ACertificate a -> Annotated EpochNumber a)
-> ACertificate a
-> EpochNumber
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ACertificate a -> Annotated EpochNumber a
forall a. ACertificate a -> Annotated EpochNumber a
aEpoch

recoverCertificateId :: ACertificate ByteString -> CertificateId
recoverCertificateId :: ACertificate ByteString -> CertificateId
recoverCertificateId = ACertificate ByteString -> CertificateId
forall t. Decoded t => t -> Hash (BaseType t)
hashDecoded

--------------------------------------------------------------------------------
-- Certificate Predicate
--------------------------------------------------------------------------------

-- | A 'Certificate' is valid if the 'Signature' is valid
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} =
  Annotated ProtocolMagicId ByteString
-> SignTag
-> VerificationKey
-> Annotated EpochNumber ByteString
-> Signature (BaseType (Annotated EpochNumber ByteString))
-> Bool
forall t.
Decoded t =>
Annotated ProtocolMagicId ByteString
-> SignTag
-> VerificationKey
-> t
-> Signature (BaseType t)
-> Bool
verifySignatureDecoded
    Annotated ProtocolMagicId ByteString
pm
    SignTag
SignCertificate
    VerificationKey
issuerVK
    ( ByteString -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize'
        (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
mappend (ByteString
"00" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XPub -> ByteString
CC.unXPub (VerificationKey -> XPub
unVerificationKey VerificationKey
delegateVK))
        (ByteString -> ByteString)
-> Annotated EpochNumber ByteString
-> Annotated EpochNumber ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotated EpochNumber ByteString
aEpoch
    )
    Signature (BaseType (Annotated EpochNumber ByteString))
Signature EpochNumber
signature

--------------------------------------------------------------------------------
-- Certificate Binary Serialization
--------------------------------------------------------------------------------

instance ToCBOR Certificate where
  toCBOR :: Certificate -> Encoding
toCBOR Certificate
cert =
    Word -> Encoding
encodeListLen Word
4
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> EpochNumber -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Certificate -> EpochNumber
forall a. ACertificate a -> EpochNumber
epoch Certificate
cert)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VerificationKey -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Certificate -> VerificationKey
forall a. ACertificate a -> VerificationKey
issuerVK Certificate
cert)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VerificationKey -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Certificate -> VerificationKey
forall a. ACertificate a -> VerificationKey
delegateVK Certificate
cert)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Signature EpochNumber -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Certificate -> Signature EpochNumber
forall a. ACertificate a -> Signature EpochNumber
signature Certificate
cert)

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy Certificate -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy Certificate
cert =
    Size
1
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy EpochNumber -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (Certificate -> EpochNumber
forall a. ACertificate a -> EpochNumber
epoch (Certificate -> EpochNumber)
-> Proxy Certificate -> Proxy EpochNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Certificate
cert)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy VerificationKey -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (Certificate -> VerificationKey
forall a. ACertificate a -> VerificationKey
issuerVK (Certificate -> VerificationKey)
-> Proxy Certificate -> Proxy VerificationKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Certificate
cert)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy VerificationKey -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (Certificate -> VerificationKey
forall a. ACertificate a -> VerificationKey
delegateVK (Certificate -> VerificationKey)
-> Proxy Certificate -> Proxy VerificationKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Certificate
cert)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Signature EpochNumber) -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (Certificate -> Signature EpochNumber
forall a. ACertificate a -> Signature EpochNumber
signature (Certificate -> Signature EpochNumber)
-> Proxy Certificate -> Proxy (Signature EpochNumber)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Certificate
cert)

instance FromCBOR Certificate where
  fromCBOR :: Decoder s Certificate
fromCBOR = ACertificate ByteSpan -> Certificate
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ACertificate ByteSpan -> Certificate)
-> Decoder s (ACertificate ByteSpan) -> Decoder s Certificate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s.
FromCBOR (ACertificate ByteSpan) =>
Decoder s (ACertificate ByteSpan)
forall a s. FromCBOR a => Decoder s a
fromCBOR @(ACertificate ByteSpan)

instance FromCBOR (ACertificate ByteSpan) where
  fromCBOR :: Decoder s (ACertificate ByteSpan)
fromCBOR = do
    Annotated (Annotated EpochNumber ByteSpan
e, VerificationKey
ivk, VerificationKey
dvk, Signature EpochNumber
sig) ByteSpan
byteSpan <- Decoder
  s
  (Annotated EpochNumber ByteSpan, VerificationKey, VerificationKey,
   Signature EpochNumber)
-> Decoder
     s
     (Annotated
        (Annotated EpochNumber ByteSpan, VerificationKey, VerificationKey,
         Signature EpochNumber)
        ByteSpan)
forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder (Decoder
   s
   (Annotated EpochNumber ByteSpan, VerificationKey, VerificationKey,
    Signature EpochNumber)
 -> Decoder
      s
      (Annotated
         (Annotated EpochNumber ByteSpan, VerificationKey, VerificationKey,
          Signature EpochNumber)
         ByteSpan))
-> Decoder
     s
     (Annotated EpochNumber ByteSpan, VerificationKey, VerificationKey,
      Signature EpochNumber)
-> Decoder
     s
     (Annotated
        (Annotated EpochNumber ByteSpan, VerificationKey, VerificationKey,
         Signature EpochNumber)
        ByteSpan)
forall a b. (a -> b) -> a -> b
$ do
      Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"Delegation.Certificate" Int
4
      (,,,)
        (Annotated EpochNumber ByteSpan
 -> VerificationKey
 -> VerificationKey
 -> Signature EpochNumber
 -> (Annotated EpochNumber ByteSpan, VerificationKey,
     VerificationKey, Signature EpochNumber))
-> Decoder s (Annotated EpochNumber ByteSpan)
-> Decoder
     s
     (VerificationKey
      -> VerificationKey
      -> Signature EpochNumber
      -> (Annotated EpochNumber ByteSpan, VerificationKey,
          VerificationKey, Signature EpochNumber))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotated EpochNumber ByteSpan)
forall a s. FromCBOR a => Decoder s (Annotated a ByteSpan)
fromCBORAnnotated
        Decoder
  s
  (VerificationKey
   -> VerificationKey
   -> Signature EpochNumber
   -> (Annotated EpochNumber ByteSpan, VerificationKey,
       VerificationKey, Signature EpochNumber))
-> Decoder s VerificationKey
-> Decoder
     s
     (VerificationKey
      -> Signature EpochNumber
      -> (Annotated EpochNumber ByteSpan, VerificationKey,
          VerificationKey, Signature EpochNumber))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s VerificationKey
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (VerificationKey
   -> Signature EpochNumber
   -> (Annotated EpochNumber ByteSpan, VerificationKey,
       VerificationKey, Signature EpochNumber))
-> Decoder s VerificationKey
-> Decoder
     s
     (Signature EpochNumber
      -> (Annotated EpochNumber ByteSpan, VerificationKey,
          VerificationKey, Signature EpochNumber))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s VerificationKey
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (Signature EpochNumber
   -> (Annotated EpochNumber ByteSpan, VerificationKey,
       VerificationKey, Signature EpochNumber))
-> Decoder s (Signature EpochNumber)
-> Decoder
     s
     (Annotated EpochNumber ByteSpan, VerificationKey, VerificationKey,
      Signature EpochNumber)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Signature EpochNumber)
forall a s. FromCBOR a => Decoder s a
fromCBOR
    ACertificate ByteSpan -> Decoder s (ACertificate ByteSpan)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ACertificate ByteSpan -> Decoder s (ACertificate ByteSpan))
-> ACertificate ByteSpan -> Decoder s (ACertificate ByteSpan)
forall a b. (a -> b) -> a -> b
$ Annotated EpochNumber ByteSpan
-> VerificationKey
-> VerificationKey
-> Signature EpochNumber
-> ByteSpan
-> ACertificate ByteSpan
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 = ACertificate ByteString -> ByteString
forall a. ACertificate a -> a
annotation

--------------------------------------------------------------------------------
-- Certificate Formatting
--------------------------------------------------------------------------------

instance B.Buildable (ACertificate a) where
  build :: ACertificate a -> Builder
build (UnsafeACertificate Annotated EpochNumber a
e VerificationKey
iVK VerificationKey
dVK Signature EpochNumber
_ a
_) =
    Format
  Builder
  (EpochNumber -> VerificationKey -> VerificationKey -> Builder)
-> EpochNumber -> VerificationKey -> VerificationKey -> Builder
forall a. Format Builder a -> a
bprint
      ( Format
  (EpochNumber -> VerificationKey -> VerificationKey -> Builder)
  (EpochNumber -> VerificationKey -> VerificationKey -> Builder)
"Delegation.Certificate { w = " Format
  (EpochNumber -> VerificationKey -> VerificationKey -> Builder)
  (EpochNumber -> VerificationKey -> VerificationKey -> Builder)
-> Format
     Builder
     (EpochNumber -> VerificationKey -> VerificationKey -> Builder)
-> Format
     Builder
     (EpochNumber -> VerificationKey -> VerificationKey -> Builder)
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)
  (EpochNumber -> VerificationKey -> VerificationKey -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
          Format
  (VerificationKey -> VerificationKey -> Builder)
  (EpochNumber -> VerificationKey -> VerificationKey -> Builder)
-> Format Builder (VerificationKey -> VerificationKey -> Builder)
-> Format
     Builder
     (EpochNumber -> VerificationKey -> VerificationKey -> Builder)
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 = "
          Format
  (VerificationKey -> VerificationKey -> Builder)
  (VerificationKey -> VerificationKey -> Builder)
-> Format Builder (VerificationKey -> VerificationKey -> Builder)
-> Format Builder (VerificationKey -> VerificationKey -> Builder)
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 -> VerificationKey -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
          Format
  (VerificationKey -> Builder)
  (VerificationKey -> VerificationKey -> Builder)
-> Format Builder (VerificationKey -> Builder)
-> Format Builder (VerificationKey -> VerificationKey -> Builder)
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 = "
          Format (VerificationKey -> Builder) (VerificationKey -> Builder)
-> Format Builder (VerificationKey -> Builder)
-> Format Builder (VerificationKey -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (VerificationKey -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
          Format Builder (VerificationKey -> Builder)
-> Format Builder Builder
-> Format Builder (VerificationKey -> Builder)
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
" }"
      )
      (Annotated EpochNumber a -> EpochNumber
forall b a. Annotated b a -> b
unAnnotated Annotated EpochNumber a
e)
      VerificationKey
iVK
      VerificationKey
dVK

--------------------------------------------------------------------------------
-- Certificate Canonical JSON
--------------------------------------------------------------------------------

instance Monad m => ToJSON m Certificate where
  toJSON :: Certificate -> m JSValue
toJSON Certificate
cert =
    [(JSString, m JSValue)] -> m JSValue
forall (m :: * -> *).
Monad m =>
[(JSString, m JSValue)] -> m JSValue
mkObject
      -- omega is encoded as a number, because in genesis we always set it to 0
      [ (JSString
"omega", JSValue -> m JSValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int54 -> JSValue
JSNum (Int54 -> JSValue)
-> (EpochNumber -> Int54) -> EpochNumber -> JSValue
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. EpochNumber -> Int54
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EpochNumber -> JSValue) -> EpochNumber -> JSValue
forall a b. (a -> b) -> a -> b
$ Certificate -> EpochNumber
forall a. ACertificate a -> EpochNumber
epoch Certificate
cert)),
        (JSString
"issuerPk", VerificationKey -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON (VerificationKey -> m JSValue) -> VerificationKey -> m JSValue
forall a b. (a -> b) -> a -> b
$ Certificate -> VerificationKey
forall a. ACertificate a -> VerificationKey
issuerVK Certificate
cert),
        (JSString
"delegatePk", VerificationKey -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON (VerificationKey -> m JSValue) -> VerificationKey -> m JSValue
forall a b. (a -> b) -> a -> b
$ Certificate -> VerificationKey
forall a. ACertificate a -> VerificationKey
delegateVK Certificate
cert),
        (JSString
"cert", Signature EpochNumber -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON (Signature EpochNumber -> m JSValue)
-> Signature EpochNumber -> m JSValue
forall a b. (a -> b) -> a -> b
$ Certificate -> Signature EpochNumber
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
      (EpochNumber
 -> VerificationKey
 -> VerificationKey
 -> Signature EpochNumber
 -> Certificate)
-> m EpochNumber
-> m (VerificationKey
      -> VerificationKey -> Signature EpochNumber -> Certificate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall b. (Integral Int54, Num b) => Int54 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int54 (Int54 -> EpochNumber) -> m Int54 -> m EpochNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> JSString -> m Int54
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"omega")
      m (VerificationKey
   -> VerificationKey -> Signature EpochNumber -> Certificate)
-> m VerificationKey
-> m (VerificationKey -> Signature EpochNumber -> Certificate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue -> JSString -> m VerificationKey
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"issuerPk"
      m (VerificationKey -> Signature EpochNumber -> Certificate)
-> m VerificationKey -> m (Signature EpochNumber -> Certificate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue -> JSString -> m VerificationKey
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"delegatePk"
      m (Signature EpochNumber -> Certificate)
-> m (Signature EpochNumber) -> m Certificate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue -> JSString -> m (Signature EpochNumber)
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"cert"