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

module Cardano.Chain.UTxO.TxProof (
  TxProof (..),
  mkTxProof,
  recoverTxProof,
)
where

import Cardano.Chain.Common.Merkle (
  MerkleRoot,
  mkMerkleTree,
  mkMerkleTreeDecoded,
  mtRoot,
 )
import Cardano.Chain.UTxO.Tx (Tx)
import Cardano.Chain.UTxO.TxPayload (
  ATxPayload,
  TxPayload,
  recoverHashedBytes,
  txpAnnotatedTxs,
  txpTxs,
  txpWitnesses,
 )
import Cardano.Chain.UTxO.TxWitness (TxWitness)
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)
import qualified Formatting.Buildable as B
import NoThunks.Class (NoThunks (..))

data TxProof = TxProof
  { TxProof -> Word32
txpNumber :: !Word32
  , TxProof -> MerkleRoot Tx
txpRoot :: !(MerkleRoot Tx)
  , TxProof -> Hash [TxWitness]
txpWitnessesHash :: !(Hash [TxWitness])
  }
  deriving (Int -> TxProof -> ShowS
[TxProof] -> ShowS
TxProof -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxProof] -> ShowS
$cshowList :: [TxProof] -> ShowS
show :: TxProof -> String
$cshow :: TxProof -> String
showsPrec :: Int -> TxProof -> ShowS
$cshowsPrec :: Int -> TxProof -> ShowS
Show, TxProof -> TxProof -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxProof -> TxProof -> Bool
$c/= :: TxProof -> TxProof -> Bool
== :: TxProof -> TxProof -> Bool
$c== :: TxProof -> TxProof -> Bool
Eq, forall x. Rep TxProof x -> TxProof
forall x. TxProof -> Rep TxProof x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxProof x -> TxProof
$cfrom :: forall x. TxProof -> Rep TxProof x
Generic, Context -> TxProof -> IO (Maybe ThunkInfo)
Proxy TxProof -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy TxProof -> String
$cshowTypeOf :: Proxy TxProof -> String
wNoThunks :: Context -> TxProof -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> TxProof -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxProof -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> TxProof -> IO (Maybe ThunkInfo)
NoThunks)
  deriving anyclass (TxProof -> ()
forall a. (a -> ()) -> NFData a
rnf :: TxProof -> ()
$crnf :: TxProof -> ()
NFData)

-- Used for debugging purposes only
instance ToJSON TxProof

instance B.Buildable TxProof where
  build :: TxProof -> Builder
build TxProof
proof =
    forall a. Format Builder a -> a
bprint
      (Format
  (Word32 -> MerkleRoot Tx -> Hash [TxWitness] -> Builder)
  (Word32 -> MerkleRoot Tx -> Hash [TxWitness] -> Builder)
"<TxProof: " 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
  (MerkleRoot Tx -> Hash [TxWitness] -> Builder)
  (MerkleRoot Tx -> Hash [TxWitness] -> 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 (Hash [TxWitness] -> Builder) (Hash [TxWitness] -> 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
">")
      (TxProof -> Word32
txpNumber TxProof
proof)
      (TxProof -> MerkleRoot Tx
txpRoot TxProof
proof)
      (TxProof -> Hash [TxWitness]
txpWitnessesHash TxProof
proof)

instance ToCBOR TxProof where
  toCBOR :: TxProof -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

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

instance EncCBOR TxProof where
  encCBOR :: TxProof -> Encoding
encCBOR TxProof
proof =
    Word -> Encoding
encodeListLen Word
3
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TxProof -> Word32
txpNumber TxProof
proof)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TxProof -> MerkleRoot Tx
txpRoot TxProof
proof)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TxProof -> Hash [TxWitness]
txpWitnessesHash TxProof
proof)
  encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy TxProof -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size Proxy TxProof
proof =
    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 (TxProof -> Word32
txpNumber forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy TxProof
proof)
      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 (TxProof -> MerkleRoot Tx
txpRoot forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy TxProof
proof)
      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 (TxProof -> Hash [TxWitness]
txpWitnessesHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy TxProof
proof)

instance DecCBOR TxProof where
  decCBOR :: forall s. Decoder s TxProof
decCBOR = do
    forall s. Text -> Int -> Decoder s ()
enforceSize Text
"TxProof" Int
3
    Word32 -> MerkleRoot Tx -> Hash [TxWitness] -> TxProof
TxProof 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

-- | Construct 'TxProof' which proves given 'TxPayload'
--
--   This will construct a Merkle tree, which can be very expensive. Use with
--   care.
mkTxProof :: TxPayload -> TxProof
mkTxProof :: TxPayload -> TxProof
mkTxProof TxPayload
payload =
  TxProof
    { txpNumber :: Word32
txpNumber = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. HasLength a => a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. ATxPayload a -> [Tx]
txpTxs TxPayload
payload)
    , txpRoot :: MerkleRoot Tx
txpRoot = forall a. MerkleTree a -> MerkleRoot a
mtRoot (forall a. EncCBOR a => [a] -> MerkleTree a
mkMerkleTree forall a b. (a -> b) -> a -> b
$ forall a. ATxPayload a -> [Tx]
txpTxs TxPayload
payload)
    , txpWitnessesHash :: Hash [TxWitness]
txpWitnessesHash = forall a. EncCBOR a => a -> Hash a
serializeCborHash forall a b. (a -> b) -> a -> b
$ TxPayload -> [TxWitness]
txpWitnesses TxPayload
payload
    }

recoverTxProof :: ATxPayload ByteString -> TxProof
recoverTxProof :: ATxPayload ByteString -> TxProof
recoverTxProof ATxPayload ByteString
payload =
  TxProof
    { txpNumber :: Word32
txpNumber = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. HasLength a => a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. ATxPayload a -> [Tx]
txpTxs ATxPayload ByteString
payload)
    , txpRoot :: MerkleRoot Tx
txpRoot = forall a. MerkleTree a -> MerkleRoot a
mtRoot (forall a. [Annotated a ByteString] -> MerkleTree a
mkMerkleTreeDecoded forall a b. (a -> b) -> a -> b
$ forall a. ATxPayload a -> [Annotated Tx a]
txpAnnotatedTxs ATxPayload ByteString
payload)
    , txpWitnessesHash :: Hash [TxWitness]
txpWitnessesHash = forall t. Decoded t => t -> Hash (BaseType t)
hashDecoded forall a b. (a -> b) -> a -> b
$ ATxPayload ByteString -> Annotated [TxWitness] ByteString
recoverHashedBytes ATxPayload ByteString
payload
    }