Move jorm listPools handler to server module

cardano-foundation · Jun 11, 2020 · b42b040 · b42b040
1 parent 7e3a5c1
commit b42b040
Show file tree

Hide file tree

Showing 2 changed files with 40 additions and 39 deletions.
diff --git 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
@@ -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,20 +103,24 @@ 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
     ( Buildable )
 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