{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Cardano.Chain.Block.Proof (
Proof (..),
ProofValidationError (..),
mkProof,
recoverProof,
) where
import Cardano.Chain.Block.Body (
ABody (..),
Body,
bodyDlgPayload,
bodyTxPayload,
bodyUpdatePayload,
)
import qualified Cardano.Chain.Delegation.Payload as Delegation
import Cardano.Chain.Ssc (SscProof (..))
import Cardano.Chain.UTxO.TxProof (TxProof, mkTxProof, recoverTxProof)
import qualified Cardano.Chain.Update.Proof as Update
import Cardano.Crypto (Hash, hashDecoded, serializeCborHash)
import Cardano.Ledger.Binary (
DecCBOR (..),
EncCBOR (..),
FromCBOR (..),
ToCBOR (..),
encodeListLen,
enforceSize,
fromByronCBOR,
toByronCBOR,
)
import Cardano.Prelude
import Data.Aeson (ToJSON)
import Formatting (bprint, build, shown)
import qualified Formatting.Buildable as B
import NoThunks.Class (NoThunks (..))
data Proof = Proof
{ Proof -> TxProof
proofUTxO :: !TxProof
, Proof -> SscProof
proofSsc :: !SscProof
, Proof -> Hash Payload
proofDelegation :: !(Hash Delegation.Payload)
, Proof -> Proof
proofUpdate :: !Update.Proof
}
deriving (Proof -> Proof -> Bool
(Proof -> Proof -> Bool) -> (Proof -> Proof -> Bool) -> Eq Proof
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Proof -> Proof -> Bool
== :: Proof -> Proof -> Bool
$c/= :: Proof -> Proof -> Bool
/= :: Proof -> Proof -> Bool
Eq, Int -> Proof -> ShowS
[Proof] -> ShowS
Proof -> String
(Int -> Proof -> ShowS)
-> (Proof -> String) -> ([Proof] -> ShowS) -> Show Proof
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Proof -> ShowS
showsPrec :: Int -> Proof -> ShowS
$cshow :: Proof -> String
show :: Proof -> String
$cshowList :: [Proof] -> ShowS
showList :: [Proof] -> ShowS
Show, (forall x. Proof -> Rep Proof x)
-> (forall x. Rep Proof x -> Proof) -> Generic Proof
forall x. Rep Proof x -> Proof
forall x. Proof -> Rep Proof x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Proof -> Rep Proof x
from :: forall x. Proof -> Rep Proof x
$cto :: forall x. Rep Proof x -> Proof
to :: forall x. Rep Proof x -> Proof
Generic, Proof -> ()
(Proof -> ()) -> NFData Proof
forall a. (a -> ()) -> NFData a
$crnf :: Proof -> ()
rnf :: Proof -> ()
NFData, Context -> Proof -> IO (Maybe ThunkInfo)
Proxy Proof -> String
(Context -> Proof -> IO (Maybe ThunkInfo))
-> (Context -> Proof -> IO (Maybe ThunkInfo))
-> (Proxy Proof -> String)
-> NoThunks Proof
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> Proof -> IO (Maybe ThunkInfo)
noThunks :: Context -> Proof -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Proof -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Proof -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy Proof -> String
showTypeOf :: Proxy Proof -> String
NoThunks)
instance B.Buildable Proof where
build :: Proof -> Builder
build Proof
proof =
Format
Builder (TxProof -> SscProof -> Hash Payload -> Proof -> Builder)
-> TxProof -> SscProof -> Hash Payload -> Proof -> Builder
forall a. Format Builder a -> a
bprint
(Format
(TxProof -> SscProof -> Hash Payload -> Proof -> Builder)
(TxProof -> SscProof -> Hash Payload -> Proof -> Builder)
"<Proof: " Format
(TxProof -> SscProof -> Hash Payload -> Proof -> Builder)
(TxProof -> SscProof -> Hash Payload -> Proof -> Builder)
-> Format
Builder (TxProof -> SscProof -> Hash Payload -> Proof -> Builder)
-> Format
Builder (TxProof -> SscProof -> Hash Payload -> Proof -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
(SscProof -> Hash Payload -> Proof -> Builder)
(TxProof -> SscProof -> Hash Payload -> Proof -> Builder)
forall a r. Buildable a => Format r (a -> r)
build Format
(SscProof -> Hash Payload -> Proof -> Builder)
(TxProof -> SscProof -> Hash Payload -> Proof -> Builder)
-> Format Builder (SscProof -> Hash Payload -> Proof -> Builder)
-> Format
Builder (TxProof -> SscProof -> Hash Payload -> Proof -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
(SscProof -> Hash Payload -> Proof -> Builder)
(SscProof -> Hash Payload -> Proof -> Builder)
", " Format
(SscProof -> Hash Payload -> Proof -> Builder)
(SscProof -> Hash Payload -> Proof -> Builder)
-> Format Builder (SscProof -> Hash Payload -> Proof -> Builder)
-> Format Builder (SscProof -> Hash Payload -> Proof -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
(Hash Payload -> Proof -> Builder)
(SscProof -> Hash Payload -> Proof -> Builder)
forall a r. Show a => Format r (a -> r)
shown Format
(Hash Payload -> Proof -> Builder)
(SscProof -> Hash Payload -> Proof -> Builder)
-> Format Builder (Hash Payload -> Proof -> Builder)
-> Format Builder (SscProof -> Hash Payload -> Proof -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
(Hash Payload -> Proof -> Builder)
(Hash Payload -> Proof -> Builder)
", " Format
(Hash Payload -> Proof -> Builder)
(Hash Payload -> Proof -> Builder)
-> Format Builder (Hash Payload -> Proof -> Builder)
-> Format Builder (Hash Payload -> Proof -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Proof -> Builder) (Hash Payload -> Proof -> Builder)
forall a r. Buildable a => Format r (a -> r)
build Format (Proof -> Builder) (Hash Payload -> Proof -> Builder)
-> Format Builder (Proof -> Builder)
-> Format Builder (Hash Payload -> Proof -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Proof -> Builder) (Proof -> Builder)
", " Format (Proof -> Builder) (Proof -> Builder)
-> Format Builder (Proof -> Builder)
-> Format Builder (Proof -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Proof -> Builder)
forall a r. Buildable a => Format r (a -> r)
build Format Builder (Proof -> Builder)
-> Format Builder Builder -> Format Builder (Proof -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
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
">")
(Proof -> TxProof
proofUTxO Proof
proof)
(Proof -> SscProof
proofSsc Proof
proof)
(Proof -> Hash Payload
proofDelegation Proof
proof)
(Proof -> Proof
proofUpdate Proof
proof)
instance ToCBOR Proof where
toCBOR :: Proof -> Encoding
toCBOR = Proof -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR
instance FromCBOR Proof where
fromCBOR :: forall s. Decoder s Proof
fromCBOR = Decoder s Proof
forall a s. DecCBOR a => Decoder s a
fromByronCBOR
instance ToJSON Proof
instance EncCBOR Proof where
encCBOR :: Proof -> Encoding
encCBOR Proof
bc =
Word -> Encoding
encodeListLen Word
4
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxProof -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Proof -> TxProof
proofUTxO Proof
bc)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SscProof -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Proof -> SscProof
proofSsc Proof
bc)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Hash Payload -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Proof -> Hash Payload
proofDelegation Proof
bc)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Proof -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Proof -> Proof
proofUpdate Proof
bc)
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy Proof -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size Proxy Proof
bc =
Size
1
Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. EncCBOR t => Proxy t -> Size) -> Proxy TxProof -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
size (Proof -> TxProof
proofUTxO (Proof -> TxProof) -> Proxy Proof -> Proxy TxProof
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Proof
bc)
Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. EncCBOR t => Proxy t -> Size) -> Proxy SscProof -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
size (Proof -> SscProof
proofSsc (Proof -> SscProof) -> Proxy Proof -> Proxy SscProof
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Proof
bc)
Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (Hash Payload) -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
size (Proof -> Hash Payload
proofDelegation (Proof -> Hash Payload) -> Proxy Proof -> Proxy (Hash Payload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Proof
bc)
Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. EncCBOR t => Proxy t -> Size) -> Proxy Proof -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
size (Proof -> Proof
proofUpdate (Proof -> Proof) -> Proxy Proof -> Proxy Proof
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Proof
bc)
instance DecCBOR Proof where
decCBOR :: forall s. Decoder s Proof
decCBOR = do
Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"Proof" Int
4
TxProof -> SscProof -> Hash Payload -> Proof -> Proof
Proof (TxProof -> SscProof -> Hash Payload -> Proof -> Proof)
-> Decoder s TxProof
-> Decoder s (SscProof -> Hash Payload -> Proof -> Proof)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s TxProof
forall s. Decoder s TxProof
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (SscProof -> Hash Payload -> Proof -> Proof)
-> Decoder s SscProof -> Decoder s (Hash Payload -> Proof -> Proof)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s SscProof
forall s. Decoder s SscProof
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (Hash Payload -> Proof -> Proof)
-> Decoder s (Hash Payload) -> Decoder s (Proof -> Proof)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Hash Payload)
forall s. Decoder s (Hash Payload)
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (Proof -> Proof) -> Decoder s Proof -> Decoder s Proof
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Proof
forall s. Decoder s Proof
forall a s. DecCBOR a => Decoder s a
decCBOR
mkProof :: Body -> Proof
mkProof :: Body -> Proof
mkProof Body
body =
Proof
{ proofUTxO :: TxProof
proofUTxO = TxPayload -> TxProof
mkTxProof (TxPayload -> TxProof) -> TxPayload -> TxProof
forall a b. (a -> b) -> a -> b
$ Body -> TxPayload
forall a. ABody a -> ATxPayload a
bodyTxPayload Body
body
, proofSsc :: SscProof
proofSsc = SscProof
SscProof
, proofDelegation :: Hash Payload
proofDelegation = Payload -> Hash Payload
forall a. EncCBOR a => a -> Hash a
serializeCborHash (Payload -> Hash Payload) -> Payload -> Hash Payload
forall a b. (a -> b) -> a -> b
$ Body -> Payload
forall a. ABody a -> APayload a
bodyDlgPayload Body
body
, proofUpdate :: Proof
proofUpdate = APayload () -> Proof
Update.mkProof (APayload () -> Proof) -> APayload () -> Proof
forall a b. (a -> b) -> a -> b
$ Body -> APayload ()
forall a. ABody a -> APayload a
bodyUpdatePayload Body
body
}
recoverProof :: ABody ByteString -> Proof
recoverProof :: ABody ByteString -> Proof
recoverProof ABody ByteString
body =
Proof
{ proofUTxO :: TxProof
proofUTxO = ATxPayload ByteString -> TxProof
recoverTxProof (ATxPayload ByteString -> TxProof)
-> ATxPayload ByteString -> TxProof
forall a b. (a -> b) -> a -> b
$ ABody ByteString -> ATxPayload ByteString
forall a. ABody a -> ATxPayload a
bodyTxPayload ABody ByteString
body
, proofSsc :: SscProof
proofSsc = SscProof
SscProof
, proofDelegation :: Hash Payload
proofDelegation = APayload ByteString -> Hash (BaseType (APayload ByteString))
forall t. Decoded t => t -> Hash (BaseType t)
hashDecoded (APayload ByteString -> Hash (BaseType (APayload ByteString)))
-> APayload ByteString -> Hash (BaseType (APayload ByteString))
forall a b. (a -> b) -> a -> b
$ ABody ByteString -> APayload ByteString
forall a. ABody a -> APayload a
bodyDlgPayload ABody ByteString
body
, proofUpdate :: Proof
proofUpdate = APayload ByteString -> Proof
Update.recoverProof (APayload ByteString -> Proof) -> APayload ByteString -> Proof
forall a b. (a -> b) -> a -> b
$ ABody ByteString -> APayload ByteString
forall a. ABody a -> APayload a
bodyUpdatePayload ABody ByteString
body
}
data ProofValidationError
=
DelegationProofValidationError
|
UTxOProofValidationError
|
UpdateProofValidationError
deriving (ProofValidationError -> ProofValidationError -> Bool
(ProofValidationError -> ProofValidationError -> Bool)
-> (ProofValidationError -> ProofValidationError -> Bool)
-> Eq ProofValidationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProofValidationError -> ProofValidationError -> Bool
== :: ProofValidationError -> ProofValidationError -> Bool
$c/= :: ProofValidationError -> ProofValidationError -> Bool
/= :: ProofValidationError -> ProofValidationError -> Bool
Eq, Int -> ProofValidationError -> ShowS
[ProofValidationError] -> ShowS
ProofValidationError -> String
(Int -> ProofValidationError -> ShowS)
-> (ProofValidationError -> String)
-> ([ProofValidationError] -> ShowS)
-> Show ProofValidationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProofValidationError -> ShowS
showsPrec :: Int -> ProofValidationError -> ShowS
$cshow :: ProofValidationError -> String
show :: ProofValidationError -> String
$cshowList :: [ProofValidationError] -> ShowS
showList :: [ProofValidationError] -> ShowS
Show)