diff --git a/lib/jormungandr/src/Cardano/Pool/Jormungandr/Metrics.hs b/lib/jormungandr/src/Cardano/Pool/Jormungandr/Metrics.hs index 17c3e5ddd53..e58d145ad71 100644 --- a/lib/jormungandr/src/Cardano/Pool/Jormungandr/Metrics.hs +++ b/lib/jormungandr/src/Cardano/Pool/Jormungandr/Metrics.hs @@ -21,7 +21,6 @@ module Cardano.Pool.Jormungandr.Metrics ( -- * Types Block (..) , StakePoolLayer (..) - , listPools -- * Listing stake-pools from the DB , newStakePoolLayer @@ -55,10 +54,6 @@ import Cardano.Pool.Jormungandr.Performance ( readPoolsPerformances ) import Cardano.Pool.Jormungandr.Ranking ( EpochConstants (..), unsafeMkNonNegative ) -import Cardano.Wallet.Api.Server - ( LiftHandler (liftHandler) ) -import Cardano.Wallet.Api.Types - ( ApiJormungandrStakePool (..), ApiStakePoolMetrics (..), ApiT (..) ) import Cardano.Wallet.Network ( ErrCurrentNodeTip , ErrNetworkUnavailable @@ -122,8 +117,6 @@ import Fmt ( pretty ) import GHC.Generics ( Generic ) -import Servant - ( Handler ) import System.Random ( StdGen ) @@ -159,34 +152,6 @@ data StakePoolLayer e m = StakePoolLayer -- that have been seen on chain. } --------------------------------------------------------------------------------- --- Api Handler --------------------------------------------------------------------------------- - -listPools - :: LiftHandler e - => StakePoolLayer e IO - -> Handler [ApiJormungandrStakePool] -listPools spl = - liftHandler $ map (uncurry mkApiJormungandrStakePool) <$> listStakePools spl - where - mkApiJormungandrStakePool - :: StakePool - -> Maybe StakePoolMetadata - -> ApiJormungandrStakePool - mkApiJormungandrStakePool sp meta = - ApiJormungandrStakePool - (ApiT $ view #poolId sp) - (ApiStakePoolMetrics - (Quantity $ fromIntegral $ getQuantity $ stake sp) - (Quantity $ fromIntegral $ getQuantity $ production sp)) - (sp ^. #performance) - (ApiT <$> meta) - (fromIntegral <$> sp ^. #cost) - (Quantity $ sp ^. #margin) - (sp ^. #desirability) - (sp ^. #saturation) - -------------------------------------------------------------------------------- -- Stake Pool Monitoring -------------------------------------------------------------------------------- diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Server.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Server.hs index c940a5482cd..f63d1f73984 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Server.hs +++ b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Server.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} @@ -23,7 +24,7 @@ module Cardano.Wallet.Jormungandr.Api.Server import Prelude import Cardano.Pool.Jormungandr.Metrics - ( ErrListStakePools (..), StakePoolLayer (..), listPools ) + ( ErrListStakePools (..), StakePoolLayer (..) ) import Cardano.Wallet ( ErrValidateSelection , genesisData @@ -85,7 +86,9 @@ import Cardano.Wallet.Api.Server ) import Cardano.Wallet.Api.Types ( ApiErrorCode (..) - , ApiJormungandrStakePool + , ApiJormungandrStakePool (..) + , ApiStakePoolMetrics (..) + , ApiT (..) , SomeByronWalletPostData (..) ) import Cardano.Wallet.Primitive.AddressDerivation @@ -100,12 +103,16 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Random ( RndState ) import Cardano.Wallet.Primitive.AddressDiscovery.Sequential ( SeqState ) +import Cardano.Wallet.Primitive.Types + ( StakePool (..), StakePoolMetadata ) import Control.Applicative ( liftA2 ) import Data.Generics.Internal.VL.Lens - ( (^.) ) + ( view, (^.) ) import Data.List ( sortOn ) +import Data.Quantity + ( Quantity (..) ) import Data.Text.Class ( ToText (..) ) import Fmt @@ -113,7 +120,7 @@ import Fmt import Network.Ntp ( NtpClient ) import Servant - ( (:<|>) (..), (:>), Server, err501, err503, throwError ) + ( (:<|>) (..), (:>), Handler, Server, err501, err503, throwError ) type ApiV2 n = "v2" :> Api n @@ -282,6 +289,35 @@ server byron icarus jormungandr spl ntp = proxy :: Server Proxy_ proxy = postExternalTransaction jormungandr + +-------------------------------------------------------------------------------- +-- List stake pools API handler +-------------------------------------------------------------------------------- + +listPools + :: LiftHandler e + => StakePoolLayer e IO + -> Handler [ApiJormungandrStakePool] +listPools spl = + liftHandler $ map (uncurry mkApiJormungandrStakePool) <$> listStakePools spl + where + mkApiJormungandrStakePool + :: StakePool + -> Maybe StakePoolMetadata + -> ApiJormungandrStakePool + mkApiJormungandrStakePool sp meta = + ApiJormungandrStakePool + (ApiT $ view #poolId sp) + (ApiStakePoolMetrics + (Quantity $ fromIntegral $ getQuantity $ stake sp) + (Quantity $ fromIntegral $ getQuantity $ production sp)) + (sp ^. #performance) + (ApiT <$> meta) + (fromIntegral <$> sp ^. #cost) + (Quantity $ sp ^. #margin) + (sp ^. #desirability) + (sp ^. #saturation) + instance LiftHandler ErrListStakePools where handler = \case ErrListStakePoolsCurrentNodeTip e -> handler e