{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Chain.UTxO.TxPayload (
  TxPayload,
  ATxPayload (..),
  mkTxPayload,
  recoverHashedBytes,
  txpAnnotatedTxs,
  txpTxs,
  txpWitnesses,
  unTxPayload,
)
where

import Cardano.Chain.UTxO.Tx (Tx)
import Cardano.Chain.UTxO.TxAux (ATxAux (..), TxAux, taTx, taWitness)
import Cardano.Chain.UTxO.TxWitness (TxWitness)
import Cardano.Ledger.Binary (
  Annotated (..),
  ByteSpan,
  DecCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  fromByronCBOR,
  toByronCBOR,
 )
import Cardano.Prelude
import Data.Aeson (ToJSON)

-- | Payload of UTxO component which is part of the block body
type TxPayload = ATxPayload ()

mkTxPayload :: [TxAux] -> TxPayload
mkTxPayload :: [TxAux] -> TxPayload
mkTxPayload = forall a. [ATxAux a] -> ATxPayload a
ATxPayload

newtype ATxPayload a = ATxPayload
  { forall a. ATxPayload a -> [ATxAux a]
aUnTxPayload :: [ATxAux a]
  }
  deriving (Int -> ATxPayload a -> ShowS
forall a. Show a => Int -> ATxPayload a -> ShowS
forall a. Show a => [ATxPayload a] -> ShowS
forall a. Show a => ATxPayload a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ATxPayload a] -> ShowS
$cshowList :: forall a. Show a => [ATxPayload a] -> ShowS
show :: ATxPayload a -> String
$cshow :: forall a. Show a => ATxPayload a -> String
showsPrec :: Int -> ATxPayload a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ATxPayload a -> ShowS
Show, ATxPayload a -> ATxPayload a -> Bool
forall a. Eq a => ATxPayload a -> ATxPayload a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ATxPayload a -> ATxPayload a -> Bool
$c/= :: forall a. Eq a => ATxPayload a -> ATxPayload a -> Bool
== :: ATxPayload a -> ATxPayload a -> Bool
$c== :: forall a. Eq a => ATxPayload a -> ATxPayload a -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ATxPayload a) x -> ATxPayload a
forall a x. ATxPayload a -> Rep (ATxPayload a) x
$cto :: forall a x. Rep (ATxPayload a) x -> ATxPayload a
$cfrom :: forall a x. ATxPayload a -> Rep (ATxPayload a) x
Generic, forall a b. a -> ATxPayload b -> ATxPayload a
forall a b. (a -> b) -> ATxPayload a -> ATxPayload b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ATxPayload b -> ATxPayload a
$c<$ :: forall a b. a -> ATxPayload b -> ATxPayload a
fmap :: forall a b. (a -> b) -> ATxPayload a -> ATxPayload b
$cfmap :: forall a b. (a -> b) -> ATxPayload a -> ATxPayload b
Functor)
  deriving anyclass (forall a. NFData a => ATxPayload a -> ()
forall a. (a -> ()) -> NFData a
rnf :: ATxPayload a -> ()
$crnf :: forall a. NFData a => ATxPayload a -> ()
NFData)

unTxPayload :: ATxPayload a -> [TxAux]
unTxPayload :: forall a. ATxPayload a -> [TxAux]
unTxPayload = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Functor f => f a -> f ()
void forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. ATxPayload a -> [ATxAux a]
aUnTxPayload

-- Used for debugging purposes only
instance ToJSON a => ToJSON (ATxPayload a)

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

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

instance FromCBOR (ATxPayload ByteSpan) where
  fromCBOR :: forall s. Decoder s (ATxPayload ByteSpan)
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance EncCBOR TxPayload where
  encCBOR :: TxPayload -> Encoding
encCBOR = forall a. EncCBOR a => a -> Encoding
encCBOR forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. ATxPayload a -> [TxAux]
unTxPayload

instance DecCBOR TxPayload where
  decCBOR :: forall s. Decoder s TxPayload
decCBOR = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR @(ATxPayload ByteSpan)

instance DecCBOR (ATxPayload ByteSpan) where
  decCBOR :: forall s. Decoder s (ATxPayload ByteSpan)
decCBOR = forall a. [ATxAux a] -> ATxPayload a
ATxPayload forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR

txpAnnotatedTxs :: ATxPayload a -> [Annotated Tx a]
txpAnnotatedTxs :: forall a. ATxPayload a -> [Annotated Tx a]
txpAnnotatedTxs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ATxAux a -> Annotated Tx a
aTaTx forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. ATxPayload a -> [ATxAux a]
aUnTxPayload

txpTxs :: ATxPayload a -> [Tx]
txpTxs :: forall a. ATxPayload a -> [Tx]
txpTxs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ATxAux a -> Tx
taTx forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. ATxPayload a -> [TxAux]
unTxPayload

txpWitnesses :: TxPayload -> [TxWitness]
txpWitnesses :: TxPayload -> [TxWitness]
txpWitnesses = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ATxAux a -> TxWitness
taWitness forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. ATxPayload a -> [TxAux]
unTxPayload

recoverHashedBytes :: ATxPayload ByteString -> Annotated [TxWitness] ByteString
recoverHashedBytes :: ATxPayload ByteString -> Annotated [TxWitness] ByteString
recoverHashedBytes (ATxPayload [ATxAux ByteString]
auxs) =
  let aWitnesses :: [Annotated TxWitness ByteString]
aWitnesses = forall a. ATxAux a -> Annotated TxWitness a
aTaWitness forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ATxAux ByteString]
auxs
      prefix :: ByteString
prefix = ByteString
"\159" :: ByteString
      -- This is the value of Codec.CBOR.Write.toLazyByteString encodeListLenIndef
      suffix :: ByteString
suffix = ByteString
"\255" :: ByteString
      -- This is the value of Codec.CBOR.Write.toLazyByteString encodeBreak
      -- They are hard coded here because the hashed bytes included them as an
      -- implementation artifact
      hashedByted :: ByteString
hashedByted = ByteString
prefix forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall b a. Annotated b a -> a
annotation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Annotated TxWitness ByteString]
aWitnesses) forall a. Semigroup a => a -> a -> a
<> ByteString
suffix
   in forall b a. b -> a -> Annotated b a
Annotated (forall b a. Annotated b a -> b
unAnnotated forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Annotated TxWitness ByteString]
aWitnesses) ByteString
hashedByted