/
Orphans.hs
1889 lines (1718 loc) · 81.3 KB
/
Orphans.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 BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
module Cardano.Api.Orphans () where
import Cardano.Api.Script
import Cardano.Api.SerialiseRaw (serialiseToRawBytesHexText)
import Cardano.Ledger.Alonzo.Rules.Bbody (AlonzoBbodyPredFail)
import Cardano.Ledger.Alonzo.Rules.Utxow (UtxowPredicateFail (..))
import Cardano.Ledger.BaseTypes (strictMaybeToMaybe)
import Cardano.Ledger.Chain
import Cardano.Ledger.Compactible (Compactible (fromCompact))
import Cardano.Ledger.Crypto (StandardCrypto)
import Cardano.Ledger.Shelley.API hiding (ShelleyBasedEra)
import Cardano.Ledger.Shelley.PParams (PParamsUpdate)
import Cardano.Ledger.Shelley.Rules.Bbody
import Cardano.Ledger.Shelley.Rules.Deleg
import Cardano.Ledger.Shelley.Rules.Delegs
import Cardano.Ledger.Shelley.Rules.Delpl
import Cardano.Ledger.Shelley.Rules.Epoch
import Cardano.Ledger.Shelley.Rules.Ledger
import Cardano.Ledger.Shelley.Rules.Ledgers
import Cardano.Ledger.Shelley.Rules.Mir
import Cardano.Ledger.Shelley.Rules.NewEpoch
import Cardano.Ledger.Shelley.Rules.Newpp
import Cardano.Ledger.Shelley.Rules.Pool
import Cardano.Ledger.Shelley.Rules.PoolReap
import Cardano.Ledger.Shelley.Rules.Ppup
import Cardano.Ledger.Shelley.Rules.Rupd
import Cardano.Ledger.Shelley.Rules.Snap
import Cardano.Ledger.Shelley.Rules.Tick
import Cardano.Ledger.Shelley.Rules.Upec
import Cardano.Ledger.Shelley.Rules.Utxo
import Cardano.Ledger.Shelley.Rules.Utxow
import Cardano.Ledger.UnifiedMap (UnifiedMap)
import Cardano.Prelude
import Cardano.Protocol.TPraos.API (ChainTransitionError (ChainTransitionError))
import Cardano.Protocol.TPraos.BHeader (LastAppliedBlock, labBlockNo)
import Cardano.Protocol.TPraos.OCert (KESPeriod (KESPeriod))
import Cardano.Protocol.TPraos.Rules.OCert
import Cardano.Protocol.TPraos.Rules.Overlay
import Cardano.Protocol.TPraos.Rules.Prtcl
import Cardano.Protocol.TPraos.Rules.Tickn
import Cardano.Protocol.TPraos.Rules.Updn
import Cardano.Slotting.Block (BlockNo (..))
import Cardano.Slotting.Slot (EpochNo, SlotNo (..))
import Cardano.Slotting.Time (SystemStart (..))
import Data.Aeson (FromJSON (..), ToJSON (..), Value(..), object, (.=))
import Data.Aeson.Types (ToJSONKey (..), toJSONKeyText)
import Data.BiMap (BiMap (..), Bimap)
import Data.Functor.Contravariant (Contravariant (..))
import Data.UMap (Trip (Triple), UMap (UnifiedMap))
import Data.VMap (VB, VMap, VP)
import Ouroboros.Consensus.Ledger.SupportsMempool (txId)
import Ouroboros.Consensus.Protocol.TPraos (TPraosCannotForge (..))
import Ouroboros.Consensus.Shelley.Eras as Consensus (StandardAlonzo)
import Ouroboros.Consensus.Shelley.Ledger hiding (TxId)
import Ouroboros.Consensus.Shelley.Ledger.Inspect
import Ouroboros.Consensus.Util.Condense (condense)
import Ouroboros.Network.Block (blockHash, blockNo, blockSlot)
import Ouroboros.Network.Point (WithOrigin, withOriginToMaybe)
import Prelude hiding ((.), map, show)
import qualified Cardano.Api.Address as Api
import qualified Cardano.Api.Alonzo.Render as Render
import qualified Cardano.Api.Certificate as Api
import qualified Cardano.Api.Ledger.Mary as Api
import qualified Cardano.Api.Script as Api
import qualified Cardano.Api.SerialiseRaw as Api
import qualified Cardano.Api.SerialiseTextEnvelope as Api
import qualified Cardano.Api.TxBody as Api
import qualified Cardano.Crypto.Hash as Hash
import qualified Cardano.Crypto.Hash.Class as Crypto
import qualified Cardano.Crypto.VRF.Class as Crypto
import qualified Cardano.Ledger.Alonzo as Alonzo
import qualified Cardano.Ledger.Alonzo.Language as Alonzo
import qualified Cardano.Ledger.Alonzo.PlutusScriptApi as Alonzo
import qualified Cardano.Ledger.Alonzo.Rules.Utxo as Alonzo
import qualified Cardano.Ledger.Alonzo.Rules.Utxos as Alonzo
import qualified Cardano.Ledger.Alonzo.Scripts as Ledger
import qualified Cardano.Ledger.Alonzo.Tx as Alonzo
import qualified Cardano.Ledger.Alonzo.TxInfo as Alonzo
import qualified Cardano.Ledger.AuxiliaryData as Core
import qualified Cardano.Ledger.Babbage as Babbage
import qualified Cardano.Ledger.Babbage.PParams as Babbage
import qualified Cardano.Ledger.Babbage.TxBody as Babbage
import qualified Cardano.Ledger.BaseTypes as Ledger
import qualified Cardano.Ledger.Coin as Shelley
import qualified Cardano.Ledger.Core as Core
import qualified Cardano.Ledger.Core as Ledger
import qualified Cardano.Ledger.Crypto as Core
import qualified Cardano.Ledger.Crypto as Crypto
import qualified Cardano.Ledger.Era as Ledger
import qualified Cardano.Ledger.Hashes as Ledger
import qualified Cardano.Ledger.Mary.Value as Mary
import qualified Cardano.Ledger.PoolDistr as Ledger
import qualified Cardano.Ledger.SafeHash as SafeHash
import qualified Cardano.Ledger.Shelley.API as Shelley
import qualified Cardano.Ledger.Shelley.Constraints as Shelley
import qualified Cardano.Ledger.Shelley.EpochBoundary as ShelleyEpoch
import qualified Cardano.Ledger.Shelley.LedgerState as ShelleyLedger
import qualified Cardano.Ledger.Shelley.PoolRank as Shelley
import qualified Cardano.Ledger.Shelley.Rewards as Shelley
import qualified Cardano.Ledger.Shelley.RewardUpdate as Shelley
import qualified Cardano.Ledger.ShelleyMA.Rules.Utxo as MA
import qualified Cardano.Ledger.ShelleyMA.Timelocks as MA
import qualified Cardano.Prelude as CP
import qualified Cardano.Protocol.TPraos.BHeader as Protocol
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Short as SBS
import qualified Data.ByteString.UTF8 as BSU
import qualified Data.List.NonEmpty as NEL
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.VMap as VMap
import qualified Ouroboros.Consensus.Ledger.SupportsMempool as SupportsMempool
import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey
import qualified Ouroboros.Consensus.Shelley.Eras as Consensus
import qualified Plutus.V1.Ledger.Api as Plutus
import qualified Plutus.V1.Ledger.Api as PV1
import qualified PlutusCore
import qualified PlutusCore.Core as Plutus
import qualified PlutusCore.DeBruijn
import qualified PlutusCore.Evaluation.Machine.ExBudget as Cek
import qualified PlutusCore.Evaluation.Machine.Exception as PlutusCore
import qualified PlutusTx.AssocMap as AssocMap
import qualified UntypedPlutusCore.Core.Type
import qualified UntypedPlutusCore.Evaluation.Machine.Cek.Internal as Cek
-- Orphan instances involved in the JSON output of the API queries.
-- We will remove/replace these as we provide more API wrapper types
-- deriving newtype instance ToJSON (Core.AuxiliaryDataHash StandardCrypto)
deriving newtype instance Core.Crypto crypto => ToJSON (Core.AuxiliaryDataHash crypto)
instance ToJSON (Mary.Value era) where
toJSON (Mary.Value l ps) =
object
[ "lovelace" .= toJSON l
, "policies" .= toJSON ps
]
instance ToJSONKey Mary.AssetName where
toJSONKey = toJSONKeyText render
where
render = Text.decodeLatin1 . B16.encode . Mary.assetName
instance ToJSON (Mary.PolicyID era) where
toJSON = toJSON . Api.PolicyID
instance ToJSONKey (Mary.PolicyID era) where
toJSONKey = contramap Api.PolicyID toJSONKey
instance ToJSON Mary.AssetName where
toJSON = Aeson.String . Text.decodeLatin1 . B16.encode . Mary.assetName
instance ToJSON Shelley.AccountState where
toJSON (Shelley.AccountState tr rs) = object [ "treasury" .= tr
, "reserves" .= rs
]
instance ( Consensus.ShelleyBasedEra era
, ToJSON (Core.TxOut era)
, ToJSON (Core.PParams era)
, ToJSON (Core.PParamsDelta era)
) => ToJSON (Shelley.EpochState era) where
toJSON eState = object [ "esAccountState" .= Shelley.esAccountState eState
, "esSnapshots" .= Shelley.esSnapshots eState
, "esLState" .= Shelley.esLState eState
, "esPrevPp" .= Shelley.esPrevPp eState
, "esPp" .= Shelley.esPp eState
, "esNonMyopic" .= Shelley.esNonMyopic eState
]
instance ( Consensus.ShelleyBasedEra era
, ToJSON (Core.TxOut era)
, ToJSON (Core.PParamsDelta era)
) => ToJSON (Shelley.LedgerState era) where
toJSON lState = object [ "utxoState" .= Shelley.lsUTxOState lState
, "delegationState" .= Shelley.lsDPState lState
]
instance Crypto.Crypto crypto => ToJSON (ShelleyLedger.IncrementalStake crypto) where
toJSON iStake = object [ "credentials" .= Map.toList (ShelleyLedger.credMap iStake)
, "pointers" .= Map.toList (ShelleyLedger.ptrMap iStake)
]
instance ( Consensus.ShelleyBasedEra era
, ToJSON (Core.TxOut era)
, ToJSON (Core.PParamsDelta era)
) => ToJSON (Shelley.UTxOState era) where
toJSON utxoState = object [ "utxo" .= Shelley._utxo utxoState
, "deposited" .= Shelley._deposited utxoState
, "fees" .= Shelley._fees utxoState
, "ppups" .= Shelley._ppups utxoState
, "stake" .= Shelley._stakeDistro utxoState
]
instance ( ToJSON (Core.PParamsDelta era)
, Shelley.UsesPParams era
) => ToJSON (Shelley.PPUPState era) where
toJSON ppUpState = object [ "proposals" .= Shelley.proposals ppUpState
, "futureProposals" .= Shelley.futureProposals ppUpState
]
instance ( ToJSON (Core.PParamsDelta era)
, Shelley.UsesPParams era
) => ToJSON (Shelley.ProposedPPUpdates era) where
toJSON (Shelley.ProposedPPUpdates ppUpdates) = toJSON $ Map.toList ppUpdates
instance ToJSON (PParamsUpdate era) where
toJSON pp =
Aeson.object $
[ "minFeeA" .= x | x <- mbfield (Shelley._minfeeA pp) ]
++ [ "minFeeB" .= x | x <- mbfield (Shelley._minfeeB pp) ]
++ [ "maxBlockBodySize" .= x | x <- mbfield (Shelley._maxBBSize pp) ]
++ [ "maxTxSize" .= x | x <- mbfield (Shelley._maxTxSize pp) ]
++ [ "maxBlockHeaderSize" .= x | x <- mbfield (Shelley._maxBHSize pp) ]
++ [ "keyDeposit" .= x | x <- mbfield (Shelley._keyDeposit pp) ]
++ [ "poolDeposit" .= x | x <- mbfield (Shelley._poolDeposit pp) ]
++ [ "eMax" .= x | x <- mbfield (Shelley._eMax pp) ]
++ [ "nOpt" .= x | x <- mbfield (Shelley._nOpt pp) ]
++ [ "a0" .= x | x <- mbfield (Shelley._a0 pp) ]
++ [ "rho" .= x | x <- mbfield (Shelley._rho pp) ]
++ [ "tau" .= x | x <- mbfield (Shelley._tau pp) ]
++ [ "decentralisationParam" .= x | x <- mbfield (Shelley._d pp) ]
++ [ "extraEntropy" .= x | x <- mbfield (Shelley._extraEntropy pp) ]
++ [ "protocolVersion" .= x | x <- mbfield (Shelley._protocolVersion pp) ]
++ [ "minUTxOValue" .= x | x <- mbfield (Shelley._minUTxOValue pp) ]
++ [ "minPoolCost" .= x | x <- mbfield (Shelley._minPoolCost pp) ]
instance ToJSON (Babbage.PParamsUpdate era) where
toJSON pp =
Aeson.object $
[ "minFeeA" .= x | x <- mbfield (Babbage._minfeeA pp) ]
++ [ "minFeeB" .= x | x <- mbfield (Babbage._minfeeB pp) ]
++ [ "maxBlockBodySize" .= x | x <- mbfield (Babbage._maxBBSize pp) ]
++ [ "maxTxSize" .= x | x <- mbfield (Babbage._maxTxSize pp) ]
++ [ "maxBlockHeaderSize" .= x | x <- mbfield (Babbage._maxBHSize pp) ]
++ [ "keyDeposit" .= x | x <- mbfield (Babbage._keyDeposit pp) ]
++ [ "poolDeposit" .= x | x <- mbfield (Babbage._poolDeposit pp) ]
++ [ "eMax" .= x | x <- mbfield (Babbage._eMax pp) ]
++ [ "nOpt" .= x | x <- mbfield (Babbage._nOpt pp) ]
++ [ "a0" .= x | x <- mbfield (Babbage._a0 pp) ]
++ [ "rho" .= x | x <- mbfield (Babbage._rho pp) ]
++ [ "tau" .= x | x <- mbfield (Babbage._tau pp) ]
++ [ "protocolVersion" .= x | x <- mbfield (Babbage._protocolVersion pp) ]
++ [ "minPoolCost" .= x | x <- mbfield (Babbage._minPoolCost pp) ]
++ [ "coinsPerUTxOByte" .= x | x <- mbfield (Babbage._coinsPerUTxOByte pp) ]
++ [ "costmdls" .= x | x <- mbfield (Babbage._costmdls pp) ]
++ [ "prices" .= x | x <- mbfield (Babbage._prices pp) ]
++ [ "maxTxExUnits" .= x | x <- mbfield (Babbage._maxTxExUnits pp) ]
++ [ "maxBlockExUnits" .= x | x <- mbfield (Babbage._maxBlockExUnits pp) ]
++ [ "maxValSize" .= x | x <- mbfield (Babbage._maxValSize pp) ]
++ [ "collateralPercentage" .= x | x <- mbfield (Babbage._collateralPercentage pp) ]
++ [ "maxCollateralInputs" .= x | x <- mbfield (Babbage._maxCollateralInputs pp) ]
instance ToJSON (Babbage.PParams (Babbage.BabbageEra Consensus.StandardCrypto)) where
toJSON pp =
Aeson.object
[ "minFeeA" .= Babbage._minfeeA pp
, "minFeeB" .= Babbage._minfeeB pp
, "maxBlockBodySize" .= Babbage._maxBBSize pp
, "maxTxSize" .= Babbage._maxTxSize pp
, "maxBlockHeaderSize" .= Babbage._maxBHSize pp
, "keyDeposit" .= Babbage._keyDeposit pp
, "poolDeposit" .= Babbage._poolDeposit pp
, "eMax" .= Babbage._eMax pp
, "nOpt" .= Babbage._nOpt pp
, "a0" .= Babbage._a0 pp
, "rho" .= Babbage._rho pp
, "tau" .= Babbage._tau pp
, "protocolVersion" .= Babbage._protocolVersion pp
, "minPoolCost" .= Babbage._minPoolCost pp
, "coinsPerUTxOByte" .= Babbage._coinsPerUTxOByte pp
, "costmdls" .= Babbage._costmdls pp
, "prices" .= Babbage._prices pp
, "maxTxExUnits" .= Babbage._maxTxExUnits pp
, "maxBlockExUnits" .= Babbage._maxBlockExUnits pp
, "maxValSize" .= Babbage._maxValSize pp
, "collateralPercentage" .= Babbage._collateralPercentage pp
, "maxCollateralInputs" .= Babbage._maxCollateralInputs pp
]
mbfield :: StrictMaybe a -> [a]
mbfield SNothing = []
mbfield (SJust x) = [x]
instance ( Ledger.Era era
, ToJSON (Core.Value era)
, ToJSON (Babbage.Datum era)
, ToJSON (Core.Script era)
) => ToJSON (Babbage.TxOut era) where
toJSON (Babbage.TxOut addr val dat mRefScript)=
object
[ "address" .= addr
, "value" .= val
, "datum" .= dat
, "referenceScript" .= mRefScript
]
instance Ledger.Crypto era ~ Consensus.StandardCrypto
=> ToJSON (Babbage.Datum era) where
toJSON d = case Babbage.datumDataHash d of
SNothing -> Aeson.Null
SJust dH -> toJSON $ ScriptDataHash dH
instance ToJSON (Alonzo.Script (Babbage.BabbageEra Consensus.StandardCrypto)) where
toJSON s = Aeson.String . serialiseToRawBytesHexText
$ Api.ScriptHash $ Ledger.hashScript @(Babbage.BabbageEra Consensus.StandardCrypto) s
instance Crypto.Crypto crypto => ToJSON (Shelley.DPState crypto) where
toJSON dpState = object [ "dstate" .= Shelley.dpsDState dpState
, "pstate" .= Shelley.dpsPState dpState
]
instance (ToJSON coin, ToJSON ptr, ToJSON pool) => ToJSON (Trip coin ptr pool) where
toJSON (Triple coin ptr pool) = object
[ "coin" .= coin
, "ptr" .= ptr
, "pool" .= pool
]
instance Crypto.Crypto crypto => ToJSON (UnifiedMap crypto) where
toJSON (UnifiedMap m1 m2) = object
[ "credentials" .= m1
, "pointers" .= m2
]
instance Crypto.Crypto crypto => ToJSON (Shelley.DState crypto) where
toJSON dState = object [ "unifiedRewards" .= Shelley._unified dState
, "fGenDelegs" .= Map.toList (Shelley._fGenDelegs dState)
, "genDelegs" .= Shelley._genDelegs dState
, "irwd" .= Shelley._irwd dState
]
instance Crypto.Crypto crypto => ToJSON (ShelleyLedger.FutureGenDeleg crypto) where
toJSON fGenDeleg =
object [ "fGenDelegSlot" .= ShelleyLedger.fGenDelegSlot fGenDeleg
, "fGenDelegGenKeyHash" .= ShelleyLedger.fGenDelegGenKeyHash fGenDeleg
]
instance Crypto.Crypto crypto => ToJSON (Shelley.GenDelegs crypto) where
toJSON (Shelley.GenDelegs delegs) = toJSON delegs
instance Crypto.Crypto crypto => ToJSON (Shelley.InstantaneousRewards crypto) where
toJSON iRwds = object [ "iRReserves" .= Shelley.iRReserves iRwds
, "iRTreasury" .= Shelley.iRTreasury iRwds
]
instance
Crypto.Crypto crypto =>
ToJSON (Bimap Shelley.Ptr (Shelley.Credential Shelley.Staking crypto))
where
toJSON (MkBiMap ptsStakeM stakePtrSetM) =
object [ "stakedCreds" .= Map.toList ptsStakeM
, "credPtrR" .= toJSON stakePtrSetM
]
deriving newtype instance ToJSON Shelley.CertIx
deriving newtype instance ToJSON Shelley.TxIx
instance ToJSON Shelley.Ptr where
toJSON (Shelley.Ptr slotNo txIndex certIndex) =
object [ "slot" .= unSlotNo slotNo
, "txIndex" .= txIndex
, "certIndex" .= certIndex
]
instance ToJSONKey Shelley.Ptr
instance Crypto.Crypto crypto => ToJSON (Shelley.PState crypto) where
toJSON pState = object [ "pParams pState" .= Shelley._pParams pState
, "fPParams pState" .= Shelley._fPParams pState
, "retiring pState" .= Shelley._retiring pState
]
instance ( Consensus.ShelleyBasedEra era
, ToJSON (Core.TxOut era)
) => ToJSON (Shelley.UTxO era) where
toJSON (Shelley.UTxO utxo) = toJSON utxo
instance ( Consensus.ShelleyBasedEra era
, ToJSON (Core.Value era)
) => ToJSON (Shelley.TxOut era) where
toJSON (Shelley.TxOut addr amount) =
object
[ "address" .= addr
, "amount" .= amount
]
instance Crypto.Crypto crypto => ToJSON (Shelley.TxIn crypto) where
toJSON = toJSON . txInToText
instance Crypto.Crypto crypto => ToJSONKey (Shelley.TxIn crypto) where
toJSONKey = toJSONKeyText txInToText
txInToText :: Shelley.TxIn crypto -> Text
txInToText (Shelley.TxIn (Shelley.TxId txidHash) ix) =
hashToText (SafeHash.extractHash txidHash)
<> Text.pack "#"
<> Text.pack (show ix)
hashToText :: Crypto.Hash crypto a -> Text
hashToText = Text.decodeLatin1 . Crypto.hashToBytesAsHex
instance Crypto.Crypto crypto => ToJSON (Shelley.NonMyopic crypto) where
toJSON nonMy = object [ "likelihoodsNM" .= Shelley.likelihoodsNM nonMy
, "rewardPotNM" .= Shelley.rewardPotNM nonMy
]
instance ToJSON Shelley.Likelihood where
toJSON (Shelley.Likelihood llhd) =
toJSON $ fmap (\(Shelley.LogWeight f) -> exp $ realToFrac f :: Double) llhd
instance Crypto.Crypto crypto => ToJSON (Shelley.SnapShots crypto) where
toJSON ss = object [ "pstakeMark" .= Shelley._pstakeMark ss
, "pstakeSet" .= Shelley._pstakeSet ss
, "pstakeGo" .= Shelley._pstakeGo ss
, "feeSS" .= Shelley._feeSS ss
]
instance Crypto.Crypto crypto => ToJSON (Shelley.SnapShot crypto) where
toJSON ss = object [ "stake" .= Shelley._stake ss
, "delegations" .= ShelleyEpoch._delegations ss
, "poolParams" .= Shelley._poolParams ss
]
instance Crypto.Crypto crypto => ToJSON (Shelley.Stake crypto) where
toJSON (Shelley.Stake s) = toJSON s
instance Crypto.Crypto crypto => ToJSON (Shelley.RewardUpdate crypto) where
toJSON rUpdate = object [ "deltaT" .= Shelley.deltaT rUpdate
, "deltaR" .= Shelley.deltaR rUpdate
, "rs" .= Shelley.rs rUpdate
, "deltaF" .= Shelley.deltaF rUpdate
, "nonMyopic" .= Shelley.nonMyopic rUpdate
]
instance Crypto.Crypto crypto => ToJSON (Shelley.PulsingRewUpdate crypto) where
toJSON (Shelley.Pulsing _ _) = Aeson.Null
toJSON (Shelley.Complete ru) = toJSON ru
instance ToJSON Shelley.DeltaCoin where
toJSON (Shelley.DeltaCoin i) = toJSON i
instance Crypto.Crypto crypto => ToJSON (Ledger.PoolDistr crypto) where
toJSON (Ledger.PoolDistr m) = toJSON m
instance Crypto.Crypto crypto => ToJSON (Ledger.IndividualPoolStake crypto) where
toJSON indivPoolStake =
object [ "individualPoolStake" .= Ledger.individualPoolStake indivPoolStake
, "individualPoolStakeVrf" .= Ledger.individualPoolStakeVrf indivPoolStake
]
instance Crypto.Crypto crypto => ToJSON (Shelley.Reward crypto) where
toJSON reward =
object [ "rewardType" .= Shelley.rewardType reward
, "rewardPool" .= Shelley.rewardPool reward
, "rewardAmount" .= Shelley.rewardAmount reward
]
instance ToJSON Shelley.RewardType where
toJSON Shelley.MemberReward = "MemberReward"
toJSON Shelley.LeaderReward = "LeaderReward"
instance Crypto.Crypto c => ToJSON (SafeHash.SafeHash c a) where
toJSON = toJSON . SafeHash.extractHash
-----
deriving newtype instance ToJSON SystemStart
deriving newtype instance FromJSON SystemStart
instance Crypto.Crypto crypto => ToJSON (VMap VB VB (Shelley.Credential 'Shelley.Staking crypto) (Shelley.KeyHash 'Shelley.StakePool crypto)) where
toJSON = toJSON . VMap.toMap
instance Crypto.Crypto crypto => ToJSON (VMap VB VB (Shelley.KeyHash 'Shelley.StakePool crypto) (Shelley.PoolParams crypto)) where
toJSON = toJSON . VMap.toMap
instance Crypto.Crypto crypto => ToJSON (VMap VB VP (Shelley.Credential 'Shelley.Staking crypto) (Shelley.CompactForm Shelley.Coin)) where
toJSON = toJSON . fmap fromCompact . VMap.toMap
instance ToJSON (PredicateFailure (Core.EraRule "LEDGER" era)) => ToJSON (ApplyTxError era) where
toJSON (ApplyTxError es) = toJSON es
instance
( ShelleyBasedEra era
, ToJSON (Core.Tx era)
, ToJSON (TxId (Ledger.Crypto era))
) => ToJSON (GenTx (ShelleyBlock protocol era)) where
toJSON tx = object [ "txid" .= Text.take 8 (Render.renderTxId (txId tx)) ]
instance ToJSON (SupportsMempool.TxId (GenTx (ShelleyBlock protocol era))) where
toJSON = String . Text.take 8 . Render.renderTxId
instance
( ShelleyCompatible protocol era
, ShelleyBasedEra era
, ToJSON (ShelleyHash (Ledger.Crypto era))
, ToJSON (Protocol.BHeader (Ledger.Crypto era))
) => ToJSON (Header (ShelleyBlock protocol era)) where
toJSON b = object
[ "kind" .= String "ShelleyBlock"
, "hash" .= do condense (blockHash b) :: String
, "slotNo" .= do condense (blockSlot b) :: String
, "blockNo" .= do condense (blockNo b) :: String
-- , "delegate" .= condense (headerSignerVk h)
]
instance Core.Crypto crypto => ToJSON (TPraosCannotForge crypto) where
toJSON (TPraosCannotForgeKeyNotUsableYet wallClockPeriod keyStartPeriod) = object
[ "kind" .= String "TPraosCannotForgeKeyNotUsableYet"
, "keyStart" .= do keyStartPeriod :: KESPeriod
, "wallClock" .= do wallClockPeriod :: KESPeriod
]
toJSON (TPraosCannotForgeWrongVRF genDlgVRFHash coreNodeVRFHash) = object
[ "kind" .= String "TPraosCannotLeadWrongVRF"
, "expected" .= do genDlgVRFHash :: Crypto.Hash (Crypto.HASH crypto) (VerKeyVRF crypto)
, "actual" .= do coreNodeVRFHash :: Crypto.Hash (Crypto.HASH crypto) (VerKeyVRF crypto)
]
deriving newtype instance ToJSON KESPeriod
instance ToJSON HotKey.KESInfo where
toJSON HotKey.KESInfo { kesStartPeriod, kesEndPeriod, kesEvolution } = object
[ "kind" .= String "KESInfo"
, "startPeriod" .= do kesStartPeriod :: KESPeriod
, "endPeriod" .= do kesEndPeriod :: KESPeriod
, "evolution" .= do kesEvolution :: Word
]
instance ToJSON HotKey.KESEvolutionError where
toJSON (HotKey.KESCouldNotEvolve kesInfo targetPeriod) = object
[ "kind" .= String "KESCouldNotEvolve"
, "kesInfo" .= do kesInfo :: HotKey.KESInfo
, "targetPeriod" .= do targetPeriod :: KESPeriod
]
toJSON (HotKey.KESKeyAlreadyPoisoned kesInfo targetPeriod) = object
[ "kind" .= String "KESKeyAlreadyPoisoned"
, "kesInfo" .= do kesInfo :: HotKey.KESInfo
, "targetPeriod" .= do targetPeriod :: KESPeriod
]
instance
( ShelleyBasedEra era
, ToJSON (PredicateFailure (UTXO era))
, ToJSON (PredicateFailure (UTXOW era))
, ToJSON (PredicateFailure (Core.EraRule "BBODY" era))
, ToJSON (BlockTransitionError era)
) => ToJSON (ShelleyLedgerError era) where
toJSON (BBodyError (BlockTransitionError fs)) = object
[ "kind" .= String "BBodyError"
, "failures" .= do map toJSON fs :: [Value]
]
instance
( ShelleyBasedEra era
, ToJSON (Ledger.PParamsDelta era)
, ToJSON (Crypto.OutputVRF (Core.VRF (Ledger.Crypto era)))
) => ToJSON (ShelleyLedgerUpdate era) where
toJSON (ShelleyUpdatedProtocolUpdates updates) = object
[ "kind" .= String "ShelleyUpdatedProtocolUpdates"
, "updates" .= do map toJSON updates :: [Value]
]
instance
( Ledger.Era era, ToJSON (Ledger.PParamsDelta era)
, ToJSON (Crypto.OutputVRF (Core.VRF (Ledger.Crypto era)))
) => ToJSON (ProtocolUpdate era) where
toJSON ProtocolUpdate{protocolUpdateProposal, protocolUpdateState} = object
[ "proposal" .= do protocolUpdateProposal :: UpdateProposal era
, "state" .= do protocolUpdateState :: UpdateState (Consensus.EraCrypto era)
]
instance ToJSON (Ledger.PParamsDelta era)
=> ToJSON (UpdateProposal era) where
toJSON UpdateProposal{proposalParams, proposalVersion, proposalEpoch} = object
[ "params" .= do proposalParams :: Ledger.PParamsDelta era
, "version" .= do proposalVersion :: Maybe ProtVer
, "epoch" .= do proposalEpoch :: EpochNo
]
instance
( Core.Crypto crypto
, ToJSON (Crypto.OutputVRF (Core.VRF crypto))
) => ToJSON (UpdateState crypto) where
toJSON UpdateState{proposalVotes, proposalReachedQuorum} = object
[ "proposal" .= do proposalVotes :: [KeyHash 'Genesis crypto]
, "reachedQuorum" .= do proposalReachedQuorum :: Bool
]
instance
( Core.Crypto crypto
, ToJSON (Crypto.CertifiedVRF (Core.VRF crypto) Nonce)
, ToJSON (Crypto.OutputVRF (Core.VRF crypto))
, ToJSON Ledger.ActiveSlotCoeff
) => ToJSON (ChainTransitionError crypto) where
toJSON (ChainTransitionError fs) = object
[ "kind" .= String "ChainTransitionError"
, "failures" .= do map toJSON fs :: [Value]
]
instance ToJSON ChainPredicateFailure where
toJSON (HeaderSizeTooLargeCHAIN hdrSz maxHdrSz) = object
[ "kind" .= String "HeaderSizeTooLarge"
, "headerSize" .= do hdrSz :: Natural
, "maxHeaderSize" .= do maxHdrSz :: Natural
]
toJSON (BlockSizeTooLargeCHAIN blkSz maxBlkSz) = object
[ "kind" .= String "BlockSizeTooLarge"
, "blockSize" .= do blkSz :: Natural
, "maxBlockSize" .= do maxBlkSz :: Natural
]
toJSON (ObsoleteNodeCHAIN currentPtcl supportedPtcl) = object
[ "kind" .= String "ObsoleteNode"
, "explanation" .= String explanation
, "currentProtocol" .= do currentPtcl :: Natural
, "supportedProtocol" .= do supportedPtcl :: Natural
]
where
explanation = "A scheduled major protocol version change (hard fork) \
\has taken place on the chain, but this node does not \
\understand the new major protocol version. This node \
\must be upgraded before it can continue with the new \
\protocol version."
instance
( ToJSON (Protocol.PrevHash crypto)
, ToJSON (WithOrigin (LastAppliedBlock crypto))
, ToJSON BlockNo
) => ToJSON (PrtlSeqFailure crypto) where
toJSON (WrongSlotIntervalPrtclSeq (SlotNo lastSlot) (SlotNo currSlot)) = object
[ "kind" .= String "WrongSlotInterval"
, "lastSlot" .= do lastSlot :: Word64
, "currentSlot" .= do currSlot :: Word64
]
toJSON (WrongBlockNoPrtclSeq lab currentBlockNo) = object
[ "kind" .= String "WrongBlockNo"
, "lastAppliedBlockNo" .= do showLastAppBlockNo lab :: Text
, "currentBlockNo" .= (String . textShow $ unBlockNo currentBlockNo)
]
toJSON (WrongBlockSequencePrtclSeq lastAppliedHash currentHash) = object
[ "kind" .= String "WrongBlockSequence"
, "lastAppliedBlockHash" .= String (textShow lastAppliedHash)
, "currentBlockHash" .= String (textShow currentHash)
]
instance
( ShelleyBasedEra era
, ToJSON (PredicateFailure (UTXO era))
, ToJSON (PredicateFailure (UTXOW era))
, ToJSON (PredicateFailure (Core.EraRule "LEDGER" era))
, ToJSON (PredicateFailure (Core.EraRule "LEDGERS" era))
) => ToJSON (BbodyPredicateFailure era) where
toJSON (WrongBlockBodySizeBBODY actualBodySz claimedBodySz) = object
[ "kind" .= String "WrongBlockBodySizeBBODY"
, "actualBlockBodySize" .= do actualBodySz :: Int
, "claimedBlockBodySize" .= do claimedBodySz :: Int
]
toJSON (InvalidBodyHashBBODY actualHash claimedHash) = object
[ "kind" .= String "InvalidBodyHashBBODY"
, "actualBodyHash" .= do textShow actualHash :: Text
, "claimedBodyHash" .= do textShow claimedHash :: Text
]
toJSON (LedgersFailure f) = toJSON f
instance
( ShelleyBasedEra era
, ToJSON (PredicateFailure (UTXO era))
, ToJSON (PredicateFailure (UTXOW era))
, ToJSON (PredicateFailure (Core.EraRule "LEDGER" era))
) => ToJSON (LedgersPredicateFailure era) where
toJSON (LedgerFailure f) = object
[ "kind" .= String "LedgerFailure"
, "value" .= do f :: LedgerPredicateFailure era
]
instance
( ShelleyBasedEra era
, ToJSON (PredicateFailure (UTXO era))
, ToJSON (PredicateFailure (UTXOW era))
, ToJSON (PredicateFailure (Core.EraRule "DELEGS" era))
, ToJSON (PredicateFailure (Core.EraRule "UTXOW" era))
) => ToJSON (LedgerPredicateFailure era) where
toJSON (UtxowFailure f) = object
[ "kind" .= String "UtxowFailure"
, "value" .= do f :: PredicateFailure (Ledger.EraRule "UTXOW" era)
]
toJSON (DelegsFailure f) = object
[ "kind" .= String "DelegsFailure"
, "value" .= do f :: PredicateFailure (Ledger.EraRule "DELEGS" era)
]
instance ToJSON (Alonzo.ScriptPurpose StandardCrypto) where
toJSON = \case
Alonzo.Minting pid -> object
[ "minting" .= toJSON (Api.PolicyID pid)
]
Alonzo.Spending txin -> object
[ "spending" .= Api.fromShelleyTxIn txin
]
Alonzo.Rewarding rwdAcct -> object
[ "rewarding" .= String (Api.serialiseAddress $ Api.fromShelleyStakeAddr rwdAcct)
]
Alonzo.Certifying cert -> object
[ "certifying" .= toJSON (Api.textEnvelopeDefaultDescr $ Api.fromShelleyCertificate cert)
]
instance ToJSONKey (Shelley.ScriptHash StandardCrypto) where
toJSONKey = contramap (Api.serialiseToRawBytesHexText . Api.ScriptHash) toJSONKey
instance
( ToJSON (Core.AuxiliaryDataHash StandardCrypto)
) => ToJSON (UtxowPredicateFail (Alonzo.AlonzoEra StandardCrypto)) where
toJSON (WrappedShelleyEraFailure utxoPredFail) = toJSON utxoPredFail
toJSON (MissingRedeemers scripts) = object
[ "kind" .= String "MissingRedeemers"
, "scripts" .= do Map.fromList $ fmap swap scripts :: Map (Shelley.ScriptHash StandardCrypto) (Alonzo.ScriptPurpose StandardCrypto)
]
toJSON (MissingRequiredDatums required received) = object
[ "kind" .= String "MissingRequiredDatums"
, "required" .= do map (Crypto.hashToTextAsHex . SafeHash.extractHash) (Set.toList required) :: [Text]
, "received" .= do map (Crypto.hashToTextAsHex . SafeHash.extractHash) (Set.toList received) :: [Text]
]
toJSON (PPViewHashesDontMatch ppHashInTxBody ppHashFromPParams) = object
[ "kind" .= String "PPViewHashesDontMatch"
, "fromTxBody" .= do strictMaybeToMaybe ppHashInTxBody :: Maybe (Alonzo.ScriptIntegrityHash StandardCrypto)
, "fromPParams" .= do strictMaybeToMaybe ppHashFromPParams :: Maybe (Alonzo.ScriptIntegrityHash StandardCrypto)
]
toJSON (MissingRequiredSigners missingKeyWitnesses) = object
[ "kind" .= String "MissingRequiredSigners"
, "witnesses" .= do Set.toList missingKeyWitnesses :: [KeyHash 'Witness StandardCrypto]
]
toJSON (UnspendableUTxONoDatumHash txins) = object
[ "kind" .= String "MissingRequiredSigners"
, "txins" .= do Set.toList txins :: [TxIn StandardCrypto]
]
toJSON (NonOutputSupplimentaryDatums disallowed acceptable) = object
[ "kind" .= String "NonOutputSupplimentaryDatums"
, "disallowed" .= do Set.toList disallowed :: [Ledger.DataHash StandardCrypto]
, "acceptable" .= do Set.toList acceptable :: [Ledger.DataHash StandardCrypto]
]
toJSON (ExtraRedeemers rdmrs) = object
[ "kind" .= String "ExtraRedeemers"
, "rdmrs" .= do map (Api.renderScriptWitnessIndex . Api.fromAlonzoRdmrPtr) rdmrs :: [String]
]
instance
( ShelleyBasedEra era
, ToJSON (PredicateFailure (UTXO era))
, ToJSON (PredicateFailure (Core.EraRule "UTXO" era))
, ToJSON (Core.AuxiliaryDataHash (Ledger.Crypto era))
) => ToJSON (UtxowPredicateFailure era) where
toJSON (ExtraneousScriptWitnessesUTXOW extraneousScripts) = object
[ "kind" .= String "InvalidWitnessesUTXOW"
, "extraneousScripts" .= do extraneousScripts :: Set (Shelley.ScriptHash (Ledger.Crypto era))
]
toJSON (InvalidWitnessesUTXOW wits') = object
[ "kind" .= String "InvalidWitnessesUTXOW"
, "invalidWitnesses" .= do map textShow wits' :: [Text]
]
toJSON (MissingVKeyWitnessesUTXOW (WitHashes wits')) = object
[ "kind" .= String "MissingVKeyWitnessesUTXOW"
, "missingWitnesses" .= do wits' :: Set (KeyHash 'Witness (Ledger.Crypto era))
]
toJSON (MissingScriptWitnessesUTXOW missingScripts) = object
[ "kind" .= String "MissingScriptWitnessesUTXOW"
, "missingScripts" .= do missingScripts :: Set (Shelley.ScriptHash (Ledger.Crypto era))
]
toJSON (ScriptWitnessNotValidatingUTXOW failedScripts) = object
[ "kind" .= String "ScriptWitnessNotValidatingUTXOW"
, "failedScripts" .= do failedScripts :: Set (Shelley.ScriptHash (Ledger.Crypto era))
]
toJSON (UtxoFailure f) = toJSON f
toJSON (MIRInsufficientGenesisSigsUTXOW genesisSigs) = object
[ "kind" .= String "MIRInsufficientGenesisSigsUTXOW"
, "genesisSigs" .= do genesisSigs :: Set (KeyHash 'Witness (Ledger.Crypto era))
]
toJSON (MissingTxBodyMetadataHash metadataHash) = object
[ "kind" .= String "MissingTxBodyMetadataHash"
, "metadataHash" .= do metadataHash :: Core.AuxiliaryDataHash (Ledger.Crypto era)
]
toJSON (MissingTxMetadata txBodyMetadataHash) = object
[ "kind" .= String "MissingTxMetadata"
, "txBodyMetadataHash" .= do txBodyMetadataHash :: Core.AuxiliaryDataHash (Ledger.Crypto era)
]
toJSON (ConflictingMetadataHash txBodyMetadataHash fullMetadataHash) = object
[ "kind" .= String "ConflictingMetadataHash"
, "txBodyMetadataHash" .= do txBodyMetadataHash :: Core.AuxiliaryDataHash (Ledger.Crypto era)
, "fullMetadataHash" .= do fullMetadataHash :: Core.AuxiliaryDataHash (Ledger.Crypto era)
]
toJSON InvalidMetadata = object
[ "kind" .= String "InvalidMetadata"
]
instance
( ShelleyBasedEra era
, ToJSON (Core.Value era)
, ToJSON (Core.TxOut era)
, ToJSON (PredicateFailure (Core.EraRule "PPUP" era))
) => ToJSON (UtxoPredicateFailure era) where
toJSON (BadInputsUTxO badInputs) = object
[ "kind" .= String "BadInputsUTxO"
, "badInputs" .= do badInputs :: Set (TxIn (Ledger.Crypto era))
, "error" .= Render.renderBadInputsUTxOErr badInputs
]
toJSON (ExpiredUTxO ttl slot) = object
[ "kind" .= String "ExpiredUTxO"
, "ttl" .= do ttl :: SlotNo
, "slot" .= do slot :: SlotNo
]
toJSON (MaxTxSizeUTxO txsize maxtxsize) = object
[ "kind" .= String "MaxTxSizeUTxO"
, "size" .= do txsize :: Integer
, "maxSize" .= do maxtxsize :: Integer
]
-- TODO: Add the minimum allowed UTxO value to OutputTooSmallUTxO
toJSON (OutputTooSmallUTxO badOutputs) = object
[ "kind" .= String "OutputTooSmallUTxO"
, "outputs" .= do badOutputs :: [Ledger.TxOut era]
, "error" .= String "The output is smaller than the allow minimum UTxO value defined in the protocol parameters"
]
toJSON (OutputBootAddrAttrsTooBig badOutputs) = object
[ "kind" .= String "OutputBootAddrAttrsTooBig"
, "outputs" .= do badOutputs :: [Ledger.TxOut era]
, "error" .= String "The Byron address attributes are too big"
]
toJSON InputSetEmptyUTxO = object
[ "kind" .= String "InputSetEmptyUTxO"
]
toJSON (FeeTooSmallUTxO minfee txfee) = object
[ "kind" .= String "FeeTooSmallUTxO"
, "minimum" .= do minfee :: Coin
, "fee" .= do txfee :: Coin
]
toJSON (ValueNotConservedUTxO consumed produced) = object
[ "kind" .= String "ValueNotConservedUTxO"
, "consumed" .= do consumed :: Ledger.Value era
, "produced" .= do produced :: Ledger.Value era
, "error" .= Render.renderValueNotConservedErr consumed produced
]
toJSON (UpdateFailure f) = object
[ "kind" .= String "UpdateFailure"
, "value" .= do f :: PredicateFailure (Ledger.EraRule "PPUP" era)
]
toJSON (WrongNetwork network addrs) = object
[ "kind" .= String "WrongNetwork"
, "network" .= do network :: Network
, "addrs" .= do addrs :: Set (Addr (Ledger.Crypto era))
]
toJSON (WrongNetworkWithdrawal network addrs) = object
[ "kind" .= String "WrongNetworkWithdrawal"
, "network" .= do network :: Network
, "addrs" .= do addrs :: Set (RewardAcnt (Ledger.Crypto era))
]
instance ToJSON MA.ValidityInterval where
toJSON vi = object $
[ "invalidBefore" .= x | x <- mbfield' (MA.invalidBefore vi) ]
++ [ "invalidHereafter" .= x | x <- mbfield' (MA.invalidHereafter vi) ]
where mbfield' SNothing = []
mbfield' (SJust x) = [x]
instance ( ShelleyBasedEra era
, ToJSON (Core.Value era)
, ToJSON (Core.TxOut era)
, ToJSON (PredicateFailure (Core.EraRule "PPUP" era))
) => ToJSON (MA.UtxoPredicateFailure era) where
toJSON (MA.BadInputsUTxO badInputs) = object
[ "kind" .= String "BadInputsUTxO"
, "badInputs" .= do badInputs :: Set (TxIn (Ledger.Crypto era))
, "error" .= do Render.renderBadInputsUTxOErr badInputs :: Value
]
toJSON (MA.OutsideValidityIntervalUTxO validityInterval slot) = object
[ "kind" .= String "ExpiredUTxO"
, "validityInterval" .= do validityInterval :: MA.ValidityInterval
, "slot" .= do slot :: SlotNo
]
toJSON (MA.MaxTxSizeUTxO txsize maxtxsize) = object
[ "kind" .= String "MaxTxSizeUTxO"
, "size" .= do txsize :: Integer
, "maxSize" .= do maxtxsize :: Integer
]
toJSON MA.InputSetEmptyUTxO = object
[ "kind" .= String "InputSetEmptyUTxO"
]
toJSON (MA.FeeTooSmallUTxO minfee txfee) = object
[ "kind" .= String "FeeTooSmallUTxO"
, "minimum" .= do minfee :: Coin
, "fee" .= do txfee :: Coin
]
toJSON (MA.ValueNotConservedUTxO consumed produced) = object
[ "kind" .= String "ValueNotConservedUTxO"
, "consumed" .= do consumed :: Ledger.Value era
, "produced" .= do produced :: Ledger.Value era
, "error" .= do Render.renderValueNotConservedErr consumed produced :: Value
]
toJSON (MA.WrongNetwork network addrs) = object
[ "kind" .= String "WrongNetwork"
, "network" .= do network :: Network
, "addrs" .= do addrs :: Set (Addr (Ledger.Crypto era))
]
toJSON (MA.WrongNetworkWithdrawal network addrs) = object
[ "kind" .= String "WrongNetworkWithdrawal"
, "network" .= do network :: Network
, "addrs" .= do addrs :: Set (RewardAcnt (Ledger.Crypto era))
]
-- TODO: Add the minimum allowed UTxO value to OutputTooSmallUTxO
toJSON (MA.OutputTooSmallUTxO badOutputs) = object
[ "kind" .= String "OutputTooSmallUTxO"
, "outputs" .= do badOutputs :: [Ledger.TxOut era]
, "error" .= String "The output is smaller than the allow minimum UTxO value defined in the protocol parameters"
]
toJSON (MA.UpdateFailure f) = toJSON f
toJSON (MA.OutputBootAddrAttrsTooBig badOutputs) = object
[ "kind" .= String "OutputBootAddrAttrsTooBig"
, "outputs" .= do badOutputs :: [Ledger.TxOut era]
, "error" .= String "The Byron address attributes are too big"
]
toJSON MA.TriesToForgeADA = object
[ "kind" .= String "TriesToForgeADA"
]
toJSON (MA.OutputTooBigUTxO badOutputs) = object
[ "kind" .= String "OutputTooBigUTxO"
, "outputs" .= do badOutputs :: [Ledger.TxOut era]
, "error" .= String "Too many asset ids in the tx output"
]
instance
( Ledger.Era era
) => ToJSON (PpupPredicateFailure era) where
toJSON (NonGenesisUpdatePPUP proposalKeys genesisKeys) = object
[ "kind" .= String "NonGenesisUpdatePPUP"
, "keys" .= do proposalKeys Set.\\ genesisKeys :: Set (KeyHash 'Genesis (Ledger.Crypto era))
]
toJSON (PPUpdateWrongEpoch currEpoch intendedEpoch votingPeriod) = object
[ "kind" .= String "PPUpdateWrongEpoch"
, "currentEpoch" .= do currEpoch :: EpochNo
, "intendedEpoch" .= do intendedEpoch :: EpochNo
, "votingPeriod" .= String (show votingPeriod)
]
toJSON (PVCannotFollowPPUP badPv) = object
[ "kind" .= String "PVCannotFollowPPUP"
, "badProtocolVersion" .= do badPv :: ProtVer
]
instance ( ShelleyBasedEra era
, ToJSON (PredicateFailure (Core.EraRule "DELPL" era))
) => ToJSON (DelegsPredicateFailure era) where
toJSON (DelegateeNotRegisteredDELEG targetPool) = object
[ "kind" .= String "DelegateeNotRegisteredDELEG"
, "targetPool" .= do targetPool :: KeyHash 'StakePool (Ledger.Crypto era)
]
toJSON (WithdrawalsNotInRewardsDELEGS incorrectWithdrawals) = object
[ "kind" .= String "WithdrawalsNotInRewardsDELEGS"
, "incorrectWithdrawals" .= do incorrectWithdrawals :: Map (RewardAcnt (Ledger.Crypto era)) Coin
]
toJSON (DelplFailure f) = toJSON do f :: PredicateFailure (Ledger.EraRule "DELPL" era)
instance ( ToJSON (PredicateFailure (Core.EraRule "POOL" era))
, ToJSON (PredicateFailure (Core.EraRule "DELEG" era))
) => ToJSON (DelplPredicateFailure era) where
toJSON (PoolFailure f) = toJSON do f :: PredicateFailure (Ledger.EraRule "POOL" era)
toJSON (DelegFailure f) = toJSON do f :: PredicateFailure (Ledger.EraRule "DELEG" era)
instance
( Ledger.Era era
) => ToJSON (DelegPredicateFailure era) where
toJSON (StakeKeyAlreadyRegisteredDELEG alreadyRegistered) = object
[ "kind" .= String "StakeKeyAlreadyRegisteredDELEG"
, "credential" .= String (textShow alreadyRegistered)