← Back to branch summary

~zinigor/cardano-node/trunk

« back to all changes in this revision

Viewing changes to cardano-api/src/Cardano/Api/Orphans.hs

  • Committer: Igor Zinovyev
  • Date: 2021-08-13 19:12:27 UTC
  • Revision ID: zinigor@gmail.com-20210813191227-stlnsj3mc5ypwn0c
Tags: upstream-1.27.0
Import upstream version 1.27.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
cardano-api/src/Cardano/Api/Orphans.hs
 
1
{-# LANGUAGE DataKinds #-}
 
2
{-# LANGUAGE FlexibleContexts #-}
 
3
{-# LANGUAGE FlexibleInstances #-}
 
4
{-# LANGUAGE GADTs #-}
 
5
{-# LANGUAGE UndecidableInstances #-}
 
6
 
 
7
{-# OPTIONS_GHC -Wno-orphans #-}
 
8
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
 
9
 
 
10
module Cardano.Api.Orphans () where
 
11
 
 
12
import           Prelude
 
13
 
 
14
import           Control.Iterate.SetAlgebra (BiMap (..), Bimap)
 
15
import           Data.Aeson (ToJSON (..), object, (.=))
 
16
import qualified Data.Aeson as Aeson
 
17
import           Data.Aeson.Types (ToJSONKey (..), toJSONKeyText)
 
18
import qualified Data.ByteString.Base16 as B16
 
19
import qualified Data.Map.Strict as Map
 
20
import           Data.Scientific
 
21
import           Data.Text (Text)
 
22
import qualified Data.Text as Text
 
23
import qualified Data.Text.Encoding as Text
 
24
 
 
25
import qualified Cardano.Crypto.Hash.Class as Crypto
 
26
import qualified Cardano.Ledger.Coin as Shelley
 
27
import qualified Cardano.Ledger.Core as Core
 
28
import qualified Cardano.Ledger.Crypto as Crypto
 
29
import qualified Cardano.Ledger.Mary.Value as Mary
 
30
import qualified Cardano.Ledger.SafeHash as SafeHash
 
31
import qualified Cardano.Ledger.Shelley.Constraints as Shelley
 
32
import           Cardano.Slotting.Slot (SlotNo (..))
 
33
import qualified Ouroboros.Consensus.Shelley.Eras as Consensus
 
34
import qualified Shelley.Spec.Ledger.API as Shelley
 
35
import           Shelley.Spec.Ledger.BaseTypes (StrictMaybe (..))
 
36
import qualified Shelley.Spec.Ledger.Delegation.Certificates as Shelley
 
37
import qualified Shelley.Spec.Ledger.EpochBoundary as ShelleyEpoch
 
38
import qualified Shelley.Spec.Ledger.LedgerState as ShelleyLedger
 
39
import           Shelley.Spec.Ledger.PParams (PParamsUpdate)
 
40
import qualified Shelley.Spec.Ledger.Rewards as Shelley
 
41
import qualified Shelley.Spec.Ledger.RewardUpdate as Shelley
 
42
 
 
43
-- Orphan instances involved in the JSON output of the API queries.
 
44
-- We will remove/replace these as we provide more API wrapper types
 
45
 
 
46
instance ToJSON (Mary.Value era) where
 
47
  toJSON (Mary.Value l ps) =
 
48
    object
 
49
      [ "lovelace" .= toJSON l
 
50
      , "policies" .= toJSON ps
 
51
      ]
 
52
 
 
53
instance ToJSONKey Mary.AssetName where
 
54
  toJSONKey = toJSONKeyText render
 
55
    where
 
56
      render = Text.decodeLatin1 . B16.encode . Mary.assetName
 
57
 
 
58
instance ToJSON (Mary.PolicyID era) where
 
59
  toJSON (Mary.PolicyID (Shelley.ScriptHash h)) = Aeson.String (hashToText h)
 
60
 
 
61
instance ToJSONKey (Mary.PolicyID era) where
 
62
  toJSONKey = toJSONKeyText render
 
63
    where
 
64
      render (Mary.PolicyID (Shelley.ScriptHash h)) = hashToText h
 
65
 
 
66
instance ToJSON Mary.AssetName where
 
67
  toJSON = Aeson.String . Text.decodeLatin1 . B16.encode . Mary.assetName
 
68
 
 
69
instance ToJSON Shelley.AccountState where
 
70
  toJSON (Shelley.AccountState tr rs) = object [ "treasury" .= tr
 
71
                                               , "reserves" .= rs
 
72
                                               ]
 
73
 
 
74
instance ( Consensus.ShelleyBasedEra era
 
75
         , ToJSON (Core.TxOut era)
 
76
         , ToJSON (Core.PParams era)
 
77
         , ToJSON (Shelley.PParamsDelta era)
 
78
         ) => ToJSON (Shelley.EpochState era) where
 
79
  toJSON eState = object [ "esAccountState" .= Shelley.esAccountState eState
 
80
                         , "esSnapshots" .= Shelley.esSnapshots eState
 
81
                         , "esLState" .= Shelley.esLState eState
 
82
                         , "esPrevPp" .= Shelley.esPrevPp eState
 
83
                         , "esPp" .= Shelley.esPp eState
 
84
                         , "esNonMyopic" .= Shelley.esNonMyopic eState
 
85
                         ]
 
86
 
 
87
instance ( Consensus.ShelleyBasedEra era
 
88
         , ToJSON (Core.TxOut era)
 
89
         , ToJSON (Shelley.PParamsDelta era)
 
90
         ) => ToJSON (Shelley.LedgerState era) where
 
91
  toJSON lState = object [ "utxoState" .= Shelley._utxoState lState
 
92
                         , "delegationState" .= Shelley._delegationState lState
 
93
                         ]
 
94
 
 
95
instance ( Consensus.ShelleyBasedEra era
 
96
         , ToJSON (Core.TxOut era)
 
97
         , ToJSON (Shelley.PParamsDelta era)
 
98
         ) => ToJSON (Shelley.UTxOState era) where
 
99
  toJSON utxoState = object [ "utxo" .= Shelley._utxo utxoState
 
100
                            , "deposited" .= Shelley._deposited utxoState
 
101
                            , "fees" .= Shelley._fees utxoState
 
102
                            , "ppups" .= Shelley._ppups utxoState
 
103
                            ]
 
104
 
 
105
instance ( ToJSON (Shelley.PParamsDelta era)
 
106
         , Shelley.UsesPParams era
 
107
         ) => ToJSON (Shelley.PPUPState era) where
 
108
  toJSON ppUpState = object [ "proposals" .= Shelley.proposals ppUpState
 
109
                            , "futureProposals" .= Shelley.futureProposals ppUpState
 
110
                            ]
 
111
 
 
112
instance ( ToJSON (Shelley.PParamsDelta era)
 
113
         , Shelley.UsesPParams era
 
114
         ) => ToJSON (Shelley.ProposedPPUpdates era) where
 
115
  toJSON (Shelley.ProposedPPUpdates ppUpdates) = toJSON $ Map.toList ppUpdates
 
116
 
 
117
instance ToJSON (PParamsUpdate era) where
 
118
  toJSON pp =
 
119
    Aeson.object $
 
120
        [ "minFeeA"               .= x | x <- mbfield (Shelley._minfeeA pp) ]
 
121
     ++ [ "minFeeB"               .= x | x <- mbfield (Shelley._minfeeB pp) ]
 
122
     ++ [ "maxBlockBodySize"      .= x | x <- mbfield (Shelley._maxBBSize pp) ]
 
123
     ++ [ "maxTxSize"             .= x | x <- mbfield (Shelley._maxTxSize pp) ]
 
124
     ++ [ "maxBlockHeaderSize"    .= x | x <- mbfield (Shelley._maxBHSize pp) ]
 
125
     ++ [ "keyDeposit"            .= x | x <- mbfield (Shelley._keyDeposit pp) ]
 
126
     ++ [ "poolDeposit"           .= x | x <- mbfield (Shelley._poolDeposit pp) ]
 
127
     ++ [ "eMax"                  .= x | x <- mbfield (Shelley._eMax pp) ]
 
128
     ++ [ "nOpt"                  .= x | x <- mbfield (Shelley._nOpt pp) ]
 
129
     ++ [ "a0" .= (fromRational x :: Scientific)
 
130
                                       | x <- mbfield (Shelley._a0 pp) ]
 
131
     ++ [ "rho"                   .= x | x <- mbfield (Shelley._rho pp) ]
 
132
     ++ [ "tau"                   .= x | x <- mbfield (Shelley._tau pp) ]
 
133
     ++ [ "decentralisationParam" .= x | x <- mbfield (Shelley._d pp) ]
 
134
     ++ [ "extraEntropy"          .= x | x <- mbfield (Shelley._extraEntropy pp) ]
 
135
     ++ [ "protocolVersion"       .= x | x <- mbfield (Shelley._protocolVersion pp) ]
 
136
     ++ [ "minUTxOValue"          .= x | x <- mbfield (Shelley._minUTxOValue pp) ]
 
137
     ++ [ "minPoolCost"           .= x | x <- mbfield (Shelley._minPoolCost pp) ]
 
138
    where
 
139
      mbfield SNothing  = []
 
140
      mbfield (SJust x) = [x]
 
141
 
 
142
instance Crypto.Crypto crypto => ToJSON (Shelley.DPState crypto) where
 
143
  toJSON dpState = object [ "dstate" .= Shelley._dstate dpState
 
144
                          , "pstate" .= Shelley._pstate dpState
 
145
                          ]
 
146
 
 
147
instance Crypto.Crypto crypto => ToJSON (Shelley.DState crypto) where
 
148
  toJSON dState = object [ "rewards" .= Shelley._rewards dState
 
149
                         , "delegations" .= ShelleyLedger._delegations dState
 
150
                         , "ptrs" .= Shelley._ptrs dState
 
151
                         , "fGenDelegs" .= Map.toList (Shelley._fGenDelegs dState)
 
152
                         , "genDelegs" .= Shelley._genDelegs dState
 
153
                         , "irwd" .= Shelley._irwd dState
 
154
                         ]
 
155
 
 
156
instance ToJSON (ShelleyLedger.FutureGenDeleg crypto) where
 
157
  toJSON fGenDeleg =
 
158
    object [ "fGenDelegSlot" .= ShelleyLedger.fGenDelegSlot fGenDeleg
 
159
           , "fGenDelegGenKeyHash" .= ShelleyLedger.fGenDelegGenKeyHash fGenDeleg
 
160
           ]
 
161
 
 
162
instance Crypto.Crypto crypto => ToJSON (Shelley.GenDelegs crypto) where
 
163
  toJSON (Shelley.GenDelegs delegs) = toJSON delegs
 
164
 
 
165
instance ToJSON (Shelley.InstantaneousRewards crypto) where
 
166
  toJSON iRwds = object [ "iRReserves" .= Shelley.iRReserves iRwds
 
167
                        , "iRTreasury" .= Shelley.iRTreasury iRwds
 
168
                        ]
 
169
 
 
170
instance ToJSON (Bimap Shelley.Ptr (Shelley.Credential Shelley.Staking crypto)) where
 
171
  toJSON (MkBiMap ptsStakeM stakePtrSetM) =
 
172
    object [ "stakedCreds" .= Map.toList ptsStakeM
 
173
           , "credPtrR" .= toJSON stakePtrSetM
 
174
           ]
 
175
instance ToJSON Shelley.Ptr where
 
176
  toJSON (Shelley.Ptr slotNo txIndex certIndex) =
 
177
    object [ "slot" .= unSlotNo slotNo
 
178
           , "txIndex" .= txIndex
 
179
           , "certIndex" .= certIndex
 
180
           ]
 
181
 
 
182
 
 
183
instance Crypto.Crypto crypto => ToJSON (Shelley.PState crypto) where
 
184
  toJSON pState = object [ "pParams pState" .= Shelley._pParams pState
 
185
                         , "fPParams pState" .= Shelley._fPParams pState
 
186
                         , "retiring pState" .= Shelley._retiring pState
 
187
                         ]
 
188
 
 
189
instance ( Consensus.ShelleyBasedEra era
 
190
         , ToJSON (Core.TxOut era)
 
191
         ) => ToJSON (Shelley.UTxO era) where
 
192
  toJSON (Shelley.UTxO utxo) = toJSON utxo
 
193
 
 
194
instance ( Consensus.ShelleyBasedEra era
 
195
         , ToJSON (Core.Value era)
 
196
         ) => ToJSON (Shelley.TxOut era) where
 
197
  toJSON (Shelley.TxOut addr amount) =
 
198
    object
 
199
      [ "address" .= addr
 
200
      , "amount" .= amount
 
201
      ]
 
202
 
 
203
instance Crypto.Crypto crypto => ToJSON (Shelley.TxIn crypto) where
 
204
  toJSON = toJSON . txInToText
 
205
 
 
206
instance Crypto.Crypto crypto => ToJSONKey (Shelley.TxIn crypto) where
 
207
  toJSONKey = toJSONKeyText txInToText
 
208
 
 
209
txInToText :: Crypto.Crypto crypto => Shelley.TxIn crypto -> Text
 
210
txInToText (Shelley.TxIn (Shelley.TxId txidHash) ix) =
 
211
  hashToText (SafeHash.extractHash txidHash)
 
212
    <> Text.pack "#"
 
213
    <> Text.pack (show ix)
 
214
 
 
215
hashToText :: Crypto.Hash crypto a -> Text
 
216
hashToText = Text.decodeLatin1 . Crypto.hashToBytesAsHex
 
217
 
 
218
instance Crypto.Crypto crypto => ToJSON (Shelley.NonMyopic crypto) where
 
219
  toJSON nonMy = object [ "likelihoodsNM" .= Shelley.likelihoodsNM nonMy
 
220
                        , "rewardPotNM" .= Shelley.rewardPotNM nonMy
 
221
                        ]
 
222
 
 
223
instance ToJSON Shelley.Likelihood where
 
224
  toJSON (Shelley.Likelihood llhd) =
 
225
    toJSON $ fmap (\(Shelley.LogWeight f) -> exp $ realToFrac f :: Double) llhd
 
226
 
 
227
instance Crypto.Crypto crypto => ToJSON (Shelley.SnapShots crypto) where
 
228
  toJSON ss = object [ "pstakeMark" .= Shelley._pstakeMark ss
 
229
                     , "pstakeSet" .= Shelley._pstakeSet ss
 
230
                     , "pstakeGo" .= Shelley._pstakeGo ss
 
231
                     , "feeSS" .= Shelley._feeSS ss
 
232
                     ]
 
233
 
 
234
instance Crypto.Crypto crypto => ToJSON (Shelley.SnapShot crypto) where
 
235
  toJSON ss = object [ "stake" .= Shelley._stake ss
 
236
                     , "delegations" .= ShelleyEpoch._delegations ss
 
237
                     , "poolParams" .= Shelley._poolParams ss
 
238
                     ]
 
239
 
 
240
instance ToJSON (Shelley.Stake crypto) where
 
241
  toJSON (Shelley.Stake s) = toJSON s
 
242
 
 
243
instance Crypto.Crypto crypto => ToJSON (Shelley.RewardUpdate crypto) where
 
244
  toJSON rUpdate = object [ "deltaT" .= Shelley.deltaT rUpdate
 
245
                          , "deltaR" .= Shelley.deltaR rUpdate
 
246
                          , "rs" .= Shelley.rs rUpdate
 
247
                          , "deltaF" .= Shelley.deltaF rUpdate
 
248
                          , "nonMyopic" .= Shelley.nonMyopic rUpdate
 
249
                          ]
 
250
 
 
251
instance Crypto.Crypto crypto => ToJSON (Shelley.PulsingRewUpdate crypto) where
 
252
  toJSON (Shelley.Pulsing _ _) = Aeson.Null
 
253
  toJSON (Shelley.Complete ru) = toJSON ru
 
254
 
 
255
instance ToJSON Shelley.DeltaCoin where
 
256
  toJSON (Shelley.DeltaCoin i) = toJSON i
 
257
 
 
258
instance Crypto.Crypto crypto => ToJSON (Shelley.PoolDistr crypto) where
 
259
  toJSON (Shelley.PoolDistr m) = toJSON m
 
260
 
 
261
instance ToJSON (Shelley.IndividualPoolStake crypto) where
 
262
  toJSON indivPoolStake =
 
263
    object [ "individualPoolStake" .= Shelley.individualPoolStake indivPoolStake
 
264
           , "individualPoolStakeVrf" .= Shelley.individualPoolStakeVrf indivPoolStake
 
265
           ]
 
266
 
 
267
instance ToJSON (Shelley.Reward crypto) where
 
268
  toJSON reward =
 
269
     object [ "rewardType" .= Shelley.rewardType reward
 
270
            , "rewardPool" .= Shelley.rewardPool reward
 
271
            , "rewardAmount" .= Shelley.rewardAmount reward
 
272
            ]
 
273
 
 
274
instance ToJSON Shelley.RewardType where
 
275
  toJSON Shelley.MemberReward = "MemberReward"
 
276
  toJSON Shelley.LeaderReward = "LeaderReward"
 
277
 
 
278
instance ToJSON (SafeHash.SafeHash c a) where
 
279
  toJSON = toJSON . SafeHash.extractHash
 
280