{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}

module Cardano.CLI.Byron.Tx
  ( ByronTxError(..)
  , TxFile(..)
  , NewTxFile(..)
  , prettyAddress
  , readByronTx
  , normalByronTxToGenTx
  , txSpendGenesisUTxOByronPBFT
  , txSpendUTxOByronPBFT
  , nodeSubmitTx
  , renderByronTxError

    --TODO: remove when they are exported from the ledger
  , fromCborTxAux
  , toCborTxAux

  , ScriptValidity(..)
  )
where

import           Cardano.Prelude hiding (option, trace, (%))
import           Prelude (error)

import           Control.Monad.Trans.Except.Extra (firstExceptT, left)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified Data.Text as Text
import           Formatting (sformat, (%))

import           Cardano.Api

import qualified Cardano.Binary as Binary

import qualified Cardano.Chain.Common as Common
import           Cardano.Chain.Genesis as Genesis
import qualified Cardano.Chain.UTxO as UTxO
import qualified Cardano.Crypto.Signing as Crypto

import           Cardano.Api.Byron
import           Cardano.CLI.Byron.Key (byronWitnessToVerKey)
import           Cardano.CLI.Environment
import           Cardano.CLI.Helpers (textShow)
import           Cardano.CLI.Types (SocketPath (..))
import           Ouroboros.Consensus.Byron.Ledger (ByronBlock, GenTx (..))
import qualified Ouroboros.Consensus.Byron.Ledger as Byron
import           Ouroboros.Consensus.Cardano.Block (EraMismatch (..))
import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Client as Net.Tx

data ByronTxError
  = TxDeserialisationFailed !FilePath !Binary.DecoderError
  | ByronTxSubmitError !Text
  | ByronTxSubmitErrorEraMismatch !EraMismatch
  | EnvSocketError !EnvSocketError
  deriving Int -> ByronTxError -> ShowS
[ByronTxError] -> ShowS
ByronTxError -> String
(Int -> ByronTxError -> ShowS)
-> (ByronTxError -> String)
-> ([ByronTxError] -> ShowS)
-> Show ByronTxError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ByronTxError] -> ShowS
$cshowList :: [ByronTxError] -> ShowS
show :: ByronTxError -> String
$cshow :: ByronTxError -> String
showsPrec :: Int -> ByronTxError -> ShowS
$cshowsPrec :: Int -> ByronTxError -> ShowS
Show

renderByronTxError :: ByronTxError -> Text
renderByronTxError :: ByronTxError -> Text
renderByronTxError ByronTxError
err =
  case ByronTxError
err of
    ByronTxSubmitError Text
res -> Text
"Error while submitting tx: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
res
    ByronTxSubmitErrorEraMismatch EraMismatch{Text
ledgerEraName :: EraMismatch -> Text
ledgerEraName :: Text
ledgerEraName, Text
otherEraName :: EraMismatch -> Text
otherEraName :: Text
otherEraName} ->
      Text
"The era of the node and the tx do not match. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text
"The node is running in the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ledgerEraName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text
" era, but the transaction is for the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
otherEraName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" era."
    TxDeserialisationFailed String
txFp DecoderError
decErr ->
      Text
"Transaction deserialisation failed at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Show a => a -> Text
textShow String
txFp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DecoderError -> Text
forall a. Show a => a -> Text
textShow DecoderError
decErr
    EnvSocketError EnvSocketError
envSockErr -> EnvSocketError -> Text
renderEnvSocketError EnvSocketError
envSockErr


newtype TxFile =
  TxFile FilePath
  deriving (TxFile -> TxFile -> Bool
(TxFile -> TxFile -> Bool)
-> (TxFile -> TxFile -> Bool) -> Eq TxFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxFile -> TxFile -> Bool
$c/= :: TxFile -> TxFile -> Bool
== :: TxFile -> TxFile -> Bool
$c== :: TxFile -> TxFile -> Bool
Eq, Eq TxFile
Eq TxFile
-> (TxFile -> TxFile -> Ordering)
-> (TxFile -> TxFile -> Bool)
-> (TxFile -> TxFile -> Bool)
-> (TxFile -> TxFile -> Bool)
-> (TxFile -> TxFile -> Bool)
-> (TxFile -> TxFile -> TxFile)
-> (TxFile -> TxFile -> TxFile)
-> Ord TxFile
TxFile -> TxFile -> Bool
TxFile -> TxFile -> Ordering
TxFile -> TxFile -> TxFile
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TxFile -> TxFile -> TxFile
$cmin :: TxFile -> TxFile -> TxFile
max :: TxFile -> TxFile -> TxFile
$cmax :: TxFile -> TxFile -> TxFile
>= :: TxFile -> TxFile -> Bool
$c>= :: TxFile -> TxFile -> Bool
> :: TxFile -> TxFile -> Bool
$c> :: TxFile -> TxFile -> Bool
<= :: TxFile -> TxFile -> Bool
$c<= :: TxFile -> TxFile -> Bool
< :: TxFile -> TxFile -> Bool
$c< :: TxFile -> TxFile -> Bool
compare :: TxFile -> TxFile -> Ordering
$ccompare :: TxFile -> TxFile -> Ordering
$cp1Ord :: Eq TxFile
Ord, Int -> TxFile -> ShowS
[TxFile] -> ShowS
TxFile -> String
(Int -> TxFile -> ShowS)
-> (TxFile -> String) -> ([TxFile] -> ShowS) -> Show TxFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxFile] -> ShowS
$cshowList :: [TxFile] -> ShowS
show :: TxFile -> String
$cshow :: TxFile -> String
showsPrec :: Int -> TxFile -> ShowS
$cshowsPrec :: Int -> TxFile -> ShowS
Show, String -> TxFile
(String -> TxFile) -> IsString TxFile
forall a. (String -> a) -> IsString a
fromString :: String -> TxFile
$cfromString :: String -> TxFile
IsString)

newtype NewTxFile =
  NewTxFile FilePath
  deriving (NewTxFile -> NewTxFile -> Bool
(NewTxFile -> NewTxFile -> Bool)
-> (NewTxFile -> NewTxFile -> Bool) -> Eq NewTxFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewTxFile -> NewTxFile -> Bool
$c/= :: NewTxFile -> NewTxFile -> Bool
== :: NewTxFile -> NewTxFile -> Bool
$c== :: NewTxFile -> NewTxFile -> Bool
Eq, Eq NewTxFile
Eq NewTxFile
-> (NewTxFile -> NewTxFile -> Ordering)
-> (NewTxFile -> NewTxFile -> Bool)
-> (NewTxFile -> NewTxFile -> Bool)
-> (NewTxFile -> NewTxFile -> Bool)
-> (NewTxFile -> NewTxFile -> Bool)
-> (NewTxFile -> NewTxFile -> NewTxFile)
-> (NewTxFile -> NewTxFile -> NewTxFile)
-> Ord NewTxFile
NewTxFile -> NewTxFile -> Bool
NewTxFile -> NewTxFile -> Ordering
NewTxFile -> NewTxFile -> NewTxFile
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NewTxFile -> NewTxFile -> NewTxFile
$cmin :: NewTxFile -> NewTxFile -> NewTxFile
max :: NewTxFile -> NewTxFile -> NewTxFile
$cmax :: NewTxFile -> NewTxFile -> NewTxFile
>= :: NewTxFile -> NewTxFile -> Bool
$c>= :: NewTxFile -> NewTxFile -> Bool
> :: NewTxFile -> NewTxFile -> Bool
$c> :: NewTxFile -> NewTxFile -> Bool
<= :: NewTxFile -> NewTxFile -> Bool
$c<= :: NewTxFile -> NewTxFile -> Bool
< :: NewTxFile -> NewTxFile -> Bool
$c< :: NewTxFile -> NewTxFile -> Bool
compare :: NewTxFile -> NewTxFile -> Ordering
$ccompare :: NewTxFile -> NewTxFile -> Ordering
$cp1Ord :: Eq NewTxFile
Ord, Int -> NewTxFile -> ShowS
[NewTxFile] -> ShowS
NewTxFile -> String
(Int -> NewTxFile -> ShowS)
-> (NewTxFile -> String)
-> ([NewTxFile] -> ShowS)
-> Show NewTxFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewTxFile] -> ShowS
$cshowList :: [NewTxFile] -> ShowS
show :: NewTxFile -> String
$cshow :: NewTxFile -> String
showsPrec :: Int -> NewTxFile -> ShowS
$cshowsPrec :: Int -> NewTxFile -> ShowS
Show, String -> NewTxFile
(String -> NewTxFile) -> IsString NewTxFile
forall a. (String -> a) -> IsString a
fromString :: String -> NewTxFile
$cfromString :: String -> NewTxFile
IsString)


-- | Pretty-print an address in its Base58 form, and also
--   its full structure.
prettyAddress :: Address ByronAddr -> Text
prettyAddress :: Address ByronAddr -> Text
prettyAddress (ByronAddress Address
addr) = Format Text (Address -> Address -> Text)
-> Address -> Address -> Text
forall a. Format Text a -> a
sformat
  (Format (Address -> Text) (Address -> Address -> Text)
forall r. Format r (Address -> r)
Common.addressF Format (Address -> Text) (Address -> Address -> Text)
-> Format Text (Address -> Text)
-> Format Text (Address -> Address -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
%Format (Address -> Text) (Address -> Text)
"\n"Format (Address -> Text) (Address -> Text)
-> Format Text (Address -> Text) -> Format Text (Address -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
%Format Text (Address -> Text)
forall r. Format r (Address -> r)
Common.addressDetailedF)
  Address
addr Address
addr

readByronTx :: TxFile -> ExceptT ByronTxError IO (UTxO.ATxAux ByteString)
readByronTx :: TxFile -> ExceptT ByronTxError IO (ATxAux ByteString)
readByronTx (TxFile String
fp) = do
  ByteString
txBS <- IO ByteString -> ExceptT ByronTxError IO ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ExceptT ByronTxError IO ByteString)
-> IO ByteString -> ExceptT ByronTxError IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
LB.readFile String
fp
  case ByteString -> Either DecoderError (ATxAux ByteString)
fromCborTxAux ByteString
txBS of
    Left DecoderError
e -> ByronTxError -> ExceptT ByronTxError IO (ATxAux ByteString)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ByronTxError -> ExceptT ByronTxError IO (ATxAux ByteString))
-> ByronTxError -> ExceptT ByronTxError IO (ATxAux ByteString)
forall a b. (a -> b) -> a -> b
$ String -> DecoderError -> ByronTxError
TxDeserialisationFailed String
fp DecoderError
e
    Right ATxAux ByteString
tx -> ATxAux ByteString -> ExceptT ByronTxError IO (ATxAux ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ATxAux ByteString
tx

-- | The 'GenTx' is all the kinds of transactions that can be submitted
-- and \"normal\" Byron transactions are just one of the kinds.
normalByronTxToGenTx :: UTxO.ATxAux ByteString -> GenTx ByronBlock
normalByronTxToGenTx :: ATxAux ByteString -> GenTx ByronBlock
normalByronTxToGenTx ATxAux ByteString
tx' = TxId -> ATxAux ByteString -> GenTx ByronBlock
Byron.ByronTx (ATxAux ByteString -> TxId
Byron.byronIdTx ATxAux ByteString
tx') ATxAux ByteString
tx'

-- | Given a genesis, and a pair of a genesis public key and address,
--   reconstruct a TxIn corresponding to the genesis UTxO entry.
genesisUTxOTxIn :: Genesis.Config -> Crypto.VerificationKey -> Common.Address -> UTxO.TxIn
genesisUTxOTxIn :: Config -> VerificationKey -> Address -> TxIn
genesisUTxOTxIn Config
gc VerificationKey
vk Address
genAddr =
  Maybe TxIn -> TxIn
handleMissingAddr (Maybe TxIn -> TxIn) -> Maybe TxIn -> TxIn
forall a b. (a -> b) -> a -> b
$ (TxIn, TxOut) -> TxIn
forall a b. (a, b) -> a
fst ((TxIn, TxOut) -> TxIn) -> Maybe (TxIn, TxOut) -> Maybe TxIn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Address -> Map Address (TxIn, TxOut) -> Maybe (TxIn, TxOut)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Address
genAddr Map Address (TxIn, TxOut)
initialUtxo
  where
    initialUtxo :: Map Common.Address (UTxO.TxIn, UTxO.TxOut)
    initialUtxo :: Map Address (TxIn, TxOut)
initialUtxo =
          [(Address, (TxIn, TxOut))] -> Map Address (TxIn, TxOut)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        ([(Address, (TxIn, TxOut))] -> Map Address (TxIn, TxOut))
-> (Config -> [(Address, (TxIn, TxOut))])
-> Config
-> Map Address (TxIn, TxOut)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((TxIn, TxOut) -> Maybe (Address, (TxIn, TxOut)))
-> [(TxIn, TxOut)] -> [(Address, (TxIn, TxOut))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(TxIn
inp, TxOut
out) -> TxIn -> Address -> TxOut -> (Address, (TxIn, TxOut))
mkEntry TxIn
inp Address
genAddr (TxOut -> (Address, (TxIn, TxOut)))
-> Maybe TxOut -> Maybe (Address, (TxIn, TxOut))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VerificationKey -> TxOut -> Maybe TxOut
keyMatchesUTxO VerificationKey
vk TxOut
out)
        ([(TxIn, TxOut)] -> [(Address, (TxIn, TxOut))])
-> (Config -> [(TxIn, TxOut)])
-> Config
-> [(Address, (TxIn, TxOut))]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [(CompactTxIn, CompactTxOut)] -> [(TxIn, TxOut)]
fromCompactTxInTxOutList
        ([(CompactTxIn, CompactTxOut)] -> [(TxIn, TxOut)])
-> (Config -> [(CompactTxIn, CompactTxOut)])
-> Config
-> [(TxIn, TxOut)]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Map CompactTxIn CompactTxOut -> [(CompactTxIn, CompactTxOut)]
forall k a. Map k a -> [(k, a)]
Map.toList
        (Map CompactTxIn CompactTxOut -> [(CompactTxIn, CompactTxOut)])
-> (Config -> Map CompactTxIn CompactTxOut)
-> Config
-> [(CompactTxIn, CompactTxOut)]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UTxO -> Map CompactTxIn CompactTxOut
UTxO.unUTxO
        (UTxO -> Map CompactTxIn CompactTxOut)
-> (Config -> UTxO) -> Config -> Map CompactTxIn CompactTxOut
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Config -> UTxO
UTxO.genesisUtxo
        (Config -> Map Address (TxIn, TxOut))
-> Config -> Map Address (TxIn, TxOut)
forall a b. (a -> b) -> a -> b
$ Config
gc
      where
        mkEntry :: UTxO.TxIn
                -> Common.Address
                -> UTxO.TxOut
                -> (Common.Address, (UTxO.TxIn, UTxO.TxOut))
        mkEntry :: TxIn -> Address -> TxOut -> (Address, (TxIn, TxOut))
mkEntry TxIn
inp Address
addr TxOut
out = (Address
addr, (TxIn
inp, TxOut
out))

    fromCompactTxInTxOutList :: [(UTxO.CompactTxIn, UTxO.CompactTxOut)]
                             -> [(UTxO.TxIn, UTxO.TxOut)]
    fromCompactTxInTxOutList :: [(CompactTxIn, CompactTxOut)] -> [(TxIn, TxOut)]
fromCompactTxInTxOutList =
        ((CompactTxIn, CompactTxOut) -> (TxIn, TxOut))
-> [(CompactTxIn, CompactTxOut)] -> [(TxIn, TxOut)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((CompactTxIn -> TxIn)
-> (CompactTxOut -> TxOut)
-> (CompactTxIn, CompactTxOut)
-> (TxIn, TxOut)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap CompactTxIn -> TxIn
UTxO.fromCompactTxIn CompactTxOut -> TxOut
UTxO.fromCompactTxOut)

    keyMatchesUTxO :: Crypto.VerificationKey -> UTxO.TxOut -> Maybe UTxO.TxOut
    keyMatchesUTxO :: VerificationKey -> TxOut -> Maybe TxOut
keyMatchesUTxO VerificationKey
key TxOut
out =
      if VerificationKey -> Address -> Bool
Common.checkVerKeyAddress VerificationKey
key (TxOut -> Address
UTxO.txOutAddress TxOut
out)
      then TxOut -> Maybe TxOut
forall a. a -> Maybe a
Just TxOut
out else Maybe TxOut
forall a. Maybe a
Nothing

    handleMissingAddr :: Maybe UTxO.TxIn -> UTxO.TxIn
    handleMissingAddr :: Maybe TxIn -> TxIn
handleMissingAddr  = TxIn -> Maybe TxIn -> TxIn
forall a. a -> Maybe a -> a
fromMaybe (TxIn -> Maybe TxIn -> TxIn)
-> (String -> TxIn) -> String -> Maybe TxIn -> TxIn
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> TxIn
forall a. HasCallStack => String -> a
error
      (String -> Maybe TxIn -> TxIn) -> String -> Maybe TxIn -> TxIn
forall a b. (a -> b) -> a -> b
$  String
"\nGenesis UTxO has no address\n"
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Address ByronAddr -> Text
prettyAddress (Address -> Address ByronAddr
ByronAddress Address
genAddr))
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n\nIt has the following, though:\n\n"
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
Cardano.Prelude.concat (Text -> String
T.unpack (Text -> String)
-> (Address ByronAddr -> Text) -> Address ByronAddr -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Address ByronAddr -> Text
prettyAddress (Address ByronAddr -> String) -> [Address ByronAddr] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Address -> Address ByronAddr) -> [Address] -> [Address ByronAddr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Address -> Address ByronAddr
ByronAddress (Map Address (TxIn, TxOut) -> [Address]
forall k a. Map k a -> [k]
Map.keys Map Address (TxIn, TxOut)
initialUtxo))

-- | Generate a transaction spending genesis UTxO at a given address,
--   to given outputs, signed by the given key.
txSpendGenesisUTxOByronPBFT
  :: Genesis.Config
  -> NetworkId
  -> SomeByronSigningKey
  -> Address ByronAddr
  -> [TxOut ByronEra]
  -> Tx ByronEra
txSpendGenesisUTxOByronPBFT :: Config
-> NetworkId
-> SomeByronSigningKey
-> Address ByronAddr
-> [TxOut ByronEra]
-> Tx ByronEra
txSpendGenesisUTxOByronPBFT Config
gc NetworkId
nId SomeByronSigningKey
sk (ByronAddress Address
bAddr) [TxOut ByronEra]
outs = do
    let txBodyCont :: TxBodyContent BuildTx ByronEra
txBodyCont =
          TxIns BuildTx ByronEra
-> TxInsCollateral ByronEra
-> [TxOut ByronEra]
-> TxFee ByronEra
-> (TxValidityLowerBound ByronEra, TxValidityUpperBound ByronEra)
-> TxMetadataInEra ByronEra
-> TxAuxScripts ByronEra
-> BuildTxWith BuildTx (TxExtraScriptData ByronEra)
-> TxExtraKeyWitnesses ByronEra
-> BuildTxWith BuildTx (Maybe ProtocolParameters)
-> TxWithdrawals BuildTx ByronEra
-> TxCertificates BuildTx ByronEra
-> TxUpdateProposal ByronEra
-> TxMintValue BuildTx ByronEra
-> BuildTxWith BuildTx (TxScriptValidity ByronEra)
-> TxBodyContent BuildTx ByronEra
forall build era.
TxIns build era
-> TxInsCollateral era
-> [TxOut era]
-> TxFee era
-> (TxValidityLowerBound era, TxValidityUpperBound era)
-> TxMetadataInEra era
-> TxAuxScripts era
-> BuildTxWith build (TxExtraScriptData era)
-> TxExtraKeyWitnesses era
-> BuildTxWith build (Maybe ProtocolParameters)
-> TxWithdrawals build era
-> TxCertificates build era
-> TxUpdateProposal era
-> TxMintValue build era
-> BuildTxWith build (TxScriptValidity era)
-> TxBodyContent build era
TxBodyContent
            [ (TxIn -> TxIn
fromByronTxIn TxIn
txIn
              , Witness WitCtxTxIn ByronEra
-> BuildTxWith BuildTx (Witness WitCtxTxIn ByronEra)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (KeyWitnessInCtx WitCtxTxIn -> Witness WitCtxTxIn ByronEra
forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
KeyWitness KeyWitnessInCtx WitCtxTxIn
KeyWitnessForSpending))
            ]
            TxInsCollateral ByronEra
forall era. TxInsCollateral era
TxInsCollateralNone
            [TxOut ByronEra]
outs
            (TxFeesImplicitInEra ByronEra -> TxFee ByronEra
forall era. TxFeesImplicitInEra era -> TxFee era
TxFeeImplicit TxFeesImplicitInEra ByronEra
TxFeesImplicitInByronEra)
            ( TxValidityLowerBound ByronEra
forall era. TxValidityLowerBound era
TxValidityNoLowerBound
            , ValidityNoUpperBoundSupportedInEra ByronEra
-> TxValidityUpperBound ByronEra
forall era.
ValidityNoUpperBoundSupportedInEra era -> TxValidityUpperBound era
TxValidityNoUpperBound ValidityNoUpperBoundSupportedInEra ByronEra
ValidityNoUpperBoundInByronEra
            )
            TxMetadataInEra ByronEra
forall era. TxMetadataInEra era
TxMetadataNone
            TxAuxScripts ByronEra
forall era. TxAuxScripts era
TxAuxScriptsNone
            (TxExtraScriptData ByronEra
-> BuildTxWith BuildTx (TxExtraScriptData ByronEra)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith TxExtraScriptData ByronEra
forall era. TxExtraScriptData era
TxExtraScriptDataNone)
            TxExtraKeyWitnesses ByronEra
forall era. TxExtraKeyWitnesses era
TxExtraKeyWitnessesNone
            (Maybe ProtocolParameters
-> BuildTxWith BuildTx (Maybe ProtocolParameters)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith Maybe ProtocolParameters
forall a. Maybe a
Nothing)
            TxWithdrawals BuildTx ByronEra
forall build era. TxWithdrawals build era
TxWithdrawalsNone
            TxCertificates BuildTx ByronEra
forall build era. TxCertificates build era
TxCertificatesNone
            TxUpdateProposal ByronEra
forall era. TxUpdateProposal era
TxUpdateProposalNone
            TxMintValue BuildTx ByronEra
forall build era. TxMintValue build era
TxMintNone
            (TxScriptValidity ByronEra
-> BuildTxWith BuildTx (TxScriptValidity ByronEra)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith TxScriptValidity ByronEra
forall era. TxScriptValidity era
TxScriptValidityNone)
    case TxBodyContent BuildTx ByronEra
-> Either TxBodyError (TxBody ByronEra)
forall era.
IsCardanoEra era =>
TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
makeTransactionBody TxBodyContent BuildTx ByronEra
txBodyCont of
      Left TxBodyError
err -> String -> Tx ByronEra
forall a. HasCallStack => String -> a
error (String -> Tx ByronEra) -> String -> Tx ByronEra
forall a b. (a -> b) -> a -> b
$ String
"Error occured while creating a Byron genesis based UTxO transaction: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TxBodyError -> String
forall a b. (Show a, ConvertText String b) => a -> b
show TxBodyError
err
      Right TxBody ByronEra
txBody -> let bWit :: KeyWitness ByronEra
bWit = SomeByronSigningKey
-> NetworkId -> TxBody ByronEra -> KeyWitness ByronEra
fromByronWitness SomeByronSigningKey
sk NetworkId
nId TxBody ByronEra
txBody
                      in [KeyWitness ByronEra] -> TxBody ByronEra -> Tx ByronEra
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [KeyWitness ByronEra
bWit] TxBody ByronEra
txBody
  where
    ByronVerificationKey vKey = SomeByronSigningKey -> VerificationKey ByronKey
byronWitnessToVerKey SomeByronSigningKey
sk

    txIn :: UTxO.TxIn
    txIn :: TxIn
txIn  = Config -> VerificationKey -> Address -> TxIn
genesisUTxOTxIn Config
gc VerificationKey
vKey Address
bAddr

-- | Generate a transaction from given Tx inputs to outputs,
--   signed by the given key.
txSpendUTxOByronPBFT
  :: NetworkId
  -> SomeByronSigningKey
  -> [TxIn]
  -> [TxOut ByronEra]
  -> Tx ByronEra
txSpendUTxOByronPBFT :: NetworkId
-> SomeByronSigningKey -> [TxIn] -> [TxOut ByronEra] -> Tx ByronEra
txSpendUTxOByronPBFT NetworkId
nId SomeByronSigningKey
sk [TxIn]
txIns [TxOut ByronEra]
outs = do
  let txBodyCont :: TxBodyContent BuildTx ByronEra
txBodyCont = TxIns BuildTx ByronEra
-> TxInsCollateral ByronEra
-> [TxOut ByronEra]
-> TxFee ByronEra
-> (TxValidityLowerBound ByronEra, TxValidityUpperBound ByronEra)
-> TxMetadataInEra ByronEra
-> TxAuxScripts ByronEra
-> BuildTxWith BuildTx (TxExtraScriptData ByronEra)
-> TxExtraKeyWitnesses ByronEra
-> BuildTxWith BuildTx (Maybe ProtocolParameters)
-> TxWithdrawals BuildTx ByronEra
-> TxCertificates BuildTx ByronEra
-> TxUpdateProposal ByronEra
-> TxMintValue BuildTx ByronEra
-> BuildTxWith BuildTx (TxScriptValidity ByronEra)
-> TxBodyContent BuildTx ByronEra
forall build era.
TxIns build era
-> TxInsCollateral era
-> [TxOut era]
-> TxFee era
-> (TxValidityLowerBound era, TxValidityUpperBound era)
-> TxMetadataInEra era
-> TxAuxScripts era
-> BuildTxWith build (TxExtraScriptData era)
-> TxExtraKeyWitnesses era
-> BuildTxWith build (Maybe ProtocolParameters)
-> TxWithdrawals build era
-> TxCertificates build era
-> TxUpdateProposal era
-> TxMintValue build era
-> BuildTxWith build (TxScriptValidity era)
-> TxBodyContent build era
TxBodyContent
                     [ ( TxIn
txIn
                       , Witness WitCtxTxIn ByronEra
-> BuildTxWith BuildTx (Witness WitCtxTxIn ByronEra)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (KeyWitnessInCtx WitCtxTxIn -> Witness WitCtxTxIn ByronEra
forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
KeyWitness KeyWitnessInCtx WitCtxTxIn
KeyWitnessForSpending)
                       ) | TxIn
txIn <- [TxIn]
txIns
                     ]
                     TxInsCollateral ByronEra
forall era. TxInsCollateral era
TxInsCollateralNone
                     [TxOut ByronEra]
outs
                     (TxFeesImplicitInEra ByronEra -> TxFee ByronEra
forall era. TxFeesImplicitInEra era -> TxFee era
TxFeeImplicit TxFeesImplicitInEra ByronEra
TxFeesImplicitInByronEra)
                     ( TxValidityLowerBound ByronEra
forall era. TxValidityLowerBound era
TxValidityNoLowerBound
                     , ValidityNoUpperBoundSupportedInEra ByronEra
-> TxValidityUpperBound ByronEra
forall era.
ValidityNoUpperBoundSupportedInEra era -> TxValidityUpperBound era
TxValidityNoUpperBound ValidityNoUpperBoundSupportedInEra ByronEra
ValidityNoUpperBoundInByronEra
                     )
                     TxMetadataInEra ByronEra
forall era. TxMetadataInEra era
TxMetadataNone
                     TxAuxScripts ByronEra
forall era. TxAuxScripts era
TxAuxScriptsNone
                     (TxExtraScriptData ByronEra
-> BuildTxWith BuildTx (TxExtraScriptData ByronEra)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith TxExtraScriptData ByronEra
forall era. TxExtraScriptData era
TxExtraScriptDataNone)
                     TxExtraKeyWitnesses ByronEra
forall era. TxExtraKeyWitnesses era
TxExtraKeyWitnessesNone
                     (Maybe ProtocolParameters
-> BuildTxWith BuildTx (Maybe ProtocolParameters)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith Maybe ProtocolParameters
forall a. Maybe a
Nothing)
                     TxWithdrawals BuildTx ByronEra
forall build era. TxWithdrawals build era
TxWithdrawalsNone
                     TxCertificates BuildTx ByronEra
forall build era. TxCertificates build era
TxCertificatesNone
                     TxUpdateProposal ByronEra
forall era. TxUpdateProposal era
TxUpdateProposalNone
                     TxMintValue BuildTx ByronEra
forall build era. TxMintValue build era
TxMintNone
                     (TxScriptValidity ByronEra
-> BuildTxWith BuildTx (TxScriptValidity ByronEra)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith TxScriptValidity ByronEra
forall era. TxScriptValidity era
TxScriptValidityNone)
  case TxBodyContent BuildTx ByronEra
-> Either TxBodyError (TxBody ByronEra)
forall era.
IsCardanoEra era =>
TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
makeTransactionBody TxBodyContent BuildTx ByronEra
txBodyCont of
    Left TxBodyError
err -> String -> Tx ByronEra
forall a. HasCallStack => String -> a
error (String -> Tx ByronEra) -> String -> Tx ByronEra
forall a b. (a -> b) -> a -> b
$ String
"Error occured while creating a Byron genesis based UTxO transaction: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TxBodyError -> String
forall a b. (Show a, ConvertText String b) => a -> b
show TxBodyError
err
    Right TxBody ByronEra
txBody -> let bWit :: KeyWitness ByronEra
bWit = SomeByronSigningKey
-> NetworkId -> TxBody ByronEra -> KeyWitness ByronEra
fromByronWitness SomeByronSigningKey
sk NetworkId
nId TxBody ByronEra
txBody
                    in [KeyWitness ByronEra] -> TxBody ByronEra -> Tx ByronEra
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [KeyWitness ByronEra
bWit] TxBody ByronEra
txBody

fromByronWitness :: SomeByronSigningKey -> NetworkId -> TxBody ByronEra -> KeyWitness ByronEra
fromByronWitness :: SomeByronSigningKey
-> NetworkId -> TxBody ByronEra -> KeyWitness ByronEra
fromByronWitness SomeByronSigningKey
bw NetworkId
nId TxBody ByronEra
txBody =
  case SomeByronSigningKey
bw of
    AByronSigningKeyLegacy SigningKey ByronKeyLegacy
sk -> NetworkId
-> TxBody ByronEra
-> SigningKey ByronKeyLegacy
-> KeyWitness ByronEra
forall key.
IsByronKey key =>
NetworkId
-> TxBody ByronEra -> SigningKey key -> KeyWitness ByronEra
makeByronKeyWitness NetworkId
nId TxBody ByronEra
txBody SigningKey ByronKeyLegacy
sk
    AByronSigningKey SigningKey ByronKey
sk' -> NetworkId
-> TxBody ByronEra -> SigningKey ByronKey -> KeyWitness ByronEra
forall key.
IsByronKey key =>
NetworkId
-> TxBody ByronEra -> SigningKey key -> KeyWitness ByronEra
makeByronKeyWitness NetworkId
nId TxBody ByronEra
txBody SigningKey ByronKey
sk'

-- | Submit a transaction to a node specified by topology info.
nodeSubmitTx
  :: NetworkId
  -> GenTx ByronBlock
  -> ExceptT ByronTxError IO ()
nodeSubmitTx :: NetworkId -> GenTx ByronBlock -> ExceptT ByronTxError IO ()
nodeSubmitTx NetworkId
network GenTx ByronBlock
gentx = do
    SocketPath String
socketPath <- (EnvSocketError -> ByronTxError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ByronTxError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ByronTxError
EnvSocketError ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
    let connctInfo :: LocalNodeConnectInfo CardanoMode
connctInfo =
          LocalNodeConnectInfo :: forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo {
            localNodeSocketPath :: String
localNodeSocketPath = String
socketPath,
            localNodeNetworkId :: NetworkId
localNodeNetworkId = NetworkId
network,
            localConsensusModeParams :: ConsensusModeParams CardanoMode
localConsensusModeParams = EpochSlots -> ConsensusModeParams CardanoMode
CardanoModeParams (Word64 -> EpochSlots
EpochSlots Word64
21600)
          }
    SubmitResult (TxValidationErrorInMode CardanoMode)
res <- IO (SubmitResult (TxValidationErrorInMode CardanoMode))
-> ExceptT
     ByronTxError
     IO
     (SubmitResult (TxValidationErrorInMode CardanoMode))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SubmitResult (TxValidationErrorInMode CardanoMode))
 -> ExceptT
      ByronTxError
      IO
      (SubmitResult (TxValidationErrorInMode CardanoMode)))
-> IO (SubmitResult (TxValidationErrorInMode CardanoMode))
-> ExceptT
     ByronTxError
     IO
     (SubmitResult (TxValidationErrorInMode CardanoMode))
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo CardanoMode
-> TxInMode CardanoMode
-> IO (SubmitResult (TxValidationErrorInMode CardanoMode))
forall mode.
LocalNodeConnectInfo mode
-> TxInMode mode
-> IO (SubmitResult (TxValidationErrorInMode mode))
submitTxToNodeLocal LocalNodeConnectInfo CardanoMode
connctInfo (GenTx ByronBlock
-> EraInMode ByronEra CardanoMode -> TxInMode CardanoMode
forall mode.
GenTx ByronBlock -> EraInMode ByronEra mode -> TxInMode mode
TxInByronSpecial GenTx ByronBlock
gentx EraInMode ByronEra CardanoMode
ByronEraInCardanoMode)
    case SubmitResult (TxValidationErrorInMode CardanoMode)
res of
      SubmitResult (TxValidationErrorInMode CardanoMode)
Net.Tx.SubmitSuccess -> IO () -> ExceptT ByronTxError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ByronTxError IO ())
-> IO () -> ExceptT ByronTxError IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
putTextLn Text
"Transaction successfully submitted."
      Net.Tx.SubmitFail TxValidationErrorInMode CardanoMode
reason ->
        case TxValidationErrorInMode CardanoMode
reason of
          TxValidationErrorInMode TxValidationError era
err EraInMode era CardanoMode
_eraInMode -> ByronTxError -> ExceptT ByronTxError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ByronTxError -> ExceptT ByronTxError IO ())
-> (String -> ByronTxError) -> String -> ExceptT ByronTxError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByronTxError
ByronTxSubmitError (Text -> ByronTxError)
-> (String -> Text) -> String -> ByronTxError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
Text.pack (String -> ExceptT ByronTxError IO ())
-> String -> ExceptT ByronTxError IO ()
forall a b. (a -> b) -> a -> b
$ TxValidationError era -> String
forall a b. (Show a, ConvertText String b) => a -> b
show TxValidationError era
err
          TxValidationEraMismatch EraMismatch
mismatchErr -> ByronTxError -> ExceptT ByronTxError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ByronTxError -> ExceptT ByronTxError IO ())
-> ByronTxError -> ExceptT ByronTxError IO ()
forall a b. (a -> b) -> a -> b
$ EraMismatch -> ByronTxError
ByronTxSubmitErrorEraMismatch EraMismatch
mismatchErr

    () -> ExceptT ByronTxError IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


--TODO: remove these local definitions when the updated ledger lib is available
fromCborTxAux :: LB.ByteString ->  Either Binary.DecoderError (UTxO.ATxAux B.ByteString)
fromCborTxAux :: ByteString -> Either DecoderError (ATxAux ByteString)
fromCborTxAux ByteString
lbs =
    (ATxAux ByteSpan -> ATxAux ByteString)
-> Either DecoderError (ATxAux ByteSpan)
-> Either DecoderError (ATxAux ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> ATxAux ByteSpan -> ATxAux ByteString
forall (f :: * -> *).
Functor f =>
ByteString -> f ByteSpan -> f ByteString
annotationBytes ByteString
lbs)
      (Either DecoderError (ATxAux ByteSpan)
 -> Either DecoderError (ATxAux ByteString))
-> Either DecoderError (ATxAux ByteSpan)
-> Either DecoderError (ATxAux ByteString)
forall a b. (a -> b) -> a -> b
$ Text
-> (forall s. Decoder s (ATxAux ByteSpan))
-> ByteString
-> Either DecoderError (ATxAux ByteSpan)
forall a.
Text
-> (forall s. Decoder s a) -> ByteString -> Either DecoderError a
Binary.decodeFullDecoder Text
"Cardano.Chain.UTxO.TxAux.fromCborTxAux"
                                 forall s. Decoder s (ATxAux ByteSpan)
forall a s. FromCBOR a => Decoder s a
Binary.fromCBOR ByteString
lbs
  where
    annotationBytes :: Functor f => LB.ByteString -> f Binary.ByteSpan -> f B.ByteString
    annotationBytes :: ByteString -> f ByteSpan -> f ByteString
annotationBytes ByteString
bytes = (ByteSpan -> ByteString) -> f ByteSpan -> f ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> ByteString
LB.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
Binary.slice ByteString
bytes)

toCborTxAux :: UTxO.ATxAux ByteString -> LB.ByteString
toCborTxAux :: ATxAux ByteString -> ByteString
toCborTxAux = ByteString -> ByteString
LB.fromStrict (ByteString -> ByteString)
-> (ATxAux ByteString -> ByteString)
-> ATxAux ByteString
-> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ATxAux ByteString -> ByteString
forall a. ATxAux a -> a
UTxO.aTaAnnotation -- The ByteString anotation is the CBOR encoded version.