{-# 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 = [TxAux] -> TxPayload
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
[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
$cshowsPrec :: forall a. Show a => Int -> ATxPayload a -> ShowS
showsPrec :: Int -> ATxPayload a -> ShowS
$cshow :: forall a. Show a => ATxPayload a -> String
show :: ATxPayload a -> String
$cshowList :: forall a. Show a => [ATxPayload a] -> ShowS
showList :: [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
$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
/= :: 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
$cfrom :: forall a x. ATxPayload a -> Rep (ATxPayload a) x
from :: forall x. ATxPayload a -> Rep (ATxPayload a) x
$cto :: forall a x. Rep (ATxPayload a) x -> ATxPayload a
to :: forall x. Rep (ATxPayload a) x -> ATxPayload a
Generic, (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
$cfmap :: forall a b. (a -> b) -> ATxPayload a -> ATxPayload b
fmap :: forall a b. (a -> b) -> ATxPayload a -> ATxPayload b
$c<$ :: forall a b. a -> ATxPayload b -> ATxPayload a
<$ :: forall a b. a -> ATxPayload b -> ATxPayload a
Functor)
  deriving anyclass (ATxPayload a -> ()
(ATxPayload a -> ()) -> NFData (ATxPayload a)
forall a. NFData a => ATxPayload a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => ATxPayload a -> ()
rnf :: ATxPayload a -> ()
NFData)

unTxPayload :: ATxPayload a -> [TxAux]
unTxPayload :: forall a. ATxPayload a -> [TxAux]
unTxPayload = (ATxAux a -> TxAux) -> [ATxAux a] -> [TxAux]
forall a b. (a -> b) -> [a] -> [b]
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 b c a. (b -> c) -> (a -> b) -> a -> c
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 = TxPayload -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

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

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

instance EncCBOR TxPayload where
  encCBOR :: TxPayload -> Encoding
encCBOR = [TxAux] -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ([TxAux] -> Encoding)
-> (TxPayload -> [TxAux]) -> TxPayload -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 DecCBOR TxPayload where
  decCBOR :: forall s. Decoder s TxPayload
decCBOR = 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 a s. DecCBOR a => Decoder s a
decCBOR @(ATxPayload ByteSpan)

instance DecCBOR (ATxPayload ByteSpan) where
  decCBOR :: forall s. Decoder s (ATxPayload ByteSpan)
decCBOR = [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 s. Decoder s [ATxAux ByteSpan]
forall a s. DecCBOR a => Decoder s a
decCBOR

txpAnnotatedTxs :: ATxPayload a -> [Annotated Tx a]
txpAnnotatedTxs :: forall a. ATxPayload a -> [Annotated Tx a]
txpAnnotatedTxs = (ATxAux a -> Annotated Tx a) -> [ATxAux a] -> [Annotated Tx a]
forall a b. (a -> b) -> [a] -> [b]
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 b c a. (b -> c) -> (a -> b) -> a -> c
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 :: forall a. ATxPayload a -> [Tx]
txpTxs = (TxAux -> Tx) -> [TxAux] -> [Tx]
forall a b. (a -> b) -> [a] -> [b]
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 b c a. (b -> c) -> (a -> b) -> a -> c
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 a b. (a -> b) -> [a] -> [b]
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 b c a. (b -> c) -> (a -> b) -> a -> c
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