Connect StakePoolLayer with Api

cardano-foundation · Oct 22, 2019 · 1337b43 · 1337b43
1 parent 4edefcd
commit 1337b43
Show file tree

Hide file tree

Showing 5 changed files with 66 additions and 16 deletions.
diff --git a/lib/core/src/Cardano/Pool/Metrics.hs b/lib/core/src/Cardano/Pool/Metrics.hs
@@ -18,7 +18,7 @@ module Cardano.Pool.Metrics
     , combineMetrics
     , ErrMetricsInconsistency (..)
 
-    -- * StakePoolLayer
+      -- * StakePoolLayer
     , StakePoolLayer (..)
     , newStakePoolLayer
     , ErrListStakePools (..)
@@ -84,7 +84,7 @@ activityForEpoch epoch s =
 --------------------------------------------------------------------------------
 
 newtype ErrListStakePools
-     = ErrListStakePoolsMetricsIsUnsynced (Quantity "percent" Percentage)
+     = ErrMetricsIsUnsynced (Quantity "percent" Percentage)
 
 -- | @StakePoolLayer@ is a thin layer ontop of the DB. It is /one/ value that
 -- can easily be passed to the API-server, where it can be used in a simple way.
@@ -103,7 +103,9 @@ newStakePoolLayer db = do
             cursor <- liftIO $ readCursor db 1
             case cursor of
                 [dbTip] -> do
-                    let epochNo = dbTip ^. #slotId ^. #epochNumber
+                    -- TODO: Figure out when we are unsynced and
+                    -- throw @ErrMetricsIsUnsynced@.
+                    let epochNo = dbTip ^. (#slotId . #epochNumber)
                     distr <- liftIO $ Map.fromList <$> readStakeDistribution db epochNo
                     prod <- liftIO $ convert <$> readPoolProduction db epochNo
                     case combineMetrics distr prod of

diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs
@@ -37,6 +37,8 @@ import Prelude
 
 import Cardano.BM.Trace
     ( Trace, logError, logNotice )
+import Cardano.Pool.Metrics
+    ( ErrListStakePools (..), StakePoolLayer (..) )
 import Cardano.Wallet
     ( ErrAdjustForFee (..)
     , ErrCoinSelection (..)
@@ -89,7 +91,7 @@ import Cardano.Wallet.Api.Types
     , ApiMigrateByronWalletData (..)
     , ApiNetworkInformation (..)
     , ApiNetworkTip (..)
-    , ApiStakePool
+    , ApiStakePool (..)
     , ApiT (..)
     , ApiTimeReference (..)
     , ApiTransaction (..)
@@ -102,6 +104,7 @@ import Cardano.Wallet.Api.Types
     , PostExternalTransactionData (..)
     , PostTransactionData
     , PostTransactionFeeData
+    , StakePoolMetrics (..)
     , WalletBalance (..)
     , WalletPostData (..)
     , WalletPutData (..)
@@ -209,7 +212,7 @@ import Data.Time
 import Data.Time.Clock
     ( getCurrentTime )
 import Data.Word
-    ( Word32 )
+    ( Word32, Word64 )
 import Fmt
     ( Buildable, pretty )
 import Network.HTTP.Media.RenderHeader
@@ -295,8 +298,9 @@ start
     -> Socket
     -> ApiLayer (RndState t) t RndKey
     -> ApiLayer (SeqState t) t SeqKey
+    -> StakePoolLayer IO
     -> IO ()
-start settings trace socket rndCtx seqCtx = do
+start settings trace socket rndCtx seqCtx spl = do
     logSettings <- newApiLoggerSettings <&> obfuscateKeys (const sensitive)
     Warp.runSettingsSocket settings socket
         $ handleRawError (curry handler)
@@ -305,7 +309,7 @@ start settings trace socket rndCtx seqCtx = do
   where
     -- | A Servant server for our wallet API
     server :: Server (Api t)
-    server = coreApiServer seqCtx :<|> compatibilityApiServer rndCtx seqCtx
+    server = coreApiServer seqCtx spl :<|> compatibilityApiServer rndCtx seqCtx
 
     application :: Application
     application = serve (Proxy @("v2" :> Api t)) server
@@ -375,12 +379,13 @@ coreApiServer
         , ctx ~ ApiLayer s t k
         )
     => ctx
+    -> StakePoolLayer IO
     -> Server (CoreApi t)
-coreApiServer ctx =
+coreApiServer ctx spl =
     addresses ctx
     :<|> wallets ctx
     :<|> transactions ctx
-    :<|> pools ctx
+    :<|> pools spl
     :<|> network ctx
 
 {-------------------------------------------------------------------------------
@@ -721,14 +726,26 @@ postTransactionFee ctx (ApiT wid) body = do
 -------------------------------------------------------------------------------}
 
 pools
-    :: ctx
+    :: StakePoolLayer IO
     -> Server StakePools
 pools = listPools
 
 listPools
-    :: ctx
+    :: StakePoolLayer IO
     -> Handler [ApiStakePool]
-listPools _ctx = throwError err501
+listPools spl = liftHandler (map f <$> listStakePools spl)
+  where
+    f
+        :: ( W.PoolId,
+            (Quantity "lovelace" Word64, Quantity "block" Natural)
+            )
+        -> ApiStakePool
+    f (pool, ((Quantity stake), blocks)) =
+        -- TODO: Make sure the stake-types match (Word64 vs Natural)
+        -- to avoid unwrapping Quantity.
+        ApiStakePool
+            (ApiT pool)
+            (StakePoolMetrics (Quantity $ fromIntegral stake) blocks)
 
 {-------------------------------------------------------------------------------
                                     Network
@@ -1432,3 +1449,12 @@ instance LiftHandler (Request, ServantErr) where
                 , renderHeader $ contentType $ Proxy @JSON
                 ) : headers
             }
+
+instance LiftHandler ErrListStakePools where
+     handler = \case
+         ErrMetricsIsUnsynced p ->
+             apiError err400 NotSynced $ mconcat
+                 [ "I can't list stake pools yet because I need to scan the "
+                 , "blockchain for metrics first. I'm at "
+                 , toText p
+                 ]
diff --git a/lib/core/src/Cardano/Wallet/Api/Types.hs b/lib/core/src/Cardano/Wallet/Api/Types.hs
@@ -323,6 +323,7 @@ data ApiErrorCode
     | StartTimeLaterThanEndTime
     | UnsupportedMediaType
     | UnexpectedError
+    | NotSynced
     deriving (Eq, Generic, Show)
 
 -- | Defines a point in time that can be formatted as and parsed from an

diff --git a/lib/http-bridge/src/Cardano/Wallet/HttpBridge.hs b/lib/http-bridge/src/Cardano/Wallet/HttpBridge.hs
@@ -26,6 +26,8 @@ import Cardano.CLI
     ( Port (..), failWith, waitForService )
 import Cardano.Launcher
     ( ProcessHasExited (..), installSignalHandlers )
+import Cardano.Pool.Metrics
+    ( StakePoolLayer (..) )
 import Cardano.Wallet.Api
     ( ApiLayer )
 import Cardano.Wallet.Api.Server
@@ -138,7 +140,8 @@ serveWallet (cfg, tr) databaseDir listen bridge mAction = do
                   let settings = Warp.defaultSettings
                           & setBeforeMainLoop beforeMainLoop
                   let ipcServer = daedalusIPC tracerIPC port
-                  let apiServer = Server.start settings tracerApi socket apiRnd apiSeq
+                  let apiServer = Server.start
+                        settings tracerApi socket apiRnd apiSeq dummyPool
                   let withAction = maybe id (\cb -> race_ (cb port)) action
                   withAction $ race_ ipcServer apiServer
                   pure ExitSuccess
@@ -172,6 +175,11 @@ serveWallet (cfg, tr) databaseDir listen bridge mAction = do
     dbFactory =
         Sqlite.mkDBFactory cfg tr databaseDir
 
+    dummyPool :: StakePoolLayer IO
+    dummyPool = StakePoolLayer
+        { listStakePools = return []
+        }
+
     handleNetworkStartupError :: ErrStartup -> IO ExitCode
     handleNetworkStartupError = \case
         ErrStartupCommandExited pe -> case pe of

diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr.hs
@@ -33,6 +33,8 @@ import Cardano.CLI
     ( Port (..), failWith, waitForService )
 import Cardano.Launcher
     ( ProcessHasExited (..), installSignalHandlers )
+import Cardano.Pool.Metrics
+    ( StakePoolLayer, newStakePoolLayer )
 import Cardano.Wallet.Api
     ( ApiLayer )
 import Cardano.Wallet.Api.Server
@@ -95,6 +97,7 @@ import System.Exit
     ( ExitCode (..) )
 
 import qualified Cardano.BM.Configuration.Model as CM
+import qualified Cardano.Pool.DB.Sqlite as PoolSqlite
 import qualified Cardano.Wallet.Api.Server as Server
 import qualified Cardano.Wallet.DB.Sqlite as Sqlite
 import qualified Cardano.Wallet.Jormungandr.Binary as J
@@ -134,7 +137,12 @@ serveWallet (cfg, tr) databaseDir hostPref listen lj beforeMainLoop = do
             let (_, bp) = staticBlockchainParameters nl
             rndApi <- apiLayer tr (toWLBlock <$> nl)
             seqApi <- apiLayer tr (toWLBlock <$> nl)
-            startServer tr nPort bp rndApi seqApi
+
+            -- StakePool
+            (_, spDB) <- PoolSqlite.newDBLayer cfg tr (poolDBPath databaseDir)
+            spl <- newStakePoolLayer spDB
+
+            startServer tr nPort bp rndApi seqApi spl
         Left e -> handleNetworkStartupError e
   where
     startServer
@@ -143,8 +151,9 @@ serveWallet (cfg, tr) databaseDir hostPref listen lj beforeMainLoop = do
         -> BlockchainParameters
         -> ApiLayer (RndState t) t RndKey
         -> ApiLayer (SeqState t) t SeqKey
+        -> StakePoolLayer IO
         -> IO ExitCode
-    startServer tracer nPort bp rndWallet seqWallet = do
+    startServer tracer nPort bp rndWallet seqWallet spl = do
         Server.withListeningSocket hostPref listen $ \case
             Right (wPort, socket) -> do
                 sockAddr <- getSocketName socket
@@ -154,13 +163,17 @@ serveWallet (cfg, tr) databaseDir hostPref listen lj beforeMainLoop = do
                         & setBeforeMainLoop (beforeMainLoop sockAddr nPort bp)
                 let ipcServer = daedalusIPC tracerIPC wPort
                 let apiServer =
-                        Server.start settings tracerApi socket rndWallet seqWallet
+                        Server.start
+                            settings tracerApi socket rndWallet seqWallet spl
                 race_ ipcServer apiServer
                 pure ExitSuccess
             Left e -> handleApiServerStartupError e
 
     toWLBlock = J.convertBlock
 
+    poolDBPath :: Maybe FilePath -> Maybe FilePath
+    poolDBPath = fmap (<> "/stake-pool-metrics.sqlite")
+
     apiLayer
         :: forall s k .
             ( KeyToAddress (Jormungandr 'Testnet) k