{-# 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.Binary (Annotated (..), ByteSpan, FromCBOR (..), ToCBOR (..))
import Cardano.Chain.UTxO.Tx (Tx)
import Cardano.Chain.UTxO.TxAux (ATxAux (..), TxAux, taTx, taWitness)
import Cardano.Chain.UTxO.TxWitness (TxWitness)
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 = [TxAux] -> TxPayload
forall a. [ATxAux a] -> ATxPayload a
ATxPayload

newtype ATxPayload a = ATxPayload
  { ATxPayload a -> [ATxAux a]
aUnTxPayload :: [ATxAux a]
  }
  deriving (Int -> ATxPayload a -> ShowS
[ATxPayload a] -> ShowS
ATxPayload a -> String
(Int -> ATxPayload a -> ShowS)
-> (ATxPayload a -> String)
-> ([ATxPayload a] -> ShowS)
-> Show (ATxPayload a)
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
(ATxPayload a -> ATxPayload a -> Bool)
-> (ATxPayload a -> ATxPayload a -> Bool) -> Eq (ATxPayload a)
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 x. ATxPayload a -> Rep (ATxPayload a) x)
-> (forall x. Rep (ATxPayload a) x -> ATxPayload a)
-> Generic (ATxPayload a)
forall x. Rep (ATxPayload a) x -> ATxPayload a
forall x. ATxPayload a -> Rep (ATxPayload a) x
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, a -> ATxPayload b -> ATxPayload a
(a -> b) -> ATxPayload a -> ATxPayload b
(forall a b. (a -> b) -> ATxPayload a -> ATxPayload b)
-> (forall a b. a -> ATxPayload b -> ATxPayload a)
-> Functor ATxPayload
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
<$ :: a -> ATxPayload b -> ATxPayload a
$c<$ :: forall a b. a -> ATxPayload b -> ATxPayload a
fmap :: (a -> b) -> ATxPayload a -> ATxPayload b
$cfmap :: forall a b. (a -> b) -> ATxPayload a -> ATxPayload b
Functor)
  deriving anyclass (ATxPayload a -> ()
(ATxPayload a -> ()) -> NFData (ATxPayload a)
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 :: ATxPayload a -> [TxAux]
unTxPayload = (ATxAux a -> TxAux) -> [ATxAux a] -> [TxAux]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ATxAux a -> TxAux
forall (f :: * -> *) a. Functor f => f a -> f ()
void ([ATxAux a] -> [TxAux])
-> (ATxPayload a -> [ATxAux a]) -> ATxPayload a -> [TxAux]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ATxPayload a -> [ATxAux a]
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 = [TxAux] -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ([TxAux] -> Encoding)
-> (TxPayload -> [TxAux]) -> TxPayload -> Encoding
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TxPayload -> [TxAux]
forall a. ATxPayload a -> [TxAux]
unTxPayload

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

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

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

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

txpWitnesses :: TxPayload -> [TxWitness]
txpWitnesses :: TxPayload -> [TxWitness]
txpWitnesses = (TxAux -> TxWitness) -> [TxAux] -> [TxWitness]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxAux -> TxWitness
forall a. ATxAux a -> TxWitness
taWitness ([TxAux] -> [TxWitness])
-> (TxPayload -> [TxAux]) -> TxPayload -> [TxWitness]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TxPayload -> [TxAux]
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 = ATxAux ByteString -> Annotated TxWitness ByteString
forall a. ATxAux a -> Annotated TxWitness a
aTaWitness (ATxAux ByteString -> Annotated TxWitness ByteString)
-> [ATxAux ByteString] -> [Annotated TxWitness ByteString]
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 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat (Annotated TxWitness ByteString -> ByteString
forall b a. Annotated b a -> a
annotation (Annotated TxWitness ByteString -> ByteString)
-> [Annotated TxWitness ByteString] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Annotated TxWitness ByteString]
aWitnesses) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
suffix
   in [TxWitness] -> ByteString -> Annotated [TxWitness] ByteString
forall b a. b -> a -> Annotated b a
Annotated (Annotated TxWitness ByteString -> TxWitness
forall b a. Annotated b a -> b
unAnnotated (Annotated TxWitness ByteString -> TxWitness)
-> [Annotated TxWitness ByteString] -> [TxWitness]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Annotated TxWitness ByteString]
aWitnesses) ByteString
hashedByted