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

module Cardano.Chain.UTxO.TxAux (
  TxAux,
  ATxAux (..),
  mkTxAux,
  annotateTxAux,
  taTx,
  taWitness,
  txaF,
)
where

import Cardano.Chain.UTxO.Tx (Tx)
import Cardano.Chain.UTxO.TxWitness (TxWitness)
import Cardano.Ledger.Binary (
  Annotated (..),
  ByteSpan,
  DecCBOR (..),
  Decoded (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  annotatedDecoder,
  byronProtVer,
  decCBORAnnotated,
  encodeListLen,
  enforceSize,
  fromByronCBOR,
  serialize,
  slice,
  toByronCBOR,
  unsafeDeserialize,
 )
import Cardano.Prelude
import Data.Aeson (ToJSON)
import qualified Data.ByteString.Lazy as Lazy
import Formatting (Format, bprint, build, later)
import qualified Formatting.Buildable as B

-- | Transaction + auxiliary data
type TxAux = ATxAux ()

mkTxAux :: Tx -> TxWitness -> TxAux
mkTxAux :: Tx -> TxWitness -> TxAux
mkTxAux Tx
tx TxWitness
tw = forall a. Annotated Tx a -> Annotated TxWitness a -> a -> ATxAux a
ATxAux (forall b a. b -> a -> Annotated b a
Annotated Tx
tx ()) (forall b a. b -> a -> Annotated b a
Annotated TxWitness
tw ()) ()

annotateTxAux :: TxAux -> ATxAux ByteString
annotateTxAux :: TxAux -> ATxAux ByteString
annotateTxAux TxAux
ta = ByteString -> ByteString
Lazy.toStrict forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteSpan -> ByteString
slice ByteString
bs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ATxAux ByteSpan
ta'
  where
    bs :: ByteString
bs = forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
byronProtVer TxAux
ta
    ta' :: ATxAux ByteSpan
ta' = forall a. DecCBOR a => Version -> ByteString -> a
unsafeDeserialize Version
byronProtVer ByteString
bs

data ATxAux a = ATxAux
  { forall a. ATxAux a -> Annotated Tx a
aTaTx :: !(Annotated Tx a)
  , forall a. ATxAux a -> Annotated TxWitness a
aTaWitness :: !(Annotated TxWitness a)
  , forall a. ATxAux a -> a
aTaAnnotation :: !a
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ATxAux a) x -> ATxAux a
forall a x. ATxAux a -> Rep (ATxAux a) x
$cto :: forall a x. Rep (ATxAux a) x -> ATxAux a
$cfrom :: forall a x. ATxAux a -> Rep (ATxAux a) x
Generic, Int -> ATxAux a -> ShowS
forall a. Show a => Int -> ATxAux a -> ShowS
forall a. Show a => [ATxAux a] -> ShowS
forall a. Show a => ATxAux a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ATxAux a] -> ShowS
$cshowList :: forall a. Show a => [ATxAux a] -> ShowS
show :: ATxAux a -> String
$cshow :: forall a. Show a => ATxAux a -> String
showsPrec :: Int -> ATxAux a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ATxAux a -> ShowS
Show, ATxAux a -> ATxAux a -> Bool
forall a. Eq a => ATxAux a -> ATxAux a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ATxAux a -> ATxAux a -> Bool
$c/= :: forall a. Eq a => ATxAux a -> ATxAux a -> Bool
== :: ATxAux a -> ATxAux a -> Bool
$c== :: forall a. Eq a => ATxAux a -> ATxAux a -> Bool
Eq, forall a b. a -> ATxAux b -> ATxAux a
forall a b. (a -> b) -> ATxAux a -> ATxAux 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 -> ATxAux b -> ATxAux a
$c<$ :: forall a b. a -> ATxAux b -> ATxAux a
fmap :: forall a b. (a -> b) -> ATxAux a -> ATxAux b
$cfmap :: forall a b. (a -> b) -> ATxAux a -> ATxAux b
Functor)
  deriving anyclass (forall a. NFData a => ATxAux a -> ()
forall a. (a -> ()) -> NFData a
rnf :: ATxAux a -> ()
$crnf :: forall a. NFData a => ATxAux a -> ()
NFData)

instance Decoded (ATxAux ByteString) where
  type BaseType (ATxAux ByteString) = ATxAux ()
  recoverBytes :: ATxAux ByteString -> ByteString
recoverBytes = forall a. ATxAux a -> a
aTaAnnotation

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

taTx :: ATxAux a -> Tx
taTx :: forall a. ATxAux a -> Tx
taTx = forall b a. Annotated b a -> b
unAnnotated forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. ATxAux a -> Annotated Tx a
aTaTx

taWitness :: ATxAux a -> TxWitness
taWitness :: forall a. ATxAux a -> TxWitness
taWitness = forall b a. Annotated b a -> b
unAnnotated forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. ATxAux a -> Annotated TxWitness a
aTaWitness

-- | Specialized formatter for 'TxAux'
txaF :: Format r (TxAux -> r)
txaF :: forall r. Format r (TxAux -> r)
txaF = forall a r. (a -> Builder) -> Format r (a -> r)
later forall a b. (a -> b) -> a -> b
$ \TxAux
ta ->
  forall a. Format Builder a -> a
bprint
    (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 (TxWitness -> Builder) (TxWitness -> Builder)
"\n" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (TxWitness -> Builder) (TxWitness -> Builder)
"witnesses: " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) a r.
(Foldable t, Buildable a) =>
Word -> Format r (t a -> r)
listJsonIndent Word
4)
    (forall a. ATxAux a -> Tx
taTx TxAux
ta)
    (forall a. ATxAux a -> TxWitness
taWitness TxAux
ta)

instance B.Buildable TxAux where
  build :: TxAux -> Builder
build = forall a. Format Builder a -> a
bprint forall r. Format r (TxAux -> r)
txaF

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

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

instance EncCBOR TxAux where
  encCBOR :: TxAux -> Encoding
encCBOR TxAux
ta = Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. ATxAux a -> Tx
taTx TxAux
ta) forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. ATxAux a -> TxWitness
taWitness TxAux
ta)

  encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy TxAux -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size Proxy TxAux
pxy = Size
1 forall a. Num a => a -> a -> a
+ forall t. EncCBOR t => Proxy t -> Size
size (forall a. ATxAux a -> Tx
taTx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy TxAux
pxy) forall a. Num a => a -> a -> a
+ forall t. EncCBOR t => Proxy t -> Size
size (forall a. ATxAux a -> TxWitness
taWitness forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy TxAux
pxy)

instance DecCBOR TxAux where
  decCBOR :: forall s. Decoder s TxAux
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 @(ATxAux ByteSpan)

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

instance DecCBOR (ATxAux ByteSpan) where
  decCBOR :: forall s. Decoder s (ATxAux ByteSpan)
decCBOR = do
    Annotated (Annotated Tx ByteSpan
tx, Annotated TxWitness ByteSpan
witness) ByteSpan
byteSpan <- forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder forall a b. (a -> b) -> a -> b
$ do
      forall s. Text -> Int -> Decoder s ()
enforceSize Text
"TxAux" Int
2
      Annotated Tx ByteSpan
tx <- forall a s. DecCBOR a => Decoder s (Annotated a ByteSpan)
decCBORAnnotated
      Annotated TxWitness ByteSpan
witness <- forall a s. DecCBOR a => Decoder s (Annotated a ByteSpan)
decCBORAnnotated
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Annotated Tx ByteSpan
tx, Annotated TxWitness ByteSpan
witness)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Annotated Tx a -> Annotated TxWitness a -> a -> ATxAux a
ATxAux Annotated Tx ByteSpan
tx Annotated TxWitness ByteSpan
witness ByteSpan
byteSpan