Skip to content
Permalink
Browse files

accommodate BlockchainParameters type

correct merge errors
  • Loading branch information...
paweljakubas committed Jul 12, 2019
1 parent a0bbe47 commit 590caee3c9f25c3454de91d1b1650d0231b46c4a
@@ -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
@@ -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

@@ -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
}

0 comments on commit 590caee

Please sign in to comment.
You can’t perform that action at this time.