wip: Trying to get jormungandr compiling with added type families

cardano-foundation · Jun 16, 2020 · 95a8af8 · 95a8af8
1 parent 1bac8cd
commit 95a8af8
Show file tree

Hide file tree

Showing 3 changed files with 19 additions and 5 deletions.
diff --git a/lib/core/src/Cardano/Wallet/Network.hs b/lib/core/src/Cardano/Wallet/Network.hs
@@ -125,7 +125,7 @@ data NetworkLayer m target block = NetworkLayer
         -- ^ Broadcast a transaction to the chain producer
 
     , stakeDistribution
-        :: GetStakeDistribution target
+        :: GetStakeDistribution target m
 
     , getAccountBalance
         :: ChimericAccount
@@ -224,7 +224,7 @@ defaultRetryPolicy =
                                  Queries
 -------------------------------------------------------------------------------}
 
-type family GetStakeDistribution target :: *
+type family GetStakeDistribution target (m :: * -> *) :: *
 
 {-------------------------------------------------------------------------------
                                 Chain Sync

diff --git a/lib/jormungandr/src/Cardano/Pool/Jormungandr/Metrics.hs b/lib/jormungandr/src/Cardano/Pool/Jormungandr/Metrics.hs
@@ -54,12 +54,15 @@ import Cardano.Pool.Jormungandr.Performance
     ( readPoolsPerformances )
 import Cardano.Pool.Jormungandr.Ranking
     ( EpochConstants (..), unsafeMkNonNegative )
+import Cardano.Wallet.Jormungandr.Compatibility
+    ( Jormungandr )
 import Cardano.Wallet.Network
     ( ErrCurrentNodeTip
     , ErrNetworkUnavailable
     , FollowAction (..)
     , FollowExit (..)
     , FollowLog
+    , GetStakeDistribution (..)
     , NetworkLayer (currentNodeTip, stakeDistribution)
     , follow
     )
@@ -166,7 +169,7 @@ monitorStakePools
     :: Tracer IO StakePoolLog
     -> (Block, Quantity "block" Word32)
         -- ^ Genesis block and 'k'
-    -> NetworkLayer IO t Block
+    -> NetworkLayer IO Jormungandr Block
     -> DBLayer IO
     -> IO ()
 monitorStakePools tr (block0, Quantity k) nl db@DBLayer{..} = do
@@ -201,7 +204,7 @@ monitorStakePools tr (block0, Quantity k) nl db@DBLayer{..} = do
         distributions <- forM epochs $ \ep -> do
             liftIO $ traceWith tr $ MsgStakeDistribution ep
             withExceptT ErrMonitorStakePoolsNetworkUnavailable $
-                (ep,) <$> stakeDistribution nl ep
+                (ep,) <$> (stakeDistribution nl ep)
 
         currentTip <- withExceptT ErrMonitorStakePoolsCurrentNodeTip $
             currentNodeTip nl
@@ -253,7 +256,7 @@ newStakePoolLayer
     -- ^ Genesis block header
     -> (EpochNo -> Quantity "lovelace" Word64 -> EpochConstants)
     -> DBLayer IO
-    -> NetworkLayer IO t Block
+    -> NetworkLayer IO Jormungandr Block
     -> FilePath
     -- ^ A directory to cache downloaded stake pool metadata. Will be created if
     -- it does not exist.

diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs
@@ -107,6 +107,7 @@ import Cardano.Wallet.Jormungandr.Compatibility
 import Cardano.Wallet.Network
     ( Cursor
     , ErrGetAccountBalance (..)
+    , GetStakeDistribution
     , NetworkLayer (..)
     , NextBlocksResult (..)
     , defaultRetryPolicy
@@ -455,6 +456,16 @@ mkRawNetworkLayer np batchSize st j = NetworkLayer
             _ ->
                 RollBackward $ Cursor emptyBlockHeaders
 
+
+{-------------------------------------------------------------------------------
+                                 Queries
+-------------------------------------------------------------------------------}
+
+type instance GetStakeDistribution Jormungandr m =
+    EpochNo
+    -> ExceptT ErrNetworkUnavailable m
+        (Map PoolId (Quantity "lovelace" Word64))
+
 {-------------------------------------------------------------------------------
                              Jormungandr Cursor
 -------------------------------------------------------------------------------}