{-# 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 (..))

-- | 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
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
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. 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: Proof -> ()
$crnf :: Proof -> ()
NFData, Context -> Proof -> IO (Maybe ThunkInfo)
Proxy Proof -> String
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 =
    forall a. Format Builder a -> a
bprint
      (Format
  (TxProof -> SscProof -> Hash Payload -> Proof -> Builder)
  (TxProof -> SscProof -> Hash Payload -> Proof -> Builder)
"<Proof: " 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
  (SscProof -> Hash Payload -> Proof -> 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
. forall a r. Show a => Format r (a -> r)
shown 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)
", " 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 (Proof -> 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
. 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
">")
      (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 = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR Proof where
  fromCBOR :: forall s. Decoder s Proof
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

-- Used for debugging purposes only
instance ToJSON Proof

instance EncCBOR Proof where
  encCBOR :: Proof -> Encoding
encCBOR Proof
bc =
    Word -> Encoding
encodeListLen Word
4
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Proof -> TxProof
proofUTxO Proof
bc)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Proof -> SscProof
proofSsc Proof
bc)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Proof -> Hash Payload
proofDelegation Proof
bc)
      forall a. Semigroup a => a -> a -> a
<> 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
      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 (Proof -> TxProof
proofUTxO forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Proof
bc)
      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 (Proof -> SscProof
proofSsc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Proof
bc)
      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 (Proof -> Hash Payload
proofDelegation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Proof
bc)
      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 (Proof -> Proof
proofUpdate 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
    forall s. Text -> Int -> Decoder s ()
enforceSize Text
"Proof" Int
4
    TxProof -> SscProof -> Hash Payload -> Proof -> Proof
Proof forall (f :: * -> *) a b. Functor 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 b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 forall a b. (a -> b) -> a -> b
$ forall a. ABody a -> ATxPayload a
bodyTxPayload Body
body
    , proofSsc :: SscProof
proofSsc = SscProof
SscProof
    , proofDelegation :: Hash Payload
proofDelegation = forall a. EncCBOR a => a -> Hash a
serializeCborHash forall a b. (a -> b) -> a -> b
$ forall a. ABody a -> APayload a
bodyDlgPayload Body
body
    , proofUpdate :: Proof
proofUpdate = APayload () -> Proof
Update.mkProof forall a b. (a -> b) -> a -> b
$ 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
    { proofUTxO :: TxProof
proofUTxO = ATxPayload ByteString -> TxProof
recoverTxProof forall a b. (a -> b) -> a -> b
$ forall a. ABody a -> ATxPayload a
bodyTxPayload ABody ByteString
body
    , proofSsc :: SscProof
proofSsc = SscProof
SscProof
    , proofDelegation :: Hash Payload
proofDelegation = forall t. Decoded t => t -> Hash (BaseType t)
hashDecoded forall a b. (a -> b) -> a -> b
$ forall a. ABody a -> APayload a
bodyDlgPayload ABody ByteString
body
    , proofUpdate :: Proof
proofUpdate = APayload ByteString -> Proof
Update.recoverProof forall a b. (a -> b) -> a -> b
$ 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
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
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)