{-# LANGUAGE TypeApplications #-}

module BtcLsp.Math.OnChain
  ( trySatToMsat,
    tryMsatToSat,
    trySatToMsatT,
    tryMsatToSatT,
    trxDustLimit,
    trxHeadSize,
    trxInSize,
    trxOutSize,
    InQty (..),
    OutQty (..),
    SatPerVbyte (..),
    minFeeRate,
    trxEstSize,
    trxEstFee,
  )
where

import BtcLsp.Data.Type
import BtcLsp.Import.External
import qualified Network.Bitcoin as Btc
import qualified Universum

trySatToMsat ::
  Btc.BTC ->
  Either Failure MSat
trySatToMsat :: BTC -> Either Failure MSat
trySatToMsat =
  (TryFromException BTC MSat -> Failure)
-> Either (TryFromException BTC MSat) MSat -> Either Failure MSat
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FailureInternal -> Failure
FailureInt (FailureInternal -> Failure)
-> (TryFromException BTC MSat -> FailureInternal)
-> TryFromException BTC MSat
-> Failure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FailureInternal
FailureMath (Text -> FailureInternal)
-> (TryFromException BTC MSat -> Text)
-> TryFromException BTC MSat
-> FailureInternal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TryFromException BTC MSat -> Text
forall b a. (Show a, IsString b) => a -> b
Universum.show)
    (Either (TryFromException BTC MSat) MSat -> Either Failure MSat)
-> (BTC -> Either (TryFromException BTC MSat) MSat)
-> BTC
-> Either Failure MSat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from @Word64
          (Word64 -> MSat)
-> (Integer -> Either (TryFromException Integer Word64) Word64)
-> Integer
-> Either (TryFromException Integer MSat) MSat
forall through source target.
('False ~ (source == through), 'False ~ (through == target)) =>
(through -> target)
-> (source -> Either (TryFromException source through) through)
-> source
-> Either (TryFromException source target) target
`composeTryRhs` forall source target.
(TryFrom source target, 'False ~ (source == target)) =>
source -> Either (TryFromException source target) target
tryFrom @Integer
            (Integer -> Either (TryFromException Integer MSat) MSat)
-> (BTC -> Integer)
-> BTC
-> Either (TryFromException BTC MSat) MSat
forall through source target.
('False ~ (source == through), 'False ~ (through == target)) =>
(through -> Either (TryFromException through target) target)
-> (source -> through)
-> source
-> Either (TryFromException source target) target
`composeTryLhs` ((Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000) (Integer -> Integer) -> (BTC -> Integer) -> BTC -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BTC -> Integer
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from)
      )

tryMsatToSat ::
  MSat ->
  Either Failure Btc.BTC
tryMsatToSat :: MSat -> Either Failure BTC
tryMsatToSat =
  (TryFromException MSat BTC -> Failure)
-> Either (TryFromException MSat BTC) BTC -> Either Failure BTC
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FailureInternal -> Failure
FailureInt (FailureInternal -> Failure)
-> (TryFromException MSat BTC -> FailureInternal)
-> TryFromException MSat BTC
-> Failure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FailureInternal
FailureMath (Text -> FailureInternal)
-> (TryFromException MSat BTC -> Text)
-> TryFromException MSat BTC
-> FailureInternal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TryFromException MSat BTC -> Text
forall b a. (Show a, IsString b) => a -> b
Universum.show)
    (Either (TryFromException MSat BTC) BTC -> Either Failure BTC)
-> (MSat -> Either (TryFromException MSat BTC) BTC)
-> MSat
-> Either Failure BTC
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( forall source target.
(TryFrom source target, 'False ~ (source == target)) =>
source -> Either (TryFromException source target) target
tryFrom @Rational @Btc.BTC
          (Rational -> Either (TryFromException Rational BTC) BTC)
-> (MSat -> Rational)
-> MSat
-> Either (TryFromException MSat BTC) BTC
forall through source target.
('False ~ (source == through), 'False ~ (through == target)) =>
(through -> Either (TryFromException through target) target)
-> (source -> through)
-> source
-> Either (TryFromException source target) target
`composeTryLhs` ((Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
100000000000) (Integer -> Rational) -> (MSat -> Integer) -> MSat -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall through source target.
(From source through, From through target,
 'False ~ (source == through), 'False ~ (through == target)) =>
source -> target
via @Word64)
      )

trySatToMsatT ::
  ( Monad m
  ) =>
  Btc.BTC ->
  ExceptT Failure m MSat
trySatToMsatT :: forall (m :: * -> *). Monad m => BTC -> ExceptT Failure m MSat
trySatToMsatT =
  Either Failure MSat -> ExceptT Failure m MSat
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either Failure MSat -> ExceptT Failure m MSat)
-> (BTC -> Either Failure MSat) -> BTC -> ExceptT Failure m MSat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BTC -> Either Failure MSat
trySatToMsat

tryMsatToSatT ::
  ( Monad m
  ) =>
  MSat ->
  ExceptT Failure m Btc.BTC
tryMsatToSatT :: forall (m :: * -> *). Monad m => MSat -> ExceptT Failure m BTC
tryMsatToSatT =
  Either Failure BTC -> ExceptT Failure m BTC
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either Failure BTC -> ExceptT Failure m BTC)
-> (MSat -> Either Failure BTC) -> MSat -> ExceptT Failure m BTC
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MSat -> Either Failure BTC
tryMsatToSat

trxDustLimit :: MSat
trxDustLimit :: MSat
trxDustLimit =
  Word64 -> MSat
MSat (Word64 -> MSat) -> Word64 -> MSat
forall a b. (a -> b) -> a -> b
$ Word64
546 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1000

--
-- NOTE : estimations are for the P2WPKH only
--

trxHeadSize :: Vbyte
trxHeadSize :: Vbyte
trxHeadSize =
  Ratio Natural -> Vbyte
Vbyte (Ratio Natural -> Vbyte) -> Ratio Natural -> Vbyte
forall a b. (a -> b) -> a -> b
$ Natural
105 Natural -> Natural -> Ratio Natural
forall a. Integral a => a -> a -> Ratio a
% Natural
10

trxInSize :: Vbyte
trxInSize :: Vbyte
trxInSize =
  Ratio Natural -> Vbyte
Vbyte Ratio Natural
68

trxOutSize :: Vbyte
trxOutSize :: Vbyte
trxOutSize =
  Ratio Natural -> Vbyte
Vbyte Ratio Natural
31

newtype InQty = InQty
  { InQty -> Natural
unInQty :: Natural
  }
  deriving newtype (InQty -> InQty -> Bool
(InQty -> InQty -> Bool) -> (InQty -> InQty -> Bool) -> Eq InQty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InQty -> InQty -> Bool
$c/= :: InQty -> InQty -> Bool
== :: InQty -> InQty -> Bool
$c== :: InQty -> InQty -> Bool
Eq, Eq InQty
Eq InQty
-> (InQty -> InQty -> Ordering)
-> (InQty -> InQty -> Bool)
-> (InQty -> InQty -> Bool)
-> (InQty -> InQty -> Bool)
-> (InQty -> InQty -> Bool)
-> (InQty -> InQty -> InQty)
-> (InQty -> InQty -> InQty)
-> Ord InQty
InQty -> InQty -> Bool
InQty -> InQty -> Ordering
InQty -> InQty -> InQty
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InQty -> InQty -> InQty
$cmin :: InQty -> InQty -> InQty
max :: InQty -> InQty -> InQty
$cmax :: InQty -> InQty -> InQty
>= :: InQty -> InQty -> Bool
$c>= :: InQty -> InQty -> Bool
> :: InQty -> InQty -> Bool
$c> :: InQty -> InQty -> Bool
<= :: InQty -> InQty -> Bool
$c<= :: InQty -> InQty -> Bool
< :: InQty -> InQty -> Bool
$c< :: InQty -> InQty -> Bool
compare :: InQty -> InQty -> Ordering
$ccompare :: InQty -> InQty -> Ordering
Ord, Int -> InQty -> ShowS
[InQty] -> ShowS
InQty -> String
(Int -> InQty -> ShowS)
-> (InQty -> String) -> ([InQty] -> ShowS) -> Show InQty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InQty] -> ShowS
$cshowList :: [InQty] -> ShowS
show :: InQty -> String
$cshow :: InQty -> String
showsPrec :: Int -> InQty -> ShowS
$cshowsPrec :: Int -> InQty -> ShowS
Show, Integer -> InQty
InQty -> InQty
InQty -> InQty -> InQty
(InQty -> InQty -> InQty)
-> (InQty -> InQty -> InQty)
-> (InQty -> InQty -> InQty)
-> (InQty -> InQty)
-> (InQty -> InQty)
-> (InQty -> InQty)
-> (Integer -> InQty)
-> Num InQty
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> InQty
$cfromInteger :: Integer -> InQty
signum :: InQty -> InQty
$csignum :: InQty -> InQty
abs :: InQty -> InQty
$cabs :: InQty -> InQty
negate :: InQty -> InQty
$cnegate :: InQty -> InQty
* :: InQty -> InQty -> InQty
$c* :: InQty -> InQty -> InQty
- :: InQty -> InQty -> InQty
$c- :: InQty -> InQty -> InQty
+ :: InQty -> InQty -> InQty
$c+ :: InQty -> InQty -> InQty
Num)
  deriving stock ((forall x. InQty -> Rep InQty x)
-> (forall x. Rep InQty x -> InQty) -> Generic InQty
forall x. Rep InQty x -> InQty
forall x. InQty -> Rep InQty x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InQty x -> InQty
$cfrom :: forall x. InQty -> Rep InQty x
Generic)

instance Out InQty

instance From InQty Natural

instance From Natural InQty

newtype OutQty = OutQty
  { OutQty -> Natural
unOutQty :: Natural
  }
  deriving newtype (OutQty -> OutQty -> Bool
(OutQty -> OutQty -> Bool)
-> (OutQty -> OutQty -> Bool) -> Eq OutQty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutQty -> OutQty -> Bool
$c/= :: OutQty -> OutQty -> Bool
== :: OutQty -> OutQty -> Bool
$c== :: OutQty -> OutQty -> Bool
Eq, Eq OutQty
Eq OutQty
-> (OutQty -> OutQty -> Ordering)
-> (OutQty -> OutQty -> Bool)
-> (OutQty -> OutQty -> Bool)
-> (OutQty -> OutQty -> Bool)
-> (OutQty -> OutQty -> Bool)
-> (OutQty -> OutQty -> OutQty)
-> (OutQty -> OutQty -> OutQty)
-> Ord OutQty
OutQty -> OutQty -> Bool
OutQty -> OutQty -> Ordering
OutQty -> OutQty -> OutQty
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OutQty -> OutQty -> OutQty
$cmin :: OutQty -> OutQty -> OutQty
max :: OutQty -> OutQty -> OutQty
$cmax :: OutQty -> OutQty -> OutQty
>= :: OutQty -> OutQty -> Bool
$c>= :: OutQty -> OutQty -> Bool
> :: OutQty -> OutQty -> Bool
$c> :: OutQty -> OutQty -> Bool
<= :: OutQty -> OutQty -> Bool
$c<= :: OutQty -> OutQty -> Bool
< :: OutQty -> OutQty -> Bool
$c< :: OutQty -> OutQty -> Bool
compare :: OutQty -> OutQty -> Ordering
$ccompare :: OutQty -> OutQty -> Ordering
Ord, Int -> OutQty -> ShowS
[OutQty] -> ShowS
OutQty -> String
(Int -> OutQty -> ShowS)
-> (OutQty -> String) -> ([OutQty] -> ShowS) -> Show OutQty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutQty] -> ShowS
$cshowList :: [OutQty] -> ShowS
show :: OutQty -> String
$cshow :: OutQty -> String
showsPrec :: Int -> OutQty -> ShowS
$cshowsPrec :: Int -> OutQty -> ShowS
Show, Integer -> OutQty
OutQty -> OutQty
OutQty -> OutQty -> OutQty
(OutQty -> OutQty -> OutQty)
-> (OutQty -> OutQty -> OutQty)
-> (OutQty -> OutQty -> OutQty)
-> (OutQty -> OutQty)
-> (OutQty -> OutQty)
-> (OutQty -> OutQty)
-> (Integer -> OutQty)
-> Num OutQty
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> OutQty
$cfromInteger :: Integer -> OutQty
signum :: OutQty -> OutQty
$csignum :: OutQty -> OutQty
abs :: OutQty -> OutQty
$cabs :: OutQty -> OutQty
negate :: OutQty -> OutQty
$cnegate :: OutQty -> OutQty
* :: OutQty -> OutQty -> OutQty
$c* :: OutQty -> OutQty -> OutQty
- :: OutQty -> OutQty -> OutQty
$c- :: OutQty -> OutQty -> OutQty
+ :: OutQty -> OutQty -> OutQty
$c+ :: OutQty -> OutQty -> OutQty
Num)
  deriving stock ((forall x. OutQty -> Rep OutQty x)
-> (forall x. Rep OutQty x -> OutQty) -> Generic OutQty
forall x. Rep OutQty x -> OutQty
forall x. OutQty -> Rep OutQty x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OutQty x -> OutQty
$cfrom :: forall x. OutQty -> Rep OutQty x
Generic)

instance Out OutQty

instance From OutQty Natural

instance From Natural OutQty

newtype SatPerVbyte = SatPerVbyte
  { SatPerVbyte -> Ratio Natural
unSatPerVbyte :: Ratio Natural
  }
  deriving newtype (SatPerVbyte -> SatPerVbyte -> Bool
(SatPerVbyte -> SatPerVbyte -> Bool)
-> (SatPerVbyte -> SatPerVbyte -> Bool) -> Eq SatPerVbyte
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SatPerVbyte -> SatPerVbyte -> Bool
$c/= :: SatPerVbyte -> SatPerVbyte -> Bool
== :: SatPerVbyte -> SatPerVbyte -> Bool
$c== :: SatPerVbyte -> SatPerVbyte -> Bool
Eq, Eq SatPerVbyte
Eq SatPerVbyte
-> (SatPerVbyte -> SatPerVbyte -> Ordering)
-> (SatPerVbyte -> SatPerVbyte -> Bool)
-> (SatPerVbyte -> SatPerVbyte -> Bool)
-> (SatPerVbyte -> SatPerVbyte -> Bool)
-> (SatPerVbyte -> SatPerVbyte -> Bool)
-> (SatPerVbyte -> SatPerVbyte -> SatPerVbyte)
-> (SatPerVbyte -> SatPerVbyte -> SatPerVbyte)
-> Ord SatPerVbyte
SatPerVbyte -> SatPerVbyte -> Bool
SatPerVbyte -> SatPerVbyte -> Ordering
SatPerVbyte -> SatPerVbyte -> SatPerVbyte
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SatPerVbyte -> SatPerVbyte -> SatPerVbyte
$cmin :: SatPerVbyte -> SatPerVbyte -> SatPerVbyte
max :: SatPerVbyte -> SatPerVbyte -> SatPerVbyte
$cmax :: SatPerVbyte -> SatPerVbyte -> SatPerVbyte
>= :: SatPerVbyte -> SatPerVbyte -> Bool
$c>= :: SatPerVbyte -> SatPerVbyte -> Bool
> :: SatPerVbyte -> SatPerVbyte -> Bool
$c> :: SatPerVbyte -> SatPerVbyte -> Bool
<= :: SatPerVbyte -> SatPerVbyte -> Bool
$c<= :: SatPerVbyte -> SatPerVbyte -> Bool
< :: SatPerVbyte -> SatPerVbyte -> Bool
$c< :: SatPerVbyte -> SatPerVbyte -> Bool
compare :: SatPerVbyte -> SatPerVbyte -> Ordering
$ccompare :: SatPerVbyte -> SatPerVbyte -> Ordering
Ord, Int -> SatPerVbyte -> ShowS
[SatPerVbyte] -> ShowS
SatPerVbyte -> String
(Int -> SatPerVbyte -> ShowS)
-> (SatPerVbyte -> String)
-> ([SatPerVbyte] -> ShowS)
-> Show SatPerVbyte
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SatPerVbyte] -> ShowS
$cshowList :: [SatPerVbyte] -> ShowS
show :: SatPerVbyte -> String
$cshow :: SatPerVbyte -> String
showsPrec :: Int -> SatPerVbyte -> ShowS
$cshowsPrec :: Int -> SatPerVbyte -> ShowS
Show, Integer -> SatPerVbyte
SatPerVbyte -> SatPerVbyte
SatPerVbyte -> SatPerVbyte -> SatPerVbyte
(SatPerVbyte -> SatPerVbyte -> SatPerVbyte)
-> (SatPerVbyte -> SatPerVbyte -> SatPerVbyte)
-> (SatPerVbyte -> SatPerVbyte -> SatPerVbyte)
-> (SatPerVbyte -> SatPerVbyte)
-> (SatPerVbyte -> SatPerVbyte)
-> (SatPerVbyte -> SatPerVbyte)
-> (Integer -> SatPerVbyte)
-> Num SatPerVbyte
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> SatPerVbyte
$cfromInteger :: Integer -> SatPerVbyte
signum :: SatPerVbyte -> SatPerVbyte
$csignum :: SatPerVbyte -> SatPerVbyte
abs :: SatPerVbyte -> SatPerVbyte
$cabs :: SatPerVbyte -> SatPerVbyte
negate :: SatPerVbyte -> SatPerVbyte
$cnegate :: SatPerVbyte -> SatPerVbyte
* :: SatPerVbyte -> SatPerVbyte -> SatPerVbyte
$c* :: SatPerVbyte -> SatPerVbyte -> SatPerVbyte
- :: SatPerVbyte -> SatPerVbyte -> SatPerVbyte
$c- :: SatPerVbyte -> SatPerVbyte -> SatPerVbyte
+ :: SatPerVbyte -> SatPerVbyte -> SatPerVbyte
$c+ :: SatPerVbyte -> SatPerVbyte -> SatPerVbyte
Num)
  deriving stock ((forall x. SatPerVbyte -> Rep SatPerVbyte x)
-> (forall x. Rep SatPerVbyte x -> SatPerVbyte)
-> Generic SatPerVbyte
forall x. Rep SatPerVbyte x -> SatPerVbyte
forall x. SatPerVbyte -> Rep SatPerVbyte x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SatPerVbyte x -> SatPerVbyte
$cfrom :: forall x. SatPerVbyte -> Rep SatPerVbyte x
Generic)

instance Out SatPerVbyte

instance From SatPerVbyte (Ratio Natural)

instance From (Ratio Natural) SatPerVbyte

minFeeRate :: SatPerVbyte
minFeeRate :: SatPerVbyte
minFeeRate = SatPerVbyte
1

trxEstSize :: InQty -> OutQty -> Vbyte
trxEstSize :: InQty -> OutQty -> Vbyte
trxEstSize InQty
inQty OutQty
outQty =
  Vbyte
trxHeadSize
    Vbyte -> Vbyte -> Vbyte
forall a. Num a => a -> a -> a
+ Ratio Natural -> Vbyte
Vbyte (forall through source target.
(From source through, From through target,
 'False ~ (source == through), 'False ~ (through == target)) =>
source -> target
via @Natural InQty
inQty) Vbyte -> Vbyte -> Vbyte
forall a. Num a => a -> a -> a
* Vbyte
trxInSize
    --
    -- TODO : LND estimator always requires +1 vout as a change
    -- even if change does not exit. So we should overpay
    -- a bit for non-existent output to use LND PSBTs.
    -- https://github.com/lightningnetwork/lnd/issues/5739
    --
    Vbyte -> Vbyte -> Vbyte
forall a. Num a => a -> a -> a
+ Ratio Natural -> Vbyte
Vbyte (forall through source target.
(From source through, From through target,
 'False ~ (source == through), 'False ~ (through == target)) =>
source -> target
via @Natural (OutQty
outQty OutQty -> OutQty -> OutQty
forall a. Num a => a -> a -> a
+ OutQty
1)) Vbyte -> Vbyte -> Vbyte
forall a. Num a => a -> a -> a
* Vbyte
trxOutSize
    --
    -- TODO : For some reason LND estimator
    -- requires +1 vbyte overhead.
    --
    Vbyte -> Vbyte -> Vbyte
forall a. Num a => a -> a -> a
+ Ratio Natural -> Vbyte
Vbyte Ratio Natural
1

trxEstFee ::
  InQty ->
  OutQty ->
  SatPerVbyte ->
  Either (TryFromException Natural MSat) MSat
trxEstFee :: InQty
-> OutQty
-> SatPerVbyte
-> Either (TryFromException Natural MSat) MSat
trxEstFee InQty
inQty OutQty
outQty SatPerVbyte
satPerVbyte =
  (forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from @Word64 (Word64 -> MSat)
-> (Natural -> Either (TryFromException Natural Word64) Word64)
-> Natural
-> Either (TryFromException Natural MSat) MSat
forall through source target.
('False ~ (source == through), 'False ~ (through == target)) =>
(through -> target)
-> (source -> Either (TryFromException source through) through)
-> source
-> Either (TryFromException source target) target
`composeTryRhs` Natural -> Either (TryFromException Natural Word64) Word64
forall source target.
(TryFrom source target, 'False ~ (source == target)) =>
source -> Either (TryFromException source target) target
tryFrom)
    (Natural -> Either (TryFromException Natural MSat) MSat)
-> (Ratio Natural -> Natural)
-> Ratio Natural
-> Either (TryFromException Natural MSat) MSat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
1000)
    (Natural -> Natural)
-> (Ratio Natural -> Natural) -> Ratio Natural -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ratio Natural -> Natural
forall a b. (RealFrac a, Integral b) => a -> b
ceiling :: Ratio Natural -> Natural)
    (Ratio Natural -> Either (TryFromException Natural MSat) MSat)
-> Ratio Natural -> Either (TryFromException Natural MSat) MSat
forall a b. (a -> b) -> a -> b
$ Vbyte -> Ratio Natural
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from (InQty -> OutQty -> Vbyte
trxEstSize InQty
inQty OutQty
outQty) Ratio Natural -> Ratio Natural -> Ratio Natural
forall a. Num a => a -> a -> a
* SatPerVbyte -> Ratio Natural
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from SatPerVbyte
satPerVbyte