Skip to content
Permalink
Browse files

most review remarks plus try with blockchainparameters

  • Loading branch information...
paweljakubas committed Jul 12, 2019
1 parent cea809c commit 74c632d2202d4c5cd9b25237cf204720481f7c47
@@ -277,11 +277,10 @@ cmdServe = command "serve" $ info (helper <*> cmd) $ mempty
-> DBLayer IO s t
-> IO (WalletLayer s t)
newWalletLayer (sb, tracer) db = do
(nl, block0, theFeePolicy) <- newNetworkLayer (sb, tracer)
(nl, block0, feePolicy) <- newNetworkLayer (sb, tracer)
let tl = HttpBridge.newTransactionLayer @n
Wallet.newWalletLayer
tracer (BlockchainParameters block0 theFeePolicy byronSlotLength)
db nl tl
let bp = BlockchainParameters block0 feePolicy byronSlotLength
Wallet.newWalletLayer tracer bp db nl tl

newNetworkLayer
:: (Switchboard Text, Trace IO Text)
@@ -74,7 +74,10 @@ import Cardano.Wallet.Jormungandr.Compatibility
import Cardano.Wallet.Jormungandr.Environment
( KnownNetwork (..), Network (..) )
import Cardano.Wallet.Jormungandr.Network
( ErrGetInitialConfigParams (..), getBlock, getInitialConfigParams )
( ErrGetInitialConfigParams (..)
, getBlock
, getInitialBlockchainParameters
)
import Cardano.Wallet.Jormungandr.Primitive.Types
( Tx (..) )
import Cardano.Wallet.Network
@@ -340,10 +343,10 @@ cmdServe = command "serve" $ info (helper <*> cmd) $ mempty
-> DBLayer IO s t
-> IO (WalletLayer s t)
newWalletLayer (sb, tracer) db = do
(nl, block0, theFeePolicy, theSlotLength) <- newNetworkLayer (sb, tracer)
(nl, block0, feePolicy, slotLength) <- newNetworkLayer (sb, tracer)
let tl = Jormungandr.newTransactionLayer @n block0H
Wallet.newWalletLayer
tracer (BlockchainParameters block0 theFeePolicy theSlotLength) db nl tl
let bp = BlockchainParameters block0 feePolicy slotLength
Wallet.newWalletLayer tracer bp db nl tl

newNetworkLayer
:: (Switchboard Text, Trace IO Text)
@@ -361,16 +364,16 @@ cmdServe = command "serve" $ info (helper <*> cmd) $ mempty
handleNetworkUnreachable tracer
Left (ErrGetBlockNotFound _) ->
handleGenesisNotFound (sb, tracer)
(theFeePolicy, theSlotLength) <-
runExceptT (getInitialConfigParams jor (coerce block0H)) >>= \case
(feePolicy, slotLength) <-
runExceptT (getInitialBlockchainParameters jor (coerce block0H)) >>= \case
Right a -> return a
Left (ErrGetInitialConfigParamsNetworkUnreachable _) ->
handleNetworkUnreachable tracer
Left (ErrGetInitialConfigParamsGenesisNotFound _) ->
handleGenesisNotFound (sb, tracer)
Left (ErrGetInitialConfigParamsNoInitialPolicy _) ->
handleNoInitialPolicy tracer
return (nl, block0, theFeePolicy, theSlotLength)
return (nl, block0, feePolicy, slotLength)

withDBLayer
:: CM.Configuration
@@ -364,10 +364,10 @@ cancelWorker (WorkerRegistry mvar) wid =
-------------------------------------------------------------------------------}

data BlockchainParameters t = BlockchainParameters
{ genesisBlock :: Block (Tx t)
{ getGenesisBlock :: Block (Tx t)
-- ^ Very first block
, feePolicy :: FeePolicy
, slotLength :: SlotLength
, getFeePolicy :: FeePolicy
, getSlotLength :: SlotLength
}

-- | Create a new instance of the wallet layer.
@@ -381,11 +381,11 @@ newWalletLayer
-> IO (WalletLayer s t)
newWalletLayer
tracer
(BlockchainParameters block0 theFeePolicy (SlotLength (Quantity theSlotLength)))
(BlockchainParameters block0 feePolicy (SlotLength (Quantity slotLength)))
db nw tl = do
logDebugT $ "Wallet layer starting with: "
<> "block0: "+| block0 |+ ", "
<> "fee policy: "+|| theFeePolicy ||+""
<> "fee policy: "+|| feePolicy ||+""
registry <- newRegistry
return WalletLayer
{ createWallet = _createWallet
@@ -546,7 +546,7 @@ newWalletLayer
-> BlockHeader
-> IO ()
restoreSleep t wid slot = do
let halfSlotLengthDelay = 500000 * (fromIntegral theSlotLength) in threadDelay halfSlotLengthDelay
let halfSlotLengthDelay = 500000 * (fromIntegral slotLength) in threadDelay halfSlotLengthDelay
runExceptT (networkTip nw) >>= \case
Left e -> do
logError t $ "Failed to get network tip: " +|| e ||+ ""
@@ -657,7 +657,7 @@ newWalletLayer
logInfoT $ "Coins selected for transaction: \n"+| sel |+""
withExceptT ErrCreateUnsignedTxFee $ do
let feeOpts = FeeOptions
{ estimate = computeFee theFeePolicy . estimateSize tl
{ estimate = computeFee feePolicy . estimateSize tl
, dustThreshold = minBound
}
debug "Coins after fee adjustment" =<< adjustForFee feeOpts utxo' sel
@@ -672,7 +672,7 @@ newWalletLayer
let utxo = availableUTxO @s @t w
(sel, _utxo') <- withExceptT ErrEstimateTxFeeCoinSelection $
CoinSelection.random opts recipients utxo
let estimateFee = computeFee theFeePolicy . estimateSize tl
let estimateFee = computeFee feePolicy . estimateSize tl
pure $ estimateFee sel

_signTx
@@ -705,7 +705,7 @@ fromFlatSlot n = SlotId e (fromIntegral s)
epochLength :: Integral a => a
epochLength = 21600

newtype SlotLength = SlotLength (Quantity "second/slot" Word8)
newtype SlotLength = SlotLength (Quantity "second" Word8)
deriving (Show, Eq)

{-------------------------------------------------------------------------------
@@ -212,10 +212,8 @@ bench_restoration _ (wid, wname, s) = withHttpBridge network $ \port -> do
let tl = newTransactionLayer
BlockHeader sl _ <- unsafeRunExceptT $ networkTip nw
sayErr . fmt $ network ||+ " tip is at " +|| sl ||+ ""
w <- newWalletLayer
@_ @t nullTracer
(BlockchainParameters block0 byronFeePolicy byronSlotLength)
db nw tl
let bp = BlockchainParameters block0 byronFeePolicy byronSlotLength
w <- newWalletLayer @_ @t nullTracer bp db nw tl
wallet <- unsafeRunExceptT $ createWallet w wid wname s
unsafeRunExceptT $ restoreWallet w wallet
waitForWalletSync w wallet
@@ -81,6 +81,6 @@ spec = do
db <- MVar.newDBLayer
nl <- HttpBridge.newNetworkLayer @'Testnet port
let tl = HttpBridge.newTransactionLayer
let bp = BlockchainParameters block0 byronFeePolicy byronSlotLength
(handle,) <$>
(newWalletLayer @_ @(HttpBridge 'Testnet)
nullTracer (BlockchainParameters block0 byronFeePolicy byronSlotLength) db nl tl)
(newWalletLayer @_ @(HttpBridge 'Testnet) nullTracer bp db nl tl)
@@ -264,10 +264,8 @@ main = do
mvar <- newEmptyMVar
thread <- forkIO $ do
let tl = HttpBridge.newTransactionLayer
wallet <-
newWalletLayer
nullTracer (BlockchainParameters block0 byronFeePolicy byronSlotLength)
db nl tl
let bp = BlockchainParameters block0 byronFeePolicy byronSlotLength
wallet <- newWalletLayer nullTracer bp db nl tl
let listen = fromMaybe (ListenOnPort defaultPort) mlisten
Server.withListeningSocket listen $ \(port, socket) -> do
let settings = Warp.defaultSettings
@@ -359,7 +359,7 @@ data ConfigParam
-- ^ Consensus version. BFT / Genesis Praos.
| SlotsPerEpoch (Quantity "slot/epoch" Word32)
-- ^ Number of slots in an epoch.
| SlotDuration (Quantity "second/slot" Word8)
| SlotDuration (Quantity "second" Word8)
-- ^ Slot duration in seconds.
| EpochStabilityDepth (Quantity "block" Word32)
-- ^ The length of the suffix of the chain (in blocks) considered unstable.
@@ -37,6 +37,8 @@ module Cardano.Wallet.Jormungandr.Network

import Prelude

import Cardano.Wallet
( BlockchainParameters )
import Cardano.Wallet.Jormungandr.Api
( BlockId (..)
, GetBlock
@@ -173,9 +175,9 @@ data JormungandrLayer m = JormungandrLayer
, postMessage
:: (Tx, [TxWitness])
-> ExceptT ErrPostTx m ()
, getInitialConfigParams
, getInitialBlockchainParameters
:: Hash "Genesis"
-> ExceptT ErrGetInitialConfigParams m (FeePolicy, SlotLength)
-> ExceptT ErrGetInitialConfigParams m (BlockchainParameters (Jormungandr network))
}

-- | Construct a 'JormungandrLayer'-client
@@ -237,8 +239,8 @@ mkJormungandrLayer mgr baseUrl = JormungandrLayer
x -> do
let ctx = safeLink api (Proxy @PostMessage)
left ErrPostTxNetworkUnreachable <$> defaultHandler ctx x
, getInitialConfigParams = \block0 -> do
J.Block _ msgs <- ExceptT $ run (cGetBlock (BlockId $ coerce block0)) >>= \case
, getInitialBlockchainParameters = \block0 -> do
jblock@(J.Block _ msgs) <- ExceptT $ run (cGetBlock (BlockId $ coerce block0)) >>= \case
Left (FailureResponse e) | responseStatusCode e == status400 ->
return . Left . ErrGetInitialConfigParamsGenesisNotFound $ block0
x -> do
@@ -266,7 +268,7 @@ mkJormungandrLayer mgr baseUrl = JormungandrLayer

case (mpolicy,mduration) of
([policy],[duration]) ->
return (policy, SlotLength duration)
return $ (coerceBlock jblock) policy (SlotLength duration)
_ ->
throwE $ ErrGetInitialConfigParamsNoInitialPolicy params
}
@@ -43,7 +43,7 @@ import Cardano.Wallet.Network
import Cardano.Wallet.Primitive.Fee
( FeePolicy (..) )
import Cardano.Wallet.Primitive.Types
( Block (..), Hash (..) )
( Block (..), Hash (..), SlotLength )
import Cardano.Wallet.Unsafe
( unsafeFromHex, unsafeRunExceptT )
import Control.Concurrent
@@ -187,7 +187,8 @@ cardanoWalletServer mlisten = do
mvar <- newEmptyMVar
handle <- async $ do
let tl = Jormungandr.newTransactionLayer block0H
wallet <- newWalletLayer tracer (BlockchainParameters block0 feePolicy slotLength) db nl tl
let bp = BlockchainParameters block0 feePolicy slotLength
wallet <- newWalletLayer tracer bp db nl tl
let listen = fromMaybe (ListenOnPort defaultPort) mlisten
Server.withListeningSocket listen $ \(port, socket) -> do
let settings = Warp.defaultSettings
@@ -215,7 +216,7 @@ newNetworkLayer url block0H = do
block0 <- unsafeRunExceptT $
getBlock jormungandr (coerce block0H)
(feePolicy, slotLength) <- unsafeRunExceptT $
getInitialConfigParams jormungandr (coerce block0H)
getInitialBlockchainParameters jormungandr (coerce block0H)
return (nl, block0, feePolicy, slotLength)

mkFeeEstimator :: FeePolicy -> TxDescription -> (Natural, Natural)

0 comments on commit 74c632d

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