-- | Conversion of Byron-era transactions to UTxO RPC messages.
--
-- cardano-api's 'Cardano.Api.Tx.Tx' GADT has no Byron constructor, so the
-- conversion works directly on the Byron ledger types.
module Cardano.Rpc.Server.Internal.UtxoRpc.Type.Byron
  ( byronBlockTxs
  , byronTxToUtxoRpcTx
  )
where

import Cardano.Api.Address (Address (..))
import Cardano.Api.Era (Inject (..))
import Cardano.Api.Serialise.Raw
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as U5c
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc
import Cardano.Rpc.Server.Internal.Orphans ()

import Cardano.Chain.Block qualified as Byron (ABlockOrBoundary (..), blockTxPayload)
import Cardano.Chain.Common (lovelaceToInteger)
import Cardano.Chain.UTxO
  ( ATxAux (..)
  , Tx (..)
  , TxIn (..)
  , TxInWitness (..)
  , TxOut (..)
  , aUnTxPayload
  , taTx
  , taWitness
  )
import Cardano.Crypto qualified as Byron
  ( RedeemSignature (..)
  , RedeemVerificationKey (..)
  , Signature (..)
  , fromVerificationKeyToByteString
  , hashDecoded
  , hashToBytes
  )
import Cardano.Crypto.DSIGN.Class qualified as DSIGN
import Cardano.Crypto.Wallet qualified as WC
import Cardano.Ledger.Keys qualified as L (VKey (..))
import Cardano.Ledger.Keys.Bootstrap qualified as L (ChainCode (..), unpackByronVKey)

import RIO

import Data.ByteArray qualified as BA
import Data.ProtoLens (defMessage)
import Network.GRPC.Spec

-- | Extract the transactions of a Byron block as UTxO RPC 'UtxoRpc.Tx'
-- messages, in block order.
byronBlockTxs :: Byron.ABlockOrBoundary ByteString -> [Proto UtxoRpc.Tx]
byronBlockTxs :: ABlockOrBoundary ByteString -> [Proto Tx]
byronBlockTxs ABlockOrBoundary ByteString
blockOrBoundary =
  case ABlockOrBoundary ByteString
blockOrBoundary of
    Byron.ABOBBlock ABlock ByteString
byronBlock ->
      ATxAux ByteString -> Proto Tx
byronTxToUtxoRpcTx (ATxAux ByteString -> Proto Tx)
-> [ATxAux ByteString] -> [Proto Tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ATxPayload ByteString -> [ATxAux ByteString]
forall a. ATxPayload a -> [ATxAux a]
aUnTxPayload (ABlock ByteString -> ATxPayload ByteString
forall a. ABlock a -> ATxPayload a
Byron.blockTxPayload ABlock ByteString
byronBlock)
    -- epoch boundary blocks carry no transactions
    Byron.ABOBBoundary ABoundaryBlock ByteString
_ -> []

-- | Convert a Byron-era transaction to the UTxO RPC 'UtxoRpc.Tx' message.
-- Populates hash, inputs, outputs, witnesses and @successful@.
--
-- The transaction hash covers the original on-chain annotated bytes
-- ('Byron.hashDecoded'); re-serialising could produce a different encoding
-- and therefore a wrong transaction id.
--
-- The @fee@ field is left unset: Byron fees are implicit (inputs minus
-- outputs) and cannot be recovered without resolving the inputs against the
-- UTxO set. @successful@ is always true because Byron has no phase-2
-- validation. All remaining fields (certificates, withdrawals, minting,
-- validity, collateral, reference inputs, auxiliary data and proposals) have
-- no Byron counterpart and stay empty.
--
-- Byron pairs witness @i@ with input @i@ positionally; splitting the
-- witnesses into the proto @bootstrapWitnesses@ and @vkeywitness@ arms does
-- not preserve that pairing, and it cannot be reconstructed from the address
-- alone. Consumers needing per-input authorisation must use @native_bytes@.
byronTxToUtxoRpcTx :: ATxAux ByteString -> Proto UtxoRpc.Tx
byronTxToUtxoRpcTx :: ATxAux ByteString -> Proto Tx
byronTxToUtxoRpcTx ATxAux ByteString
txAux = do
  let tx :: Tx
tx = ATxAux ByteString -> Tx
forall a. ATxAux a -> Tx
taTx ATxAux ByteString
txAux
      inputs :: [Proto UtxoRpc.TxInput]
      inputs :: [Proto TxInput]
inputs =
        NonEmpty TxIn -> [TxIn]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Tx -> NonEmpty TxIn
txInputs Tx
tx) [TxIn] -> (TxIn -> Proto TxInput) -> [Proto TxInput]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(TxInUtxo TxId
txId Word16
txIx) ->
          Proto TxInput
forall msg. Message msg => msg
defMessage
            Proto TxInput -> (Proto TxInput -> Proto TxInput) -> Proto TxInput
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto TxInput) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "txHash" a) =>
LensLike' f s a
U5c.txHash LensLike' Identity (Proto TxInput) ByteString
-> ByteString -> Proto TxInput -> Proto TxInput
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxId -> ByteString
forall algo a. AbstractHash algo a -> ByteString
Byron.hashToBytes TxId
txId
            Proto TxInput -> (Proto TxInput -> Proto TxInput) -> Proto TxInput
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto TxInput) Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "outputIndex" a) =>
LensLike' f s a
U5c.outputIndex LensLike' Identity (Proto TxInput) Word32
-> Word32 -> Proto TxInput -> Proto TxInput
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
txIx
      outputs :: [Proto UtxoRpc.TxOutput]
      outputs :: [Proto TxOutput]
outputs =
        NonEmpty TxOut -> [TxOut]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Tx -> NonEmpty TxOut
txOutputs Tx
tx) [TxOut] -> (TxOut -> Proto TxOutput) -> [Proto TxOutput]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(TxOut Address
address Lovelace
value) ->
          Proto TxOutput
forall msg. Message msg => msg
defMessage
            Proto TxOutput
-> (Proto TxOutput -> Proto TxOutput) -> Proto TxOutput
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto TxOutput) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "address" a) =>
LensLike' f s a
U5c.address LensLike' Identity (Proto TxOutput) ByteString
-> ByteString -> Proto TxOutput -> Proto TxOutput
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Address ByronAddr -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes (Address -> Address ByronAddr
ByronAddress Address
address)
            Proto TxOutput
-> (Proto TxOutput -> Proto TxOutput) -> Proto TxOutput
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto TxOutput) (Proto BigInt)
forall (f :: * -> *) s a.
(Functor f, HasField s "coin" a) =>
LensLike' f s a
U5c.coin LensLike' Identity (Proto TxOutput) (Proto BigInt)
-> Proto BigInt -> Proto TxOutput -> Proto TxOutput
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Proto BigInt
forall t s. Inject t s => t -> s
inject (Lovelace -> Integer
lovelaceToInteger Lovelace
value)
      witnesses :: [TxInWitness]
witnesses = Vector TxInWitness -> [TxInWitness]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ATxAux ByteString -> Vector TxInWitness
forall a. ATxAux a -> Vector TxInWitness
taWitness ATxAux ByteString
txAux)
      -- a 'VKWitness' carries an extended public key, which is what the
      -- bootstrap witness shape (vkey + chain code) models; the attributes
      -- stay empty because Byron witnesses carry none (address attributes
      -- live in the address itself)
      bootstrapWitnesses :: [Proto UtxoRpc.BootstrapWitness]
      bootstrapWitnesses :: [Proto BootstrapWitness]
bootstrapWitnesses =
        [ Proto BootstrapWitness
forall msg. Message msg => msg
defMessage
            Proto BootstrapWitness
-> (Proto BootstrapWitness -> Proto BootstrapWitness)
-> Proto BootstrapWitness
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto BootstrapWitness) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "vkey" a) =>
LensLike' f s a
U5c.vkey LensLike' Identity (Proto BootstrapWitness) ByteString
-> ByteString -> Proto BootstrapWitness -> Proto BootstrapWitness
forall s t a b. ASetter s t a b -> b -> s -> t
.~ VerKeyDSIGN DSIGN -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
DSIGN.rawSerialiseVerKeyDSIGN VerKeyDSIGN DSIGN
vkey
            Proto BootstrapWitness
-> (Proto BootstrapWitness -> Proto BootstrapWitness)
-> Proto BootstrapWitness
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto BootstrapWitness) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "signature" a) =>
LensLike' f s a
U5c.signature LensLike' Identity (Proto BootstrapWitness) ByteString
-> ByteString -> Proto BootstrapWitness -> Proto BootstrapWitness
forall s t a b. ASetter s t a b -> b -> s -> t
.~ XSignature -> ByteString
WC.unXSignature XSignature
xSignature
            Proto BootstrapWitness
-> (Proto BootstrapWitness -> Proto BootstrapWitness)
-> Proto BootstrapWitness
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto BootstrapWitness) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "chainCode" a) =>
LensLike' f s a
U5c.chainCode LensLike' Identity (Proto BootstrapWitness) ByteString
-> ByteString -> Proto BootstrapWitness -> Proto BootstrapWitness
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ChainCode -> ByteString
L.unChainCode ChainCode
chainCode
        | VKWitness VerificationKey
verificationKey (Byron.Signature XSignature
xSignature) <- [TxInWitness]
witnesses
        , let (L.VKey VerKeyDSIGN DSIGN
vkey, ChainCode
chainCode) = VerificationKey -> (VKey Witness, ChainCode)
L.unpackByronVKey VerificationKey
verificationKey
        ]
      -- a 'RedeemWitness' is a plain Ed25519 key pair
      vkeyWitnesses :: [Proto UtxoRpc.VKeyWitness]
      vkeyWitnesses :: [Proto VKeyWitness]
vkeyWitnesses =
        [ Proto VKeyWitness
forall msg. Message msg => msg
defMessage
            Proto VKeyWitness
-> (Proto VKeyWitness -> Proto VKeyWitness) -> Proto VKeyWitness
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto VKeyWitness) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "vkey" a) =>
LensLike' f s a
U5c.vkey LensLike' Identity (Proto VKeyWitness) ByteString
-> ByteString -> Proto VKeyWitness -> Proto VKeyWitness
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PublicKey -> ByteString
Byron.fromVerificationKeyToByteString PublicKey
redeemKey
            Proto VKeyWitness
-> (Proto VKeyWitness -> Proto VKeyWitness) -> Proto VKeyWitness
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto VKeyWitness) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "signature" a) =>
LensLike' f s a
U5c.signature LensLike' Identity (Proto VKeyWitness) ByteString
-> ByteString -> Proto VKeyWitness -> Proto VKeyWitness
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Signature -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert Signature
redeemSignature
        | RedeemWitness
            (Byron.RedeemVerificationKey PublicKey
redeemKey)
            (Byron.RedeemSignature Signature
redeemSignature) <-
            [TxInWitness]
witnesses
        ]
  Proto Tx
forall msg. Message msg => msg
defMessage
    Proto Tx -> (Proto Tx -> Proto Tx) -> Proto Tx
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Tx) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "hash" a) =>
LensLike' f s a
U5c.hash LensLike' Identity (Proto Tx) ByteString
-> ByteString -> Proto Tx -> Proto Tx
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxId -> ByteString
forall algo a. AbstractHash algo a -> ByteString
Byron.hashToBytes (Annotated Tx ByteString
-> Hash (BaseType (Annotated Tx ByteString))
forall t. Decoded t => t -> Hash (BaseType t)
Byron.hashDecoded (ATxAux ByteString -> Annotated Tx ByteString
forall a. ATxAux a -> Annotated Tx a
aTaTx ATxAux ByteString
txAux))
    Proto Tx -> (Proto Tx -> Proto Tx) -> Proto Tx
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Tx) [Proto TxInput]
forall (f :: * -> *) s a.
(Functor f, HasField s "inputs" a) =>
LensLike' f s a
U5c.inputs LensLike' Identity (Proto Tx) [Proto TxInput]
-> [Proto TxInput] -> Proto Tx -> Proto Tx
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Proto TxInput]
inputs
    Proto Tx -> (Proto Tx -> Proto Tx) -> Proto Tx
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Tx) [Proto TxOutput]
forall (f :: * -> *) s a.
(Functor f, HasField s "outputs" a) =>
LensLike' f s a
U5c.outputs LensLike' Identity (Proto Tx) [Proto TxOutput]
-> [Proto TxOutput] -> Proto Tx -> Proto Tx
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Proto TxOutput]
outputs
    Proto Tx -> (Proto Tx -> Proto Tx) -> Proto Tx
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Tx) (Proto WitnessSet)
forall (f :: * -> *) s a.
(Functor f, HasField s "witnesses" a) =>
LensLike' f s a
U5c.witnesses
      LensLike' Identity (Proto Tx) (Proto WitnessSet)
-> Proto WitnessSet -> Proto Tx -> Proto Tx
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ( Proto WitnessSet
forall msg. Message msg => msg
defMessage
             Proto WitnessSet
-> (Proto WitnessSet -> Proto WitnessSet) -> Proto WitnessSet
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto WitnessSet) [Proto VKeyWitness]
forall (f :: * -> *) s a.
(Functor f, HasField s "vkeywitness" a) =>
LensLike' f s a
U5c.vkeywitness LensLike' Identity (Proto WitnessSet) [Proto VKeyWitness]
-> [Proto VKeyWitness] -> Proto WitnessSet -> Proto WitnessSet
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Proto VKeyWitness]
vkeyWitnesses
             Proto WitnessSet
-> (Proto WitnessSet -> Proto WitnessSet) -> Proto WitnessSet
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto WitnessSet) [Proto BootstrapWitness]
forall (f :: * -> *) s a.
(Functor f, HasField s "bootstrapWitnesses" a) =>
LensLike' f s a
U5c.bootstrapWitnesses LensLike' Identity (Proto WitnessSet) [Proto BootstrapWitness]
-> [Proto BootstrapWitness] -> Proto WitnessSet -> Proto WitnessSet
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Proto BootstrapWitness]
bootstrapWitnesses
         )
    Proto Tx -> (Proto Tx -> Proto Tx) -> Proto Tx
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Tx) Bool
forall (f :: * -> *) s a.
(Functor f, HasField s "successful" a) =>
LensLike' f s a
U5c.successful LensLike' Identity (Proto Tx) Bool -> Bool -> Proto Tx -> Proto Tx
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True