{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

module Cardano.Chain.Block.Proof
  ( Proof (..),
    ProofValidationError (..),
    mkProof,
    recoverProof,
  )
where

import Cardano.Binary (FromCBOR (..), ToCBOR (..), encodeListLen, enforceSize)
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.Prelude
import Data.Aeson (ToJSON)
import Formatting (bprint, build, shown)
import qualified Formatting.Buildable as B
import NoThunks.Class (NoThunks (..))

-- | Proof of everything contained in the payload
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
/= :: Proof -> Proof -> Bool
$c/= :: Proof -> Proof -> Bool
== :: Proof -> Proof -> Bool
$c== :: 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
showList :: [Proof] -> ShowS
$cshowList :: [Proof] -> ShowS
show :: Proof -> String
$cshow :: Proof -> String
showsPrec :: Int -> Proof -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep Proof x -> Proof
$cfrom :: forall x. Proof -> Rep Proof x
Generic, Proof -> ()
(Proof -> ()) -> NFData Proof
forall a. (a -> ()) -> NFData a
rnf :: Proof -> ()
$crnf :: 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
showTypeOf :: Proxy Proof -> String
$cshowTypeOf :: Proxy Proof -> String
wNoThunks :: Context -> Proof -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Proof -> IO (Maybe ThunkInfo)
noThunks :: Context -> Proof -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> Proof -> IO (Maybe ThunkInfo)
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 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 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 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 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 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 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 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 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)

-- Used for debugging purposes only
instance ToJSON Proof

instance ToCBOR Proof where
  toCBOR :: Proof -> Encoding
toCBOR Proof
bc =
    Word -> Encoding
encodeListLen Word
4
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxProof -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Proof -> TxProof
proofUTxO Proof
bc)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SscProof -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Proof -> SscProof
proofSsc Proof
bc)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Hash Payload -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Proof -> Hash Payload
proofDelegation Proof
bc)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Proof -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Proof -> Proof
proofUpdate Proof
bc)

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Proof -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy Proof
bc =
    Size
1
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size) -> Proxy TxProof -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR 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. ToCBOR t => Proxy t -> Size) -> Proxy SscProof -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR 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. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash Payload) -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR 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. ToCBOR t => Proxy t -> Size) -> Proxy Proof -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR 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 FromCBOR Proof where
  fromCBOR :: Decoder s Proof
fromCBOR = 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 a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (SscProof -> Hash Payload -> Proof -> Proof)
-> Decoder s SscProof -> Decoder s (Hash Payload -> Proof -> Proof)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s SscProof
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (Hash Payload -> Proof -> Proof)
-> Decoder s (Hash Payload) -> Decoder s (Proof -> Proof)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Hash Payload)
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (Proof -> Proof) -> Decoder s Proof -> Decoder s Proof
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Proof
forall a s. FromCBOR a => Decoder s a
fromCBOR

mkProof :: Body -> Proof
mkProof :: Body -> Proof
mkProof Body
body =
  Proof :: TxProof -> SscProof -> Hash Payload -> Proof -> Proof
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. ToCBOR 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 = Payload -> Proof
Update.mkProof (Payload -> Proof) -> Payload -> Proof
forall a b. (a -> b) -> a -> b
$ Body -> Payload
forall a. ABody a -> APayload a
bodyUpdatePayload Body
body
    }

-- TODO: Should we be using this somewhere?
recoverProof :: ABody ByteString -> Proof
recoverProof :: ABody ByteString -> Proof
recoverProof ABody ByteString
body =
  Proof :: TxProof -> SscProof -> Hash Payload -> Proof -> Proof
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
    }

-- | Error which can result from attempting to validate an invalid payload
-- proof.
data ProofValidationError
  = -- | The delegation payload proof did not match
    DelegationProofValidationError
  | -- | The UTxO payload proof did not match
    UTxOProofValidationError
  | -- | The update payload proof did not match
    UpdateProofValidationError
  deriving (ProofValidationError -> ProofValidationError -> Bool
(ProofValidationError -> ProofValidationError -> Bool)
-> (ProofValidationError -> ProofValidationError -> Bool)
-> Eq ProofValidationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProofValidationError -> ProofValidationError -> Bool
$c/= :: ProofValidationError -> ProofValidationError -> Bool
== :: ProofValidationError -> ProofValidationError -> Bool
$c== :: 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
showList :: [ProofValidationError] -> ShowS
$cshowList :: [ProofValidationError] -> ShowS
show :: ProofValidationError -> String
$cshow :: ProofValidationError -> String
showsPrec :: Int -> ProofValidationError -> ShowS
$cshowsPrec :: Int -> ProofValidationError -> ShowS
Show)