{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}

module BtcLsp.Thread.Refunder
  ( apply,
    SendUtxosResult (..),
  )
where

import BtcLsp.Data.Orphan ()
import BtcLsp.Import
import qualified BtcLsp.Import.Psql as Psql
import qualified BtcLsp.Math.OnChain as Math
import BtcLsp.Psbt.Utils
  ( releaseUtxosLocks,
    releaseUtxosPsbtLocks,
    swapUtxoToPsbtUtxo,
  )
import qualified BtcLsp.Storage.Model.SwapIntoLn as SwapIntoLn
import qualified BtcLsp.Storage.Model.SwapUtxo as SwapUtxo
  ( getUtxosForRefundSql,
    updateRefundedSql,
  )
import Data.List (groupBy)
import qualified Data.Map as M
import LndClient (txIdParser)
import qualified LndClient.Data.FinalizePsbt as FNP
import qualified LndClient.Data.FundPsbt as FP
import qualified LndClient.Data.PublishTransaction as PT
import qualified LndClient.RPC.Katip as Lnd
import qualified Network.Bitcoin as Btc
import qualified Network.Bitcoin.Types as Btc

apply :: (Env m) => m ()
apply :: forall (m :: * -> *). Env m => m ()
apply =
  m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    ReaderT SqlBackend m () -> m ()
forall (m :: * -> *) a. Storage m => ReaderT SqlBackend m a -> m a
runSql (ReaderT SqlBackend m () -> m ())
-> ReaderT SqlBackend m () -> m ()
forall a b. (a -> b) -> a -> b
$
      ReaderT SqlBackend m [(Entity SwapUtxo, Entity SwapIntoLn)]
forall (m :: * -> *).
MonadIO m =>
ReaderT SqlBackend m [(Entity SwapUtxo, Entity SwapIntoLn)]
SwapUtxo.getUtxosForRefundSql
        ReaderT SqlBackend m [(Entity SwapUtxo, Entity SwapIntoLn)]
-> ([(Entity SwapUtxo, Entity SwapIntoLn)]
    -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Element [[(Entity SwapUtxo, Entity SwapIntoLn)]]
 -> ReaderT SqlBackend m ())
-> [[(Entity SwapUtxo, Entity SwapIntoLn)]]
-> ReaderT SqlBackend m ()
forall t (m :: * -> *) b.
(Container t, Monad m) =>
(Element t -> m b) -> t -> m ()
mapM_ Element [[(Entity SwapUtxo, Entity SwapIntoLn)]]
-> ReaderT SqlBackend m ()
forall (m :: * -> *).
Env m =>
[(Entity SwapUtxo, Entity SwapIntoLn)] -> ReaderT SqlBackend m ()
processRefundSql
          ([[(Entity SwapUtxo, Entity SwapIntoLn)]]
 -> ReaderT SqlBackend m ())
-> ([(Entity SwapUtxo, Entity SwapIntoLn)]
    -> [[(Entity SwapUtxo, Entity SwapIntoLn)]])
-> [(Entity SwapUtxo, Entity SwapIntoLn)]
-> ReaderT SqlBackend m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Entity SwapUtxo, Entity SwapIntoLn)
 -> (Entity SwapUtxo, Entity SwapIntoLn) -> Bool)
-> [(Entity SwapUtxo, Entity SwapIntoLn)]
-> [[(Entity SwapUtxo, Entity SwapIntoLn)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\(Entity SwapUtxo, Entity SwapIntoLn)
a (Entity SwapUtxo, Entity SwapIntoLn)
b -> (Entity SwapUtxo, Entity SwapIntoLn) -> Key SwapIntoLn
forall {a} {record}. (a, Entity record) -> Key record
swpId (Entity SwapUtxo, Entity SwapIntoLn)
a Key SwapIntoLn -> Key SwapIntoLn -> Bool
forall a. Eq a => a -> a -> Bool
== (Entity SwapUtxo, Entity SwapIntoLn) -> Key SwapIntoLn
forall {a} {record}. (a, Entity record) -> Key record
swpId (Entity SwapUtxo, Entity SwapIntoLn)
b)
    m ()
forall (m :: * -> *). MonadIO m => m ()
sleep300ms
  where
    swpId :: (a, Entity record) -> Key record
swpId = Entity record -> Key record
forall record. Entity record -> Key record
entityKey (Entity record -> Key record)
-> ((a, Entity record) -> Entity record)
-> (a, Entity record)
-> Key record
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Entity record) -> Entity record
forall a b. (a, b) -> b
snd

data SendUtxosResult = SendUtxosResult
  { SendUtxosResult -> DecodedRawTransaction
getGetDecTrx :: Btc.DecodedRawTransaction,
    SendUtxosResult -> MSat
getTotalAmt :: MSat,
    SendUtxosResult -> MSat
getFee :: MSat
  }

newtype TxLabel = TxLabel
  { TxLabel -> Text
unTxLabel :: Text
  }
  deriving newtype
    ( Int -> TxLabel -> ShowS
[TxLabel] -> ShowS
TxLabel -> String
(Int -> TxLabel -> ShowS)
-> (TxLabel -> String) -> ([TxLabel] -> ShowS) -> Show TxLabel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxLabel] -> ShowS
$cshowList :: [TxLabel] -> ShowS
show :: TxLabel -> String
$cshow :: TxLabel -> String
showsPrec :: Int -> TxLabel -> ShowS
$cshowsPrec :: Int -> TxLabel -> ShowS
Show,
      TxLabel -> TxLabel -> Bool
(TxLabel -> TxLabel -> Bool)
-> (TxLabel -> TxLabel -> Bool) -> Eq TxLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxLabel -> TxLabel -> Bool
$c/= :: TxLabel -> TxLabel -> Bool
== :: TxLabel -> TxLabel -> Bool
$c== :: TxLabel -> TxLabel -> Bool
Eq,
      Eq TxLabel
Eq TxLabel
-> (TxLabel -> TxLabel -> Ordering)
-> (TxLabel -> TxLabel -> Bool)
-> (TxLabel -> TxLabel -> Bool)
-> (TxLabel -> TxLabel -> Bool)
-> (TxLabel -> TxLabel -> Bool)
-> (TxLabel -> TxLabel -> TxLabel)
-> (TxLabel -> TxLabel -> TxLabel)
-> Ord TxLabel
TxLabel -> TxLabel -> Bool
TxLabel -> TxLabel -> Ordering
TxLabel -> TxLabel -> TxLabel
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 :: TxLabel -> TxLabel -> TxLabel
$cmin :: TxLabel -> TxLabel -> TxLabel
max :: TxLabel -> TxLabel -> TxLabel
$cmax :: TxLabel -> TxLabel -> TxLabel
>= :: TxLabel -> TxLabel -> Bool
$c>= :: TxLabel -> TxLabel -> Bool
> :: TxLabel -> TxLabel -> Bool
$c> :: TxLabel -> TxLabel -> Bool
<= :: TxLabel -> TxLabel -> Bool
$c<= :: TxLabel -> TxLabel -> Bool
< :: TxLabel -> TxLabel -> Bool
$c< :: TxLabel -> TxLabel -> Bool
compare :: TxLabel -> TxLabel -> Ordering
$ccompare :: TxLabel -> TxLabel -> Ordering
Ord,
      NonEmpty TxLabel -> TxLabel
TxLabel -> TxLabel -> TxLabel
(TxLabel -> TxLabel -> TxLabel)
-> (NonEmpty TxLabel -> TxLabel)
-> (forall b. Integral b => b -> TxLabel -> TxLabel)
-> Semigroup TxLabel
forall b. Integral b => b -> TxLabel -> TxLabel
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> TxLabel -> TxLabel
$cstimes :: forall b. Integral b => b -> TxLabel -> TxLabel
sconcat :: NonEmpty TxLabel -> TxLabel
$csconcat :: NonEmpty TxLabel -> TxLabel
<> :: TxLabel -> TxLabel -> TxLabel
$c<> :: TxLabel -> TxLabel -> TxLabel
Semigroup
    )

sendUtxos ::
  ( Env m
  ) =>
  Math.SatPerVbyte ->
  [PsbtUtxo] ->
  OnChainAddress 'Refund ->
  TxLabel ->
  ExceptT Failure m SendUtxosResult
sendUtxos :: forall (m :: * -> *).
Env m =>
SatPerVbyte
-> [PsbtUtxo]
-> OnChainAddress 'Refund
-> TxLabel
-> ExceptT Failure m SendUtxosResult
sendUtxos SatPerVbyte
feeRate [PsbtUtxo]
utxos OnChainAddress 'Refund
addr TxLabel
txLabel = do
  Natural
inQty <- Text -> Int -> ExceptT Failure m Natural
forall source target (m :: * -> *).
(Show source, Typeable source, Typeable target,
 TryFrom source target, Monad m, 'False ~ (source == target)) =>
Text -> source -> ExceptT Failure m target
tryFromT Text
"SendUtxos length" (Int -> ExceptT Failure m Natural)
-> Int -> ExceptT Failure m Natural
forall a b. (a -> b) -> a -> b
$ [PsbtUtxo] -> Int
forall t. Container t => t -> Int
length [PsbtUtxo]
utxos
  MSat
estFee <-
    Text
-> Either (TryFromException Natural MSat) MSat
-> ExceptT Failure m MSat
forall source target (m :: * -> *).
(Show source, Typeable source, Typeable target, Monad m) =>
Text
-> Either (TryFromException source target) target
-> ExceptT Failure m target
tryFailureT Text
"SendUtxos fee estimator" (Either (TryFromException Natural MSat) MSat
 -> ExceptT Failure m MSat)
-> Either (TryFromException Natural MSat) MSat
-> ExceptT Failure m MSat
forall a b. (a -> b) -> a -> b
$
      InQty
-> OutQty
-> SatPerVbyte
-> Either (TryFromException Natural MSat) MSat
Math.trxEstFee
        (Natural -> InQty
Math.InQty Natural
inQty)
        (Natural -> OutQty
Math.OutQty Natural
1)
        SatPerVbyte
feeRate
  let finalOutputAmt :: MSat
finalOutputAmt = Element [MSat]
MSat
totalInputsAmt MSat -> MSat -> MSat
forall a. Num a => a -> a -> a
- MSat
estFee
  Bool -> ExceptT Failure m () -> ExceptT Failure m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MSat
finalOutputAmt MSat -> MSat -> Bool
forall a. Ord a => a -> a -> Bool
< MSat
Math.trxDustLimit) (ExceptT Failure m () -> ExceptT Failure m ())
-> (Failure -> ExceptT Failure m ())
-> Failure
-> ExceptT Failure m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Failure -> ExceptT Failure m ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Failure -> ExceptT Failure m ())
-> Failure -> ExceptT Failure m ()
forall a b. (a -> b) -> a -> b
$
    FailureInternal -> Failure
FailureInt (FailureInternal -> Failure)
-> (Text -> FailureInternal) -> Text -> Failure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FailureInternal
FailurePrivate (Text -> Failure) -> Text -> Failure
forall a b. (a -> b) -> a -> b
$
      Text
"Final output amount "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> MSat -> Text
forall a. Out a => a -> Text
inspectPlain MSat
finalOutputAmt
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> MSat -> Text
forall a. Out a => a -> Text
inspectPlain Element [MSat]
MSat
totalInputsAmt
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" - "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> MSat -> Text
forall a. Out a => a -> Text
inspectPlain MSat
estFee
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is below dust limit "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> MSat -> Text
forall a. Out a => a -> Text
inspectPlain MSat
Math.trxDustLimit
  [PsbtUtxo] -> ExceptT Failure m ()
forall (m :: * -> *). Env m => [PsbtUtxo] -> ExceptT Failure m ()
releaseUtxosPsbtLocks [PsbtUtxo]
utxos
  FundPsbtResponse
estPsbt <-
    (LndEnv -> FundPsbtRequest -> m (Either LndError FundPsbtResponse))
-> ((FundPsbtRequest -> m (Either LndError FundPsbtResponse))
    -> m (Either LndError FundPsbtResponse))
-> ExceptT Failure m FundPsbtResponse
forall (m :: * -> *) a b.
Env m =>
(LndEnv -> a)
-> (a -> m (Either LndError b)) -> ExceptT Failure m b
withLndT
      LndEnv -> FundPsbtRequest -> m (Either LndError FundPsbtResponse)
forall (m :: * -> *).
(KatipContext m, MonadUnliftIO m) =>
LndEnv -> FundPsbtRequest -> m (Either LndError FundPsbtResponse)
Lnd.fundPsbt
      ((FundPsbtRequest -> m (Either LndError FundPsbtResponse))
-> FundPsbtRequest -> m (Either LndError FundPsbtResponse)
forall a b. (a -> b) -> a -> b
$ SatPerVbyte
-> [PsbtUtxo] -> OnChainAddress 'Refund -> MSat -> FundPsbtRequest
newFundPsbtReq SatPerVbyte
feeRate [PsbtUtxo]
utxos OnChainAddress 'Refund
addr MSat
finalOutputAmt)
  [UtxoLease] -> ExceptT Failure m ()
forall (m :: * -> *). Env m => [UtxoLease] -> ExceptT Failure m ()
releaseUtxosLocks ([UtxoLease] -> ExceptT Failure m ())
-> [UtxoLease] -> ExceptT Failure m ()
forall a b. (a -> b) -> a -> b
$ FundPsbtResponse -> [UtxoLease]
FP.lockedUtxos FundPsbtResponse
estPsbt
  FinalizePsbtResponse
finPsbt <-
    (LndEnv
 -> FinalizePsbtRequest -> m (Either LndError FinalizePsbtResponse))
-> ((FinalizePsbtRequest
     -> m (Either LndError FinalizePsbtResponse))
    -> m (Either LndError FinalizePsbtResponse))
-> ExceptT Failure m FinalizePsbtResponse
forall (m :: * -> *) a b.
Env m =>
(LndEnv -> a)
-> (a -> m (Either LndError b)) -> ExceptT Failure m b
withLndT
      LndEnv
-> FinalizePsbtRequest -> m (Either LndError FinalizePsbtResponse)
forall (m :: * -> *).
(KatipContext m, MonadUnliftIO m) =>
LndEnv
-> FinalizePsbtRequest -> m (Either LndError FinalizePsbtResponse)
Lnd.finalizePsbt
      ((FinalizePsbtRequest -> m (Either LndError FinalizePsbtResponse))
-> FinalizePsbtRequest -> m (Either LndError FinalizePsbtResponse)
forall a b. (a -> b) -> a -> b
$ ByteString -> Text -> FinalizePsbtRequest
FNP.FinalizePsbtRequest (FundPsbtResponse -> ByteString
FP.fundedPsbt FundPsbtResponse
estPsbt) Text
forall a. Monoid a => a
mempty)
  DecodedRawTransaction
decodedTrx <-
    (Client -> Text -> IO DecodedRawTransaction)
-> ((Text -> IO DecodedRawTransaction) -> IO DecodedRawTransaction)
-> ExceptT Failure m DecodedRawTransaction
forall (m :: * -> *) a b.
Env m =>
(Client -> a) -> (a -> IO b) -> ExceptT Failure m b
withBtcT
      Client -> Text -> IO DecodedRawTransaction
Btc.decodeRawTransaction
      ((Text -> IO DecodedRawTransaction)
-> Text -> IO DecodedRawTransaction
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
toHex (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ FinalizePsbtResponse -> ByteString
FNP.rawFinalTx FinalizePsbtResponse
finPsbt)
  PublishTransactionResponse
ptRes <-
    (LndEnv
 -> PublishTransactionRequest
 -> m (Either LndError PublishTransactionResponse))
-> ((PublishTransactionRequest
     -> m (Either LndError PublishTransactionResponse))
    -> m (Either LndError PublishTransactionResponse))
-> ExceptT Failure m PublishTransactionResponse
forall (m :: * -> *) a b.
Env m =>
(LndEnv -> a)
-> (a -> m (Either LndError b)) -> ExceptT Failure m b
withLndT
      LndEnv
-> PublishTransactionRequest
-> m (Either LndError PublishTransactionResponse)
forall (m :: * -> *).
(KatipContext m, MonadUnliftIO m) =>
LndEnv
-> PublishTransactionRequest
-> m (Either LndError PublishTransactionResponse)
Lnd.publishTransaction
      ( (PublishTransactionRequest
 -> m (Either LndError PublishTransactionResponse))
-> PublishTransactionRequest
-> m (Either LndError PublishTransactionResponse)
forall a b. (a -> b) -> a -> b
$
          ByteString -> Text -> PublishTransactionRequest
PT.PublishTransactionRequest
            (FinalizePsbtResponse -> ByteString
FNP.rawFinalTx FinalizePsbtResponse
finPsbt)
            (Text -> PublishTransactionRequest)
-> Text -> PublishTransactionRequest
forall a b. (a -> b) -> a -> b
$ TxLabel -> Text
unTxLabel TxLabel
txLabel
      )
  if Text -> Bool
forall t. Container t => t -> Bool
null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ PublishTransactionResponse -> Text
PT.publishError PublishTransactionResponse
ptRes
    then SendUtxosResult -> ExceptT Failure m SendUtxosResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SendUtxosResult -> ExceptT Failure m SendUtxosResult)
-> SendUtxosResult -> ExceptT Failure m SendUtxosResult
forall a b. (a -> b) -> a -> b
$ DecodedRawTransaction -> MSat -> MSat -> SendUtxosResult
SendUtxosResult DecodedRawTransaction
decodedTrx Element [MSat]
MSat
totalInputsAmt MSat
estFee
    else Failure -> ExceptT Failure m SendUtxosResult
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Failure -> ExceptT Failure m SendUtxosResult)
-> (FailureInternal -> Failure)
-> FailureInternal
-> ExceptT Failure m SendUtxosResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailureInternal -> Failure
FailureInt (FailureInternal -> ExceptT Failure m SendUtxosResult)
-> FailureInternal -> ExceptT Failure m SendUtxosResult
forall a b. (a -> b) -> a -> b
$ Text -> FailureInternal
FailurePrivate Text
"Failed to publish refund transaction"
  where
    totalInputsAmt :: Element [MSat]
totalInputsAmt =
      [MSat] -> Element [MSat]
forall t. (Container t, Num (Element t)) => t -> Element t
sum ([MSat] -> Element [MSat]) -> [MSat] -> Element [MSat]
forall a b. (a -> b) -> a -> b
$ PsbtUtxo -> MSat
getAmt (PsbtUtxo -> MSat) -> [PsbtUtxo] -> [MSat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PsbtUtxo]
utxos

newFundPsbtReq ::
  Math.SatPerVbyte ->
  [PsbtUtxo] ->
  OnChainAddress 'Refund ->
  MSat ->
  FP.FundPsbtRequest
newFundPsbtReq :: SatPerVbyte
-> [PsbtUtxo] -> OnChainAddress 'Refund -> MSat -> FundPsbtRequest
newFundPsbtReq SatPerVbyte
feeRate [PsbtUtxo]
utxos' OnChainAddress 'Refund
outAddr MSat
est = do
  let mtpl :: TxTemplate
mtpl =
        [OutPoint] -> Map Text MSat -> TxTemplate
FP.TxTemplate
          (PsbtUtxo -> OutPoint
getOutPoint (PsbtUtxo -> OutPoint) -> [PsbtUtxo] -> [OutPoint]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PsbtUtxo]
utxos')
          ([(Text, MSat)] -> Map Text MSat
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(OnChainAddress 'Refund -> Text
forall (mrel :: MoneyRelation). OnChainAddress mrel -> Text
unOnChainAddress OnChainAddress 'Refund
outAddr, MSat
est)])
  FundPsbtRequest :: Text -> TxTemplate -> Int32 -> Bool -> Fee -> FundPsbtRequest
FP.FundPsbtRequest
    { account :: Text
FP.account = Text
forall a. Monoid a => a
mempty,
      template :: TxTemplate
FP.template = TxTemplate
mtpl,
      minConfs :: Int32
FP.minConfs = Int32
2,
      spendUnconfirmed :: Bool
FP.spendUnconfirmed = Bool
False,
      fee :: Fee
FP.fee =
        Word64 -> Fee
FP.SatPerVbyte
          (Word64 -> Fee)
-> (Ratio Natural -> Word64) -> Ratio Natural -> Fee
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ratio Natural -> Word64
forall a b. (RealFrac a, Integral b) => a -> b
ceiling
          (Ratio Natural -> Fee) -> Ratio Natural -> Fee
forall a b. (a -> b) -> a -> b
$ SatPerVbyte -> Ratio Natural
Math.unSatPerVbyte SatPerVbyte
feeRate
    }

processRefundSql ::
  ( Env m
  ) =>
  [(Entity SwapUtxo, Entity SwapIntoLn)] ->
  ReaderT Psql.SqlBackend m ()
processRefundSql :: forall (m :: * -> *).
Env m =>
[(Entity SwapUtxo, Entity SwapIntoLn)] -> ReaderT SqlBackend m ()
processRefundSql [] = () -> ReaderT SqlBackend m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
processRefundSql utxos :: [(Entity SwapUtxo, Entity SwapIntoLn)]
utxos@((Entity SwapUtxo, Entity SwapIntoLn)
x : [(Entity SwapUtxo, Entity SwapIntoLn)]
_) = do
  Either (Entity SwapIntoLn) ()
res <- Key SwapIntoLn
-> (SwapStatus -> Bool)
-> (SwapIntoLn -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m (Either (Entity SwapIntoLn) ())
forall (m :: * -> *) a.
MonadIO m =>
Key SwapIntoLn
-> (SwapStatus -> Bool)
-> (SwapIntoLn -> ReaderT SqlBackend m a)
-> ReaderT SqlBackend m (Either (Entity SwapIntoLn) a)
SwapIntoLn.withLockedRowSql
    (Entity SwapIntoLn -> Key SwapIntoLn
forall record. Entity record -> Key record
entityKey (Entity SwapIntoLn -> Key SwapIntoLn)
-> Entity SwapIntoLn -> Key SwapIntoLn
forall a b. (a -> b) -> a -> b
$ (Entity SwapUtxo, Entity SwapIntoLn) -> Entity SwapIntoLn
forall a b. (a, b) -> b
snd (Entity SwapUtxo, Entity SwapIntoLn)
x)
    (Element [SwapStatus] -> [SwapStatus] -> Bool
forall t. (Container t, Eq (Element t)) => Element t -> t -> Bool
`elem` [SwapStatus]
swapStatusFinal)
    ((SwapIntoLn -> ReaderT SqlBackend m ())
 -> ReaderT SqlBackend m (Either (Entity SwapIntoLn) ()))
-> (ReaderT SqlBackend m ()
    -> SwapIntoLn -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m ()
-> ReaderT SqlBackend m (Either (Entity SwapIntoLn) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT SqlBackend m () -> SwapIntoLn -> ReaderT SqlBackend m ()
forall a b. a -> b -> a
const
    (ReaderT SqlBackend m ()
 -> ReaderT SqlBackend m (Either (Entity SwapIntoLn) ()))
-> ReaderT SqlBackend m ()
-> ReaderT SqlBackend m (Either (Entity SwapIntoLn) ())
forall a b. (a -> b) -> a -> b
$ do
      $(logTM) Severity
DebugS (LogStr -> ReaderT SqlBackend m ())
-> (Text -> LogStr) -> Text -> ReaderT SqlBackend m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LogStr
forall a. StringConv a Text => a -> LogStr
logStr (Text -> ReaderT SqlBackend m ())
-> Text -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$
        Text
"Start refunding utxos:"
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [PsbtUtxo] -> Text
forall a. Out a => a -> Text
inspect [PsbtUtxo]
refUtxos
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to address:"
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OnChainAddress 'Refund -> Text
forall a. Out a => a -> Text
inspect OnChainAddress 'Refund
refAddr
      (Failure -> ReaderT SqlBackend m ())
-> (SendUtxosResult -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m (Either Failure SendUtxosResult)
-> ReaderT SqlBackend m ()
forall (m :: * -> *) a c b.
Monad m =>
(a -> m c) -> (b -> m c) -> m (Either a b) -> m c
eitherM
        ( \Failure
e -> do
            ReaderT SqlBackend m ()
forall (m :: * -> *). MonadIO m => ReaderT SqlBackend m ()
Psql.transactionUndo
            $(logTM) Severity
ErrorS (LogStr -> ReaderT SqlBackend m ())
-> (Text -> LogStr) -> Text -> ReaderT SqlBackend m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LogStr
forall a. StringConv a Text => a -> LogStr
logStr (Text -> ReaderT SqlBackend m ())
-> Text -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$
              Text
"Failed to refund utxos:"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [PsbtUtxo] -> Text
forall a. Out a => a -> Text
inspect [PsbtUtxo]
refUtxos
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to address:"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OnChainAddress 'Refund -> Text
forall a. Out a => a -> Text
inspect OnChainAddress 'Refund
refAddr
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with error:"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Failure -> Text
forall a. Out a => a -> Text
inspect Failure
e
        )
        ( \(SendUtxosResult DecodedRawTransaction
rtx MSat
total MSat
fee) -> do
            $(logTM) Severity
DebugS (LogStr -> ReaderT SqlBackend m ())
-> (Text -> LogStr) -> Text -> ReaderT SqlBackend m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LogStr
forall a. StringConv a Text => a -> LogStr
logStr (Text -> ReaderT SqlBackend m ())
-> Text -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$
              Text
"Successfully refunded utxos: "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [PsbtUtxo] -> Text
forall a. Out a => a -> Text
inspect [PsbtUtxo]
refUtxos
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to address:"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OnChainAddress 'Refund -> Text
forall a. Out a => a -> Text
inspect OnChainAddress 'Refund
refAddr
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" on chain rawTx:"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DecodedRawTransaction -> Text
forall a. Out a => a -> Text
inspect DecodedRawTransaction
rtx
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" amount: "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> MSat -> Text
forall a. Out a => a -> Text
inspect MSat
total
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with fee:"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> MSat -> Text
forall a. Out a => a -> Text
inspect MSat
fee
            case Text -> Either LndError ByteString
txIdParser
              (Text -> Either LndError ByteString)
-> (TransactionID -> Text)
-> TransactionID
-> Either LndError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionID -> Text
Btc.unTransactionID
              (TransactionID -> Either LndError ByteString)
-> TransactionID -> Either LndError ByteString
forall a b. (a -> b) -> a -> b
$ DecodedRawTransaction -> TransactionID
Btc.decTxId DecodedRawTransaction
rtx of
              Right ByteString
rtxid ->
                [SwapUtxoId] -> TxId 'Funding -> ReaderT SqlBackend m ()
forall (m :: * -> *).
MonadIO m =>
[SwapUtxoId] -> TxId 'Funding -> ReaderT SqlBackend m ()
SwapUtxo.updateRefundedSql
                  (Entity SwapUtxo -> SwapUtxoId
forall record. Entity record -> Key record
entityKey (Entity SwapUtxo -> SwapUtxoId)
-> ((Entity SwapUtxo, Entity SwapIntoLn) -> Entity SwapUtxo)
-> (Entity SwapUtxo, Entity SwapIntoLn)
-> SwapUtxoId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity SwapUtxo, Entity SwapIntoLn) -> Entity SwapUtxo
forall a b. (a, b) -> a
fst ((Entity SwapUtxo, Entity SwapIntoLn) -> SwapUtxoId)
-> [(Entity SwapUtxo, Entity SwapIntoLn)] -> [SwapUtxoId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Entity SwapUtxo, Entity SwapIntoLn)]
utxos)
                  (ByteString -> TxId 'Funding
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from ByteString
rtxid)
              Left LndError
e -> do
                ReaderT SqlBackend m ()
forall (m :: * -> *). MonadIO m => ReaderT SqlBackend m ()
Psql.transactionUndo
                $(logTM) Severity
ErrorS (LogStr -> ReaderT SqlBackend m ())
-> (Text -> LogStr) -> Text -> ReaderT SqlBackend m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LogStr
forall a. StringConv a Text => a -> LogStr
logStr (Text -> ReaderT SqlBackend m ())
-> Text -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$
                  Text
"Failed to convert txid:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LndError -> Text
forall a. Out a => a -> Text
inspect LndError
e
        )
        (ReaderT SqlBackend m (Either Failure SendUtxosResult)
 -> ReaderT SqlBackend m ())
-> (ExceptT Failure m SendUtxosResult
    -> ReaderT SqlBackend m (Either Failure SendUtxosResult))
-> ExceptT Failure m SendUtxosResult
-> ReaderT SqlBackend m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either Failure SendUtxosResult)
-> ReaderT SqlBackend m (Either Failure SendUtxosResult)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
        (m (Either Failure SendUtxosResult)
 -> ReaderT SqlBackend m (Either Failure SendUtxosResult))
-> (ExceptT Failure m SendUtxosResult
    -> m (Either Failure SendUtxosResult))
-> ExceptT Failure m SendUtxosResult
-> ReaderT SqlBackend m (Either Failure SendUtxosResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT Failure m SendUtxosResult
-> m (Either Failure SendUtxosResult)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
        (ExceptT Failure m SendUtxosResult -> ReaderT SqlBackend m ())
-> ExceptT Failure m SendUtxosResult -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ SatPerVbyte
-> [PsbtUtxo]
-> OnChainAddress 'Refund
-> TxLabel
-> ExceptT Failure m SendUtxosResult
forall (m :: * -> *).
Env m =>
SatPerVbyte
-> [PsbtUtxo]
-> OnChainAddress 'Refund
-> TxLabel
-> ExceptT Failure m SendUtxosResult
sendUtxos
          SatPerVbyte
Math.minFeeRate
          [PsbtUtxo]
refUtxos
          (OnChainAddress 'Refund -> OnChainAddress 'Refund
coerce OnChainAddress 'Refund
refAddr)
          (Text -> TxLabel
TxLabel (Text -> TxLabel) -> Text -> TxLabel
forall a b. (a -> b) -> a -> b
$ Text
"refund to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OnChainAddress 'Refund -> Text
forall (mrel :: MoneyRelation). OnChainAddress mrel -> Text
unOnChainAddress OnChainAddress 'Refund
refAddr)
  Either (Entity SwapIntoLn) ()
-> (Entity SwapIntoLn -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m ()
forall (f :: * -> *) l r.
Applicative f =>
Either l r -> (l -> f ()) -> f ()
whenLeft Either (Entity SwapIntoLn) ()
res ((Entity SwapIntoLn -> ReaderT SqlBackend m ())
 -> ReaderT SqlBackend m ())
-> (Entity SwapIntoLn -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$
    $(logTM) Severity
ErrorS
      (LogStr -> ReaderT SqlBackend m ())
-> (Entity SwapIntoLn -> LogStr)
-> Entity SwapIntoLn
-> ReaderT SqlBackend m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LogStr
forall a. StringConv a Text => a -> LogStr
logStr
      (Text -> LogStr)
-> (Entity SwapIntoLn -> Text) -> Entity SwapIntoLn -> LogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"No refund due to wrong status " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
      (Text -> Text)
-> (Entity SwapIntoLn -> Text) -> Entity SwapIntoLn -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity SwapIntoLn -> Text
forall a. Out a => a -> Text
inspect
  where
    refAddr :: OnChainAddress 'Refund
refAddr = SwapIntoLn -> OnChainAddress 'Refund
swapIntoLnRefundAddress (SwapIntoLn -> OnChainAddress 'Refund)
-> SwapIntoLn -> OnChainAddress 'Refund
forall a b. (a -> b) -> a -> b
$ Entity SwapIntoLn -> SwapIntoLn
forall record. Entity record -> record
entityVal (Entity SwapIntoLn -> SwapIntoLn)
-> Entity SwapIntoLn -> SwapIntoLn
forall a b. (a -> b) -> a -> b
$ (Entity SwapUtxo, Entity SwapIntoLn) -> Entity SwapIntoLn
forall a b. (a, b) -> b
snd (Entity SwapUtxo, Entity SwapIntoLn)
x
    refUtxos :: [PsbtUtxo]
refUtxos = SwapUtxo -> PsbtUtxo
swapUtxoToPsbtUtxo (SwapUtxo -> PsbtUtxo)
-> ((Entity SwapUtxo, Entity SwapIntoLn) -> SwapUtxo)
-> (Entity SwapUtxo, Entity SwapIntoLn)
-> PsbtUtxo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity SwapUtxo -> SwapUtxo
forall record. Entity record -> record
entityVal (Entity SwapUtxo -> SwapUtxo)
-> ((Entity SwapUtxo, Entity SwapIntoLn) -> Entity SwapUtxo)
-> (Entity SwapUtxo, Entity SwapIntoLn)
-> SwapUtxo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity SwapUtxo, Entity SwapIntoLn) -> Entity SwapUtxo
forall a b. (a, b) -> a
fst ((Entity SwapUtxo, Entity SwapIntoLn) -> PsbtUtxo)
-> [(Entity SwapUtxo, Entity SwapIntoLn)] -> [PsbtUtxo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Entity SwapUtxo, Entity SwapIntoLn)]
utxos