From e53e797d685e55f021acf416fbbb5c0c2f535737 Mon Sep 17 00:00:00 2001
From: Rodney Lorrimar <rodney.lorrimar@iohk.io>
Date: Mon, 7 Jan 2019 20:57:37 +1000
Subject: [PATCH 01/13] [DEVOPS-1203] configuration.yaml: Bump
 applicationVersion

mainnet: 11 -> 12
staging: 18 -> 19
testnet: 4 -> 5
---
 lib/configuration.yaml | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/lib/configuration.yaml b/lib/configuration.yaml
index 281dd3be661..b4854c63669 100644
--- a/lib/configuration.yaml
+++ b/lib/configuration.yaml
@@ -14839,7 +14839,7 @@ mainnet_wallet_win64: &mainnet_wallet_win64
   <<: *mainnet_full
   update:
     applicationName: csl-daedalus
-    applicationVersion: 11
+    applicationVersion: 12
     lastKnownBlockVersion:
       bvMajor: 0
       bvMinor: 1
@@ -14849,7 +14849,7 @@ mainnet_wallet_macos64: &mainnet_wallet_macos64
   <<: *mainnet_full
   update:
     applicationName: csl-daedalus
-    applicationVersion: 11
+    applicationVersion: 12
     lastKnownBlockVersion:
       bvMajor: 0
       bvMinor: 1
@@ -14859,7 +14859,7 @@ mainnet_wallet_linux64: &mainnet_wallet_linux64
   <<: *mainnet_full
   update:
     applicationName: csl-daedalus
-    applicationVersion: 11
+    applicationVersion: 12
     lastKnownBlockVersion:
       bvMajor: 0
       bvMinor: 1
@@ -14929,7 +14929,7 @@ testnet_wallet: &testnet_wallet
   <<: *testnet_full
   update: &testnet_wallet_update
     applicationName: csl-daedalus
-    applicationVersion: 4
+    applicationVersion: 5
     lastKnownBlockVersion:
       bvMajor: 0
       bvMinor: 0
@@ -14973,7 +14973,7 @@ mainnet_dryrun_wallet_win64: &mainnet_dryrun_wallet_win64
   <<: *mainnet_dryrun_full
   update:
     applicationName: csl-daedalus
-    applicationVersion: 18
+    applicationVersion: 19
     lastKnownBlockVersion:
       bvMajor: 0
       bvMinor: 2
@@ -14983,7 +14983,7 @@ mainnet_dryrun_wallet_macos64: &mainnet_dryrun_wallet_macos64
   <<: *mainnet_dryrun_full
   update:
     applicationName: csl-daedalus
-    applicationVersion: 18
+    applicationVersion: 19
     lastKnownBlockVersion:
       bvMajor: 0
       bvMinor: 2
@@ -14993,7 +14993,7 @@ mainnet_dryrun_wallet_linux64: &mainnet_dryrun_wallet_linux64
   <<: *mainnet_dryrun_full
   update:
     applicationName: csl-daedalus
-    applicationVersion: 18
+    applicationVersion: 19
     lastKnownBlockVersion:
       bvMajor: 0
       bvMinor: 2

From e49c93de5bc823849563247cdfc292fcc1a9bbdb Mon Sep 17 00:00:00 2001
From: KtorZ <matthias.benkort@gmail.com>
Date: Mon, 7 Jan 2019 13:04:14 +0100
Subject: [PATCH 02/13] [CO-446] Fix fee sanity check

The main idea here is to relocate this check to be done during fee
calculation. After adjusting fees, we simply verify that actual fees are
somewhere close to the original estimation. If not, we throw hard and
call that an invariant violation. This is a security measure as we do
not expect such deviation from the original estimation. We may have to
pick some extra inputs to cover for fees but if done in such way that
the fees are more than double, we should better run the fee calculation
on a different selection.

This commits also removes some tests from the Spec/GetTransactions
module that are now redundant with the checks occuring in
Spec/CoinSelection.
---
 .../Kernel/CoinSelection/FromGeneric.hs       |  19 +--
 .../Wallet/Kernel/CoinSelection/Generic.hs    |   4 +
 .../Kernel/CoinSelection/Generic/Fees.hs      |  80 +++++++++--
 .../src/Cardano/Wallet/Kernel/Transactions.hs |  17 +--
 .../Wallet/WalletLayer/Kernel/Active.hs       |   2 +-
 .../test/unit/Test/Spec/CoinSelection.hs      |  97 +++++--------
 .../Test/Spec/CoinSelection/Generators.hs     |  16 +++
 .../test/unit/Test/Spec/GetTransactions.hs    | 130 +-----------------
 wallet-new/test/unit/Test/Spec/NewPayment.hs  |  13 +-
 9 files changed, 142 insertions(+), 236 deletions(-)

diff --git a/wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/FromGeneric.hs b/wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/FromGeneric.hs
index 43ac4633052..1282f0988d0 100644
--- a/wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/FromGeneric.hs
+++ b/wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/FromGeneric.hs
@@ -18,7 +18,6 @@ module Cardano.Wallet.Kernel.CoinSelection.FromGeneric (
   , largestFirst
     -- * Estimating fees
   , estimateCardanoFee
-  , checkCardanoFeeSanity
   , boundAddrAttrSize
   , boundTxAttrSize
     -- * Estimating transaction limits
@@ -44,7 +43,7 @@ import           Pos.Chain.Txp as Core (TxIn, TxOutAux, Utxo, toaOut,
 import           Pos.Core as Core (AddrAttributes, Address, Coin (..),
                      TxSizeLinear, addCoin, calculateTxSizeLinear, checkCoin,
                      divCoin, isRedeemAddress, maxCoinVal, mkCoin, subCoin,
-                     txSizeLinearMinValue, unsafeMulCoin, unsafeSubCoin)
+                     unsafeSubCoin)
 
 import           Pos.Core.Attributes (Attributes)
 import           Pos.Crypto (Signature)
@@ -147,8 +146,6 @@ data InputGrouping =
 data CoinSelectionOptions = CoinSelectionOptions {
       csoEstimateFee       :: Int -> NonEmpty Core.Coin -> Core.Coin
     -- ^ A function to estimate the fees.
-    , csoFeesSanityCheck   :: Core.Coin -> Bool
-    -- ^ A function we can use to check if fees are not too big or too small.
     , csoInputGrouping     :: InputGrouping
     -- ^ A preference regarding input grouping.
     , csoExpenseRegulation :: ExpenseRegulation
@@ -162,10 +159,9 @@ data CoinSelectionOptions = CoinSelectionOptions {
 -- | Creates new 'CoinSelectionOptions' using 'NoGrouping' as default
 -- 'InputGrouping' and 'SenderPaysFee' as default 'ExpenseRegulation'.
 newOptions :: (Int -> NonEmpty Core.Coin -> Core.Coin)
-           -> (Core.Coin -> Bool) -> CoinSelectionOptions
-newOptions estimateFee check = CoinSelectionOptions {
+           -> CoinSelectionOptions
+newOptions estimateFee = CoinSelectionOptions {
       csoEstimateFee       = estimateFee
-    , csoFeesSanityCheck   = check
     , csoInputGrouping     = IgnoreGrouping
     , csoExpenseRegulation = SenderPaysFee
     , csoDustThreshold     = Core.mkCoin 0
@@ -396,15 +392,6 @@ estimateCardanoFee linearFeePolicy ins outs
     = ceiling $ calculateTxSizeLinear linearFeePolicy
               $ hi $ estimateSize boundAddrAttrSize boundTxAttrSize ins outs
 
-checkCardanoFeeSanity :: TxSizeLinear -> Coin -> Bool
-checkCardanoFeeSanity linearFeePolicy fees =
-    let
-        maxCoeff :: Int = 2
-        minFees = Core.mkCoin $ floor $ txSizeLinearMinValue linearFeePolicy
-    in
-        (fees >= minFees) && (fees <= Core.unsafeMulCoin minFees maxCoeff)
-
-
 -- | Size to use for a value of type @Attributes AddrAttributes@ when estimating
 --   encoded transaction sizes. The minimum possible value is 2.
 --
diff --git a/wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/Generic.hs b/wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/Generic.hs
index 4579e6bee9e..eb32e33facb 100644
--- a/wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/Generic.hs
+++ b/wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/Generic.hs
@@ -12,6 +12,7 @@ module Cardano.Wallet.Kernel.CoinSelection.Generic (
   , Rounding(..)
   , Fee(..)
   , adjustFee
+  , valueSum
   , unsafeFeeSum
   , utxoEntryVal
   , sizeOfEntries
@@ -156,6 +157,9 @@ newtype Fee dom = Fee { getFee :: Value dom }
 adjustFee :: (Value dom -> Value dom) -> Fee dom -> Fee dom
 adjustFee f = Fee . f . getFee
 
+valueSum :: CoinSelDom dom => [Value dom] -> Maybe (Value dom)
+valueSum = foldM valueAdd valueZero
+
 unsafeFeeSum :: CoinSelDom dom => [Fee dom] -> Fee dom
 unsafeFeeSum = Fee . unsafeValueSum . map getFee
 
diff --git a/wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/Generic/Fees.hs b/wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/Generic/Fees.hs
index 6fe5eda8a74..c6bf5d57424 100644
--- a/wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/Generic/Fees.hs
+++ b/wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/Generic/Fees.hs
@@ -97,15 +97,33 @@ adjustForFees feeOptions pickUtxo css = do
           SenderPaysFee ->
             senderPaysFee pickUtxo feeOptions inps outs chgs
 
-    let neInps = case inps' of
-            []   -> error "adjustForFees: empty list of inputs"
-            i:is -> i :| is
-
-    let neOuts = case outs' of
-            []   -> error "adjustForFees: empty list of outputs"
-            o:os -> o :| os
-
-    return $ CoinSelFinalResult neInps neOuts chgs'
+    let estimatedFee = getFee $ feeUpperBound feeOptions inps outs chgs
+    let actualFee = getFee $ computeFee inps' outs' chgs'
+    -- NOTE
+    -- We enforce the following invariant:
+    --
+    --   estimatedFee < actualFee < 2 * estimatedFee
+    --
+    -- This coefficient (2*...) is mostly taken out of nowhere, but if anything
+    -- go beyond that upper bound, we would know that our algorithm for fee
+    -- reconciliation below is messed up.
+    -- Similarly, the algorithm tries to take money from inputs until it reaches
+    -- the goal fixed by 'estimatedFee'. So, the actualFee just can't be lower
+    -- than the goal.
+    --
+    -- (PS: using `valueDiv` instead of `valueMul` to avoid overflow)
+    if (actualFee < estimatedFee || actualFee `valueDiv` 2 > estimatedFee) then
+        error $ "adjustForFees: fee out of bounds: " <> pretty actualFee <> " while expecting ~" <> pretty estimatedFee
+    else do
+        let neInps = case inps' of
+                []   -> error "adjustForFees: empty list of inputs"
+                i:is -> i :| is
+
+        let neOuts = case outs' of
+                []   -> error "adjustForFees: empty list of outputs"
+                o:os -> o :| os
+
+        return $ CoinSelFinalResult neInps neOuts chgs'
 
 
 {-------------------------------------------------------------------------------
@@ -281,6 +299,50 @@ feeUpperBound FeeOptions{..} inps outs chgs =
     numInputs = fromIntegral $ sizeToWord $ selectedSize $ foldr' select emptySelection inps
     outputs = map outVal outs <> chgs
 
+-- Computing actual fee is a bit tricky in the generic realm because we don't
+-- know what type representation is used by the underlying implementation. So,
+-- we can't just sum up all the input and substract the sub of all outputs
+-- (incl. change) because we'll risk an overflow with each sum. Instead, we
+-- reduce the input value iteratively, coin by coin using a safe distance
+-- between coins that are known to be within bounds.
+-- The algorithm converge because we know that by construction, there are less
+-- outputs than inputs. In essence, this computes:
+--
+--     fees = ∑ inputs - (∑ outputs + ∑ changes)
+computeFee
+    :: forall dom. (CoinSelDom dom)
+    => [UtxoEntry dom]
+    -> [Output dom]
+    -> [Value dom]
+    -> Fee dom
+computeFee inps outs chgs =
+    Fee $ collapse (map utxoEntryVal inps) (filter (> valueZero) $ map outVal outs <> chgs)
+  where
+    invariantViolation msg = error $ "invariant violation: " <> msg
+        <> "\n  inps: " <> show (pretty . utxoEntryOut <$> inps)
+        <> "\n  outs: " <> show (pretty <$> outs)
+        <> "\n  chgs: " <> show (pretty <$> chgs)
+
+    -- Some remaining inputs together. At this point, we've removed
+    -- all outputs and changes, so what's left are simply the actual fees.
+    -- It's unrealistic to imagine them being bigger than the max coin value.
+    collapse plus [] = case valueSum plus of
+        Nothing -> invariantViolation "fees are bigger than max coin value"
+        Just a  -> a
+
+    -- In order to safely compute fees at this level, we need make sure we don't
+    -- overflow. Therefore, we remove outputs to inputs until there's no outputs
+    -- left to remove.
+    collapse (p:ps) (m:ms)
+        | p > m     = let p' = valueDist p m in collapse (p':ps) ms
+        | p < m     = let m' = valueDist p m in collapse ps (m':ms)
+        | otherwise = collapse ps ms
+
+    -- This branch can only happens if we've depleted all our inputs and there
+    -- are still some outputs left to remove from them. If means the total value
+    -- of outputs (incl. change) was bigger than the total input value which is
+    -- by definition, impossible; unless we messed up real hard.
+    collapse []  _ = invariantViolation "outputs are bigger than inputs"
 
 -- | divvy fee across outputs, discarding zero-output if any. Returns `Nothing`
 -- when there's no more outputs after filtering, in which case, we just can't
diff --git a/wallet-new/src/Cardano/Wallet/Kernel/Transactions.hs b/wallet-new/src/Cardano/Wallet/Kernel/Transactions.hs
index 1c17373aafa..e36c7bd5574 100644
--- a/wallet-new/src/Cardano/Wallet/Kernel/Transactions.hs
+++ b/wallet-new/src/Cardano/Wallet/Kernel/Transactions.hs
@@ -11,7 +11,6 @@ module Cardano.Wallet.Kernel.Transactions (
     , EstimateFeesError(..)
     , RedeemAdaError(..)
     , cardanoFee
-    , cardanoFeeSanity
     , mkStdTx
     , prepareUnsignedTxWithSources
     , submitSignedTx
@@ -44,8 +43,7 @@ import           Cardano.Crypto.Wallet (DerivationIndex)
 import qualified Cardano.Wallet.Kernel.Addresses as Kernel
 import           Cardano.Wallet.Kernel.CoinSelection.FromGeneric
                      (CoinSelFinalResult (..), CoinSelectionOptions (..),
-                     checkCardanoFeeSanity, estimateCardanoFee,
-                     estimateMaxTxInputs)
+                     estimateCardanoFee, estimateMaxTxInputs)
 import qualified Cardano.Wallet.Kernel.CoinSelection.FromGeneric as CoinSelection
 import           Cardano.Wallet.Kernel.CoinSelection.Generic
                      (CoinSelHardErr (..))
@@ -231,13 +229,8 @@ newUnsignedTransaction ActiveWallet{..} options accountId payees = runExceptT $
     -- that it may change in the future.
     let attributes = def :: TxAttributes
     let tx = UnsignedTx inputs outputs attributes coins
-
-    -- STEP 3: Sanity test. Here we check whether our fees are within a reasonable
-    -- range.
     let fees = computeFeesOfUnsignedTx tx
-    if csoFeesSanityCheck options fees
-    then return (snapshot, tx, fees, availableUtxo)
-    else error $ "fees out of bound " <> show fees
+    return (snapshot, tx, fees, availableUtxo)
   where
     -- Generate an initial seed for the random generator using the hash of
     -- the payees, which ensure that the coin selection (and the fee estimation)
@@ -637,12 +630,6 @@ cardanoFee (TxFeePolicyTxSizeLinear policy) inputs outputs =
 cardanoFee TxFeePolicyUnknown{} _ _ =
     error "cardanoFee: unknown policy"
 
-cardanoFeeSanity :: TxFeePolicy -> Coin -> Bool
-cardanoFeeSanity (TxFeePolicyTxSizeLinear policy) fees =
-    checkCardanoFeeSanity policy fees
-cardanoFeeSanity TxFeePolicyUnknown{} _ =
-    error "cardanoFeeSanity: unknown policy"
-
 {-------------------------------------------------------------------------------
   Ada redemption
 
diff --git a/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Active.hs b/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Active.hs
index 75054b4c773..c85c1a350c5 100644
--- a/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Active.hs
+++ b/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Active.hs
@@ -229,7 +229,7 @@ setupPayment :: Monad m
                                )
 setupPayment policy grouping regulation payment = do
     rootId <- fromRootId wId
-    let opts   = (newOptions (Kernel.cardanoFee policy) (Kernel.cardanoFeeSanity policy)) {
+    let opts   = (newOptions (Kernel.cardanoFee policy)) {
                      csoExpenseRegulation = regulation
                    , csoInputGrouping     = grouping
                    }
diff --git a/wallet-new/test/unit/Test/Spec/CoinSelection.hs b/wallet-new/test/unit/Test/Spec/CoinSelection.hs
index 97a5e9ef518..dd8ed30c383 100644
--- a/wallet-new/test/unit/Test/Spec/CoinSelection.hs
+++ b/wallet-new/test/unit/Test/Spec/CoinSelection.hs
@@ -49,9 +49,10 @@ import           Cardano.Wallet.Kernel.Util.Core (paymentAmount, utxoBalance,
 import           Pos.Crypto.Signing.Safe (fakeSigner)
 import           Test.Pos.Configuration (withProvidedMagicConfig)
 import           Test.Spec.CoinSelection.Generators (InitialBalance (..),
-                     Pay (..), genFiddlyPayees, genFiddlyUtxo, genGroupedUtxo,
-                     genPayee, genPayees, genRedeemPayee,
-                     genUniqueChangeAddress, genUtxoWithAtLeast)
+                     Pay (..), genFiddlyPayees, genFiddlyUtxo,
+                     genFragmentedUtxo, genGroupedUtxo, genPayee, genPayees,
+                     genRedeemPayee, genUniqueChangeAddress,
+                     genUtxoWithAtLeast)
 
 {-# ANN module ("HLint: ignore Reduce duplication" :: Text) #-}
 
@@ -63,15 +64,9 @@ import           Test.Spec.CoinSelection.Generators (InitialBalance (..),
 freeLunch :: Int -> NonEmpty Core.Coin -> Core.Coin
 freeLunch _ _ = Core.mkCoin 0
 
-freeLunchCheck :: Core.Coin -> Bool
-freeLunchCheck c = c == Core.mkCoin 0
-
 -- | The smallest fee possible.
 minFee :: Int -> NonEmpty Core.Coin -> Core.Coin
-minFee _ _ = Core.mkCoin 1
-
-minFeeCheck :: Core.Coin -> Bool
-minFeeCheck c = c == Core.mkCoin 1
+minFee _ outs = Core.mkCoin (fromIntegral $ NE.length outs)
 
 -- | An hopefully-accurate estimate of the Tx fees in Cardano.
 cardanoFee :: Int -> NonEmpty Core.Coin -> Core.Coin
@@ -80,21 +75,10 @@ cardanoFee inputs outputs = Core.mkCoin $
     where
       linearFeePolicy = TxSizeLinear (Coeff 155381) (Coeff 43.946)
 
-cardanoFeeCheck :: Core.Coin -> Bool
-cardanoFeeCheck fees =
-    let
-        minFees = Core.mkCoin 155381
-        maxCoeff :: Int = 2
-    in
-        (fees >= minFees) && (fees <= Core.unsafeMulCoin minFees maxCoeff)
-
 -- | A simple linear fee proportional in the #inputs & #outputs.
 linearFee :: Int -> NonEmpty Core.Coin -> Core.Coin
 linearFee inputsLen outputs = Core.mkCoin (fromIntegral $ inputsLen + length outputs)
 
-linearFeeCheck :: Core.Coin -> Bool
-linearFeeCheck _ = True
-
 -- | For some reason the version of 'QuickCheck' we are using doesn't seem
 -- to export 'withMaxSuccess'.
 withMaxSuccess :: Int -> Spec -> Spec
@@ -503,18 +487,17 @@ payRestrictInputsTo :: ProtocolMagic
                     -> (InitialBalance -> Gen Core.Utxo)
                     -> (Core.Utxo -> Pay -> Gen (NonEmpty Core.TxOut))
                     -> (Int -> NonEmpty Core.Coin -> Core.Coin)
-                    -> (Core.Coin -> Bool)
                     -> (CoinSelectionOptions -> CoinSelectionOptions)
                     -> InitialBalance
                     -> Pay
                     -> Policy
                     -> Gen RunResult
-payRestrictInputsTo pm maxInputs genU genP feeFunction feeSanity adjustOptions bal amount policy =
+payRestrictInputsTo pm maxInputs genU genP feeFunction adjustOptions bal amount policy =
     withProvidedMagicConfig pm $ \genesisConfig _ _ -> do
         utxo  <- genU bal
         payee <- genP utxo amount
         key   <- arbitrary
-        let options = adjustOptions (newOptions feeFunction feeSanity)
+        let options = adjustOptions (newOptions feeFunction)
         res <- policy options
                       maxInputs
                       (fmap Core.TxOutAux payee)
@@ -534,7 +517,6 @@ pay :: ProtocolMagic
     -> (InitialBalance -> Gen Core.Utxo)
     -> (Core.Utxo -> Pay -> Gen (NonEmpty Core.TxOut))
     -> (Int -> NonEmpty Core.Coin -> Core.Coin)
-    -> (Core.Coin -> Bool)
     -> (CoinSelectionOptions -> CoinSelectionOptions)
     -> InitialBalance
     -> Pay
@@ -544,7 +526,6 @@ pay pm = payRestrictInputsTo pm maxNumInputs
 
 payOne :: ProtocolMagic
        -> (Int -> NonEmpty Core.Coin -> Core.Coin)
-       -> (Core.Coin -> Bool)
        -> (CoinSelectionOptions -> CoinSelectionOptions)
        -> InitialBalance
        -> Pay
@@ -556,7 +537,6 @@ payOne pm = pay pm genUtxoWithAtLeast genPayee
 payOne' :: ProtocolMagic
         -> (Core.Utxo -> Pay -> Gen (NonEmpty Core.TxOut))
         -> (Int -> NonEmpty Core.Coin -> Core.Coin)
-        -> (Core.Coin -> Bool)
         -> (CoinSelectionOptions -> CoinSelectionOptions)
         -> InitialBalance
         -> Pay
@@ -566,7 +546,6 @@ payOne' pm payeeGenerator = pay pm genUtxoWithAtLeast payeeGenerator
 
 payBatch :: ProtocolMagic
          -> (Int -> NonEmpty Core.Coin -> Core.Coin)
-         -> (Core.Coin -> Bool)
          -> (CoinSelectionOptions -> CoinSelectionOptions)
          -> InitialBalance
          -> Pay
@@ -591,65 +570,65 @@ spec =
     describe "Coin selection policies unit tests" $ do
         withMaxSuccess 1000 $ describe "largestFirst" $ do
             prop "one payee, SenderPaysFee, fee = 0" $ \pm -> forAll (
-                 payOne pm freeLunch freeLunchCheck identity (InitialLovelace 1000) (PayLovelace 100) largestFirst
+                 payOne pm freeLunch identity (InitialLovelace 1000) (PayLovelace 100) largestFirst
                  ) $ \(utxo, payee, res) -> paymentSucceeded utxo payee res
             prop "one payee, ReceiverPaysFee, fee = 0" $ \pm -> forAll (
-                 payOne pm freeLunch freeLunchCheck receiverPays (InitialLovelace 1000) (PayLovelace 100) largestFirst
+                 payOne pm freeLunch receiverPays (InitialLovelace 1000) (PayLovelace 100) largestFirst
                  ) $ \(utxo, payee, res) -> paymentSucceeded utxo payee res
             prop "multiple payees, SenderPaysFee, fee = 0" $ \pm -> forAll (
-                 payBatch pm freeLunch freeLunchCheck identity (InitialLovelace 1000) (PayLovelace 100) largestFirst
+                 payBatch pm freeLunch identity (InitialLovelace 1000) (PayLovelace 100) largestFirst
                  ) $ \(utxo, payee, res) -> paymentSucceeded utxo payee res
             prop "multiple payees, ReceiverPaysFee, fee = 0" $ \pm -> forAll (
-                 payBatch pm freeLunch freeLunchCheck receiverPays (InitialLovelace 1000) (PayLovelace 100) largestFirst
+                 payBatch pm freeLunch receiverPays (InitialLovelace 1000) (PayLovelace 100) largestFirst
                  ) $ \(utxo, payee, res) -> paymentSucceeded utxo payee res
 
             -- Minimal fee
             prop "one payee, SenderPaysFee, fee = 1 Lovelace" $ \pm -> forAll (
-                payOne pm minFee minFeeCheck identity (InitialLovelace 1000) (PayLovelace 100) largestFirst
+                payOne pm minFee identity (InitialLovelace 1000) (PayLovelace 100) largestFirst
                 ) $ \(utxo, payee, res) -> paymentSucceeded utxo payee res
             prop "one payee, ReceiverPaysFee, fee = 1 Lovelace" $ \pm -> forAll (
-                payOne pm minFee minFeeCheck receiverPays (InitialLovelace 1000) (PayLovelace 100) largestFirst
+                payOne pm minFee receiverPays (InitialLovelace 1000) (PayLovelace 100) largestFirst
                 ) $ \(utxo, payee, res) -> paymentSucceeded utxo payee res
             prop "multiple payees, SenderPaysFee, fee = 1 Lovelace" $ \pm -> forAll (
-                payBatch pm minFee minFeeCheck identity (InitialLovelace 1000) (PayLovelace 100) largestFirst
+                payBatch pm minFee identity (InitialLovelace 1000) (PayLovelace 100) largestFirst
                 ) $ \(utxo, payee, res) -> paymentSucceeded utxo payee res
             prop "multiple payees, ReceiverPaysFee, fee = 1 Lovelace" $ \pm -> forAll (
-                payBatch pm minFee minFeeCheck receiverPays (InitialLovelace 1000) (PayLovelace 100) largestFirst
+                payBatch pm minFee receiverPays (InitialLovelace 1000) (PayLovelace 100) largestFirst
                 ) $ \(utxo, payee, res) -> paymentSucceeded utxo payee res
 
         withMaxSuccess 2000 $ describe "random" $ do
             prop "one payee, SenderPaysFee, fee = 0" $ \pm -> forAll (
-                payOne pm freeLunch freeLunchCheck identity (InitialLovelace 1000) (PayLovelace 100) random
+                payOne pm freeLunch identity (InitialLovelace 1000) (PayLovelace 100) random
                 ) $ \(utxo, payee, res) -> paymentSucceeded utxo payee res
             prop "one payee, ReceiverPaysFee, fee = 0" $ \pm -> forAll (
-                payOne pm freeLunch freeLunchCheck receiverPays (InitialLovelace 1000) (PayLovelace 100) random
+                payOne pm freeLunch receiverPays (InitialLovelace 1000) (PayLovelace 100) random
                 ) $ \(utxo, payee, res) -> paymentSucceeded utxo payee res
             prop "multiple payees, SenderPaysFee, fee = 0" $ \pm -> forAll (
-                payBatch pm freeLunch freeLunchCheck identity (InitialLovelace 1000) (PayLovelace 100) random
+                payBatch pm freeLunch identity (InitialLovelace 1000) (PayLovelace 100) random
                 ) $ \(utxo, payee, res) -> paymentSucceeded utxo payee res
             prop "multiple payees, ReceiverPaysFee, fee = 0" $ \pm -> forAll (
-                payBatch pm freeLunch freeLunchCheck receiverPays (InitialLovelace 1000) (PayLovelace 100) random
+                payBatch pm freeLunch receiverPays (InitialLovelace 1000) (PayLovelace 100) random
                 ) $ \(utxo, payee, res) -> paymentSucceeded utxo payee res
 
             -- minimal fee. It doesn't make sense to use it for 'ReceiverPaysFee', because
             -- rounding will essentially cause the computed @epsilon@ will be 0 for each
             -- output. For those cases, we use the 'linear' fee policy.
             prop "one payee, SenderPaysFee, fee = 1 Lovelace" $ \pm -> forAll (
-                payOne pm minFee minFeeCheck identity (InitialLovelace 1000) (PayLovelace 100) random
+                payOne pm minFee identity (InitialLovelace 1000) (PayLovelace 100) random
                 ) $ \(utxo, payee, res) ->
                   paymentSucceededWith utxo payee res [feeWasPayed SenderPaysFee]
             prop "multiple payees, SenderPaysFee, fee = 1 Lovelace" $ \pm -> forAll (
-                payBatch pm minFee minFeeCheck identity (InitialLovelace 1000) (PayLovelace 100) random
+                payBatch pm minFee identity (InitialLovelace 1000) (PayLovelace 100) random
                 ) $ \(utxo, payee, res) ->
                   paymentSucceededWith utxo payee res [feeWasPayed SenderPaysFee]
 
             -- linear fee
             prop "one payee, ReceiverPaysFee, fee = linear" $ \pm -> forAll (
-                payOne pm linearFee linearFeeCheck receiverPays (InitialLovelace 1000) (PayLovelace 100) random
+                payOne pm linearFee receiverPays (InitialLovelace 1000) (PayLovelace 100) random
                 ) $ \(utxo, payee, res) ->
                   paymentSucceededWith utxo payee res [feeWasPayed ReceiverPaysFee]
             prop "multiple payees, ReceiverPaysFee, fee = linear" $ \pm -> forAll (
-                payBatch pm linearFee linearFeeCheck receiverPays (InitialLovelace 1000) (PayLovelace 100) random
+                payBatch pm linearFee receiverPays (InitialLovelace 1000) (PayLovelace 100) random
                 ) $ \(utxo, payee, res) ->
                   paymentSucceededWith utxo payee res [feeWasPayed ReceiverPaysFee]
 
@@ -659,37 +638,37 @@ spec =
             -- like attributes, and trying to setup syntetic experiments with
             -- less than 1ADA (10^6 lovelaces) is probably counter-productive
             prop "one payee, SenderPaysFee, fee = cardano" $ \pm -> forAll (
-                payOne pm cardanoFee cardanoFeeCheck identity (InitialADA 1000) (PayADA 100) random
+                payOne pm cardanoFee identity (InitialADA 1000) (PayADA 100) random
                 ) $ \(utxo, payee, res) ->
                   paymentSucceededWith utxo payee res [feeWasPayed SenderPaysFee]
             prop "multiple payees, SenderPaysFee, fee = cardano" $ \pm -> forAll (
-                payBatch pm cardanoFee cardanoFeeCheck identity (InitialADA 1000) (PayADA 100) random
+                pay pm genFragmentedUtxo genPayees cardanoFee identity (InitialADA 1000) (PayADA 100) random
                 ) $ \(utxo, payee, res) ->
                   paymentSucceededWith utxo payee res [feeWasPayed SenderPaysFee]
             prop "one payee, ReceiverPaysFee, fee = cardano" $ \pm -> forAll (
-                payOne pm cardanoFee cardanoFeeCheck receiverPays (InitialADA 1000) (PayADA 100) random
+                payOne pm cardanoFee receiverPays (InitialADA 1000) (PayADA 100) random
                 ) $ \(utxo, payee, res) ->
                   paymentSucceededWith utxo payee res [feeWasPayed ReceiverPaysFee]
             prop "multiple payees, ReceiverPaysFee, fee = cardano" $ \pm -> forAll (
-                payBatch pm cardanoFee cardanoFeeCheck receiverPays (InitialADA 1000) (PayADA 100) random
+                payBatch pm cardanoFee receiverPays (InitialADA 1000) (PayADA 100) random
                 ) $ \(utxo, payee, res) ->
                   paymentSucceededWith utxo payee res [feeWasPayed ReceiverPaysFee]
 
         withMaxSuccess 2000 $ describe "Expected failures" $ do
             prop "Paying a redeem address should always be rejected" $ \pm -> forAll (
-                payOne' pm genRedeemPayee linearFee linearFeeCheck receiverPays (InitialLovelace 1000) (PayLovelace 100) random
+                payOne' pm genRedeemPayee linearFee receiverPays (InitialLovelace 1000) (PayLovelace 100) random
                 ) $ \(utxo, payee, res) ->
                   paymentFailedWith utxo payee res [errorWas outputWasRedeem]
             prop "Paying somebody not having enough money should fail" $ \pm -> forAll (
-                payBatch pm linearFee linearFeeCheck receiverPays (InitialLovelace 10) (PayLovelace 100) random
+                payBatch pm linearFee receiverPays (InitialLovelace 10) (PayLovelace 100) random
                 ) $ \(utxo, payee, res) -> do
                   paymentFailedWith utxo payee res [errorWas notEnoughMoney]
             prop "Restricting too much the number of inputs results in an hard error for a single payee" $ \pm -> forAll (
-                payRestrictInputsTo pm 1 genUtxoWithAtLeast genPayee freeLunch freeLunchCheck identity (InitialLovelace 200) (PayLovelace 100) random
+                payRestrictInputsTo pm 1 genUtxoWithAtLeast genPayee freeLunch identity (InitialLovelace 200) (PayLovelace 100) random
                 ) $ \(utxo, payee, res) -> do
                   paymentFailedWith utxo payee res [errorWas maxInputsReached]
             prop "Restricting too much the number of inputs results in an hard error for multiple payees" $ \pm -> forAll (
-                payRestrictInputsTo pm 1 genUtxoWithAtLeast genPayees freeLunch freeLunchCheck identity (InitialLovelace 200) (PayLovelace 100) random
+                payRestrictInputsTo pm 1 genUtxoWithAtLeast genPayees freeLunch identity (InitialLovelace 200) (PayLovelace 100) random
                 ) $ \(utxo, payee, res) -> do
                   paymentFailedWith utxo payee res [errorWas maxInputsReached]
 
@@ -699,11 +678,11 @@ spec =
         -- the average in Cardano.
         withMaxSuccess 200 $ describe "Fiddly Addresses" $ do
             prop "multiple payees, SenderPaysFee, fee = cardano" $ \pm -> forAll (
-                pay pm genFiddlyUtxo genFiddlyPayees cardanoFee cardanoFeeCheck identity (InitialADA 1000) (PayADA 100) random
+                pay pm genFiddlyUtxo genFiddlyPayees cardanoFee identity (InitialADA 1000) (PayADA 100) random
                 ) $ \(utxo, payee, res) ->
                   paymentSucceededWith utxo payee res [feeWasPayed SenderPaysFee]
             prop "multiple payees, ReceiverPaysFee, fee = cardano" $ \pm -> forAll (
-                pay pm genFiddlyUtxo genFiddlyPayees cardanoFee cardanoFeeCheck receiverPays (InitialADA 1000) (PayADA 100) random
+                pay pm genFiddlyUtxo genFiddlyPayees cardanoFee receiverPays (InitialADA 1000) (PayADA 100) random
                 ) $ \(utxo, payee, res) ->
                   paymentSucceededWith utxo payee res [feeWasPayed ReceiverPaysFee]
 
@@ -719,23 +698,23 @@ spec =
         -- the associated inputs paying into the address we just picked.
         withMaxSuccess 2000 $ describe "Input Grouping" $ do
             prop "Require grouping, fee = 0, one big group depletes the Utxo completely" $ \pm -> forAll (
-                pay pm (genGroupedUtxo 1) genPayee freeLunch freeLunchCheck requireGrouping (InitialLovelace 1000) (PayLovelace 10) random
+                pay pm (genGroupedUtxo 1) genPayee freeLunch requireGrouping (InitialLovelace 1000) (PayLovelace 10) random
                 ) $ \(utxo, payee, res) -> do
                   paymentSucceededWith utxo payee res [utxoWasDepleted]
             prop "Require grouping, fee = cardano, one big group depletes the Utxo completely" $ \pm -> forAll (
-                pay pm (genGroupedUtxo 1) genPayee freeLunch freeLunchCheck requireGrouping (InitialADA 1000) (PayADA 10) random
+                pay pm (genGroupedUtxo 1) genPayee freeLunch requireGrouping (InitialADA 1000) (PayADA 10) random
                 ) $ \(utxo, payee, res) -> do
                   paymentSucceededWith utxo payee res [utxoWasDepleted]
             prop "Require grouping, fee = 0, several groups allows the payment to be fullfilled" $ \pm -> forAll (
-                pay pm (genGroupedUtxo 10) genPayee freeLunch freeLunchCheck requireGrouping (InitialLovelace 1000) (PayLovelace 10) random
+                pay pm (genGroupedUtxo 10) genPayee freeLunch requireGrouping (InitialLovelace 1000) (PayLovelace 10) random
                 ) $ \(utxo, payee, res) -> do
                   paymentSucceeded utxo payee res
             prop "Prefer grouping, fee = 0" $ \pm -> forAll (
-                payOne pm freeLunch freeLunchCheck preferGrouping (InitialLovelace 1000) (PayLovelace 10) random
+                payOne pm freeLunch preferGrouping (InitialLovelace 1000) (PayLovelace 10) random
                 ) $ \(utxo, payee, res) -> do
                   paymentSucceeded utxo payee res
             prop "IgnoreGrouping, fee = 0 must not deplete the utxo" $ \pm -> forAll (
-                pay pm (genGroupedUtxo 1) genPayee freeLunch freeLunchCheck ignoreGrouping (InitialLovelace 1000) (PayLovelace 10) random
+                pay pm (genGroupedUtxo 1) genPayee freeLunch ignoreGrouping (InitialLovelace 1000) (PayLovelace 10) random
                 ) $ \(utxo, payee, res) -> do
                   paymentSucceededWith utxo payee res [utxoWasNotDepleted]
 
diff --git a/wallet-new/test/unit/Test/Spec/CoinSelection/Generators.hs b/wallet-new/test/unit/Test/Spec/CoinSelection/Generators.hs
index 9ead2ed9e60..56a3724e827 100644
--- a/wallet-new/test/unit/Test/Spec/CoinSelection/Generators.hs
+++ b/wallet-new/test/unit/Test/Spec/CoinSelection/Generators.hs
@@ -14,6 +14,7 @@ module Test.Spec.CoinSelection.Generators (
     , Pay(..)
     , genUniqueChangeAddress
     , genUtxoWithAtLeast
+    , genFragmentedUtxo
     , genRedeemPayee
     ) where
 
@@ -204,6 +205,21 @@ genUtxoWithAtLeast payment = do
                 , allowRedeemAddresses  = False
             }
 
+-- | Generate a very fragment Utxo with @at least@ the supplied amount of money.
+genFragmentedUtxo :: InitialBalance -> Gen Core.Utxo
+genFragmentedUtxo payment = do
+    let balance       = toLovelaces payment
+        twoPercentOf  = balance `div` 50
+    genUtxo $ StakeGenOptions {
+                  stakeMaxValue         = Just (Core.mkCoin twoPercentOf)
+                , stakeGenerationTarget = AtLeast
+                , stakeNeeded           = Core.mkCoin (toLovelaces payment)
+                , stakeMaxEntries       = Just 1000
+                , fiddlyAddresses       = False
+                , allowRedeemAddresses  = False
+            }
+
+
 {-------------------------------------------------------------------------------
   Dealing with grouping
 -------------------------------------------------------------------------------}
diff --git a/wallet-new/test/unit/Test/Spec/GetTransactions.hs b/wallet-new/test/unit/Test/Spec/GetTransactions.hs
index ac4bd897fb6..4ad86e04718 100644
--- a/wallet-new/test/unit/Test/Spec/GetTransactions.hs
+++ b/wallet-new/test/unit/Test/Spec/GetTransactions.hs
@@ -56,7 +56,6 @@ import           Cardano.Wallet.Kernel.DB.TxMeta
 import qualified Cardano.Wallet.Kernel.DB.Util.IxSet as IxSet
 import           Cardano.Wallet.Kernel.Internal
 import qualified Cardano.Wallet.Kernel.Keystore as Keystore
-import qualified Cardano.Wallet.Kernel.NodeStateAdaptor as Node
 import qualified Cardano.Wallet.Kernel.PrefilterTx as Kernel
 import qualified Cardano.Wallet.Kernel.Read as Kernel
 import qualified Cardano.Wallet.Kernel.Transactions as Kernel
@@ -66,13 +65,12 @@ import           Cardano.Wallet.WalletLayer (ActiveWalletLayer (..),
                      walletPassiveLayer)
 import qualified Cardano.Wallet.WalletLayer as WalletLayer
 import qualified Cardano.Wallet.WalletLayer.Kernel.Accounts as Accounts
-import qualified Cardano.Wallet.WalletLayer.Kernel.Active as Active
 import qualified Cardano.Wallet.WalletLayer.Kernel.Conv as Kernel.Conv
 import           Cardano.Wallet.WalletLayer.Kernel.Transactions (toTransaction)
 
 import qualified Test.Spec.Addresses as Addresses
 import           Test.Spec.CoinSelection.Generators (InitialBalance (..),
-                     Pay (..), genPayeeWithNM, genUtxoWithAtLeast)
+                     Pay (..), genUtxoWithAtLeast)
 import qualified Test.Spec.Fixture as Fixture
 import qualified Test.Spec.NewPayment as NewPayment
 import           TxMetaStorageSpecs (Isomorphic (..), genMeta)
@@ -147,62 +145,6 @@ prepareFixtures nm initialBalance = do
             , fixturePw = pw
         }
 
-prepareUTxoFixtures :: NetworkMagic
-                    -> [Word64]
-                    -> Fixture.GenActiveWalletFixture Fix
-prepareUTxoFixtures nm coins = do
-    let (_, esk) = safeDeterministicKeyGen (B.pack $ replicate 32 0x42) mempty
-    let newRootId = eskToHdRootId nm esk
-    newRoot <- initHdRoot <$> pure newRootId
-                        <*> pure (WalletName "A wallet")
-                        <*> pure NoSpendingPassword
-                        <*> pure AssuranceLevelNormal
-                        <*> (InDb <$> pick arbitrary)
-
-    newAccountId <- HdAccountId newRootId <$> deriveIndex (pick . choose) HdAccountIx HardDerivation
-    utxo <- foldlM (\acc coin -> do
-            newIndex <- deriveIndex (pick . choose) HdAddressIx HardDerivation
-            txIn <- pick $ Core.TxInUtxo <$> arbitrary <*> arbitrary
-            let Just (addr, _) = deriveLvl2KeyPair nm
-                                                (IsBootstrapEraAddr True)
-                                                (ShouldCheckPassphrase True)
-                                                mempty
-                                                esk
-                                                (newAccountId ^. hdAccountIdIx . to getHdAccountIx)
-                                                (getHdAddressIx newIndex)
-            return $ M.insert txIn (TxOutAux (TxOut addr coin)) acc
-        ) M.empty (mkCoin <$> coins)
-    return $ \keystore aw -> do
-        let pw = Kernel.walletPassive aw
-        Keystore.insert (WalletIdHdRnd newRootId) esk keystore
-        let accounts         = Kernel.prefilterUtxo nm newRootId esk utxo
-            hdAccountId      = Kernel.defaultHdAccountId newRootId
-            (Just hdAddress) = Kernel.defaultHdAddress nm esk emptyPassphrase newRootId
-
-        void $ liftIO $ update (pw ^. wallets) (CreateHdWallet newRoot hdAccountId hdAddress accounts)
-        return $ Fix {
-            fixtureHdRootId = newRootId
-          , fixtureHdRoot = newRoot
-          , fixtureAccountId = AccountIdHdRnd newAccountId
-          , fixtureESK = esk
-          , fixtureUtxo = utxo
-          }
-
-withUtxosFixture :: MonadIO m
-                => ProtocolMagic
-                -> [Word64]
-                -> (  Keystore.Keystore
-                    -> WalletLayer.ActiveWalletLayer m
-                    -> Kernel.ActiveWallet
-                    -> Fix
-                    -> IO a
-                    )
-                -> PropertyM IO a
-withUtxosFixture pm coins cc =
-    Fixture.withActiveWalletFixture pm (prepareUTxoFixtures nm coins) cc
-        where
-            nm = makeNetworkMagic pm
-
 withFixture :: MonadIO m
             => ProtocolMagic
             -> InitialBalance
@@ -266,77 +208,9 @@ getAccountBalanceNow pw Fix{..} = do
 constantFee :: Word64 -> Int -> NonEmpty Coin -> Coin
 constantFee c _ _ = mkCoin c
 
-constantFeeCheck :: Word64 -> Coin -> Bool
-constantFeeCheck c c' = mkCoin c == c'
-
 spec :: Spec
 spec = do
     describe "GetTransactions" $ do
-        prop "utxo fixture creates the correct balance" $ withMaxSuccess 10 $
-            monadicIO $ do
-                pm <- pick arbitrary
-                withUtxosFixture @IO pm [1,2,3] $ \_keystore _activeLayer aw f@Fix{..} -> do
-                    let pw = Kernel.walletPassive aw
-                    balance <- getAccountBalanceNow pw f
-                    balance `shouldBe` 6
-
-        prop "sanity tests checks" $ withMaxSuccess 10 $
-            monadicIO $ do
-                pm <- pick arbitrary
-                Fixture.withPassiveWalletFixture @IO pm (return $ \_ -> return ()) $ \_ _ pw _ -> do
-                    policy <- Node.getFeePolicy (pw ^. Kernel.walletNode)
-                    let checker = Kernel.cardanoFeeSanity policy . mkCoin
-                    checker 100 `shouldBe` False
-                    checker 155380 `shouldBe` False
-                    checker 155381 `shouldBe` True
-                    checker 213345 `shouldBe` True
-                    checker (2 * 155381) `shouldBe` True
-                    checker (2 * 155381 + 1) `shouldBe` False
-                    checker 755381 `shouldBe` False
-
-        prop "pay works normally for coin selection with additional utxos and changes" $ withMaxSuccess 10 $
-            monadicIO $ do
-                pm <- pick arbitrary
-                let nm = makeNetworkMagic pm
-                distr <- fmap (\(TxOut addr coin) -> V1.PaymentDistribution (V1.V1 addr) (V1.V1 coin))
-                                <$> pick (genPayeeWithNM nm mempty (PayLovelace 100))
-                withUtxosFixture @IO pm [300, 400, 500, 600, 5000000] $ \_keystore _activeLayer aw f@Fix{..} -> do
-                    let pw = Kernel.walletPassive aw
-                    -- get the balance before the payment.
-                    coinsBefore <- getAccountBalanceNow pw f
-                    -- do the payment
-                    let (AccountIdHdRnd myAccountId) = fixtureAccountId
-                        src = V1.PaymentSource (Kernel.Conv.toRootId fixtureHdRootId)
-                                        (V1.unsafeMkAccountIndex $ getHdAccountIx $ myAccountId ^. hdAccountIdIx)
-                        payment = V1.Payment src distr Nothing Nothing
-                    Right _ <- Active.pay aw emptyPassphrase PreferGrouping SenderPaysFee payment
-                    -- get the balance after the payment.
-                    coinsAfter <- getAccountBalanceNow pw f
-                    -- sanity check.
-                    policy <- Node.getFeePolicy (pw ^. Kernel.walletNode)
-                    let checker = Kernel.cardanoFeeSanity policy . mkCoin
-                    -- payment is very small so difference is almost equa to fees.
-                    coinsBefore - coinsAfter `shouldSatisfy` checker
-
-        prop "estimateFees looks sane for coin selection with additional utxos and changes" $ withMaxSuccess 10 $
-            monadicIO $ do
-                pm <- pick arbitrary
-                let nm = makeNetworkMagic pm
-                distr <- fmap (\(TxOut addr coin) -> V1.PaymentDistribution (V1.V1 addr) (V1.V1 coin))
-                                <$> pick (genPayeeWithNM nm mempty (PayLovelace 100))
-                withUtxosFixture @IO pm [300, 400, 500, 600, 5000000] $ \_keystore _activeLayer aw Fix{..} -> do
-                    let pw = Kernel.walletPassive aw
-                    -- do the payment
-                    let (AccountIdHdRnd myAccountId) = fixtureAccountId
-                        src = V1.PaymentSource (Kernel.Conv.toRootId fixtureHdRootId)
-                                        (V1.unsafeMkAccountIndex $ getHdAccountIx $ myAccountId ^. hdAccountIdIx)
-                        payment = V1.Payment src distr Nothing Nothing
-                    Right c <- Active.estimateFees aw PreferGrouping SenderPaysFee payment
-                    -- sanity check.
-                    policy <- Node.getFeePolicy (pw ^. Kernel.walletNode)
-                    let checker = Kernel.cardanoFeeSanity policy
-                    c `shouldSatisfy` checker
-
         prop "scenario: Layer.CreateAddress -> TxMeta.putTxMeta -> Layer.getTransactions works properly." $ withMaxSuccess 5 $
             monadicIO $ do
                 testMetaSTB <- pick genMeta
@@ -607,7 +481,7 @@ spec = do
 
 payAux :: Kernel.ActiveWallet -> HdAccountId -> NonEmpty (Address, Coin) -> Word64 -> IO (Core.Tx, TxMeta)
 payAux aw hdAccountId payees fees = do
-    let opts = (newOptions (constantFee fees) (constantFeeCheck fees)) {
+    let opts = (newOptions (constantFee fees)) {
                           csoExpenseRegulation = SenderPaysFee
                         , csoInputGrouping = IgnoreGrouping
                         }
diff --git a/wallet-new/test/unit/Test/Spec/NewPayment.hs b/wallet-new/test/unit/Test/Spec/NewPayment.hs
index 2552fafbda6..497258d3646 100644
--- a/wallet-new/test/unit/Test/Spec/NewPayment.hs
+++ b/wallet-new/test/unit/Test/Spec/NewPayment.hs
@@ -149,9 +149,6 @@ withFixture pm initialBalance toPay cc =
 constantFee :: Int -> NonEmpty Coin -> Coin
 constantFee _ _ = mkCoin 10
 
-constantFeeCheck :: Coin -> Bool
-constantFeeCheck c = c == mkCoin 10
-
 -- | Helper function to facilitate payments via the Layer or Servant.
 withPayment :: MonadIO n
             => ProtocolMagic
@@ -202,7 +199,7 @@ spec = describe "NewPayment" $ do
                 pm <- pick arbitrary
                 withFixture @IO pm (InitialADA 10000) (PayLovelace 10) $ \_ _ aw Fixture{..} -> do
                     policy <- Node.getFeePolicy (Kernel.walletPassive aw ^. Kernel.walletNode)
-                    let opts = (newOptions (Kernel.cardanoFee policy) (Kernel.cardanoFeeSanity policy)) {
+                    let opts = (newOptions (Kernel.cardanoFee policy)) {
                                csoExpenseRegulation = SenderPaysFee
                              , csoInputGrouping     = IgnoreGrouping
                              }
@@ -220,7 +217,7 @@ spec = describe "NewPayment" $ do
                 pm <- pick arbitrary
                 withFixture @IO pm (InitialADA 10000) (PayADA 1) $ \_ _ aw Fixture{..} -> do
                     policy <- Node.getFeePolicy (Kernel.walletPassive aw ^. Kernel.walletNode)
-                    let opts = (newOptions (Kernel.cardanoFee policy) (Kernel.cardanoFeeSanity policy)) {
+                    let opts = (newOptions (Kernel.cardanoFee policy)) {
                                csoExpenseRegulation = ReceiverPaysFee
                              , csoInputGrouping     = IgnoreGrouping
                              }
@@ -264,7 +261,7 @@ spec = describe "NewPayment" $ do
                 monadicIO $ do
                     pm <- pick arbitrary
                     withFixture @IO pm (InitialADA 10000) (PayADA 1) $ \_ _ aw Fixture{..} -> do
-                        let opts = (newOptions constantFee constantFeeCheck) {
+                        let opts = (newOptions constantFee) {
                                    csoExpenseRegulation = SenderPaysFee
                                  , csoInputGrouping     = IgnoreGrouping
                                  }
@@ -284,7 +281,7 @@ spec = describe "NewPayment" $ do
                 monadicIO $ do
                     pm <- pick arbitrary
                     withFixture @IO pm (InitialADA 10000) (PayADA 1) $ \_ _ aw Fixture{..} -> do
-                        let opts = (newOptions constantFee constantFeeCheck) {
+                        let opts = (newOptions constantFee) {
                                    csoExpenseRegulation = SenderPaysFee
                                  , csoInputGrouping     = IgnoreGrouping
                                  }
@@ -305,7 +302,7 @@ spec = describe "NewPayment" $ do
                     pm <- pick arbitrary
                     withFixture @IO pm (InitialADA 10000) (PayADA 1) $ \_ _ aw Fixture{..} -> do
                         policy <- Node.getFeePolicy (Kernel.walletPassive aw ^. Kernel.walletNode)
-                        let opts = (newOptions (Kernel.cardanoFee policy) (Kernel.cardanoFeeSanity policy)) {
+                        let opts = (newOptions (Kernel.cardanoFee policy)) {
                                    csoExpenseRegulation = SenderPaysFee
                                  , csoInputGrouping     = IgnoreGrouping
                                  }

From 3cae3f7b3bc843b251458253c7524ead9074941d Mon Sep 17 00:00:00 2001
From: KtorZ <matthias.benkort@gmail.com>
Date: Mon, 7 Jan 2019 13:08:37 +0100
Subject: [PATCH 03/13] [CO-446] Update CHANGELOG.md & bump versions to 2.0.1

---
 CHANGELOG.md                                         | 7 +++++++
 auxx/cardano-sl-auxx.cabal                           | 2 +-
 binary/cardano-sl-binary.cabal                       | 2 +-
 binary/test/cardano-sl-binary-test.cabal             | 2 +-
 chain/cardano-sl-chain.cabal                         | 2 +-
 chain/test/cardano-sl-chain-test.cabal               | 2 +-
 client/cardano-sl-client.cabal                       | 2 +-
 cluster/cardano-sl-cluster.cabal                     | 2 +-
 core/cardano-sl-core.cabal                           | 2 +-
 core/test/cardano-sl-core-test.cabal                 | 2 +-
 crypto/cardano-sl-crypto.cabal                       | 2 +-
 crypto/test/cardano-sl-crypto-test.cabal             | 2 +-
 db/cardano-sl-db.cabal                               | 2 +-
 db/test/cardano-sl-db-test.cabal                     | 2 +-
 explorer/cardano-sl-explorer.cabal                   | 2 +-
 faucet/cardano-sl-faucet.cabal                       | 2 +-
 generator/cardano-sl-generator.cabal                 | 2 +-
 infra/cardano-sl-infra.cabal                         | 2 +-
 infra/test/cardano-sl-infra-test.cabal               | 2 +-
 lib/cardano-sl.cabal                                 | 2 +-
 networking/cardano-sl-networking.cabal               | 2 +-
 node-ipc/cardano-sl-node-ipc.cabal                   | 2 +-
 node/cardano-sl-node.cabal                           | 2 +-
 tools/cardano-sl-tools.cabal                         | 2 +-
 tools/post-mortem/cardano-sl-tools-post-mortem.cabal | 2 +-
 util/cardano-sl-util.cabal                           | 2 +-
 util/test/cardano-sl-util-test.cabal                 | 2 +-
 utxo/cardano-sl-utxo.cabal                           | 2 +-
 wallet-new/cardano-sl-wallet-new.cabal               | 2 +-
 wallet/cardano-sl-wallet.cabal                       | 2 +-
 wallet/test/cardano-sl-wallet-test.cabal             | 2 +-
 x509/cardano-sl-x509.cabal                           | 2 +-
 32 files changed, 38 insertions(+), 31 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 298c4ae27dc..151e8d4e6d7 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,12 @@
 # CHANGELOG
 
+## Cardano SL 2.0.1
+
+### Fixes
+
+- Relocate fee sanity check and make it relative to each transaction (rather than absolute) ([CO-446](https://iohk.myjetbrains.com/youtrack/issue/CO-446) [#3993](https://github.com/input-output-hk/cardano-sl/pull/3993)
+
+
 ## Cardano SL 2.0.0
 
 
diff --git a/auxx/cardano-sl-auxx.cabal b/auxx/cardano-sl-auxx.cabal
index 322638577ca..daad6c7ec18 100644
--- a/auxx/cardano-sl-auxx.cabal
+++ b/auxx/cardano-sl-auxx.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-auxx
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL - Auxx
 description:         Cardano SL - Auxx
 license:             MIT
diff --git a/binary/cardano-sl-binary.cabal b/binary/cardano-sl-binary.cabal
index 0f2c9b37a02..b82cc343efc 100644
--- a/binary/cardano-sl-binary.cabal
+++ b/binary/cardano-sl-binary.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-binary
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL - binary serialization
 description:         This package defines a type class for binary serialization,
                      helpers and instances.
diff --git a/binary/test/cardano-sl-binary-test.cabal b/binary/test/cardano-sl-binary-test.cabal
index 3251f9166cb..d87407f9e37 100644
--- a/binary/test/cardano-sl-binary-test.cabal
+++ b/binary/test/cardano-sl-binary-test.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-binary-test
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL - binary serializarion (tests)
 description:         This package contains test helpers for cardano-sl-binary.
 license:             MIT
diff --git a/chain/cardano-sl-chain.cabal b/chain/cardano-sl-chain.cabal
index 3f97f7f7c98..4f166959a1a 100644
--- a/chain/cardano-sl-chain.cabal
+++ b/chain/cardano-sl-chain.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-chain
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL - transaction processing
 description:         Cardano SL - transaction processing
 license:             MIT
diff --git a/chain/test/cardano-sl-chain-test.cabal b/chain/test/cardano-sl-chain-test.cabal
index c6742705edb..a1509e0ad2a 100644
--- a/chain/test/cardano-sl-chain-test.cabal
+++ b/chain/test/cardano-sl-chain-test.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-chain-test
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL - arbitrary instances for cardano-sl-chain
 description:         Cardano SL - arbitrary instances for cardano-sl-chain
 license:             MIT
diff --git a/client/cardano-sl-client.cabal b/client/cardano-sl-client.cabal
index 5cc74da1b66..2a6124242d9 100644
--- a/client/cardano-sl-client.cabal
+++ b/client/cardano-sl-client.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-client
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL client modules
 description:         Cardano SL client modules
 license:             MIT
diff --git a/cluster/cardano-sl-cluster.cabal b/cluster/cardano-sl-cluster.cabal
index fd3a3db5362..e62f93e9a54 100644
--- a/cluster/cardano-sl-cluster.cabal
+++ b/cluster/cardano-sl-cluster.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-cluster
-version:             2.0.0
+version:             2.0.1
 synopsis:            Utilities to generate and run cluster of nodes
 description:         See README
 homepage:            https://github.com/input-output-hk/cardano-sl/cluster/README.md
diff --git a/core/cardano-sl-core.cabal b/core/cardano-sl-core.cabal
index 5dca127030f..49ade204b89 100644
--- a/core/cardano-sl-core.cabal
+++ b/core/cardano-sl-core.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-core
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL - core
 description:         Cardano SL - core
 license:             MIT
diff --git a/core/test/cardano-sl-core-test.cabal b/core/test/cardano-sl-core-test.cabal
index 1376328dbaf..7ea48af9e7a 100644
--- a/core/test/cardano-sl-core-test.cabal
+++ b/core/test/cardano-sl-core-test.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-core-test
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL - core functionality (tests)
 description:         QuickCheck Arbitrary instances for the Cardano SL core
                      functionality.
diff --git a/crypto/cardano-sl-crypto.cabal b/crypto/cardano-sl-crypto.cabal
index 08d9d2bc053..938a6a083e2 100644
--- a/crypto/cardano-sl-crypto.cabal
+++ b/crypto/cardano-sl-crypto.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-crypto
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL - cryptography primitives
 description:         This package contains cryptography primitives used in Cardano SL.
 license:             MIT
diff --git a/crypto/test/cardano-sl-crypto-test.cabal b/crypto/test/cardano-sl-crypto-test.cabal
index 9acf351e9c3..38440c2b94e 100644
--- a/crypto/test/cardano-sl-crypto-test.cabal
+++ b/crypto/test/cardano-sl-crypto-test.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-crypto-test
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL - arbitrary instances for cardano-sl-crypto
 description:         This package contains arbitrary instances for the cryptography primitives used in Cardano SL.
 license:             MIT
diff --git a/db/cardano-sl-db.cabal b/db/cardano-sl-db.cabal
index 0fd05ffaa0a..39d8957f9aa 100644
--- a/db/cardano-sl-db.cabal
+++ b/db/cardano-sl-db.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-db
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL - basic DB interfaces
 description:         Cardano SL - basic DB interfaces
 license:             MIT
diff --git a/db/test/cardano-sl-db-test.cabal b/db/test/cardano-sl-db-test.cabal
index 4a0edcd845b..b9ee01aafc1 100644
--- a/db/test/cardano-sl-db-test.cabal
+++ b/db/test/cardano-sl-db-test.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-db-test
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL - arbitrary instances for cardano-sl-db
 description:         Cardano SL - arbitrary instances for cardano-sl-db
 license:             MIT
diff --git a/explorer/cardano-sl-explorer.cabal b/explorer/cardano-sl-explorer.cabal
index 90a74be28bf..514838e4f96 100644
--- a/explorer/cardano-sl-explorer.cabal
+++ b/explorer/cardano-sl-explorer.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-explorer
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano explorer
 description:         Please see README.md
 license:             MIT
diff --git a/faucet/cardano-sl-faucet.cabal b/faucet/cardano-sl-faucet.cabal
index 6d510fcd0b2..4575cd1e9bb 100644
--- a/faucet/cardano-sl-faucet.cabal
+++ b/faucet/cardano-sl-faucet.cabal
@@ -1,5 +1,5 @@
 name:           cardano-sl-faucet
-version:        2.0.0
+version:        2.0.1
 description:    Cardano SL - faucet
 license:        MIT
 author:         Ben Ford
diff --git a/generator/cardano-sl-generator.cabal b/generator/cardano-sl-generator.cabal
index 0cacb37568c..5df358e84a4 100644
--- a/generator/cardano-sl-generator.cabal
+++ b/generator/cardano-sl-generator.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-generator
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL - arbitrary data generation
 description:         Cardano SL - arbitrary data generation
 license:             MIT
diff --git a/infra/cardano-sl-infra.cabal b/infra/cardano-sl-infra.cabal
index 2c1a9ba0e08..a0321d066d6 100644
--- a/infra/cardano-sl-infra.cabal
+++ b/infra/cardano-sl-infra.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-infra
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL - infrastructural
 description:         Cardano SL - infrastructural
 license:             MIT
diff --git a/infra/test/cardano-sl-infra-test.cabal b/infra/test/cardano-sl-infra-test.cabal
index da509a3002f..de740362158 100644
--- a/infra/test/cardano-sl-infra-test.cabal
+++ b/infra/test/cardano-sl-infra-test.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-infra-test
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL - generators for cardano-sl-infra
 description:         This package contains generators for the infrastructural data types used in Cardano SL.
 license:             MIT
diff --git a/lib/cardano-sl.cabal b/lib/cardano-sl.cabal
index 3a555e6dd3f..4b67ba0ccf1 100644
--- a/lib/cardano-sl.cabal
+++ b/lib/cardano-sl.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL main implementation
 description:         Please see README.md
 license:             MIT
diff --git a/networking/cardano-sl-networking.cabal b/networking/cardano-sl-networking.cabal
index 3faa736efed..d364570e243 100644
--- a/networking/cardano-sl-networking.cabal
+++ b/networking/cardano-sl-networking.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-networking
-version:             2.0.0
+version:             2.0.1
 license:             MIT
 license-file:        LICENSE
 category:            Network
diff --git a/node-ipc/cardano-sl-node-ipc.cabal b/node-ipc/cardano-sl-node-ipc.cabal
index c0fe74480bc..fe906a337b7 100644
--- a/node-ipc/cardano-sl-node-ipc.cabal
+++ b/node-ipc/cardano-sl-node-ipc.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-node-ipc
-version:             2.0.0
+version:             2.0.1
 license:             MIT
 license-file:        LICENSE
 author:              Michael Bishop
diff --git a/node/cardano-sl-node.cabal b/node/cardano-sl-node.cabal
index 87e3437d03c..60a02b39315 100644
--- a/node/cardano-sl-node.cabal
+++ b/node/cardano-sl-node.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-node
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL simple node executable
 description:         Provides a 'cardano-node-simple' executable which can
                      connect to the Cardano network and act as a full node
diff --git a/tools/cardano-sl-tools.cabal b/tools/cardano-sl-tools.cabal
index 4a9eb90725c..8b735ec6484 100644
--- a/tools/cardano-sl-tools.cabal
+++ b/tools/cardano-sl-tools.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-tools
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL - Tools
 description:         Cardano SL - Tools
 license:             MIT
diff --git a/tools/post-mortem/cardano-sl-tools-post-mortem.cabal b/tools/post-mortem/cardano-sl-tools-post-mortem.cabal
index 7ac22747af0..81a1ffd62b3 100644
--- a/tools/post-mortem/cardano-sl-tools-post-mortem.cabal
+++ b/tools/post-mortem/cardano-sl-tools-post-mortem.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-tools-post-mortem
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL - post-mortem tool
 description:         Cardano SL - post-mortem tool
 license:             MIT
diff --git a/util/cardano-sl-util.cabal b/util/cardano-sl-util.cabal
index 47799a1498b..1191b4a3fd3 100644
--- a/util/cardano-sl-util.cabal
+++ b/util/cardano-sl-util.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-util
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL - general utilities
 description:         This package contains utility functions not specific
                      to Cardano SL which extend 3rd party libraries or implement
diff --git a/util/test/cardano-sl-util-test.cabal b/util/test/cardano-sl-util-test.cabal
index af0f95fc123..e4dba7162e7 100644
--- a/util/test/cardano-sl-util-test.cabal
+++ b/util/test/cardano-sl-util-test.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-util-test
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL - general utilities (tests)
 description:         QuickCheck Arbitrary instances for the Cardano SL general
                      utilities package.
diff --git a/utxo/cardano-sl-utxo.cabal b/utxo/cardano-sl-utxo.cabal
index 8d90bc6bd4a..b55a7e32857 100644
--- a/utxo/cardano-sl-utxo.cabal
+++ b/utxo/cardano-sl-utxo.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-utxo
-version:             2.0.0
+version:             2.0.1
 synopsis:            Abstract definitions of UTxO based accounting
 -- description:
 homepage:            https://github.com/input-output-hk/cardano-sl/#readme
diff --git a/wallet-new/cardano-sl-wallet-new.cabal b/wallet-new/cardano-sl-wallet-new.cabal
index e2f66242448..aa31d5d4e35 100755
--- a/wallet-new/cardano-sl-wallet-new.cabal
+++ b/wallet-new/cardano-sl-wallet-new.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-wallet-new
-version:             2.0.0
+version:             2.0.1
 synopsis:            The Wallet Backend for a Cardano node.
 description:         Please see README.md
 homepage:            https://github.com/input-output-hk/cardano-sl/#readme
diff --git a/wallet/cardano-sl-wallet.cabal b/wallet/cardano-sl-wallet.cabal
index 9113881956a..98eae099253 100644
--- a/wallet/cardano-sl-wallet.cabal
+++ b/wallet/cardano-sl-wallet.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-wallet
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL - wallet
 description:         Cardano SL - wallet
 license:             MIT
diff --git a/wallet/test/cardano-sl-wallet-test.cabal b/wallet/test/cardano-sl-wallet-test.cabal
index e1011e4a085..3c2f123bc7c 100644
--- a/wallet/test/cardano-sl-wallet-test.cabal
+++ b/wallet/test/cardano-sl-wallet-test.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-wallet-test
-version:             2.0.0
+version:             2.0.1
 synopsis:            Cardano SL - wallet (Arbitrary instances)
 description:         QuickCheck Arbitrary instances for the Cardano SL wallet
                      functionality.
diff --git a/x509/cardano-sl-x509.cabal b/x509/cardano-sl-x509.cabal
index d82f39c2a9b..9fa76e037ca 100644
--- a/x509/cardano-sl-x509.cabal
+++ b/x509/cardano-sl-x509.cabal
@@ -1,5 +1,5 @@
 name:                cardano-sl-x509
-version:             2.0.0
+version:             2.0.1
 synopsis:            Tool-suite for generating x509 certificates specialized for RSA with SHA-256
 description:         See README
 homepage:            https://github.com/input-output-hk/cardano-sl/x509/README.md

From d841646f3333982ea1830379dc18015fc1aa916b Mon Sep 17 00:00:00 2001
From: KtorZ <matthias.benkort@gmail.com>
Date: Mon, 7 Jan 2019 13:32:28 +0100
Subject: [PATCH 04/13] [CO-446] Re-generate pkgs/default.nix

---
 pkgs/default.nix | 62 ++++++++++++++++++++++++------------------------
 1 file changed, 31 insertions(+), 31 deletions(-)

diff --git a/pkgs/default.nix b/pkgs/default.nix
index 7573da9ab22..73fc6461959 100644
--- a/pkgs/default.nix
+++ b/pkgs/default.nix
@@ -14772,7 +14772,7 @@ license = stdenv.lib.licenses.bsd3;
 mkDerivation {
 
 pname = "cardano-sl";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../lib;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -15002,7 +15002,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-auxx";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../auxx;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -15144,7 +15144,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-binary";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../binary;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -15243,7 +15243,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-binary-test";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../binary/test;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -15351,7 +15351,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-chain";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../chain;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -15508,7 +15508,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-chain-test";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../chain/test;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -15588,7 +15588,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-client";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../client;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -15690,7 +15690,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-cluster";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../cluster;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -15831,7 +15831,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-core";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../core;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -15964,7 +15964,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-core-test";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../core/test;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -16045,7 +16045,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-crypto";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../crypto;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -16133,7 +16133,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-crypto-test";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../crypto/test;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -16215,7 +16215,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-db";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../db;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -16305,7 +16305,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-db-test";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../db/test;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -16404,7 +16404,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-explorer";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../explorer;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -16600,7 +16600,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-faucet";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../faucet;
 isLibrary = true;
 isExecutable = true;
@@ -16753,7 +16753,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-generator";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../generator;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -16947,7 +16947,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-infra";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../infra;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -17069,7 +17069,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-infra-test";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../infra/test;
 libraryHaskellDepends = [
 async
@@ -17147,7 +17147,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-networking";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../networking;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -17271,7 +17271,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-node";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../node;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -17344,7 +17344,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-node-ipc";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../node-ipc;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -17440,7 +17440,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-tools";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../tools;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -17600,7 +17600,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-tools-post-mortem";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../tools/post-mortem;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -17709,7 +17709,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-util";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../util;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -17838,7 +17838,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-util-test";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../util/test;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -17920,7 +17920,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-utxo";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../utxo;
 libraryHaskellDepends = [
 base
@@ -18038,7 +18038,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-wallet";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../wallet;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -18283,7 +18283,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-wallet-new";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../wallet-new;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"
@@ -18531,7 +18531,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-wallet-test";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../wallet/test;
 libraryHaskellDepends = [
 base
@@ -18576,7 +18576,7 @@ license = stdenv.lib.licenses.mit;
 mkDerivation {
 
 pname = "cardano-sl-x509";
-version = "2.0.0";
+version = "2.0.1";
 src = ./../x509;
 configureFlags = [
 "--ghc-option=-fwarn-redundant-constraints"

From 7828708b97d72dd1d2f9a6e2f4c929e66bb635b0 Mon Sep 17 00:00:00 2001
From: Michael Bishop <michael.bishop@iohk.io>
Date: Fri, 11 Jan 2019 14:38:25 -0400
Subject: [PATCH 05/13] [DEVOPS-1203] configuration.yaml: Bump
 applicationVersion

staging: 19 -> 20
---
 lib/configuration.yaml | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/lib/configuration.yaml b/lib/configuration.yaml
index b4854c63669..da01d8b9c0e 100644
--- a/lib/configuration.yaml
+++ b/lib/configuration.yaml
@@ -14973,7 +14973,7 @@ mainnet_dryrun_wallet_win64: &mainnet_dryrun_wallet_win64
   <<: *mainnet_dryrun_full
   update:
     applicationName: csl-daedalus
-    applicationVersion: 19
+    applicationVersion: 20
     lastKnownBlockVersion:
       bvMajor: 0
       bvMinor: 2
@@ -14983,7 +14983,7 @@ mainnet_dryrun_wallet_macos64: &mainnet_dryrun_wallet_macos64
   <<: *mainnet_dryrun_full
   update:
     applicationName: csl-daedalus
-    applicationVersion: 19
+    applicationVersion: 20
     lastKnownBlockVersion:
       bvMajor: 0
       bvMinor: 2
@@ -14993,7 +14993,7 @@ mainnet_dryrun_wallet_linux64: &mainnet_dryrun_wallet_linux64
   <<: *mainnet_dryrun_full
   update:
     applicationName: csl-daedalus
-    applicationVersion: 19
+    applicationVersion: 20
     lastKnownBlockVersion:
       bvMajor: 0
       bvMinor: 2

From 11d79f7970fb81aafa5e900aa4eaeecff9fc308b Mon Sep 17 00:00:00 2001
From: "iohk-bors[bot]" <iohk-bors[bot]@users.noreply.github.com>
Date: Wed, 9 Jan 2019 17:41:11 +0000
Subject: [PATCH 06/13] Merge #3994

3994: [CDEC-658] simplify threading in block streaming r=avieth a=avieth

If there is a connection problem causing the block streaming conversation to fail even to come up, then the retrieval worker will hang, because the block streaming `TBQueue` will never show `StreamEnd`: this is done in the `finally` clauses of the conversation callbacks _themselves_ rather than the conversation at large (they never started in this case).

The solution in this pull request is to do the queue sourcing (`retrieveBlocks`) as well as the queue sinking (`processBlocks`) from within the conversation callback itself, by way of `concurrently`. If the conversation fails to even come up, then the exception will come through, and the retrieval worker will carry on.

A bit more detail on how this arose: it required a network failure while _streaming_ blocks, rather than just fetching the next one, so it was a bit more rare than might be expected.

I'd like to make a test case for this, but it's difficult, because it requires a network failure at a particular moment. The node must be able to get the header announcements, but the network needs to go down as soon as it attempts to make a connection from streaming blocks.

The first two commits are not strictly related, but I had them around because I need them in order to build cardano-sl as a dependency. I can drop them if somebody really feels strongly that I should, but I'll need to merge them anyway.

https://iohk.myjetbrains.com/youtrack/issue/CDEC-658

Co-authored-by: Alexander Vieth <aovieth@gmail.com>
---
 infra/src/Pos/Infra/Diffusion/Types.hs        |  24 ++-
 lib/src/Pos/Diffusion/Full.hs                 |   5 +-
 lib/src/Pos/Diffusion/Full/Block.hs           | 196 +++++++++---------
 lib/src/Pos/Network/Block/Retrieval.hs        |  15 +-
 lib/test/Test/Pos/Diffusion/BlockSpec.hs      |  13 +-
 networking/cardano-sl-networking.cabal        |  24 ---
 networking/examples/Discovery.hs              | 134 ------------
 .../Network/Discovery/Transport/Kademlia.hs   | 174 ----------------
 networking/src/Ntp/Util.hs                    |  15 +-
 9 files changed, 149 insertions(+), 451 deletions(-)
 delete mode 100644 networking/examples/Discovery.hs
 delete mode 100644 networking/src/Network/Discovery/Transport/Kademlia.hs

diff --git a/infra/src/Pos/Infra/Diffusion/Types.hs b/infra/src/Pos/Infra/Diffusion/Types.hs
index f8207603591..9d08575f502 100644
--- a/infra/src/Pos/Infra/Diffusion/Types.hs
+++ b/infra/src/Pos/Infra/Diffusion/Types.hs
@@ -7,6 +7,8 @@ module Pos.Infra.Diffusion.Types
     , Diffusion (..)
     , hoistDiffusion
     , dummyDiffusionLayer
+    , StreamBlocks (..)
+    , hoistStreamBlocks
     , DiffusionHealth (..)
     ) where
 
@@ -29,6 +31,24 @@ import           Pos.Infra.Diffusion.Subscription.Status (SubscriptionStates,
                      emptySubscriptionStates)
 import           Pos.Infra.Reporting.Health.Types (HealthStatus (..))
 
+-- | How to handle a stream of blocks.
+data StreamBlocks block m t = StreamBlocks
+  { streamBlocksMore :: NonEmpty block -> m (StreamBlocks block m t)
+    -- ^ The server gives a batch of blocks.
+  , streamBlocksDone :: m t
+    -- ^ The server has no more blocks.
+  }
+
+hoistStreamBlocks
+  :: ( Functor n )
+  => (forall x . m x -> n x)
+  -> StreamBlocks block m t
+  -> StreamBlocks block n t
+hoistStreamBlocks nat streamBlocks = streamBlocks
+  { streamBlocksMore = \blks ->
+      fmap (hoistStreamBlocks nat) (nat (streamBlocksMore streamBlocks blks))
+  , streamBlocksDone = nat (streamBlocksDone streamBlocks)
+  }
 
 data DiffusionHealth = DiffusionHealth {
     dhStreamWriteQueue :: !Gauge -- Number of blocks stored in the block stream write queue
@@ -49,7 +69,7 @@ data Diffusion m = Diffusion
                             NodeId
                          -> HeaderHash
                          -> [HeaderHash]
-                         -> ([Block] -> m t)
+                         -> StreamBlocks Block m t
                          -> m (Maybe t)
       -- | This is needed because there's a security worker which will request
       -- tip-of-chain from the network if it determines it's very far behind.
@@ -108,7 +128,7 @@ hoistDiffusion
     -> Diffusion n
 hoistDiffusion nat rnat orig = Diffusion
     { getBlocks = \nid bh hs -> nat $ getBlocks orig nid bh hs
-    , streamBlocks = \nid hh hhs k -> nat $ streamBlocks orig nid hh hhs (rnat . k)
+    , streamBlocks = \nid hh hhs k -> nat $ streamBlocks orig nid hh hhs (hoistStreamBlocks rnat k)
     , requestTip = nat $ (fmap . fmap) nat (requestTip orig)
     , announceBlockHeader = nat . announceBlockHeader orig
     , sendTx = nat . sendTx orig
diff --git a/lib/src/Pos/Diffusion/Full.hs b/lib/src/Pos/Diffusion/Full.hs
index 67e4f0629c3..d35b4137d53 100644
--- a/lib/src/Pos/Diffusion/Full.hs
+++ b/lib/src/Pos/Diffusion/Full.hs
@@ -68,7 +68,8 @@ import           Pos.Infra.Diffusion.Subscription.Status (SubscriptionStates,
                      emptySubscriptionStates)
 import           Pos.Infra.Diffusion.Transport.TCP (bracketTransportTCP)
 import           Pos.Infra.Diffusion.Types (Diffusion (..),
-                     DiffusionHealth (..), DiffusionLayer (..))
+                     DiffusionHealth (..), DiffusionLayer (..),
+                     StreamBlocks (..))
 import           Pos.Infra.Network.Types (Bucket (..), NetworkConfig (..),
                      NodeType, SubscriptionWorker (..), initQueue,
                      topologyHealthStatus, topologyRunKademlia,
@@ -358,7 +359,7 @@ diffusionLayerFullExposeInternals fdconf
                         NodeId
                      -> HeaderHash
                      -> [HeaderHash]
-                     -> ([Block] -> IO t)
+                     -> StreamBlocks Block IO t
                      -> IO (Maybe t)
         streamBlocks = Diffusion.Block.streamBlocks logTrace diffusionHealth logic streamWindow enqueue
 
diff --git a/lib/src/Pos/Diffusion/Full/Block.hs b/lib/src/Pos/Diffusion/Full/Block.hs
index 13ff033409a..b24b374b5a8 100644
--- a/lib/src/Pos/Diffusion/Full/Block.hs
+++ b/lib/src/Pos/Diffusion/Full/Block.hs
@@ -14,8 +14,7 @@ module Pos.Diffusion.Full.Block
 
 import           Universum
 
-import           Control.Concurrent (threadDelay)
-import           Control.Concurrent.Async (cancel)
+import qualified Control.Concurrent.Async as Async
 import qualified Control.Concurrent.STM as Conc
 import           Control.Exception (Exception (..), throwIO)
 import           Control.Lens (to)
@@ -55,7 +54,8 @@ import           Pos.Infra.Communication.Protocol (Conversation (..),
                      MkListeners (..), MsgType (..), NodeId, Origin (..),
                      OutSpecs, constantListeners, recvLimited,
                      waitForConversations, waitForDequeues)
-import           Pos.Infra.Diffusion.Types (DiffusionHealth (..))
+import           Pos.Infra.Diffusion.Types (DiffusionHealth (..),
+                     StreamBlocks (..))
 import           Pos.Infra.Network.Types (Bucket)
 import           Pos.Infra.Util.TimeWarp (nodeIdToAddress)
 import           Pos.Logic.Types (Logic)
@@ -281,78 +281,28 @@ getBlocks logTrace logic recoveryHeadersMessage enqueue nodeId tipHeaderHash che
 data StreamEntry = StreamEnd | StreamBlock !Block
 
 -- | Stream some blocks from the network.
--- Returns Nothing if streaming is disabled by the client or not supported by the peer.
+-- If streaming is not supported by the client or peer, you get 'Nothing'. We
+-- don't fall back to batching because we can't: that method requires having
+-- all of the header hashes for the blocks you desire.
 streamBlocks
     :: forall t .
        Trace IO (Severity, Text)
     -> Maybe DiffusionHealth
     -> Logic IO
-    -> Word32
+    -> Word32 -- ^ Size of stream window. 0 implies 'Nothing' is returned.
     -> EnqueueMsg
     -> NodeId
     -> HeaderHash
     -> [HeaderHash]
-    -> ([Block] -> IO t)
+    -> StreamBlocks Block IO t
     -> IO (Maybe t)
-streamBlocks _        _   _     0            _       _      _         _           _ = return Nothing -- Fallback to batch mode
-streamBlocks logTrace smM logic streamWindow enqueue nodeId tipHeader checkpoints k = do
-    blockChan <- atomically $ Conc.newTBQueue $ fromIntegral streamWindow
-    let batchSize = min 64 streamWindow
-    fallBack <- atomically $ Conc.newTVar False
-    requestVar <- requestBlocks fallBack blockChan
-    r <- processBlocks batchSize 0 [] blockChan `finally` (atomically $ do
-        status <- Conc.readTVar requestVar
-        case status of
-             OQ.PacketAborted -> pure (pure ())
-             OQ.PacketEnqueued -> do
-                 Conc.writeTVar requestVar OQ.PacketAborted
-                 pure (pure ())
-             OQ.PacketDequeued asyncIO -> pure (cancel asyncIO))
-    r' <- atomically $ Conc.readTVar fallBack
-    if r' then pure Nothing
-          else pure $ Just r
+streamBlocks _        _   _     0            _       _      _         _           _ =
+    return Nothing -- Fallback to batch mode
+streamBlocks logTrace smM logic streamWindow enqueue nodeId tipHeader checkpoints streamBlocksK =
+    requestBlocks >>= Async.wait
   where
 
-    processBlocks :: Word32 -> Word32 -> [Block] -> Conc.TBQueue StreamEntry -> IO t
-    processBlocks batchSize !n !blocks blockChan = do
-        streamEntry <- atomically $ Conc.readTBQueue blockChan
-        case streamEntry of
-             StreamEnd         -> k blocks
-             StreamBlock block -> do
-                 let n' = n + 1
-                 when (n' `mod` 256 == 0) $
-                      traceWith logTrace (Debug,
-                           sformat ("Read block "%shortHashF%" difficulty "%int) (headerHash block)
-                                   (block ^. difficultyL))
-                 case smM of
-                      Nothing -> pure ()
-                      Just sm -> liftIO $ Gauge.dec $ dhStreamWriteQueue sm
-
-                 if n' `mod` batchSize == 0
-                     then do
-                         _ <- k (block : blocks)
-                         processBlocks batchSize n' [] blockChan
-                     else
-                         processBlocks batchSize n' (block : blocks) blockChan
-
-    writeStreamEnd :: Conc.TBQueue StreamEntry -> IO ()
-    writeStreamEnd blockChan = writeBlock 1024 blockChan StreamEnd
-
-    -- It is possible that the reader of the TBQueue stops unexpectedly which
-    -- means that we we will have to use a timeout instead of blocking forever
-    -- while attempting to write to a full queue.
-    writeBlock :: Int -> Conc.TBQueue StreamEntry -> StreamEntry -> IO ()
-    writeBlock delay _ _ | delay >= 4000000 = do
-        let msg = "Error write timeout to local reader"
-        traceWith logTrace (Warning, msg)
-        throwM $ DialogUnexpected msg
-    writeBlock delay blockChan b = do
-        isFull <- atomically $ Conc.isFullTBQueue blockChan
-        if isFull
-            then do
-                threadDelay delay
-                writeBlock (delay * 2) blockChan b
-            else atomically $ Conc.writeTBQueue blockChan b
+    batchSize = min 64 streamWindow
 
     mkStreamStart :: [HeaderHash] -> HeaderHash -> MsgStream
     mkStreamStart chain wantedBlock =
@@ -362,39 +312,45 @@ streamBlocks logTrace smM logic streamWindow enqueue nodeId tipHeader checkpoint
         , mssWindow = streamWindow
         }
 
-    requestBlocks :: Conc.TVar Bool -> Conc.TBQueue StreamEntry -> IO (Conc.TVar (OQ.PacketStatus ()))
-    requestBlocks fallBack blockChan = do
-        convMap <- enqueue (MsgRequestBlocks (S.singleton nodeId))
-                            (\_ _ -> (Conversation $ \it -> requestBlocksConversation blockChan it `onException` writeStreamEnd blockChan) :|
-                                      [(Conversation $ \it -> requestBatch fallBack blockChan it `finally` writeStreamEnd blockChan)]
-                                     )
+    -- Enqueue a conversation which will attempt to stream.
+    -- This returns when the conversation is dequeued, or throws an exception
+    -- in case it's aborted or is not enqueued.
+    requestBlocks :: IO (Async.Async (Maybe t))
+    requestBlocks = do
+        convMap <- enqueue
+          (MsgRequestBlocks (S.singleton nodeId))
+          (\_ _ ->  (Conversation $ streamBlocksConversation) :|
+                   [(Conversation $ batchConversation)]
+          )
+        -- Outbound queue guarantees that the map is either size 0 or 1, since
+        -- 'S.singleton nodeId' was given to the enqueue.
         case M.lookup nodeId convMap of
-            Just tvar -> pure tvar
+            Just tvar -> atomically $ do
+                pStatus <- Conc.readTVar tvar
+                case pStatus of
+                    OQ.PacketEnqueued -> Conc.retry
+                    -- Somebody else arborted our call; nothing to do but
+                    -- throw.
+                    OQ.PacketAborted  -> Conc.throwSTM $ DialogUnexpected $ "streamBlocks: aborted"
+                    OQ.PacketDequeued streamThread -> pure streamThread
             -- FIXME shouldn't have to deal with this.
             -- One possible solution: do the block request in response to an
             -- unsolicited header, so that's it's all done in one conversation,
             -- and so there's no need to even track the 'nodeId'.
-            Nothing   -> throwM $ DialogUnexpected $ "requestBlocks did not contact given peer"
-
-    requestBatch
-        :: Conc.TVar Bool
-        -> Conc.TBQueue StreamEntry
-        -> ConversationActions MsgGetBlocks MsgBlock
-        -> IO ()
-    requestBatch fallBack _ _ = do
-        -- The peer doesn't support streaming, we need to fall back to batching but
-        -- the current conversation is unusable since there is no way for us to learn
-        -- which blocks we shall fetch.
-        -- We will always have room to write a singel StreamEnd so there is no need to
-        -- differentiate between normal execution and when we get an expection.
-        atomically $ writeTVar fallBack True
-        return ()
-
-    requestBlocksConversation
-        :: Conc.TBQueue StreamEntry
-        -> ConversationActions MsgStream MsgStreamBlock
-        -> IO ()
-    requestBlocksConversation blockChan conv = do
+            Nothing   -> throwIO $ DialogUnexpected $ "streamBlocks: did not contact given peer"
+
+    -- The peer doesn't support streaming, we need to fall back to batching but
+    -- the current conversation is unusable since there is no way for us to learn
+    -- which blocks we shall fetch.
+    batchConversation
+      :: ConversationActions MsgGetBlocks MsgBlock
+      -> IO (Maybe t)
+    batchConversation _ = pure Nothing
+
+    streamBlocksConversation
+        :: ConversationActions MsgStream MsgStreamBlock
+        -> IO (Maybe t)
+    streamBlocksConversation conv = do
         let newestHash = headerHash tipHeader
         traceWith logTrace (Debug,
             sformat ("streamBlocks: Requesting stream of blocks from "%listJson%" to "%shortHashF)
@@ -402,9 +358,16 @@ streamBlocks logTrace smM logic streamWindow enqueue nodeId tipHeader checkpoint
                      newestHash)
         send conv $ mkStreamStart checkpoints newestHash
         bvd <- Logic.getAdoptedBVData logic
-        retrieveBlocks bvd blockChan conv streamWindow
-        atomically $ Conc.writeTBQueue blockChan StreamEnd
-        return ()
+        -- Two threads are used here: one to pull in blocks, and one to
+        -- call into the application 'StreamBlocks' value. The reason:
+        -- the latter could do a lot of work for each batch, so having another
+        -- thread continually pulling in with a buffer in the middle will
+        -- smooth the traffic.
+        blockChan <- atomically $ Conc.newTBQueue $ fromIntegral streamWindow
+        (_, b) <- Async.concurrently
+          (retrieveBlocks bvd blockChan conv streamWindow)
+          (processBlocks 0 [] blockChan streamBlocksK)
+        pure $ Just b
 
     halfStreamWindow = max 1 $ streamWindow `div` 2
 
@@ -426,15 +389,14 @@ streamBlocks logTrace smM logic streamWindow enqueue nodeId tipHeader checkpoint
             else return $ window - 1
         block <- retrieveBlock bvd conv
         case block of
-             MsgStreamNoBlock t -> do
-                 let msg = sformat ("MsgStreamNoBlock "%stext) t
-                 traceWith logTrace (Warning, msg)
+             MsgStreamNoBlock e -> do
+                 let msg = sformat ("MsgStreamNoBlock "%stext) e
+                 traceWith logTrace (Error, msg)
                  throwM $ DialogUnexpected msg
              MsgStreamEnd -> do
+                 atomically $ Conc.writeTBQueue blockChan StreamEnd
                  traceWith logTrace (Debug, sformat ("Streaming done client-side for node"%build) nodeId)
-                 return ()
              MsgStreamBlock b -> do
-                 -- traceWith logTrace (Debug, sformat ("Read block "%shortHashF) (headerHash b))
                  atomically $ Conc.writeTBQueue blockChan (StreamBlock b)
                  case smM of
                       Nothing -> pure ()
@@ -452,10 +414,44 @@ streamBlocks logTrace smM logic streamWindow enqueue nodeId tipHeader checkpoint
         case blockE of
             Nothing -> do
                 let msg = sformat ("Error retrieving blocks from peer "%build) nodeId
-                traceWith logTrace (Warning, msg)
+                traceWith logTrace (Error, msg)
                 throwM $ DialogUnexpected msg
             Just block -> return block
 
+    processBlocks
+      :: Word32
+      -> [Block]
+      -> Conc.TBQueue StreamEntry
+      -> StreamBlocks Block IO t
+      -> IO t
+    processBlocks n !blocks blockChan k = do
+        streamEntry <- atomically $ Conc.readTBQueue blockChan
+        case streamEntry of
+             StreamEnd         -> case blocks of
+               [] -> streamBlocksDone k
+               (blk:blks) -> do
+                 k' <- streamBlocksMore k (blk :| blks)
+                 streamBlocksDone k'
+             StreamBlock block -> do
+                 -- FIXME this logging stuff should go into the particular
+                 -- 'StreamBlocks' value rather than here.
+                 let n' = n + 1
+                 when (n' `mod` 256 == 0) $
+                      traceWith logTrace (Debug,
+                           sformat ("Read block "%shortHashF%" difficulty "%int) (headerHash block)
+                                   (block ^. difficultyL))
+                 case smM of
+                      Nothing -> pure ()
+                      Just sm -> liftIO $ Gauge.dec $ dhStreamWriteQueue sm
+
+                 if n' `mod` batchSize == 0
+                     then do
+                         k' <- streamBlocksMore k (block :| blocks)
+                         processBlocks n' [] blockChan k'
+                     else
+                         processBlocks n' (block : blocks) blockChan k
+
+
 requestTip
     :: Trace IO (Severity, Text)
     -> Logic IO
diff --git a/lib/src/Pos/Network/Block/Retrieval.hs b/lib/src/Pos/Network/Block/Retrieval.hs
index 394492a1d3e..2b6d7ba44c9 100644
--- a/lib/src/Pos/Network/Block/Retrieval.hs
+++ b/lib/src/Pos/Network/Block/Retrieval.hs
@@ -31,7 +31,7 @@ import           Pos.DB.Block (ClassifyHeaderRes (..), classifyNewHeader,
                      getHeadersOlderExp)
 import qualified Pos.DB.BlockIndex as DB
 import           Pos.Infra.Communication.Protocol (NodeId)
-import           Pos.Infra.Diffusion.Types (Diffusion)
+import           Pos.Infra.Diffusion.Types (Diffusion, StreamBlocks (..))
 import qualified Pos.Infra.Diffusion.Types as Diffusion
 import           Pos.Infra.Recovery.Types (RecoveryHeaderTag)
 import           Pos.Infra.Reporting (reportOrLogE, reportOrLogW)
@@ -374,8 +374,11 @@ streamProcessBlocks genesisConfig txpConfig diffusion nodeId desired checkpoints
                     _ <- dropRecoveryHeaderAndRepeat genesisConfig diffusion nodeId
                     return ()
   where
-    writeCallback :: (TVar (Maybe Block)) -> [Block] -> m ()
-    writeCallback _ [] = return ()
-    writeCallback mostDifficultBlock (block:blocks) = do
-        _ <- atomically $ swapTVar mostDifficultBlock (Just block)
-        handleBlocks genesisConfig txpConfig (OldestFirst (NE.reverse $ block :| blocks)) diffusion
+    writeCallback :: TVar (Maybe Block) -> StreamBlocks Block m ()
+    writeCallback mostDifficultBlock = StreamBlocks
+      { streamBlocksMore = \blks -> do
+          _ <- atomically $ swapTVar mostDifficultBlock (Just (NE.head blks))
+          _ <- handleBlocks genesisConfig txpConfig (OldestFirst (NE.reverse $ blks)) diffusion
+          pure (writeCallback mostDifficultBlock)
+      , streamBlocksDone = pure ()
+      }
diff --git a/lib/test/Test/Pos/Diffusion/BlockSpec.hs b/lib/test/Test/Pos/Diffusion/BlockSpec.hs
index 71434d04995..ab40c726bc1 100644
--- a/lib/test/Test/Pos/Diffusion/BlockSpec.hs
+++ b/lib/test/Test/Pos/Diffusion/BlockSpec.hs
@@ -40,7 +40,8 @@ import           Pos.Diffusion.Full (FullDiffusionConfiguration (..),
                      FullDiffusionInternals (..),
                      RunFullDiffusionInternals (..),
                      diffusionLayerFullExposeInternals)
-import           Pos.Infra.Diffusion.Types as Diffusion (Diffusion (..))
+import           Pos.Infra.Diffusion.Types as Diffusion (Diffusion (..),
+                     StreamBlocks (..))
 import qualified Pos.Infra.Network.Policy as Policy
 import           Pos.Infra.Network.Types (Bucket (..))
 import           Pos.Infra.Reporting.Health.Types (HealthStatus (..))
@@ -213,15 +214,19 @@ blockDownloadStream :: NodeId -> IORef Bool -> IORef [Block] -> (Int -> IO ()) -
 blockDownloadStream serverAddress resultIORef streamIORef setStreamIORef ~(blockHeader, checkpoints) client = do
     setStreamIORef 1
     recvIORef <- newIORef []
-    _ <- Diffusion.streamBlocks client serverAddress blockHeader checkpoints (writeCallback recvIORef)
+    _ <- Diffusion.streamBlocks client serverAddress blockHeader checkpoints (streamBlocksK recvIORef)
 
     expectedBlocks <- readIORef streamIORef
     recvBlocks <- readIORef recvIORef
     writeIORef resultIORef $ expectedBlocks == reverse recvBlocks
     return ()
   where
-    writeCallback recvBlocks !blocks =
-        modifyIORef' recvBlocks (\d -> blocks <> d)
+    streamBlocksK recvBlocks = StreamBlocks
+      { streamBlocksMore = \(!blocks) -> do
+          modifyIORef' recvBlocks (\d -> (NE.toList blocks) <> d)
+          pure (streamBlocksK recvBlocks)
+      , streamBlocksDone = pure ()
+      }
 
 -- Generate a list of n+1 blocks
 generateBlocks :: ProtocolMagic -> Int -> NonEmpty Block
diff --git a/networking/cardano-sl-networking.cabal b/networking/cardano-sl-networking.cabal
index d364570e243..79744db20de 100644
--- a/networking/cardano-sl-networking.cabal
+++ b/networking/cardano-sl-networking.cabal
@@ -16,7 +16,6 @@ Library
   exposed-modules:      Network.QDisc.Fair
 
                         Network.Discovery.Abstract
-                        Network.Discovery.Transport.Kademlia
 
                         Network.Broadcast.OutboundQueue
                         Network.Broadcast.OutboundQueue.Types
@@ -55,7 +54,6 @@ Library
                       , formatting
                       , formatting
                       , hashable
-                      , kademlia
                       , lens
                       , mtl
                       , mtl >= 2.2.1
@@ -82,28 +80,6 @@ Library
                         OverloadedStrings
                         MonadFailDesugaring
 
-executable discovery
-  main-is:              Discovery.hs
-  build-depends:        base >= 4.8 && < 5
-                      , binary
-                      , bytestring
-                      , cardano-sl-networking
-                      , cardano-sl-util
-                      , containers
-                      , contravariant
-                      , network-transport
-                      , network-transport-tcp
-                      , random
-
-  hs-source-dirs:       examples
-  default-language:     Haskell2010
-  ghc-options:          -threaded -Wall
-  default-extensions:   DeriveDataTypeable
-                        DeriveGeneric
-                        GeneralizedNewtypeDeriving
-                        OverloadedStrings
-                        MonadFailDesugaring
-
 executable ping-pong
   main-is:             PingPong.hs
   build-depends:       base >= 4.8 && < 5
diff --git a/networking/examples/Discovery.hs b/networking/examples/Discovery.hs
deleted file mode 100644
index 10746e84c86..00000000000
--- a/networking/examples/Discovery.hs
+++ /dev/null
@@ -1,134 +0,0 @@
-{-# LANGUAGE DeriveGeneric         #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE GADTs                 #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE RankNTypes            #-}
-{-# LANGUAGE RecursiveDo           #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE StandaloneDeriving    #-}
-{-# LANGUAGE TypeApplications      #-}
-{-# LANGUAGE TypeFamilies          #-}
-
-module Main where
-
-import           Control.Concurrent (ThreadId, forkIO, killThread, threadDelay)
-import           Control.Exception (finally, throwIO)
-import           Control.Monad (forM, forM_, when)
-import           Data.Binary
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Char8 as B8
-import           Data.Functor.Contravariant (contramap)
-import qualified Data.Set as S
-import           Data.Void (Void)
-import           GHC.Generics (Generic)
-import           Network.Discovery.Abstract
-import qualified Network.Discovery.Transport.Kademlia as K
-import           Network.Transport (Transport (..))
-import qualified Network.Transport.TCP as TCP
-import           Node
-import           Node.Message.Binary (BinaryP, binaryPacking)
-import           Pos.Util.Trace (stdoutTrace)
-import           System.Environment (getArgs)
-import           System.Random
-
-data Pong = Pong BS.ByteString
-deriving instance Generic Pong
-deriving instance Show Pong
-instance Binary Pong where
-
-type Packing = BinaryP
-
-worker
-    :: NodeId
-    -> StdGen
-    -> NetworkDiscovery K.KademliaDiscoveryErrorCode
-    -> Converse Packing BS.ByteString
-    -> IO ()
-worker anId generator discovery = pingWorker generator
-    where
-    pingWorker
-       :: StdGen
-       -> Converse Packing BS.ByteString
-       -> IO ()
-    pingWorker gen converse = loop gen
-        where
-        loop g = do
-            let (us, gen') = randomR (1000,2000000) g
-            threadDelay us
-            _ <- knownPeers discovery
-            _ <- discoverPeers discovery
-            peerSet <- knownPeers discovery
-            putStrLn $ show anId ++ " has peer set: " ++ show peerSet
-            forM_ (S.toList peerSet) $ \addr -> converseWith converse (NodeId addr) $
-                \_peerData -> Conversation $ \(cactions :: ConversationActions Void Pong) -> do
-                    received <- recv cactions maxBound
-                    case received of
-                        Just (Pong _) -> putStrLn $ show anId ++ " heard PONG from " ++ show addr
-                        Nothing       -> error "Unexpected end of input"
-            loop gen'
-
-listeners
-    :: NodeId
-    -> BS.ByteString
-    -> [Listener Packing BS.ByteString]
-listeners anId peerData = [pongListener]
-    where
-    pongListener :: Listener Packing BS.ByteString
-    pongListener = Listener $ \_ peerId (cactions :: ConversationActions Pong Void) -> do
-        putStrLn $ show anId ++  " heard PING from " ++ show peerId ++ " with peer data " ++ B8.unpack peerData
-        send cactions (Pong "")
-
-makeNode :: Transport
-         -> Int
-         -> IO ThreadId
-makeNode transport i = do
-    let port = 3000 + i
-        host = "127.0.0.1"
-        addr = (host, fromIntegral port)
-        anId = makeId i
-        initialPeer =
-            if i == 0
-            -- First node uses itself as initial peer, else it'll panic because
-            -- its initial peer appears to be down.
-            then K.Peer host (fromIntegral port)
-            else K.Peer host (fromIntegral (port - 1))
-        kademliaConfig = K.KademliaConfiguration addr addr anId
-        prng1 = mkStdGen (2 * i)
-        prng2 = mkStdGen ((2 * i) + 1)
-    putStrLn $ "Starting node " ++ show i
-    forkIO $ node (contramap snd stdoutTrace) (simpleNodeEndPoint transport) (const noReceiveDelay) (const noReceiveDelay)
-                prng1 binaryPacking (B8.pack "my peer data!") defaultNodeEnvironment $ \node' ->
-        NodeAction (listeners . nodeId $ node') $ \converse -> do
-            putStrLn $ "Making discovery for node " ++ show i
-            discovery <- K.kademliaDiscovery kademliaConfig initialPeer (nodeEndPointAddress node')
-            worker (nodeId node') prng2 discovery converse `finally` closeDiscovery discovery
-    where
-    makeId anId
-        | anId < 10 = B8.pack ("node_identifier_0" ++ show anId)
-        | otherwise = B8.pack ("node_identifier_" ++ show anId)
-
-main :: IO ()
-main = do
-
-    args <- getArgs
-    number <- case args of
-        [arg0] | Just number <- read arg0 -> return number
-        _                                 -> error "Input argument must be a number"
-
-    when (number > 99 || number < 1) $ error "Give a number in [1,99]"
-
-    let params = TCP.defaultTCPParameters { TCP.tcpCheckPeerHost = True }
-    transport <- do
-        transportOrError <-
-            TCP.createTransport (TCP.defaultTCPAddr "127.0.0.1" "10128") params
-        either throwIO return transportOrError
-
-    putStrLn $ "Spawning " ++ show number ++ " nodes"
-    nodeThreads <- forM [0..number] (makeNode transport)
-
-    putStrLn "Hit return to stop"
-    _ <- getChar
-
-    putStrLn "Stopping nodes"
-    forM_ nodeThreads killThread
-    closeTransport transport
diff --git a/networking/src/Network/Discovery/Transport/Kademlia.hs b/networking/src/Network/Discovery/Transport/Kademlia.hs
deleted file mode 100644
index b3085a2a546..00000000000
--- a/networking/src/Network/Discovery/Transport/Kademlia.hs
+++ /dev/null
@@ -1,174 +0,0 @@
-{-# LANGUAGE DeriveGeneric       #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Network.Discovery.Transport.Kademlia
-       ( K.Node (..)
-       , K.Peer (..)
-       , KademliaConfiguration (..)
-       , KademliaDiscoveryErrorCode (..)
-       , kademliaDiscovery
-       ) where
-
-import qualified Control.Concurrent.STM as STM
-import qualified Control.Concurrent.STM.TVar as TVar
-import           Control.Monad (forM)
-import           Data.Binary (Binary, decodeOrFail, encode)
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.Map.Strict as M
-import qualified Data.Set as S
-import           Data.Typeable (Typeable)
-import           Data.Word (Word16)
-import           GHC.Generics (Generic)
-import qualified Network.Kademlia as K
-
-import           Network.Discovery.Abstract
-import           Network.Transport
-
--- | Wrapper which provides a 'K.Serialize' instance for any type with a
---   'Binary' instance.
-newtype KSerialize i = KSerialize i
-    deriving (Eq, Ord, Show)
-
-instance Binary i => K.Serialize (KSerialize i) where
-    fromBS bs = case decodeOrFail (BL.fromStrict bs) of
-        Left (_, _, str)         -> Left str
-        Right (unconsumed, _, i) -> Right (KSerialize i, BL.toStrict unconsumed)
-    toBS (KSerialize i) = BL.toStrict . encode $ i
-
--- | Configuration for a Kademlia node.
-data KademliaConfiguration i = KademliaConfiguration {
-      kademliaBindAddress     :: (String, Word16)
-    , kademliaExternalAddress :: (String, Word16)
-    , kademliaId              :: i
-      -- ^ Some value to use as the identifier for this node. To use it, it must
-      --   have a 'Binary' instance. You may want to take a random value, and
-      --   it should serialize to something long enough for your expected
-      --   network size (every node in the network needs a unique id).
-    }
-
--- | Discovery peers using the Kademlia DHT. Nodes in this network will store
---   their (assumed to be TCP transport) 'EndPointAddress'es and send them
---   over the wire on request. NB there are two notions of ID here: the
---   Kademlia IDs, and the 'EndPointAddress'es which are indexed by the former.
---
---   Many side-effects here: a Kademlia instance is created, grabbing a UDP
---   socket and using it to talk to a peer, storing data in the DHT once it has
---   been joined.
-kademliaDiscovery
-    :: forall i .
-       (Binary i, Ord i, Show i)
-    => KademliaConfiguration i
-    -> K.Peer
-    -- ^ A known peer, necessary in order to join the network.
-    --   If there are no other peers in the network, use this node's id.
-    -> EndPointAddress
-    -- ^ Local endpoint address. Will store it in the DHT.
-    -> IO (NetworkDiscovery KademliaDiscoveryErrorCode)
-kademliaDiscovery configuration peer myAddress = do
-    let kid :: KSerialize i
-        kid = KSerialize (kademliaId configuration)
-    -- A Kademlia instance to do the DHT magic.
-    kademliaInst :: K.KademliaInstance (KSerialize i) (KSerialize EndPointAddress)
-        <- K.create (kademliaBindAddress configuration)
-                    (kademliaExternalAddress configuration) kid
-    -- A TVar to cache the set of known peers at the last use of 'discoverPeers'
-    peersTVar :: TVar.TVar (M.Map (K.Node (KSerialize i)) EndPointAddress)
-        <- TVar.newTVarIO $ M.empty
-    let knownPeers' = fmap (S.fromList . M.elems) . TVar.readTVarIO $ peersTVar
-    let discoverPeers' = kademliaDiscoverPeers kademliaInst peersTVar
-    let close' = K.close kademliaInst
-    -- Join the network and store the local 'EndPointAddress'.
-    _ <- kademliaJoinAndUpdate kademliaInst peersTVar peer
-    K.store kademliaInst kid (KSerialize myAddress)
-    pure $ NetworkDiscovery knownPeers' discoverPeers' close'
-
--- | Join a Kademlia network (using a given known node address) and update the
---   known peers cache.
-kademliaJoinAndUpdate
-    :: forall i .
-       ( Binary i, Ord i )
-    => K.KademliaInstance (KSerialize i) (KSerialize EndPointAddress)
-    -> TVar.TVar (M.Map (K.Node (KSerialize i)) EndPointAddress)
-    -> K.Peer
-    -> IO (Either (DiscoveryError KademliaDiscoveryErrorCode) (S.Set EndPointAddress))
-kademliaJoinAndUpdate kademliaInst peersTVar peer = do
-    result <- K.joinNetwork kademliaInst peer
-    case result of
-        K.NodeBanned -> pure $ Left (DiscoveryError KademliaNodeBanned "Node is banned by network")
-        K.IDClash -> pure $ Left (DiscoveryError KademliaIdClash "ID clash in network")
-        K.NodeDown -> pure $ Left (DiscoveryError KademliaInitialPeerDown "Initial peer is down")
-        -- [sic]
-        K.JoinSuccess -> do
-            peerList <- map fst <$> K.dumpPeers kademliaInst
-            -- We have the peers, but we do not have the 'EndPointAddress'es for
-            -- them. We must ask the network for them.
-            endPointAddresses <- fmap (M.mapMaybe id) (kademliaLookupEndPointAddresses kademliaInst M.empty peerList)
-            STM.atomically $ TVar.writeTVar peersTVar endPointAddresses
-            pure $ Right (S.fromList (M.elems endPointAddresses))
-
--- | Update the known peers cache.
---
---   FIXME: error reporting. Should perhaps give a list of all of the errors
---   which occurred.
-kademliaDiscoverPeers
-    :: forall i .
-       ( Binary i, Ord i )
-    => K.KademliaInstance (KSerialize i) (KSerialize EndPointAddress)
-    -> TVar.TVar (M.Map (K.Node (KSerialize i)) EndPointAddress)
-    -> IO (Either (DiscoveryError KademliaDiscoveryErrorCode) (S.Set EndPointAddress))
-kademliaDiscoverPeers kademliaInst peersTVar = do
-    recordedPeers <- TVar.readTVarIO peersTVar
-    currentPeers <- map fst <$> K.dumpPeers kademliaInst
-    -- The idea is to always update the TVar to the set of nodes in allPeers,
-    -- but only lookup the addresses for nodes which are not in the recorded
-    -- set to begin with.
-    currentWithAddresses <- fmap (M.mapMaybe id) (kademliaLookupEndPointAddresses kademliaInst recordedPeers currentPeers)
-    STM.atomically $ TVar.writeTVar peersTVar currentWithAddresses
-    let new = currentWithAddresses `M.difference` recordedPeers
-    pure $ Right (S.fromList (M.elems new))
-
--- | Look up the 'EndPointAddress's for a set of nodes.
---   See 'kademliaLookupEndPointAddress'
-kademliaLookupEndPointAddresses
-    :: forall i .
-       ( Binary i, Ord i )
-    => K.KademliaInstance (KSerialize i) (KSerialize EndPointAddress)
-    -> M.Map (K.Node (KSerialize i)) EndPointAddress
-    -> [K.Node (KSerialize i)]
-    -> IO (M.Map (K.Node (KSerialize i)) (Maybe EndPointAddress))
-kademliaLookupEndPointAddresses kademliaInst recordedPeers currentPeers = do
-    -- TODO do this in parallel, as each one may induce a blocking lookup.
-    endPointAddresses <- forM currentPeers (kademliaLookupEndPointAddress kademliaInst recordedPeers)
-    let assoc :: [(K.Node (KSerialize i), Maybe EndPointAddress)]
-        assoc = zip currentPeers endPointAddresses
-    pure $ M.fromList assoc
-
--- | Look up the 'EndPointAddress' for a given node. The host and port of
---   the node are known, along with its Kademlia identifier, but the
---   'EndPointAddress' cannot be inferred from these things. The DHT stores
---   that 'EndPointAddress' using the node's Kademlia identifier as key, so
---   we look that up in the table. Nodes for which the 'EndPointAddress' is
---   already known are not looked up.
-kademliaLookupEndPointAddress
-    :: forall i .
-       ( Binary i, Ord i )
-    => K.KademliaInstance (KSerialize i) (KSerialize EndPointAddress)
-    -> M.Map (K.Node (KSerialize i)) EndPointAddress
-    -- ^ The current set of recorded peers. We don't lookup an 'EndPointAddress'
-    --   for any of these, we just use the one in the map.
-    -> K.Node (KSerialize i)
-    -> IO (Maybe EndPointAddress)
-kademliaLookupEndPointAddress kademliaInst recordedPeers peer@(K.Node _ nid) =
-    case M.lookup peer recordedPeers of
-        Nothing -> do
-            outcome <- K.lookup kademliaInst nid
-            pure $ case outcome of
-                Nothing                              -> Nothing
-                Just (KSerialize endPointAddress, _) -> Just endPointAddress
-        Just address' -> pure (Just address')
-
-data KademliaDiscoveryErrorCode
-    = KademliaIdClash
-    | KademliaInitialPeerDown
-    | KademliaNodeBanned
-    deriving (Show, Typeable, Generic)
diff --git a/networking/src/Ntp/Util.hs b/networking/src/Ntp/Util.hs
index 5404a41c981..e2fa7553113 100644
--- a/networking/src/Ntp/Util.hs
+++ b/networking/src/Ntp/Util.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP                 #-}
 {-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE GADTs               #-}
@@ -44,10 +45,9 @@ import           Data.These (These (..))
 import           Formatting (sformat, shown, (%))
 import           Network.Socket (AddrInfo,
                      AddrInfoFlag (AI_ADDRCONFIG, AI_PASSIVE),
-                     Family (AF_INET, AF_INET6), PortNumber (..),
-                     SockAddr (..), Socket, SocketOption (ReuseAddr),
-                     SocketType (Datagram), aNY_PORT, addrAddress, addrFamily,
-                     addrFlags, addrSocketType)
+                     Family (AF_INET, AF_INET6), PortNumber, SockAddr (..),
+                     Socket, SocketOption (ReuseAddr), SocketType (Datagram),
+                     addrAddress, addrFamily, addrFlags, addrSocketType)
 import qualified Network.Socket as Socket
 import qualified Network.Socket.ByteString as Socket.ByteString (sendTo)
 
@@ -219,8 +219,13 @@ udpLocalAddresses = do
     let hints = Socket.defaultHints
             { addrFlags = [AI_PASSIVE]
             , addrSocketType = Datagram }
+#if MIN_VERSION_network(2,8,0)
+        port = Socket.defaultPort
+#else
+        port = Socket.aNY_PORT
+#endif
     --                 Hints        Host    Service
-    Socket.getAddrInfo (Just hints) Nothing (Just $ show aNY_PORT)
+    Socket.getAddrInfo (Just hints) Nothing (Just $ show port)
 
 data SendToException
     = NoMatchingSocket

From bdcc9c594a4593cccb13f9c2fa49571e3e5095e0 Mon Sep 17 00:00:00 2001
From: Alexander Vieth <aovieth@gmail.com>
Date: Mon, 14 Jan 2019 13:30:34 -0500
Subject: [PATCH 07/13] pkgs/default.nix

---
 pkgs/default.nix | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/pkgs/default.nix b/pkgs/default.nix
index 73fc6461959..56aba26f41a 100644
--- a/pkgs/default.nix
+++ b/pkgs/default.nix
@@ -17120,7 +17120,6 @@ license = stdenv.lib.licenses.mit;
 , hashable
 , hspec
 , hspec-core
-, kademlia
 , lens
 , mtl
 , mwc-random
@@ -17171,7 +17170,6 @@ containers
 ekg-core
 formatting
 hashable
-kademlia
 lens
 mtl
 network
@@ -17194,7 +17192,6 @@ base
 binary
 bytestring
 cardano-sl-util
-containers
 contravariant
 network-transport
 network-transport-tcp

From ea18f8b6f79ce15a3ae4f1d5e46ccf7b1db90743 Mon Sep 17 00:00:00 2001
From: Alexander Vieth <aovieth@gmail.com>
Date: Mon, 14 Jan 2019 13:50:04 -0500
Subject: [PATCH 08/13] fix download benchmark

---
 lib/bench/Bench/Pos/Diffusion/BlockDownload.hs | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/lib/bench/Bench/Pos/Diffusion/BlockDownload.hs b/lib/bench/Bench/Pos/Diffusion/BlockDownload.hs
index d4b1a1f076f..44a538c3e36 100644
--- a/lib/bench/Bench/Pos/Diffusion/BlockDownload.hs
+++ b/lib/bench/Bench/Pos/Diffusion/BlockDownload.hs
@@ -44,7 +44,7 @@ import           Pos.Diffusion.Full (FullDiffusionConfiguration (..),
                      FullDiffusionInternals (..),
                      RunFullDiffusionInternals (..),
                      diffusionLayerFullExposeInternals)
-import           Pos.Infra.Diffusion.Types as Diffusion (Diffusion (..))
+import           Pos.Infra.Diffusion.Types as Diffusion (Diffusion (..), StreamBlocks (..))
 import qualified Pos.Infra.Network.Policy as Policy
 import           Pos.Infra.Network.Types (Bucket (..))
 import           Pos.Infra.Reporting.Health.Types (HealthStatus (..))
@@ -226,7 +226,10 @@ blockDownloadStream serverAddress setStreamIORef client ~(blockHeader, checkpoin
   where
     numBlocks = batches * 2200
 
-    writeCallback !_ = return ()
+    writeCallback = StreamBlocks
+      { streamBlocksMore = \(!_) -> pure writeCallback
+      , streamBlocksDone = pure ()
+      }
 
 blockDownloadBenchmarks :: NodeId -> (Int -> IO ()) -> Diffusion IO -> [Criterion.Benchmark]
 blockDownloadBenchmarks serverAddress setStreamIORef client =

From b8e8d8e97609573055c00779c8d03954268a3259 Mon Sep 17 00:00:00 2001
From: Alexander Vieth <aovieth@gmail.com>
Date: Mon, 14 Jan 2019 23:21:54 -0500
Subject: [PATCH 09/13] stylish haskell

---
 lib/bench/Bench/Pos/Diffusion/BlockDownload.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/lib/bench/Bench/Pos/Diffusion/BlockDownload.hs b/lib/bench/Bench/Pos/Diffusion/BlockDownload.hs
index 44a538c3e36..3f95bb9df29 100644
--- a/lib/bench/Bench/Pos/Diffusion/BlockDownload.hs
+++ b/lib/bench/Bench/Pos/Diffusion/BlockDownload.hs
@@ -44,7 +44,8 @@ import           Pos.Diffusion.Full (FullDiffusionConfiguration (..),
                      FullDiffusionInternals (..),
                      RunFullDiffusionInternals (..),
                      diffusionLayerFullExposeInternals)
-import           Pos.Infra.Diffusion.Types as Diffusion (Diffusion (..), StreamBlocks (..))
+import           Pos.Infra.Diffusion.Types as Diffusion (Diffusion (..),
+                     StreamBlocks (..))
 import qualified Pos.Infra.Network.Policy as Policy
 import           Pos.Infra.Network.Types (Bucket (..))
 import           Pos.Infra.Reporting.Health.Types (HealthStatus (..))

From 3f2b76f0bbf6d516b36ae017132276b8798d10cd Mon Sep 17 00:00:00 2001
From: Samuel Leathers <samuel.leathers@iohk.io>
Date: Wed, 16 Jan 2019 12:20:29 -0500
Subject: [PATCH 10/13] [DEVOPS-1203] csl-daedalus appversion bump

---
 lib/configuration.yaml | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/lib/configuration.yaml b/lib/configuration.yaml
index da01d8b9c0e..339aa912b50 100644
--- a/lib/configuration.yaml
+++ b/lib/configuration.yaml
@@ -14929,7 +14929,7 @@ testnet_wallet: &testnet_wallet
   <<: *testnet_full
   update: &testnet_wallet_update
     applicationName: csl-daedalus
-    applicationVersion: 5
+    applicationVersion: 6
     lastKnownBlockVersion:
       bvMajor: 0
       bvMinor: 0
@@ -14973,7 +14973,7 @@ mainnet_dryrun_wallet_win64: &mainnet_dryrun_wallet_win64
   <<: *mainnet_dryrun_full
   update:
     applicationName: csl-daedalus
-    applicationVersion: 20
+    applicationVersion: 21
     lastKnownBlockVersion:
       bvMajor: 0
       bvMinor: 2
@@ -14983,7 +14983,7 @@ mainnet_dryrun_wallet_macos64: &mainnet_dryrun_wallet_macos64
   <<: *mainnet_dryrun_full
   update:
     applicationName: csl-daedalus
-    applicationVersion: 20
+    applicationVersion: 21
     lastKnownBlockVersion:
       bvMajor: 0
       bvMinor: 2
@@ -14993,7 +14993,7 @@ mainnet_dryrun_wallet_linux64: &mainnet_dryrun_wallet_linux64
   <<: *mainnet_dryrun_full
   update:
     applicationName: csl-daedalus
-    applicationVersion: 20
+    applicationVersion: 21
     lastKnownBlockVersion:
       bvMajor: 0
       bvMinor: 2

From d5dcd88a572d2dd05bf0057ae2ed182a81ae6d3e Mon Sep 17 00:00:00 2001
From: Marcin Szamotulski <marcin.szamotulski@iohk.io>
Date: Mon, 21 Jan 2019 11:23:34 +0100
Subject: [PATCH 11/13] [CDEC-658] Updated CHANGELOG.md file

---
 CHANGELOG.md | 1 +
 1 file changed, 1 insertion(+)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 151e8d4e6d7..a1e10f97671 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -5,6 +5,7 @@
 ### Fixes
 
 - Relocate fee sanity check and make it relative to each transaction (rather than absolute) ([CO-446](https://iohk.myjetbrains.com/youtrack/issue/CO-446) [#3993](https://github.com/input-output-hk/cardano-sl/pull/3993)
+- Correction to block retrieval concurrency and exception handling, so that it will recover in case of certain network failure conditions. ([CDEC-658](https://iohk.myjetbrains.com/youtrack/issue/CDEC-658) [#3994](https://github.com/input-output-hk/cardano-sl/pull/3994))
 
 
 ## Cardano SL 2.0.0

From 9215325ebc95e1729da3ec5d72a4d31d9515de31 Mon Sep 17 00:00:00 2001
From: Marcin Szamotulski <marcin.szamotulski@iohk.io>
Date: Tue, 22 Jan 2019 16:14:48 +0100
Subject: [PATCH 12/13] [CDEC-658] Change PR link in CHANGELOG.md

---
 CHANGELOG.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index a1e10f97671..d020e2a271e 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -5,7 +5,7 @@
 ### Fixes
 
 - Relocate fee sanity check and make it relative to each transaction (rather than absolute) ([CO-446](https://iohk.myjetbrains.com/youtrack/issue/CO-446) [#3993](https://github.com/input-output-hk/cardano-sl/pull/3993)
-- Correction to block retrieval concurrency and exception handling, so that it will recover in case of certain network failure conditions. ([CDEC-658](https://iohk.myjetbrains.com/youtrack/issue/CDEC-658) [#3994](https://github.com/input-output-hk/cardano-sl/pull/3994))
+- Correction to block retrieval concurrency and exception handling, so that it will recover in case of certain network failure conditions. ([CDEC-658](https://iohk.myjetbrains.com/youtrack/issue/CDEC-658) [#3998](https://github.com/input-output-hk/cardano-sl/pull/3998))
 
 
 ## Cardano SL 2.0.0

From 6a13e2550e13930a28647788131ba20e129b54e7 Mon Sep 17 00:00:00 2001
From: Samuel Leathers <samuel.leathers@iohk.io>
Date: Tue, 22 Jan 2019 14:11:22 -0500
Subject: [PATCH 13/13] [DEVOPS-1219] remove systemTag override

---
 lib/configuration.yaml | 9 ---------
 1 file changed, 9 deletions(-)

diff --git a/lib/configuration.yaml b/lib/configuration.yaml
index 339aa912b50..71efb985145 100644
--- a/lib/configuration.yaml
+++ b/lib/configuration.yaml
@@ -14937,21 +14937,12 @@ testnet_wallet: &testnet_wallet
 
 testnet_wallet_win64: &testnet_wallet_win64
   <<: *testnet_wallet
-  update:
-    <<: *testnet_wallet_update
-    systemTag: win64
 
 testnet_wallet_macos64: &testnet_wallet_macos64
   <<: *testnet_wallet
-  update:
-    <<: *testnet_wallet_update
-    systemTag: macos64
 
 testnet_wallet_linux64: &testnet_wallet_linux64
   <<: *testnet_wallet
-  update:
-    <<: *testnet_wallet_update
-    systemTag: linux
 
 ##############################################################################
 ##                                                                          ##