accommodate BlockchainParameters type

correct merge errors
cardano-foundation · Jul 12, 2019 · 590caee · 590caee
1 parent a0bbe47
commit 590caee
Show file tree

Hide file tree

Showing 3 changed files with 19 additions and 43 deletions.
diff --git a/exe/wallet/jormungandr/Main.hs b/exe/wallet/jormungandr/Main.hs
@@ -74,27 +74,15 @@ import Cardano.Wallet.Jormungandr.Compatibility
 import Cardano.Wallet.Jormungandr.Environment
     ( KnownNetwork (..), Network (..) )
 import Cardano.Wallet.Jormungandr.Network
-    ( ErrGetInitialConfigParams (..)
-    , getBlock
-    , getInitialBlockchainParameters
-    )
-import Cardano.Wallet.Jormungandr.Primitive.Types
-    ( Tx (..) )
+    ( ErrGetInitialConfigParams (..), getInitialBlockchainParameters )
 import Cardano.Wallet.Network
-    ( ErrGetBlock (..)
-    , ErrNetworkTip
-    , NetworkLayer (..)
-    , defaultRetryPolicy
-    , waitForConnection
-    )
+    ( ErrNetworkTip, NetworkLayer (..), defaultRetryPolicy, waitForConnection )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( KeyToAddress )
 import Cardano.Wallet.Primitive.AddressDiscovery
     ( SeqState )
-import Cardano.Wallet.Primitive.Fee
-    ( FeePolicy )
 import Cardano.Wallet.Primitive.Types
-    ( Block (..), Hash (..), SlotLength )
+    ( Hash (..) )
 import Cardano.Wallet.Version
     ( showVersion, version )
 import Control.Applicative
@@ -343,28 +331,21 @@ cmdServe = command "serve" $ info (helper <*> cmd) $ mempty
             -> DBLayer IO s t
             -> IO (WalletLayer s t)
         newWalletLayer (sb, tracer) db = do
-            (nl, block0, feePolicy, slotLength) <- newNetworkLayer (sb, tracer)
+            (nl, blockchainParams) <- newNetworkLayer (sb, tracer)
             let tl = Jormungandr.newTransactionLayer @n block0H
-            let bp = BlockchainParameters block0 feePolicy slotLength
-            Wallet.newWalletLayer tracer bp db nl tl
+            Wallet.newWalletLayer tracer blockchainParams db nl tl
 
         newNetworkLayer
             :: (Switchboard Text, Trace IO Text)
-            -> IO (NetworkLayer t IO, Block Tx, FeePolicy, SlotLength)
+            -> IO (NetworkLayer t IO, BlockchainParameters t)
         newNetworkLayer (sb, tracer) = do
             let url = BaseUrl Http "localhost" (getPort nodePort) "/api"
             mgr <- newManager defaultManagerSettings
             let jor = Jormungandr.mkJormungandrLayer mgr url
             let nl = Jormungandr.mkNetworkLayer jor
             waitForService @ErrNetworkTip "Jörmungandr" (sb, tracer) nodePort $
                 waitForConnection nl defaultRetryPolicy
-            block0 <- runExceptT (getBlock jor (coerce block0H)) >>= \case
-                Right a -> return a
-                Left (ErrGetBlockNetworkUnreachable _) ->
-                    handleNetworkUnreachable tracer
-                Left (ErrGetBlockNotFound _) ->
-                    handleGenesisNotFound (sb, tracer)
-            (feePolicy, slotLength) <-
+            blockchainParams <-
                 runExceptT (getInitialBlockchainParameters jor (coerce block0H)) >>= \case
                 Right a -> return a
                 Left (ErrGetInitialConfigParamsNetworkUnreachable _) ->
@@ -373,7 +354,7 @@ cmdServe = command "serve" $ info (helper <*> cmd) $ mempty
                     handleGenesisNotFound (sb, tracer)
                 Left (ErrGetInitialConfigParamsNoInitialPolicy _) ->
                     handleNoInitialPolicy tracer
-            return (nl, block0, feePolicy, slotLength)
+            return (nl, blockchainParams)
 
         withDBLayer
             :: CM.Configuration

diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs
@@ -656,10 +656,6 @@ newWalletLayer
             CoinSelection.random coinSelOpts recipients utxo
         logInfoT $ "Coins selected for transaction: \n"+| sel |+""
         withExceptT ErrCreateUnsignedTxFee $ do
-            let feeOpts = FeeOptions
-                    { estimate = computeFee feePolicy . estimateSize tl
-                    , dustThreshold = minBound
-                    }
             debug "Coins after fee adjustment" =<< adjustForFee feeOpts utxo' sel
 
     _estimateTxFee
@@ -671,7 +667,7 @@ newWalletLayer
         (w, _) <- withExceptT ErrEstimateTxFeeNoSuchWallet (_readWallet wid)
         let utxo = availableUTxO @s @t w
         (sel, _utxo') <- withExceptT ErrEstimateTxFeeCoinSelection $
-            CoinSelection.random opts recipients utxo
+            CoinSelection.random coinSelOpts recipients utxo
         let estimateFee = computeFee feePolicy . estimateSize tl
         pure $ estimateFee sel
 

diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs
@@ -38,7 +38,7 @@ module Cardano.Wallet.Jormungandr.Network
 import Prelude
 
 import Cardano.Wallet
-    ( BlockchainParameters )
+    ( BlockchainParameters (..) )
 import Cardano.Wallet.Jormungandr.Api
     ( BlockId (..)
     , GetBlock
@@ -60,8 +60,6 @@ import Cardano.Wallet.Network
     , ErrPostTx (..)
     , NetworkLayer (..)
     )
-import Cardano.Wallet.Primitive.Fee
-    ( FeePolicy (..) )
 import Cardano.Wallet.Primitive.Types
     ( Block (..)
     , BlockHeader (..)
@@ -118,12 +116,12 @@ newNetworkLayer
     -> IO (NetworkLayer (Jormungandr n) IO)
 newNetworkLayer url = do
     mgr <- newManager defaultManagerSettings
-    return $ mkNetworkLayer $ mkJormungandrLayer mgr url
+    return $ mkNetworkLayer $ mkJormungandrLayer @n mgr url
 
 -- | Wrap a Jormungandr client into a 'NetworkLayer' common interface.
 mkNetworkLayer
     :: Monad m
-    => JormungandrLayer m
+    => JormungandrLayer n m
     -> NetworkLayer (Jormungandr n) m
 mkNetworkLayer j = NetworkLayer
     { networkTip = do
@@ -162,7 +160,7 @@ mkNetworkLayer j = NetworkLayer
 -------------------------------------------------------------------------------}
 
 -- | Endpoints of the jormungandr REST API.
-data JormungandrLayer m = JormungandrLayer
+data JormungandrLayer n m = JormungandrLayer
     { getTipId
         :: ExceptT ErrNetworkUnreachable m (Hash "BlockHeader")
     , getBlock
@@ -177,7 +175,7 @@ data JormungandrLayer m = JormungandrLayer
         -> ExceptT ErrPostTx m ()
     , getInitialBlockchainParameters
         :: Hash "Genesis"
-        -> ExceptT ErrGetInitialConfigParams m (BlockchainParameters (Jormungandr network))
+        -> ExceptT ErrGetInitialConfigParams m (BlockchainParameters (Jormungandr n))
     }
 
 -- | Construct a 'JormungandrLayer'-client
@@ -200,7 +198,8 @@ data JormungandrLayer m = JormungandrLayer
 -- >>> runExceptT $ getDescendantIds j t 4
 -- Right []
 mkJormungandrLayer
-    :: Manager -> BaseUrl -> JormungandrLayer IO
+    :: forall n. ()
+    => Manager -> BaseUrl -> JormungandrLayer n IO
 mkJormungandrLayer mgr baseUrl = JormungandrLayer
     { getTipId = ExceptT $ do
         let ctx = safeLink api (Proxy @GetTipId)
@@ -254,9 +253,9 @@ mkJormungandrLayer mgr baseUrl = JormungandrLayer
                     Initial xs -> Just xs
                     _ -> Nothing
 
-        let mpolicy = mapMaybe getFeePolicy params
+        let mpolicy = mapMaybe getsFeePolicy params
               where
-                getFeePolicy = \case
+                getsFeePolicy = \case
                     ConfigLinearFee x -> Just x
                     _ -> Nothing
 
@@ -268,7 +267,7 @@ mkJormungandrLayer mgr baseUrl = JormungandrLayer
 
         case (mpolicy,mduration) of
             ([policy],[duration]) ->
-                return $ (coerceBlock jblock) policy (SlotLength duration)
+                return $ BlockchainParameters (coerceBlock jblock) policy (SlotLength duration)
             _ ->
                 throwE $ ErrGetInitialConfigParamsNoInitialPolicy params
     }