-
Notifications
You must be signed in to change notification settings - Fork 721
/
Transaction.hs
1521 lines (1340 loc) · 66 KB
/
Transaction.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Cardano.CLI.Shelley.Run.Transaction
( ShelleyTxCmdError
, renderShelleyTxCmdError
, runTransactionCmd
) where
import Cardano.Prelude hiding (All, Any)
import Prelude (String, error)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.List (intersect, (\\))
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as Text
import Data.Type.Equality (TestEquality (..))
import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither,
hoistMaybe, left, newExceptT)
import Cardano.Api
import Cardano.Api.Byron hiding (SomeByronSigningKey (..))
import Cardano.Api.Shelley
import Ouroboros.Consensus.Shelley.Eras (StandardAllegra, StandardMary, StandardShelley)
--TODO: do this nicely via the API too:
import qualified Cardano.Binary as CBOR
--TODO: following import needed for orphan Eq Script instance
import Cardano.Ledger.Shelley.Scripts ()
import Cardano.Ledger.ShelleyMA.TxBody ()
import Cardano.CLI.Environment (EnvSocketError, readEnvSocketPath, renderEnvSocketError)
import Cardano.CLI.Run.Friendly (friendlyTxBodyBS)
import Cardano.CLI.Shelley.Key (InputDecodeError, readSigningKeyFileAnyOf)
import Cardano.CLI.Shelley.Parsers
import Cardano.CLI.Shelley.Run.Genesis (ShelleyGenesisCmdError (..),
readShelleyGenesisWithDefault)
import Cardano.CLI.Shelley.Run.Query (ShelleyQueryCmdLocalStateQueryError (..),
renderLocalStateQueryError)
import Cardano.CLI.Shelley.Script
import Cardano.CLI.Types
import Ouroboros.Consensus.Byron.Ledger (ByronBlock)
import Ouroboros.Consensus.Cardano.Block (EraMismatch (..))
import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr)
import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock)
import Ouroboros.Network.Protocol.LocalStateQuery.Type (AcquireFailure (..))
import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Client as Net.Tx
import qualified System.IO as IO
{- HLINT ignore "Use let" -}
data ShelleyTxCmdError
= ShelleyTxCmdAesonDecodeProtocolParamsError !FilePath !Text
| ShelleyTxCmdReadFileError !(FileError ())
| ShelleyTxCmdScriptFileError (FileError ScriptDecodeError)
| ShelleyTxCmdReadTextViewFileError !(FileError TextEnvelopeError)
| ShelleyTxCmdReadWitnessSigningDataError !ReadWitnessSigningDataError
| ShelleyTxCmdReadRequiredSignerError !(FileError InputDecodeError)
| ShelleyTxCmdRequiredSignerByronKeyError !SigningKeyFile
| ShelleyTxCmdWriteFileError !(FileError ())
| ShelleyTxCmdEraConsensusModeMismatch
!(Maybe FilePath)
!AnyConsensusMode
!AnyCardanoEra
-- ^ Era
| ShelleyTxCmdMetadataJsonParseError !FilePath !String
| ShelleyTxCmdMetadataConversionError !FilePath !TxMetadataJsonError
| ShelleyTxCmdMetaValidationError !FilePath ![(Word64, TxMetadataRangeError)]
| ShelleyTxCmdScriptDataJsonParseError !FilePath !String
| ShelleyTxCmdScriptDataConversionError !FilePath !ScriptDataJsonError
| ShelleyTxCmdScriptDataValidationError !FilePath !ScriptDataRangeError
| ShelleyTxCmdMetaDecodeError !FilePath !CBOR.DecoderError
| ShelleyTxCmdBootstrapWitnessError !ShelleyBootstrapWitnessError
| ShelleyTxCmdSocketEnvError !EnvSocketError
| ShelleyTxCmdTxSubmitError !Text
| ShelleyTxCmdTxSubmitErrorByron !(ApplyTxErr ByronBlock)
| ShelleyTxCmdTxSubmitErrorShelley !(ApplyTxErr (ShelleyBlock StandardShelley))
| ShelleyTxCmdTxSubmitErrorAllegra !(ApplyTxErr (ShelleyBlock StandardAllegra))
| ShelleyTxCmdTxSubmitErrorMary !(ApplyTxErr (ShelleyBlock StandardMary))
| ShelleyTxCmdTxSubmitErrorEraMismatch !EraMismatch
| ShelleyTxCmdTxFeatureMismatch !AnyCardanoEra !TxFeature
| ShelleyTxCmdTxBodyError !TxBodyError
| ShelleyTxCmdNotImplemented !Text
| ShelleyTxCmdWitnessEraMismatch !AnyCardanoEra !AnyCardanoEra !WitnessFile
| ShelleyTxCmdScriptLanguageNotSupportedInEra !AnyScriptLanguage !AnyCardanoEra
| ShelleyTxCmdScriptExpectedSimple !FilePath !AnyScriptLanguage
| ShelleyTxCmdScriptExpectedPlutus !FilePath !AnyScriptLanguage
| ShelleyTxCmdGenesisCmdError !ShelleyGenesisCmdError
| ShelleyTxCmdPolicyIdsMissing ![PolicyId]
| ShelleyTxCmdPolicyIdsExcess ![PolicyId]
| ShelleyTxCmdAcquireFailure !AcquireFailure
| ShelleyTxCmdUnsupportedMode !AnyConsensusMode
| ShelleyTxCmdByronEra
| ShelleyTxCmdEraConsensusModeMismatchTxBalance
!TxBodyFile
!AnyConsensusMode
!AnyCardanoEra
| ShelleyTxCmdBalanceTxBody !TxBodyErrorAutoBalance
| ShelleyTxCmdEraConsensusModeMismatchQuery !AnyConsensusMode !AnyCardanoEra
| ShelleyTxCmdByronEraQuery
| ShelleyTxCmdLocalStateQueryError !ShelleyQueryCmdLocalStateQueryError
| ShelleyTxCmdExpectedKeyLockedTxIn ![TxIn]
| ShelleyTxCmdTxInsDoNotExist ![TxIn]
| ShelleyTxCmdMinimumUTxOErr !MinimumUTxOError
| ShelleyTxCmdPParamsErr !ProtocolParametersError
deriving Show
renderShelleyTxCmdError :: ShelleyTxCmdError -> Text
renderShelleyTxCmdError err =
case err of
ShelleyTxCmdReadFileError fileErr -> Text.pack (displayError fileErr)
ShelleyTxCmdReadTextViewFileError fileErr -> Text.pack (displayError fileErr)
ShelleyTxCmdScriptFileError fileErr -> Text.pack (displayError fileErr)
ShelleyTxCmdReadWitnessSigningDataError witSignDataErr ->
renderReadWitnessSigningDataError witSignDataErr
ShelleyTxCmdReadRequiredSignerError fileErr ->
"Error reading required signer: " <> Text.pack (displayError fileErr)
ShelleyTxCmdRequiredSignerByronKeyError (SigningKeyFile fp) ->
"Byron key witness was used as a required signer: " <> show fp
ShelleyTxCmdWriteFileError fileErr -> Text.pack (displayError fileErr)
ShelleyTxCmdMetadataJsonParseError fp jsonErr ->
"Invalid JSON format in file: " <> show fp
<> "\nJSON parse error: " <> Text.pack jsonErr
ShelleyTxCmdMetadataConversionError fp metadataErr ->
"Error reading metadata at: " <> show fp
<> "\n" <> Text.pack (displayError metadataErr)
ShelleyTxCmdMetaDecodeError fp metadataErr ->
"Error decoding CBOR metadata at: " <> show fp
<> " Error: " <> show metadataErr
ShelleyTxCmdMetaValidationError fp errs ->
"Error validating transaction metadata at: " <> show fp <> "\n" <>
Text.intercalate "\n"
[ "key " <> show k <> ":" <> Text.pack (displayError valErr)
| (k, valErr) <- errs ]
ShelleyTxCmdScriptDataJsonParseError fp jsonErr ->
"Invalid JSON format in file: " <> show fp <>
"\nJSON parse error: " <> Text.pack jsonErr
ShelleyTxCmdScriptDataConversionError fp cerr ->
"Error reading metadata at: " <> show fp
<> "\n" <> Text.pack (displayError cerr)
ShelleyTxCmdScriptDataValidationError fp verr ->
"Error validating script data at: " <> show fp <> ":\n" <>
Text.pack (displayError verr)
ShelleyTxCmdSocketEnvError envSockErr -> renderEnvSocketError envSockErr
ShelleyTxCmdAesonDecodeProtocolParamsError fp decErr ->
"Error while decoding the protocol parameters at: " <> show fp
<> " Error: " <> show decErr
ShelleyTxCmdTxSubmitError res -> "Error while submitting tx: " <> res
ShelleyTxCmdTxSubmitErrorByron res ->
"Error while submitting tx: " <> Text.pack (show res)
ShelleyTxCmdTxSubmitErrorShelley res ->
"Error while submitting tx: " <> Text.pack (show res)
ShelleyTxCmdTxSubmitErrorAllegra res ->
"Error while submitting tx: " <> Text.pack (show res)
ShelleyTxCmdTxSubmitErrorMary res ->
"Error while submitting tx: " <> Text.pack (show res)
ShelleyTxCmdTxSubmitErrorEraMismatch EraMismatch{ledgerEraName, otherEraName} ->
"The era of the node and the tx do not match. " <>
"The node is running in the " <> ledgerEraName <>
" era, but the transaction is for the " <> otherEraName <> " era."
ShelleyTxCmdBootstrapWitnessError sbwErr ->
renderShelleyBootstrapWitnessError sbwErr
ShelleyTxCmdTxFeatureMismatch era TxFeatureImplicitFees ->
"An explicit transaction fee must be specified for " <>
renderEra era <> " era transactions."
ShelleyTxCmdTxFeatureMismatch (AnyCardanoEra ShelleyEra)
TxFeatureValidityNoUpperBound ->
"A TTL must be specified for Shelley era transactions."
ShelleyTxCmdTxFeatureMismatch era feature ->
renderFeature feature <> " cannot be used for " <> renderEra era <>
" era transactions."
ShelleyTxCmdTxBodyError err' ->
"Transaction validaton error: " <> Text.pack (displayError err')
ShelleyTxCmdNotImplemented msg ->
"Feature not yet implemented: " <> msg
ShelleyTxCmdWitnessEraMismatch era era' (WitnessFile file) ->
"The era of a witness does not match the era of the transaction. " <>
"The transaction is for the " <> renderEra era <> " era, but the " <>
"witness in " <> show file <> " is for the " <> renderEra era' <> " era."
ShelleyTxCmdScriptLanguageNotSupportedInEra (AnyScriptLanguage lang) era ->
"The script language " <> show lang <> " is not supported in the " <>
renderEra era <> " era."
ShelleyTxCmdScriptExpectedSimple file (AnyScriptLanguage lang) ->
Text.pack file <> ": expected a script in the simple script language, " <>
"but it is actually using " <> show lang <> ". Alternatively, to use " <>
"a Plutus script, you must also specify the redeemer " <>
"(datum if appropriate) and script execution units."
ShelleyTxCmdScriptExpectedPlutus file (AnyScriptLanguage lang) ->
Text.pack file <> ": expected a script in the Plutus script language, " <>
"but it is actually using " <> show lang <> "."
ShelleyTxCmdEraConsensusModeMismatch fp mode era ->
"Submitting " <> renderEra era <> " era transaction (" <> show fp <>
") is not supported in the " <> renderMode mode <> " consensus mode."
ShelleyTxCmdGenesisCmdError e -> Text.pack $ displayError e
ShelleyTxCmdPolicyIdsMissing policyids ->
"The \"--mint\" flag specifies an asset with a policy Id, but no \
\corresponding monetary policy script has been provided as a witness \
\(via the \"--minting-script-file\" flag). The policy Id in question is: "
<> Text.intercalate ", " (map serialiseToRawBytesHexText policyids)
ShelleyTxCmdPolicyIdsExcess policyids ->
"A script provided to witness minting does not correspond to the policy \
\id of any asset specified in the \"--mint\" field. The script hash is: "
<> Text.intercalate ", " (map serialiseToRawBytesHexText policyids)
ShelleyTxCmdAcquireFailure acquireFail -> Text.pack $ show acquireFail
ShelleyTxCmdUnsupportedMode mode -> "Unsupported mode: " <> renderMode mode
ShelleyTxCmdByronEra -> "This query cannot be used for the Byron era"
ShelleyTxCmdEraConsensusModeMismatchTxBalance fp mode era ->
"Cannot balance " <> renderEra era <> " era transaction body (" <> show fp <>
") because is not supported in the " <> renderMode mode <> " consensus mode."
ShelleyTxCmdEraConsensusModeMismatchQuery (AnyConsensusMode cMode) (AnyCardanoEra era) ->
"Consensus mode and era mismatch. Consensus mode: " <> show cMode <>
" Era: " <> show era
ShelleyTxCmdByronEraQuery -> "Query not available in Byron era"
ShelleyTxCmdLocalStateQueryError err' -> renderLocalStateQueryError err'
ShelleyTxCmdBalanceTxBody err' -> Text.pack $ displayError err'
ShelleyTxCmdExpectedKeyLockedTxIn txins ->
"Expected key witnessed collateral tx inputs but got script witnessed tx inputs: " <>
Text.singleton '\n' <>
Text.intercalate (Text.singleton '\n') (map renderTxIn txins)
ShelleyTxCmdTxInsDoNotExist txins ->
"The following tx input(s) were not present in the UTxO: " <>
Text.singleton '\n' <>
Text.intercalate (Text.singleton '\n') (map renderTxIn txins)
ShelleyTxCmdMinimumUTxOErr err' -> Text.pack $ displayError err'
ShelleyTxCmdPParamsErr err' -> Text.pack $ displayError err'
renderEra :: AnyCardanoEra -> Text
renderEra (AnyCardanoEra ByronEra) = "Byron"
renderEra (AnyCardanoEra ShelleyEra) = "Shelley"
renderEra (AnyCardanoEra AllegraEra) = "Allegra"
renderEra (AnyCardanoEra MaryEra) = "Mary"
renderEra (AnyCardanoEra AlonzoEra) = "Alonzo"
renderFeature :: TxFeature -> Text
renderFeature TxFeatureShelleyAddresses = "Shelley addresses"
renderFeature TxFeatureExplicitFees = "Explicit fees"
renderFeature TxFeatureImplicitFees = "Implicit fees"
renderFeature TxFeatureValidityLowerBound = "A validity lower bound"
renderFeature TxFeatureValidityUpperBound = "A validity upper bound"
renderFeature TxFeatureValidityNoUpperBound = "An absent validity upper bound"
renderFeature TxFeatureTxMetadata = "Transaction metadata"
renderFeature TxFeatureAuxScripts = "Auxiliary scripts"
renderFeature TxFeatureWithdrawals = "Reward account withdrawals"
renderFeature TxFeatureCertificates = "Certificates"
renderFeature TxFeatureMintValue = "Asset minting"
renderFeature TxFeatureMultiAssetOutputs = "Multi-Asset outputs"
renderFeature TxFeatureScriptWitnesses = "Script witnesses"
renderFeature TxFeatureShelleyKeys = "Shelley keys"
renderFeature TxFeatureCollateral = "Collateral inputs"
renderFeature TxFeatureProtocolParameters = "Protocol parameters"
renderFeature TxFeatureTxOutDatum = "Transaction output datums"
renderFeature TxFeatureScriptValidity = "Script validity"
renderFeature TxFeatureExtraKeyWits = "Required signers"
runTransactionCmd :: TransactionCmd -> ExceptT ShelleyTxCmdError IO ()
runTransactionCmd cmd =
case cmd of
TxBuild era consensusModeParams nid mScriptValidity mOverrideWits txins reqSigners
txinsc txouts changeAddr mValue mLowBound mUpperBound certs wdrls metadataSchema
scriptFiles metadataFiles mpparams mUpProp outputFormat out ->
runTxBuild era consensusModeParams nid mScriptValidity txins txinsc txouts changeAddr mValue mLowBound
mUpperBound certs wdrls reqSigners metadataSchema scriptFiles
metadataFiles mpparams mUpProp outputFormat out mOverrideWits
TxBuildRaw era mScriptValidity txins txinsc reqSigners txouts mValue mLowBound mUpperBound
fee certs wdrls metadataSchema scriptFiles
metadataFiles mpparams mUpProp outputFormat out ->
runTxBuildRaw era mScriptValidity txins txinsc txouts mLowBound mUpperBound
fee mValue certs wdrls reqSigners metadataSchema
scriptFiles metadataFiles mpparams mUpProp outputFormat out
TxSign txinfile skfiles network txoutfile ->
runTxSign txinfile skfiles network txoutfile
TxSubmit anyConensusModeParams network txFp ->
runTxSubmit anyConensusModeParams network txFp
TxCalculateMinFee txbody mnw pGenesisOrParamsFile nInputs nOutputs
nShelleyKeyWitnesses nByronKeyWitnesses ->
runTxCalculateMinFee txbody mnw pGenesisOrParamsFile nInputs nOutputs
nShelleyKeyWitnesses nByronKeyWitnesses
TxCalculateMinRequiredUTxO era pParamSpec txOuts -> runTxCalculateMinRequiredUTxO era pParamSpec txOuts
TxHashScriptData scriptDataOrFile -> runTxHashScriptData scriptDataOrFile
TxGetTxId txinfile -> runTxGetTxId txinfile
TxView txinfile -> runTxView txinfile
TxMintedPolicyId sFile -> runTxCreatePolicyId sFile
TxCreateWitness txBodyfile witSignData mbNw outFile ->
runTxCreateWitness txBodyfile witSignData mbNw outFile
TxAssembleTxBodyWitness txBodyFile witnessFile outFile ->
runTxSignWitness txBodyFile witnessFile outFile
-- ----------------------------------------------------------------------------
-- Building transactions
--
runTxBuildRaw
:: AnyCardanoEra
-> Maybe ScriptValidity
-- ^ Mark script as expected to pass or fail validation
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-- ^ TxIn with potential script witness
-> [TxIn]
-- ^ TxIn for collateral
-> [TxOutAnyEra]
-> Maybe SlotNo
-- ^ Tx lower bound
-> Maybe SlotNo
-- ^ Tx upper bound
-> Maybe Lovelace
-- ^ Tx fee
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-- ^ Multi-Asset value(s)
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-- ^ Certificate with potential script witness
-> [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
-> [RequiredSigner]
-- ^ Required signers
-> TxMetadataJsonSchema
-> [ScriptFile]
-> [MetadataFile]
-> Maybe ProtocolParamsSourceSpec
-> Maybe UpdateProposalFile
-> OutputSerialisation
-> TxBodyFile
-> ExceptT ShelleyTxCmdError IO ()
runTxBuildRaw (AnyCardanoEra era)
mScriptValidity inputsAndScripts inputsCollateral txouts
mLowerBound mUpperBound
mFee mValue
certFiles withdrawals reqSigners
metadataSchema scriptFiles
metadataFiles mpparams mUpdatePropFile
outputFormat
(TxBodyFile fpath) = do
txBodyContent <-
TxBodyContent
<$> validateTxIns era inputsAndScripts
<*> validateTxInsCollateral
era inputsCollateral
<*> validateTxOuts era txouts
<*> validateTxFee era mFee
<*> ((,) <$> validateTxValidityLowerBound era mLowerBound
<*> validateTxValidityUpperBound era mUpperBound)
<*> validateTxMetadataInEra era metadataSchema metadataFiles
<*> validateTxAuxScripts era scriptFiles
<*> validateRequiredSigners era reqSigners
<*> validateProtocolParameters era mpparams
<*> validateTxWithdrawals era withdrawals
<*> validateTxCertificates era certFiles
<*> validateTxUpdateProposal era mUpdatePropFile
<*> validateTxMintValue era mValue
<*> validateTxScriptValidity era mScriptValidity
txBody <-
firstExceptT ShelleyTxCmdTxBodyError . hoistEither $
makeTransactionBody txBodyContent
case outputFormat of
OutputCliSerialisation ->
firstExceptT ShelleyTxCmdWriteFileError . newExceptT $
writeFileTextEnvelope fpath Nothing txBody
OutputLedgerCDDLSerialisation ->
let noWitTx = makeSignedTransaction [] txBody
in firstExceptT ShelleyTxCmdWriteFileError . newExceptT $
writeTxFileTextEnvelopeCddl fpath noWitTx
runTxBuild
:: AnyCardanoEra
-> AnyConsensusModeParams
-> NetworkId
-> Maybe ScriptValidity
-- ^ Mark script as expected to pass or fail validation
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-- ^ TxIn with potential script witness
-> [TxIn]
-- ^ TxIn for collateral
-> [TxOutAnyEra]
-- ^ Normal outputs
-> TxOutChangeAddress
-- ^ A change output
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-- ^ Multi-Asset value(s)
-> Maybe SlotNo
-- ^ Tx lower bound
-> Maybe SlotNo
-- ^ Tx upper bound
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-- ^ Certificate with potential script witness
-> [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
-> [RequiredSigner]
-- ^ Required signers
-> TxMetadataJsonSchema
-> [ScriptFile]
-> [MetadataFile]
-> Maybe ProtocolParamsSourceSpec
-> Maybe UpdateProposalFile
-> OutputSerialisation
-> TxBodyFile
-> Maybe Word
-> ExceptT ShelleyTxCmdError IO ()
runTxBuild (AnyCardanoEra era) (AnyConsensusModeParams cModeParams) networkId mScriptValidity
txins txinsc txouts (TxOutChangeAddress changeAddr) mValue mLowerBound mUpperBound
certFiles withdrawals reqSigners metadataSchema scriptFiles metadataFiles mpparams
mUpdatePropFile outputFormat outBody@(TxBodyFile fpath) mOverrideWits = do
SocketPath sockPath <- firstExceptT ShelleyTxCmdSocketEnvError readEnvSocketPath
let localNodeConnInfo = LocalNodeConnectInfo cModeParams networkId sockPath
consensusMode = consensusModeOnly cModeParams
dummyFee = Just $ Lovelace 0
onlyInputs = [input | (input,_) <- txins]
case (consensusMode, cardanoEraStyle era) of
(CardanoMode, ShelleyBasedEra sbe) -> do
txBodyContent <-
TxBodyContent
<$> validateTxIns era txins
<*> validateTxInsCollateral era txinsc
<*> validateTxOuts era txouts
<*> validateTxFee era dummyFee
<*> ((,) <$> validateTxValidityLowerBound era mLowerBound
<*> validateTxValidityUpperBound era mUpperBound)
<*> validateTxMetadataInEra era metadataSchema metadataFiles
<*> validateTxAuxScripts era scriptFiles
<*> validateRequiredSigners era reqSigners
<*> validateProtocolParameters era mpparams
<*> validateTxWithdrawals era withdrawals
<*> validateTxCertificates era certFiles
<*> validateTxUpdateProposal era mUpdatePropFile
<*> validateTxMintValue era mValue
<*> validateTxScriptValidity era mScriptValidity
eInMode <- case toEraInMode era CardanoMode of
Just result -> return result
Nothing ->
left (ShelleyTxCmdEraConsensusModeMismatchTxBalance outBody
(AnyConsensusMode CardanoMode) (AnyCardanoEra era))
(utxo, pparams, eraHistory, systemStart, stakePools) <-
newExceptT . fmap (join . first ShelleyTxCmdAcquireFailure) $
executeLocalStateQueryExpr localNodeConnInfo Nothing $ \_ntcVersion -> runExceptT $ do
unless (null txinsc) $ do
collateralUtxo <- firstExceptT ShelleyTxCmdTxSubmitErrorEraMismatch . newExceptT . queryExpr
$ QueryInEra eInMode
$ QueryInShelleyBasedEra sbe (QueryUTxO . QueryUTxOByTxIn $ Set.fromList txinsc)
txinsExist txinsc collateralUtxo
notScriptLockedTxIns collateralUtxo
utxo <- firstExceptT ShelleyTxCmdTxSubmitErrorEraMismatch . newExceptT . queryExpr
$ QueryInEra eInMode $ QueryInShelleyBasedEra sbe
$ QueryUTxO (QueryUTxOByTxIn (Set.fromList onlyInputs))
txinsExist onlyInputs utxo
pparams <- firstExceptT ShelleyTxCmdTxSubmitErrorEraMismatch . newExceptT . queryExpr
$ QueryInEra eInMode $ QueryInShelleyBasedEra sbe QueryProtocolParameters
eraHistory <- lift . queryExpr $ QueryEraHistory CardanoModeIsMultiEra
systemStart <- lift $ queryExpr QuerySystemStart
stakePools <- firstExceptT ShelleyTxCmdTxSubmitErrorEraMismatch . ExceptT $
queryExpr . QueryInEra eInMode . QueryInShelleyBasedEra sbe $ QueryStakePools
return (utxo, pparams, eraHistory, systemStart, stakePools)
let cAddr = case anyAddressInEra era changeAddr of
Just addr -> addr
Nothing -> error $ "runTxBuild: Byron address used: " <> show changeAddr
(BalancedTxBody balancedTxBody _ fee) <-
firstExceptT ShelleyTxCmdBalanceTxBody
. hoistEither
$ makeTransactionBodyAutoBalance eInMode systemStart eraHistory
pparams stakePools utxo txBodyContent
cAddr mOverrideWits
putStrLn $ "Estimated transaction fee: " <> (show fee :: String)
case outputFormat of
OutputCliSerialisation ->
firstExceptT ShelleyTxCmdWriteFileError . newExceptT $
writeFileTextEnvelope fpath Nothing balancedTxBody
OutputLedgerCDDLSerialisation ->
let noWitTx = makeSignedTransaction [] balancedTxBody
in firstExceptT ShelleyTxCmdWriteFileError . newExceptT $
writeTxFileTextEnvelopeCddl fpath noWitTx
(CardanoMode, LegacyByronEra) -> left ShelleyTxCmdByronEra
(wrongMode, _) -> left (ShelleyTxCmdUnsupportedMode (AnyConsensusMode wrongMode))
where
txinsExist :: Monad m => [TxIn] -> UTxO era -> ExceptT ShelleyTxCmdError m ()
txinsExist ins (UTxO utxo)
| null utxo = left $ ShelleyTxCmdTxInsDoNotExist ins
| otherwise = do
let utxoIns = Map.keys utxo
occursInUtxo = [ txin | txin <- ins, txin `elem` utxoIns ]
if length occursInUtxo == length ins
then return ()
else left . ShelleyTxCmdTxInsDoNotExist $ ins \\ ins `intersect` occursInUtxo
notScriptLockedTxIns :: Monad m => UTxO era -> ExceptT ShelleyTxCmdError m ()
notScriptLockedTxIns (UTxO utxo) = do
let scriptLockedTxIns =
filter (\(_, TxOut aInEra _ _) -> not $ isKeyAddress aInEra ) $ Map.assocs utxo
if null scriptLockedTxIns
then return ()
else left . ShelleyTxCmdExpectedKeyLockedTxIn $ map fst scriptLockedTxIns
-- ----------------------------------------------------------------------------
-- Transaction body validation and conversion
--
-- | An enumeration of era-dependent features where we have to check that it
-- is permissible to use this feature in this era.
--
data TxFeature = TxFeatureShelleyAddresses
| TxFeatureExplicitFees
| TxFeatureImplicitFees
| TxFeatureValidityLowerBound
| TxFeatureValidityUpperBound
| TxFeatureValidityNoUpperBound
| TxFeatureTxMetadata
| TxFeatureAuxScripts
| TxFeatureWithdrawals
| TxFeatureCertificates
| TxFeatureMintValue
| TxFeatureMultiAssetOutputs
| TxFeatureScriptWitnesses
| TxFeatureShelleyKeys
| TxFeatureCollateral
| TxFeatureProtocolParameters
| TxFeatureTxOutDatum
| TxFeatureScriptValidity
| TxFeatureExtraKeyWits
deriving Show
txFeatureMismatch :: CardanoEra era
-> TxFeature
-> ExceptT ShelleyTxCmdError IO a
txFeatureMismatch era feature =
left (ShelleyTxCmdTxFeatureMismatch (anyCardanoEra era) feature)
validateTxIns
:: forall era.
CardanoEra era
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> ExceptT ShelleyTxCmdError IO
[(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
validateTxIns era = mapM convert
where
convert
:: (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))
-> ExceptT ShelleyTxCmdError IO
(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
convert (txin, mScriptWitnessFiles) =
case mScriptWitnessFiles of
Just scriptWitnessFiles -> do
sWit <- createScriptWitness era scriptWitnessFiles
return ( txin
, BuildTxWith $ ScriptWitness ScriptWitnessForSpending sWit
)
Nothing -> return (txin, BuildTxWith $ KeyWitness KeyWitnessForSpending)
validateTxInsCollateral :: CardanoEra era
-> [TxIn]
-> ExceptT ShelleyTxCmdError IO (TxInsCollateral era)
validateTxInsCollateral _ [] = return TxInsCollateralNone
validateTxInsCollateral era txins =
case collateralSupportedInEra era of
Nothing -> txFeatureMismatch era TxFeatureCollateral
Just supported -> return (TxInsCollateral supported txins)
validateTxOuts :: forall era.
CardanoEra era
-> [TxOutAnyEra]
-> ExceptT ShelleyTxCmdError IO [TxOut CtxTx era]
validateTxOuts era = mapM (toTxOutInAnyEra era)
toAddressInAnyEra
:: CardanoEra era
-> AddressAny
-> ExceptT ShelleyTxCmdError IO (AddressInEra era)
toAddressInAnyEra era addrAny =
case addrAny of
AddressByron bAddr -> return (AddressInEra ByronAddressInAnyEra bAddr)
AddressShelley sAddr ->
case cardanoEraStyle era of
LegacyByronEra -> txFeatureMismatch era TxFeatureShelleyAddresses
ShelleyBasedEra era' ->
return (AddressInEra (ShelleyAddressInEra era') sAddr)
toTxOutValueInAnyEra
:: CardanoEra era
-> Value
-> ExceptT ShelleyTxCmdError IO (TxOutValue era)
toTxOutValueInAnyEra era val =
case multiAssetSupportedInEra era of
Left adaOnlyInEra ->
case valueToLovelace val of
Just l -> return (TxOutAdaOnly adaOnlyInEra l)
Nothing -> txFeatureMismatch era TxFeatureMultiAssetOutputs
Right multiAssetInEra -> return (TxOutValue multiAssetInEra val)
toTxOutInAnyEra :: CardanoEra era
-> TxOutAnyEra
-> ExceptT ShelleyTxCmdError IO (TxOut CtxTx era)
toTxOutInAnyEra era (TxOutAnyEra addr val mDatumHash) =
case (scriptDataSupportedInEra era, mDatumHash) of
(_, TxOutDatumByNone) ->
TxOut <$> toAddressInAnyEra era addr
<*> toTxOutValueInAnyEra era val
<*> pure TxOutDatumNone
(Just supported, TxOutDatumByHashOnly dh) ->
TxOut <$> toAddressInAnyEra era addr
<*> toTxOutValueInAnyEra era val
<*> pure (TxOutDatumHash supported dh)
(Just supported, TxOutDatumByHashOf fileOrSdata) -> do
sData <- readScriptDataOrFile fileOrSdata
TxOut <$> toAddressInAnyEra era addr
<*> toTxOutValueInAnyEra era val
<*> pure (TxOutDatumHash supported $ hashScriptData sData)
(Just supported, TxOutDatumByValue fileOrSdata) -> do
sData <- readScriptDataOrFile fileOrSdata
TxOut <$> toAddressInAnyEra era addr
<*> toTxOutValueInAnyEra era val
<*> pure (TxOutDatum supported sData)
(Nothing, _) ->
txFeatureMismatch era TxFeatureTxOutDatum
validateTxFee :: CardanoEra era
-> Maybe Lovelace
-> ExceptT ShelleyTxCmdError IO (TxFee era)
validateTxFee era mfee =
case (txFeesExplicitInEra era, mfee) of
(Left implicit, Nothing) -> return (TxFeeImplicit implicit)
(Right explicit, Just fee) -> return (TxFeeExplicit explicit fee)
(Right _, Nothing) -> txFeatureMismatch era TxFeatureImplicitFees
(Left _, Just _) -> txFeatureMismatch era TxFeatureExplicitFees
validateTxValidityLowerBound :: CardanoEra era
-> Maybe SlotNo
-> ExceptT ShelleyTxCmdError IO
(TxValidityLowerBound era)
validateTxValidityLowerBound _ Nothing = return TxValidityNoLowerBound
validateTxValidityLowerBound era (Just slot) =
case validityLowerBoundSupportedInEra era of
Nothing -> txFeatureMismatch era TxFeatureValidityLowerBound
Just supported -> return (TxValidityLowerBound supported slot)
validateTxValidityUpperBound :: CardanoEra era
-> Maybe SlotNo
-> ExceptT ShelleyTxCmdError IO
(TxValidityUpperBound era)
validateTxValidityUpperBound era Nothing =
case validityNoUpperBoundSupportedInEra era of
Nothing -> txFeatureMismatch era TxFeatureValidityNoUpperBound
Just supported -> return (TxValidityNoUpperBound supported)
validateTxValidityUpperBound era (Just slot) =
case validityUpperBoundSupportedInEra era of
Nothing -> txFeatureMismatch era TxFeatureValidityUpperBound
Just supported -> return (TxValidityUpperBound supported slot)
validateTxMetadataInEra :: CardanoEra era
-> TxMetadataJsonSchema
-> [MetadataFile]
-> ExceptT ShelleyTxCmdError IO (TxMetadataInEra era)
validateTxMetadataInEra _ _ [] = return TxMetadataNone
validateTxMetadataInEra era schema files =
case txMetadataSupportedInEra era of
Nothing -> txFeatureMismatch era TxFeatureTxMetadata
Just supported -> do
metadata <- mconcat <$> mapM (readFileTxMetadata schema) files
return (TxMetadataInEra supported metadata)
validateTxAuxScripts :: CardanoEra era
-> [ScriptFile]
-> ExceptT ShelleyTxCmdError IO (TxAuxScripts era)
validateTxAuxScripts _ [] = return TxAuxScriptsNone
validateTxAuxScripts era files =
case auxScriptsSupportedInEra era of
Nothing -> txFeatureMismatch era TxFeatureAuxScripts
Just supported -> do
scripts <- sequence
[ do script <- firstExceptT ShelleyTxCmdScriptFileError $
readFileScriptInAnyLang file
validateScriptSupportedInEra era script
| ScriptFile file <- files ]
return $ TxAuxScripts supported scripts
validateRequiredSigners :: CardanoEra era
-> [RequiredSigner]
-> ExceptT ShelleyTxCmdError IO (TxExtraKeyWitnesses era)
validateRequiredSigners _ [] = return TxExtraKeyWitnessesNone
validateRequiredSigners era reqSigs =
case extraKeyWitnessesSupportedInEra era of
Nothing -> txFeatureMismatch era TxFeatureExtraKeyWits
Just supported -> do
rSignerHashes <- mapM readRequiredSigner reqSigs
return $ TxExtraKeyWitnesses supported rSignerHashes
validateTxWithdrawals
:: forall era.
CardanoEra era
-> [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT ShelleyTxCmdError IO (TxWithdrawals BuildTx era)
validateTxWithdrawals _ [] = return TxWithdrawalsNone
validateTxWithdrawals era withdrawals =
case withdrawalsSupportedInEra era of
Nothing -> txFeatureMismatch era TxFeatureWithdrawals
Just supported -> do
convWithdrawals <- mapM convert withdrawals
return (TxWithdrawals supported convWithdrawals)
where
convert
:: (StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))
-> ExceptT ShelleyTxCmdError IO
(StakeAddress,
Lovelace,
BuildTxWith BuildTx (Witness WitCtxStake era))
convert (sAddr, ll, mScriptWitnessFiles) =
case mScriptWitnessFiles of
Just scriptWitnessFiles -> do
sWit <- createScriptWitness era scriptWitnessFiles
return ( sAddr
, ll
, BuildTxWith $ ScriptWitness ScriptWitnessForStakeAddr sWit
)
Nothing -> return (sAddr,ll, BuildTxWith $ KeyWitness KeyWitnessForStakeAddr)
validateTxCertificates
:: forall era.
CardanoEra era
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT ShelleyTxCmdError IO (TxCertificates BuildTx era)
validateTxCertificates era certFiles =
case certificatesSupportedInEra era of
Nothing
| null certFiles -> return TxCertificatesNone
| otherwise -> txFeatureMismatch era TxFeatureCertificates
Just supported -> do
certs <- sequence
[ firstExceptT ShelleyTxCmdReadTextViewFileError . newExceptT $
readFileTextEnvelope AsCertificate certFile
| CertificateFile certFile <- map fst certFiles ]
reqWits <- Map.fromList . catMaybes <$> mapM convert certFiles
return $ TxCertificates supported certs $ BuildTxWith reqWits
where
-- We get the stake credential witness for a certificate that requires it.
-- NB: Only stake address deregistration and delegation requires
-- witnessing (witness can be script or key)
deriveStakeCredentialWitness
:: CertificateFile
-> ExceptT ShelleyTxCmdError IO (Maybe StakeCredential)
deriveStakeCredentialWitness (CertificateFile certFile) = do
cert <- firstExceptT ShelleyTxCmdReadTextViewFileError . newExceptT
$ readFileTextEnvelope AsCertificate certFile
case cert of
StakeAddressDeregistrationCertificate sCred -> return $ Just sCred
StakeAddressDelegationCertificate sCred _ -> return $ Just sCred
_ -> return Nothing
convert
:: (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))
-> ExceptT ShelleyTxCmdError IO
(Maybe (StakeCredential, Witness WitCtxStake era))
convert (cert, mScriptWitnessFiles) = do
mStakeCred <- deriveStakeCredentialWitness cert
case mStakeCred of
Nothing -> return Nothing
Just sCred ->
case mScriptWitnessFiles of
Just scriptWitnessFiles -> do
sWit <- createScriptWitness era scriptWitnessFiles
return $ Just ( sCred
, ScriptWitness ScriptWitnessForStakeAddr sWit
)
Nothing -> return $ Just (sCred, KeyWitness KeyWitnessForStakeAddr)
validateProtocolParameters
:: CardanoEra era
-> Maybe ProtocolParamsSourceSpec
-> ExceptT ShelleyTxCmdError IO
(BuildTxWith BuildTx (Maybe ProtocolParameters))
validateProtocolParameters _ Nothing = return (BuildTxWith Nothing)
validateProtocolParameters era (Just pparamsspec) =
case scriptDataSupportedInEra era of
Nothing -> txFeatureMismatch era TxFeatureProtocolParameters
Just _ -> BuildTxWith . Just <$>
readProtocolParametersSourceSpec pparamsspec
validateTxUpdateProposal :: CardanoEra era
-> Maybe UpdateProposalFile
-> ExceptT ShelleyTxCmdError IO (TxUpdateProposal era)
validateTxUpdateProposal _ Nothing = return TxUpdateProposalNone
validateTxUpdateProposal era (Just (UpdateProposalFile file)) =
case updateProposalSupportedInEra era of
Nothing -> txFeatureMismatch era TxFeatureCertificates
Just supported -> do
prop <- firstExceptT ShelleyTxCmdReadTextViewFileError $ newExceptT $
readFileTextEnvelope AsUpdateProposal file
return (TxUpdateProposal supported prop)
validateTxScriptValidity :: forall era.
CardanoEra era
-> Maybe ScriptValidity
-> ExceptT ShelleyTxCmdError IO (TxScriptValidity era)
validateTxScriptValidity _ Nothing = pure TxScriptValidityNone
validateTxScriptValidity era (Just scriptValidity) =
case txScriptValiditySupportedInCardanoEra era of
Nothing -> txFeatureMismatch era TxFeatureScriptValidity
Just supported -> pure $ TxScriptValidity supported scriptValidity
validateTxMintValue :: forall era.
CardanoEra era
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> ExceptT ShelleyTxCmdError IO (TxMintValue BuildTx era)
validateTxMintValue _ Nothing = return TxMintNone
validateTxMintValue era (Just (val, scriptWitnessFiles)) =
case multiAssetSupportedInEra era of
Left _ -> txFeatureMismatch era TxFeatureMintValue
Right supported -> do
-- The set of policy ids for which we need witnesses:
let witnessesNeededSet :: Set PolicyId
witnessesNeededSet =
Set.fromList [ pid | (AssetId pid _, _) <- valueToList val ]
-- The set (and map) of policy ids for which we have witnesses:
witnesses <- mapM (createScriptWitness era) scriptWitnessFiles
let witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era)
witnessesProvidedMap = Map.fromList
[ (scriptWitnessPolicyId witness, witness)
| witness <- witnesses ]
witnessesProvidedSet = Map.keysSet witnessesProvidedMap
-- Check not too many, nor too few:
validateAllWitnessesProvided witnessesNeededSet witnessesProvidedSet
validateNoUnnecessaryWitnesses witnessesNeededSet witnessesProvidedSet
return (TxMintValue supported val (BuildTxWith witnessesProvidedMap))
where
validateAllWitnessesProvided witnessesNeeded witnessesProvided
| null witnessesMissing = return ()
| otherwise = left (ShelleyTxCmdPolicyIdsMissing witnessesMissing)
where
witnessesMissing = Set.elems (witnessesNeeded Set.\\ witnessesProvided)
validateNoUnnecessaryWitnesses witnessesNeeded witnessesProvided
| null witnessesExtra = return ()
| otherwise = left (ShelleyTxCmdPolicyIdsExcess witnessesExtra)
where
witnessesExtra = Set.elems (witnessesProvided Set.\\ witnessesNeeded)
scriptWitnessPolicyId :: ScriptWitness witctx era -> PolicyId
scriptWitnessPolicyId witness =
case scriptWitnessScript witness of
ScriptInEra _ script -> scriptPolicyId script
createScriptWitness
:: CardanoEra era
-> ScriptWitnessFiles witctx
-> ExceptT ShelleyTxCmdError IO (ScriptWitness witctx era)
createScriptWitness era (SimpleScriptWitnessFile (ScriptFile scriptFile)) = do
script@(ScriptInAnyLang lang _) <- firstExceptT ShelleyTxCmdScriptFileError $
readFileScriptInAnyLang scriptFile
ScriptInEra langInEra script' <- validateScriptSupportedInEra era script
case script' of
SimpleScript version sscript ->
return $ SimpleScriptWitness
langInEra version sscript
-- If the supplied cli flags were for a simple script (i.e. the user did
-- not supply the datum, redeemer or ex units), but the script file turns
-- out to be a valid plutus script, then we must fail.
PlutusScript{} ->
left $ ShelleyTxCmdScriptExpectedSimple
scriptFile
(AnyScriptLanguage lang)
createScriptWitness era (PlutusScriptWitnessFiles
(ScriptFile scriptFile)
datumOrFile
redeemerOrFile
execUnits) = do
script@(ScriptInAnyLang lang _) <- firstExceptT ShelleyTxCmdScriptFileError $
readFileScriptInAnyLang scriptFile
ScriptInEra langInEra script' <- validateScriptSupportedInEra era script
case script' of
PlutusScript version pscript -> do
datum <- readScriptDatumOrFile datumOrFile
redeemer <- readScriptRedeemerOrFile redeemerOrFile
return $ PlutusScriptWitness
langInEra version pscript
datum
redeemer
execUnits
-- If the supplied cli flags were for a plutus script (i.e. the user did
-- supply the datum, redeemer and ex units), but the script file turns
-- out to be a valid simple script, then we must fail.
SimpleScript{} ->
left $ ShelleyTxCmdScriptExpectedPlutus
scriptFile
(AnyScriptLanguage lang)
readScriptDatumOrFile :: ScriptDatumOrFile witctx
-> ExceptT ShelleyTxCmdError IO (ScriptDatum witctx)
readScriptDatumOrFile (ScriptDatumOrFileForTxIn df) = ScriptDatumForTxIn <$>
readScriptDataOrFile df
readScriptDatumOrFile NoScriptDatumOrFileForMint = pure NoScriptDatumForMint
readScriptDatumOrFile NoScriptDatumOrFileForStake = pure NoScriptDatumForStake
readScriptRedeemerOrFile :: ScriptRedeemerOrFile
-> ExceptT ShelleyTxCmdError IO ScriptRedeemer
readScriptRedeemerOrFile = readScriptDataOrFile
readScriptDataOrFile :: ScriptDataOrFile
-> ExceptT ShelleyTxCmdError IO ScriptData
readScriptDataOrFile (ScriptDataValue d) = return d
readScriptDataOrFile (ScriptDataFile fp) = do
bs <- handleIOExceptT (ShelleyTxCmdReadFileError . FileIOError fp) $
LBS.readFile fp
v <- firstExceptT (ShelleyTxCmdScriptDataJsonParseError fp) $
hoistEither $
Aeson.eitherDecode' bs
sd <- firstExceptT (ShelleyTxCmdScriptDataConversionError fp) $
hoistEither $
scriptDataFromJson ScriptDataJsonDetailedSchema v
firstExceptT (ShelleyTxCmdScriptDataValidationError fp) $
hoistEither $
validateScriptData sd
return sd
-- ----------------------------------------------------------------------------
-- Transaction signing
--
runTxSign :: TxBodyFile
-> [WitnessSigningData]
-> Maybe NetworkId
-> TxFile
-> ExceptT ShelleyTxCmdError IO ()
runTxSign (TxBodyFile txbodyFile) witSigningData mnw (TxFile txFile) = do
InAnyShelleyBasedEra _era txbody <-
--TODO: in principle we should be able to support Byron era txs too
onlyInShelleyBasedEras "sign for Byron era transactions"
=<< readFileTxBody txbodyFile
sks <- firstExceptT ShelleyTxCmdReadWitnessSigningDataError $
mapM readWitnessSigningData witSigningData
let (sksByron, sksShelley) = partitionSomeWitnesses $ map categoriseSomeWitness sks
-- Byron witnesses require the network ID. This can either be provided
-- directly or derived from a provided Byron address.
byronWitnesses <- firstExceptT ShelleyTxCmdBootstrapWitnessError
. hoistEither
$ mkShelleyBootstrapWitnesses mnw txbody sksByron
let shelleyKeyWitnesses = map (makeShelleyKeyWitness txbody) sksShelley
tx = makeSignedTransaction (byronWitnesses ++ shelleyKeyWitnesses) txbody