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

module Bcc.CLI.Cole.Tx
  ( ColeTxError(..)
  , TxFile(..)
  , NewTxFile(..)
  , prettyAddress
  , readColeTx
  , normalColeTxToGenTx
  , txSpendGenesisUTxOColePBFT
  , txSpendUTxOColePBFT
  , nodeSubmitTx
  , renderColeTxError

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

  , ScriptValidity(..)
  )
where

import           Bcc.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           Bcc.Api

import qualified Bcc.Binary as Binary

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

import           Bcc.Api.Cole
import           Bcc.CLI.Cole.Key (coleWitnessToVerKey)
import           Bcc.CLI.Environment
import           Bcc.CLI.Helpers (textShow)
import           Bcc.CLI.Types (SocketPath (..))
import           Shardagnostic.Consensus.Cole.Ledger (ColeBlock, GenTx (..))
import qualified Shardagnostic.Consensus.Cole.Ledger as Cole
import           Shardagnostic.Consensus.Bcc.Block (EraMismatch (..))
import qualified Shardagnostic.Network.Protocol.LocalTxSubmission.Client as Net.Tx

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

renderColeTxError :: ColeTxError -> Text
renderColeTxError :: ColeTxError -> Text
renderColeTxError ColeTxError
err =
  case ColeTxError
err of
    ColeTxSubmitError Text
res -> Text
"Error while submitting tx: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
res
    ColeTxSubmitErrorEraMismatch 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 ColeAddr -> Text
prettyAddress :: Address ColeAddr -> Text
prettyAddress (ColeAddress 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

readColeTx :: TxFile -> ExceptT ColeTxError IO (UTxO.ATxAux ByteString)
readColeTx :: TxFile -> ExceptT ColeTxError IO (ATxAux ByteString)
readColeTx (TxFile String
fp) = do
  ByteString
txBS <- IO ByteString -> ExceptT ColeTxError IO ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ExceptT ColeTxError IO ByteString)
-> IO ByteString -> ExceptT ColeTxError 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 -> ColeTxError -> ExceptT ColeTxError IO (ATxAux ByteString)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ColeTxError -> ExceptT ColeTxError IO (ATxAux ByteString))
-> ColeTxError -> ExceptT ColeTxError IO (ATxAux ByteString)
forall a b. (a -> b) -> a -> b
$ String -> DecoderError -> ColeTxError
TxDeserialisationFailed String
fp DecoderError
e
    Right ATxAux ByteString
tx -> ATxAux ByteString -> ExceptT ColeTxError 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\" Cole transactions are just one of the kinds.
normalColeTxToGenTx :: UTxO.ATxAux ByteString -> GenTx ColeBlock
normalColeTxToGenTx :: ATxAux ByteString -> GenTx ColeBlock
normalColeTxToGenTx ATxAux ByteString
tx' = TxId -> ATxAux ByteString -> GenTx ColeBlock
Cole.ColeTx (ATxAux ByteString -> TxId
Cole.coleIdTx 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 ColeAddr -> Text
prettyAddress (Address -> Address ColeAddr
ColeAddress 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]
Bcc.Prelude.concat (Text -> String
T.unpack (Text -> String)
-> (Address ColeAddr -> Text) -> Address ColeAddr -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Address ColeAddr -> Text
prettyAddress (Address ColeAddr -> String) -> [Address ColeAddr] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Address -> Address ColeAddr) -> [Address] -> [Address ColeAddr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Address -> Address ColeAddr
ColeAddress (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.
txSpendGenesisUTxOColePBFT
  :: Genesis.Config
  -> NetworkId
  -> SomeColeSigningKey
  -> Address ColeAddr
  -> [TxOut ColeEra]
  -> Tx ColeEra
txSpendGenesisUTxOColePBFT :: Config
-> NetworkId
-> SomeColeSigningKey
-> Address ColeAddr
-> [TxOut ColeEra]
-> Tx ColeEra
txSpendGenesisUTxOColePBFT Config
gc NetworkId
nId SomeColeSigningKey
sk (ColeAddress Address
bAddr) [TxOut ColeEra]
outs = do
    let txBodyCont :: TxBodyContent BuildTx ColeEra
txBodyCont =
          TxIns BuildTx ColeEra
-> TxInsCollateral ColeEra
-> [TxOut ColeEra]
-> TxFee ColeEra
-> (TxValidityLowerBound ColeEra, TxValidityUpperBound ColeEra)
-> TxMetadataInEra ColeEra
-> TxAuxScripts ColeEra
-> BuildTxWith BuildTx (TxExtraScriptData ColeEra)
-> TxExtraKeyWitnesses ColeEra
-> BuildTxWith BuildTx (Maybe ProtocolParameters)
-> TxWithdrawals BuildTx ColeEra
-> TxCertificates BuildTx ColeEra
-> TxUpdateProposal ColeEra
-> TxMintValue BuildTx ColeEra
-> TxScriptValidity ColeEra
-> TxBodyContent BuildTx ColeEra
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
-> TxScriptValidity era
-> TxBodyContent build era
TxBodyContent
            [ (TxIn -> TxIn
fromColeTxIn TxIn
txIn
              , Witness WitCtxTxIn ColeEra
-> BuildTxWith BuildTx (Witness WitCtxTxIn ColeEra)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (KeyWitnessInCtx WitCtxTxIn -> Witness WitCtxTxIn ColeEra
forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
KeyWitness KeyWitnessInCtx WitCtxTxIn
KeyWitnessForSpending))
            ]
            TxInsCollateral ColeEra
forall era. TxInsCollateral era
TxInsCollateralNone
            [TxOut ColeEra]
outs
            (TxFeesImplicitInEra ColeEra -> TxFee ColeEra
forall era. TxFeesImplicitInEra era -> TxFee era
TxFeeImplicit TxFeesImplicitInEra ColeEra
TxFeesImplicitInColeEra)
            ( TxValidityLowerBound ColeEra
forall era. TxValidityLowerBound era
TxValidityNoLowerBound
            , ValidityNoUpperBoundSupportedInEra ColeEra
-> TxValidityUpperBound ColeEra
forall era.
ValidityNoUpperBoundSupportedInEra era -> TxValidityUpperBound era
TxValidityNoUpperBound ValidityNoUpperBoundSupportedInEra ColeEra
ValidityNoUpperBoundInColeEra
            )
            TxMetadataInEra ColeEra
forall era. TxMetadataInEra era
TxMetadataNone
            TxAuxScripts ColeEra
forall era. TxAuxScripts era
TxAuxScriptsNone
            (TxExtraScriptData ColeEra
-> BuildTxWith BuildTx (TxExtraScriptData ColeEra)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith TxExtraScriptData ColeEra
forall era. TxExtraScriptData era
TxExtraScriptDataNone)
            TxExtraKeyWitnesses ColeEra
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 ColeEra
forall build era. TxWithdrawals build era
TxWithdrawalsNone
            TxCertificates BuildTx ColeEra
forall build era. TxCertificates build era
TxCertificatesNone
            TxUpdateProposal ColeEra
forall era. TxUpdateProposal era
TxUpdateProposalNone
            TxMintValue BuildTx ColeEra
forall build era. TxMintValue build era
TxMintNone
            TxScriptValidity ColeEra
forall era. TxScriptValidity era
TxScriptValidityNone
    case TxBodyContent BuildTx ColeEra
-> Either TxBodyError (TxBody ColeEra)
forall era.
IsBccEra era =>
TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
makeTransactionBody TxBodyContent BuildTx ColeEra
txBodyCont of
      Left TxBodyError
err -> String -> Tx ColeEra
forall a. HasCallStack => String -> a
error (String -> Tx ColeEra) -> String -> Tx ColeEra
forall a b. (a -> b) -> a -> b
$ String
"Error occured while creating a Cole 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 ColeEra
txBody -> let bWit :: KeyWitness ColeEra
bWit = SomeColeSigningKey
-> NetworkId -> TxBody ColeEra -> KeyWitness ColeEra
fromColeWitness SomeColeSigningKey
sk NetworkId
nId TxBody ColeEra
txBody
                      in [KeyWitness ColeEra] -> TxBody ColeEra -> Tx ColeEra
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [KeyWitness ColeEra
bWit] TxBody ColeEra
txBody
  where
    ColeVerificationKey vKey = SomeColeSigningKey -> VerificationKey ColeKey
coleWitnessToVerKey SomeColeSigningKey
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.
txSpendUTxOColePBFT
  :: NetworkId
  -> SomeColeSigningKey
  -> [TxIn]
  -> [TxOut ColeEra]
  -> Tx ColeEra
txSpendUTxOColePBFT :: NetworkId
-> SomeColeSigningKey -> [TxIn] -> [TxOut ColeEra] -> Tx ColeEra
txSpendUTxOColePBFT NetworkId
nId SomeColeSigningKey
sk [TxIn]
txIns [TxOut ColeEra]
outs = do
  let txBodyCont :: TxBodyContent BuildTx ColeEra
txBodyCont = TxIns BuildTx ColeEra
-> TxInsCollateral ColeEra
-> [TxOut ColeEra]
-> TxFee ColeEra
-> (TxValidityLowerBound ColeEra, TxValidityUpperBound ColeEra)
-> TxMetadataInEra ColeEra
-> TxAuxScripts ColeEra
-> BuildTxWith BuildTx (TxExtraScriptData ColeEra)
-> TxExtraKeyWitnesses ColeEra
-> BuildTxWith BuildTx (Maybe ProtocolParameters)
-> TxWithdrawals BuildTx ColeEra
-> TxCertificates BuildTx ColeEra
-> TxUpdateProposal ColeEra
-> TxMintValue BuildTx ColeEra
-> TxScriptValidity ColeEra
-> TxBodyContent BuildTx ColeEra
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
-> TxScriptValidity era
-> TxBodyContent build era
TxBodyContent
                     [ ( TxIn
txIn
                       , Witness WitCtxTxIn ColeEra
-> BuildTxWith BuildTx (Witness WitCtxTxIn ColeEra)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (KeyWitnessInCtx WitCtxTxIn -> Witness WitCtxTxIn ColeEra
forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
KeyWitness KeyWitnessInCtx WitCtxTxIn
KeyWitnessForSpending)
                       ) | TxIn
txIn <- [TxIn]
txIns
                     ]
                     TxInsCollateral ColeEra
forall era. TxInsCollateral era
TxInsCollateralNone
                     [TxOut ColeEra]
outs
                     (TxFeesImplicitInEra ColeEra -> TxFee ColeEra
forall era. TxFeesImplicitInEra era -> TxFee era
TxFeeImplicit TxFeesImplicitInEra ColeEra
TxFeesImplicitInColeEra)
                     ( TxValidityLowerBound ColeEra
forall era. TxValidityLowerBound era
TxValidityNoLowerBound
                     , ValidityNoUpperBoundSupportedInEra ColeEra
-> TxValidityUpperBound ColeEra
forall era.
ValidityNoUpperBoundSupportedInEra era -> TxValidityUpperBound era
TxValidityNoUpperBound ValidityNoUpperBoundSupportedInEra ColeEra
ValidityNoUpperBoundInColeEra
                     )
                     TxMetadataInEra ColeEra
forall era. TxMetadataInEra era
TxMetadataNone
                     TxAuxScripts ColeEra
forall era. TxAuxScripts era
TxAuxScriptsNone
                     (TxExtraScriptData ColeEra
-> BuildTxWith BuildTx (TxExtraScriptData ColeEra)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith TxExtraScriptData ColeEra
forall era. TxExtraScriptData era
TxExtraScriptDataNone)
                     TxExtraKeyWitnesses ColeEra
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 ColeEra
forall build era. TxWithdrawals build era
TxWithdrawalsNone
                     TxCertificates BuildTx ColeEra
forall build era. TxCertificates build era
TxCertificatesNone
                     TxUpdateProposal ColeEra
forall era. TxUpdateProposal era
TxUpdateProposalNone
                     TxMintValue BuildTx ColeEra
forall build era. TxMintValue build era
TxMintNone
                     TxScriptValidity ColeEra
forall era. TxScriptValidity era
TxScriptValidityNone
  case TxBodyContent BuildTx ColeEra
-> Either TxBodyError (TxBody ColeEra)
forall era.
IsBccEra era =>
TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
makeTransactionBody TxBodyContent BuildTx ColeEra
txBodyCont of
    Left TxBodyError
err -> String -> Tx ColeEra
forall a. HasCallStack => String -> a
error (String -> Tx ColeEra) -> String -> Tx ColeEra
forall a b. (a -> b) -> a -> b
$ String
"Error occured while creating a Cole 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 ColeEra
txBody -> let bWit :: KeyWitness ColeEra
bWit = SomeColeSigningKey
-> NetworkId -> TxBody ColeEra -> KeyWitness ColeEra
fromColeWitness SomeColeSigningKey
sk NetworkId
nId TxBody ColeEra
txBody
                    in [KeyWitness ColeEra] -> TxBody ColeEra -> Tx ColeEra
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [KeyWitness ColeEra
bWit] TxBody ColeEra
txBody

fromColeWitness :: SomeColeSigningKey -> NetworkId -> TxBody ColeEra -> KeyWitness ColeEra
fromColeWitness :: SomeColeSigningKey
-> NetworkId -> TxBody ColeEra -> KeyWitness ColeEra
fromColeWitness SomeColeSigningKey
bw NetworkId
nId TxBody ColeEra
txBody =
  case SomeColeSigningKey
bw of
    AColeSigningKeyLegacy SigningKey ColeKeyLegacy
sk -> NetworkId
-> TxBody ColeEra -> SigningKey ColeKeyLegacy -> KeyWitness ColeEra
forall key.
IsColeKey key =>
NetworkId -> TxBody ColeEra -> SigningKey key -> KeyWitness ColeEra
makeColeKeyWitness NetworkId
nId TxBody ColeEra
txBody SigningKey ColeKeyLegacy
sk
    AColeSigningKey SigningKey ColeKey
sk' -> NetworkId
-> TxBody ColeEra -> SigningKey ColeKey -> KeyWitness ColeEra
forall key.
IsColeKey key =>
NetworkId -> TxBody ColeEra -> SigningKey key -> KeyWitness ColeEra
makeColeKeyWitness NetworkId
nId TxBody ColeEra
txBody SigningKey ColeKey
sk'

-- | Submit a transaction to a node specified by topology info.
nodeSubmitTx
  :: NetworkId
  -> GenTx ColeBlock
  -> ExceptT ColeTxError IO ()
nodeSubmitTx :: NetworkId -> GenTx ColeBlock -> ExceptT ColeTxError IO ()
nodeSubmitTx NetworkId
network GenTx ColeBlock
gentx = do
    SocketPath String
socketPath <- (EnvSocketError -> ColeTxError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ColeTxError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ColeTxError
EnvSocketError ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
    let connctInfo :: LocalNodeConnectInfo BccMode
connctInfo =
          LocalNodeConnectInfo :: forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo {
            localNodeSocketPath :: String
localNodeSocketPath = String
socketPath,
            localNodeNetworkId :: NetworkId
localNodeNetworkId = NetworkId
network,
            localConsensusModeParams :: ConsensusModeParams BccMode
localConsensusModeParams = EpochSlots -> ConsensusModeParams BccMode
BccModeParams (Word64 -> EpochSlots
EpochSlots Word64
21600)
          }
    SubmitResult (TxValidationErrorInMode BccMode)
res <- IO (SubmitResult (TxValidationErrorInMode BccMode))
-> ExceptT
     ColeTxError IO (SubmitResult (TxValidationErrorInMode BccMode))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SubmitResult (TxValidationErrorInMode BccMode))
 -> ExceptT
      ColeTxError IO (SubmitResult (TxValidationErrorInMode BccMode)))
-> IO (SubmitResult (TxValidationErrorInMode BccMode))
-> ExceptT
     ColeTxError IO (SubmitResult (TxValidationErrorInMode BccMode))
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo BccMode
-> TxInMode BccMode
-> IO (SubmitResult (TxValidationErrorInMode BccMode))
forall mode.
LocalNodeConnectInfo mode
-> TxInMode mode
-> IO (SubmitResult (TxValidationErrorInMode mode))
submitTxToNodeLocal LocalNodeConnectInfo BccMode
connctInfo (GenTx ColeBlock -> EraInMode ColeEra BccMode -> TxInMode BccMode
forall mode.
GenTx ColeBlock -> EraInMode ColeEra mode -> TxInMode mode
TxInColeSpecial GenTx ColeBlock
gentx EraInMode ColeEra BccMode
ColeEraInBccMode)
    case SubmitResult (TxValidationErrorInMode BccMode)
res of
      SubmitResult (TxValidationErrorInMode BccMode)
Net.Tx.SubmitSuccess -> IO () -> ExceptT ColeTxError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ColeTxError IO ())
-> IO () -> ExceptT ColeTxError IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
putTextLn Text
"Transaction successfully submitted."
      Net.Tx.SubmitFail TxValidationErrorInMode BccMode
reason ->
        case TxValidationErrorInMode BccMode
reason of
          TxValidationErrorInMode TxValidationError era
err EraInMode era BccMode
_eraInMode -> ColeTxError -> ExceptT ColeTxError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ColeTxError -> ExceptT ColeTxError IO ())
-> (String -> ColeTxError) -> String -> ExceptT ColeTxError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ColeTxError
ColeTxSubmitError (Text -> ColeTxError) -> (String -> Text) -> String -> ColeTxError
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 ColeTxError IO ())
-> String -> ExceptT ColeTxError 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 -> ColeTxError -> ExceptT ColeTxError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ColeTxError -> ExceptT ColeTxError IO ())
-> ColeTxError -> ExceptT ColeTxError IO ()
forall a b. (a -> b) -> a -> b
$ EraMismatch -> ColeTxError
ColeTxSubmitErrorEraMismatch EraMismatch
mismatchErr

    () -> ExceptT ColeTxError 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
"Bcc.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.