-
Notifications
You must be signed in to change notification settings - Fork 51
/
Pools.purs
101 lines (91 loc) · 3.13 KB
/
Pools.purs
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
module Ctl.Internal.QueryM.Pools
( getPoolIds
, getPoolParameters
, getPoolsParameters
, getPubKeyHashDelegationsAndRewards
, getValidatorHashDelegationsAndRewards
) where
import Prelude
import Cardano.AsCbor (encodeCbor)
import Cardano.Types (PoolParams, PoolPubKeyHash, StakePubKeyHash)
import Cardano.Types.Ed25519KeyHash (toBech32Unsafe) as Ed25519KeyHash
import Cardano.Types.ScriptHash as ScriptHash
import Ctl.Internal.Helpers (liftM)
import Ctl.Internal.QueryM (QueryM, mkOgmiosRequest)
import Ctl.Internal.QueryM.Ogmios
( DelegationsAndRewardsR(DelegationsAndRewardsR)
, PoolParameters
)
import Ctl.Internal.QueryM.Ogmios as Ogmios
import Ctl.Internal.Types.DelegationsAndRewards (DelegationsAndRewards)
import Ctl.Internal.Types.StakeValidatorHash (StakeValidatorHash)
import Data.ByteArray (byteArrayToHex)
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(Nothing, Just))
import Data.Newtype (unwrap, wrap)
import Data.Tuple (fst)
import Effect.Exception (error)
import Partial.Unsafe (unsafePartial)
import Record.Builder (build, merge)
-- | Get pool parameters of all pools or of the provided pools.
getStakePools
:: Maybe (Array PoolPubKeyHash)
-> QueryM (Map PoolPubKeyHash PoolParameters)
getStakePools selected = unwrap <$>
mkOgmiosRequest Ogmios.queryStakePoolsCall
_.stakePools
(wrap selected)
getPoolIds :: QueryM (Array PoolPubKeyHash)
getPoolIds = (Map.toUnfoldableUnordered >>> map fst) <$>
getStakePools Nothing
getPoolParameters :: PoolPubKeyHash -> QueryM PoolParams
getPoolParameters poolPubKeyHash = do
params <- getPoolsParameters [ poolPubKeyHash ]
res <- liftM (error "Unable to find pool ID in the response") $ Map.lookup
poolPubKeyHash
params
pure res
getPoolsParameters
:: Array PoolPubKeyHash -> QueryM (Map PoolPubKeyHash PoolParams)
getPoolsParameters poolPubKeyHashes = do
response <- getStakePools (Just poolPubKeyHashes)
pure $ Map.mapMaybeWithKey
( \poolPkh params -> Just $ wrap $ build
( merge
{ operator: poolPkh
, poolOwners: params.poolOwners
}
)
params
)
response
getValidatorHashDelegationsAndRewards
:: StakeValidatorHash -> QueryM (Maybe DelegationsAndRewards)
getValidatorHashDelegationsAndRewards skh = do
DelegationsAndRewardsR mp <- mkOgmiosRequest Ogmios.queryDelegationsAndRewards
_.delegationsAndRewards
[ stringRep
]
pure $ Map.lookup byteHex mp
where
stringRep :: String
stringRep = unsafePartial $ ScriptHash.toBech32Unsafe "script" $ unwrap skh
byteHex :: String
byteHex = byteArrayToHex $ unwrap $ encodeCbor $ unwrap skh
-- TODO: batched variant
getPubKeyHashDelegationsAndRewards
:: StakePubKeyHash -> QueryM (Maybe DelegationsAndRewards)
getPubKeyHashDelegationsAndRewards pkh = do
DelegationsAndRewardsR mp <- mkOgmiosRequest Ogmios.queryDelegationsAndRewards
_.delegationsAndRewards
[ stringRep ]
pure $ Map.lookup byteHex mp
where
stringRep :: String
stringRep = unsafePartial
$ Ed25519KeyHash.toBech32Unsafe "stake_vkh"
$ unwrap pkh
byteHex :: String
byteHex = byteArrayToHex $ unwrap $ encodeCbor
$ unwrap pkh