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

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

import Cardano.Binary
  ( Annotated (..),
    ByteSpan,
    Decoded (..),
    FromCBOR (..),
    ToCBOR (..),
    annotatedDecoder,
    encodeListLen,
    enforceSize,
    fromCBORAnnotated,
    serialize,
    slice,
    unsafeDeserialize,
  )
import Cardano.Chain.UTxO.Tx (Tx)
import Cardano.Chain.UTxO.TxWitness (TxWitness)
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 = Annotated Tx () -> Annotated TxWitness () -> () -> TxAux
forall a. Annotated Tx a -> Annotated TxWitness a -> a -> ATxAux a
ATxAux (Tx -> () -> Annotated Tx ()
forall b a. b -> a -> Annotated b a
Annotated Tx
tx ()) (TxWitness -> () -> Annotated TxWitness ()
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 (ByteString -> ByteString)
-> (ByteSpan -> ByteString) -> ByteSpan -> ByteString
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 (ByteSpan -> ByteString) -> ATxAux ByteSpan -> ATxAux ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ATxAux ByteSpan
ta'
  where
    bs :: ByteString
bs = TxAux -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize TxAux
ta
    ta' :: ATxAux ByteSpan
ta' = ByteString -> ATxAux ByteSpan
forall a. FromCBOR a => ByteString -> a
unsafeDeserialize ByteString
bs

data ATxAux a = ATxAux
  { ATxAux a -> Annotated Tx a
aTaTx :: !(Annotated Tx a),
    ATxAux a -> Annotated TxWitness a
aTaWitness :: !(Annotated TxWitness a),
    ATxAux a -> a
aTaAnnotation :: !a
  }
  deriving ((forall x. ATxAux a -> Rep (ATxAux a) x)
-> (forall x. Rep (ATxAux a) x -> ATxAux a) -> Generic (ATxAux a)
forall x. Rep (ATxAux a) x -> ATxAux a
forall x. ATxAux a -> Rep (ATxAux a) x
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
[ATxAux a] -> ShowS
ATxAux a -> String
(Int -> ATxAux a -> ShowS)
-> (ATxAux a -> String) -> ([ATxAux a] -> ShowS) -> Show (ATxAux a)
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
(ATxAux a -> ATxAux a -> Bool)
-> (ATxAux a -> ATxAux a -> Bool) -> Eq (ATxAux a)
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, a -> ATxAux b -> ATxAux a
(a -> b) -> ATxAux a -> ATxAux b
(forall a b. (a -> b) -> ATxAux a -> ATxAux b)
-> (forall a b. a -> ATxAux b -> ATxAux a) -> Functor ATxAux
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
<$ :: a -> ATxAux b -> ATxAux a
$c<$ :: forall a b. a -> ATxAux b -> ATxAux a
fmap :: (a -> b) -> ATxAux a -> ATxAux b
$cfmap :: forall a b. (a -> b) -> ATxAux a -> ATxAux b
Functor)
  deriving anyclass (ATxAux a -> ()
(ATxAux a -> ()) -> NFData (ATxAux a)
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 = ATxAux ByteString -> ByteString
forall a. ATxAux a -> a
aTaAnnotation

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

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

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

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

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

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

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

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

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