{-# LANGUAGE TemplateHaskell #-}

module BtcLsp.Thread.LnChanOpener
  ( apply,
  )
where

import BtcLsp.Import
import qualified BtcLsp.Import.Psql as Psql
import qualified BtcLsp.Psbt.PsbtOpener as PO
import BtcLsp.Psbt.Utils (swapUtxoToPsbtUtxo)
import qualified BtcLsp.Storage.Model.LnChan as LnChan
import qualified BtcLsp.Storage.Model.SwapIntoLn as SwapIntoLn
import qualified BtcLsp.Storage.Model.SwapUtxo as SwapUtxo
import qualified Data.Set as Set
import qualified LndClient.Data.ChannelPoint as ChannelPoint
import qualified LndClient.Data.Peer as Peer
import qualified LndClient.RPC.Silent as LndSilent

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
    Either Failure [Peer]
ePeerList <-
      (LndEnv -> m (Either LndError [Peer]))
-> (m (Either LndError [Peer]) -> m (Either LndError [Peer]))
-> m (Either Failure [Peer])
forall (m :: * -> *) a b.
Env m =>
(LndEnv -> a)
-> (a -> m (Either LndError b)) -> m (Either Failure b)
withLnd LndEnv -> m (Either LndError [Peer])
forall (m :: * -> *).
MonadUnliftIO m =>
LndEnv -> m (Either LndError [Peer])
LndSilent.listPeers m (Either LndError [Peer]) -> m (Either LndError [Peer])
forall a. a -> a
id
    Either Failure [Peer] -> (Failure -> m ()) -> m ()
forall (f :: * -> *) l r.
Applicative f =>
Either l r -> (l -> f ()) -> f ()
whenLeft Either Failure [Peer]
ePeerList ((Failure -> m ()) -> m ()) -> (Failure -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
      $(logTM) Severity
ErrorS
        (LogStr -> m ()) -> (Failure -> LogStr) -> Failure -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LogStr
forall a. StringConv a Text => a -> LogStr
logStr
        (Text -> LogStr) -> (Failure -> Text) -> Failure -> LogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"ListPeers procedure failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
        (Text -> Text) -> (Failure -> Text) -> Failure -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Failure -> Text
forall a. Out a => a -> Text
inspect
    let peerSet :: Set NodePubKey
peerSet =
          [NodePubKey] -> Set NodePubKey
forall a. Ord a => [a] -> Set a
Set.fromList ([NodePubKey] -> Set NodePubKey) -> [NodePubKey] -> Set NodePubKey
forall a b. (a -> b) -> a -> b
$
            Peer -> NodePubKey
Peer.pubKey (Peer -> NodePubKey) -> [Peer] -> [NodePubKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Peer] -> Either Failure [Peer] -> [Peer]
forall b a. b -> Either a b -> b
fromRight [] Either Failure [Peer]
ePeerList
    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
$ do
      [(Entity SwapIntoLn, Entity User)]
swaps <-
        ((Entity SwapIntoLn, Entity User) -> Bool)
-> [(Entity SwapIntoLn, Entity User)]
-> [(Entity SwapIntoLn, Entity User)]
forall a. (a -> Bool) -> [a] -> [a]
filter
          ( \(Entity SwapIntoLn, Entity User)
x ->
              NodePubKey -> Set NodePubKey -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member
                (User -> NodePubKey
userNodePubKey (User -> NodePubKey)
-> (Entity User -> User) -> Entity User -> NodePubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity User -> User
forall record. Entity record -> record
entityVal (Entity User -> NodePubKey) -> Entity User -> NodePubKey
forall a b. (a -> b) -> a -> b
$ (Entity SwapIntoLn, Entity User) -> Entity User
forall a b. (a, b) -> b
snd (Entity SwapIntoLn, Entity User)
x)
                Set NodePubKey
peerSet
          )
          ([(Entity SwapIntoLn, Entity User)]
 -> [(Entity SwapIntoLn, Entity User)])
-> ReaderT SqlBackend m [(Entity SwapIntoLn, Entity User)]
-> ReaderT SqlBackend m [(Entity SwapIntoLn, Entity User)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT SqlBackend m [(Entity SwapIntoLn, Entity User)]
forall (m :: * -> *).
MonadIO m =>
ReaderT SqlBackend m [(Entity SwapIntoLn, Entity User)]
SwapIntoLn.getSwapsWaitingPeerSql
      (Element [(Entity SwapIntoLn, Entity User)]
 -> ReaderT SqlBackend m ())
-> [(Entity SwapIntoLn, Entity User)] -> ReaderT SqlBackend m ()
forall t (m :: * -> *) b.
(Container t, Monad m) =>
(Element t -> m b) -> t -> m ()
mapM_
        ((Entity SwapIntoLn -> Entity User -> ReaderT SqlBackend m ())
-> (Entity SwapIntoLn, Entity User) -> ReaderT SqlBackend m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Entity SwapIntoLn -> Entity User -> ReaderT SqlBackend m ()
forall (m :: * -> *).
Env m =>
Entity SwapIntoLn -> Entity User -> ReaderT SqlBackend m ()
openChanSql)
        [(Entity SwapIntoLn, Entity User)]
swaps
    m ()
forall (m :: * -> *). MonadIO m => m ()
sleep300ms

--
-- TODO : Do not open channel in case where
-- there not is enough liquidity to perform swap.
-- Maybe also put some limits into amount of
-- opening chans per user.
--
openChanSql ::
  ( Env m
  ) =>
  Entity SwapIntoLn ->
  Entity User ->
  ReaderT Psql.SqlBackend m ()
openChanSql :: forall (m :: * -> *).
Env m =>
Entity SwapIntoLn -> Entity User -> ReaderT SqlBackend m ()
openChanSql (Entity Key SwapIntoLn
swapKey SwapIntoLn
_) Entity User
userEnt = 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 Key SwapIntoLn
swapKey (SwapStatus -> SwapStatus -> Bool
forall a. Eq a => a -> a -> Bool
== SwapStatus
SwapWaitingPeer) ((SwapIntoLn -> ReaderT SqlBackend m ())
 -> ReaderT SqlBackend m (Either (Entity SwapIntoLn) ()))
-> (SwapIntoLn -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m (Either (Entity SwapIntoLn) ())
forall a b. (a -> b) -> a -> b
$
      \SwapIntoLn
swapVal -> do
        [Entity SwapUtxo]
utxos <- Key SwapIntoLn -> ReaderT SqlBackend m [Entity SwapUtxo]
forall (m :: * -> *).
MonadIO m =>
Key SwapIntoLn -> ReaderT SqlBackend m [Entity SwapUtxo]
SwapUtxo.getSpendableUtxosBySwapIdSql Key SwapIntoLn
swapKey
        Either Failure ChannelPoint
cpEither <- m (Either Failure ChannelPoint)
-> ReaderT SqlBackend m (Either Failure ChannelPoint)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either Failure ChannelPoint)
 -> ReaderT SqlBackend m (Either Failure ChannelPoint))
-> (ExceptT Failure m ChannelPoint
    -> m (Either Failure ChannelPoint))
-> ExceptT Failure m ChannelPoint
-> ReaderT SqlBackend m (Either Failure ChannelPoint)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT Failure m ChannelPoint -> m (Either Failure ChannelPoint)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Failure m ChannelPoint
 -> ReaderT SqlBackend m (Either Failure ChannelPoint))
-> ExceptT Failure m ChannelPoint
-> ReaderT SqlBackend m (Either Failure ChannelPoint)
forall a b. (a -> b) -> a -> b
$ do
          OpenChannelPsbtResult
r <-
            [PsbtUtxo]
-> NodePubKey
-> OnChainAddress 'Gain
-> Money 'Lsp 'OnChain 'Gain
-> Privacy
-> ExceptT Failure m OpenChannelPsbtResult
forall (m :: * -> *).
Env m =>
[PsbtUtxo]
-> NodePubKey
-> OnChainAddress 'Gain
-> Money 'Lsp 'OnChain 'Gain
-> Privacy
-> ExceptT Failure m OpenChannelPsbtResult
PO.openChannelPsbt
              (SwapUtxo -> PsbtUtxo
swapUtxoToPsbtUtxo (SwapUtxo -> PsbtUtxo)
-> (Entity SwapUtxo -> SwapUtxo) -> Entity SwapUtxo -> PsbtUtxo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity SwapUtxo -> SwapUtxo
forall record. Entity record -> record
entityVal (Entity SwapUtxo -> PsbtUtxo) -> [Entity SwapUtxo] -> [PsbtUtxo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Entity SwapUtxo]
utxos)
              (User -> NodePubKey
userNodePubKey (User -> NodePubKey) -> User -> NodePubKey
forall a b. (a -> b) -> a -> b
$ Entity User -> User
forall record. Entity record -> record
entityVal Entity User
userEnt)
              (OnChainAddress 'Gain -> OnChainAddress 'Gain
coerce (OnChainAddress 'Gain -> OnChainAddress 'Gain)
-> OnChainAddress 'Gain -> OnChainAddress 'Gain
forall a b. (a -> b) -> a -> b
$ SwapIntoLn -> OnChainAddress 'Gain
swapIntoLnLspFeeAndChangeAddress SwapIntoLn
swapVal)
              ((SwapIntoLn -> Money 'Lsp 'OnChain 'Gain)
-> SwapIntoLn -> Money 'Lsp 'OnChain 'Gain
coerce SwapIntoLn -> Money 'Lsp 'OnChain 'Gain
swapIntoLnFeeLsp SwapIntoLn
swapVal)
              (SwapIntoLn -> Privacy
swapIntoLnPrivacy SwapIntoLn
swapVal)
          IO (Either Failure ChannelPoint)
-> ExceptT Failure m (Either Failure ChannelPoint)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Async (Either Failure ChannelPoint)
-> IO (Either Failure ChannelPoint)
forall a. Async a -> IO a
wait (Async (Either Failure ChannelPoint)
 -> IO (Either Failure ChannelPoint))
-> Async (Either Failure ChannelPoint)
-> IO (Either Failure ChannelPoint)
forall a b. (a -> b) -> a -> b
$ OpenChannelPsbtResult -> Async (Either Failure ChannelPoint)
PO.fundAsync OpenChannelPsbtResult
r) ExceptT Failure m (Either Failure ChannelPoint)
-> (Either Failure ChannelPoint -> ExceptT Failure m ChannelPoint)
-> ExceptT Failure m ChannelPoint
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either Failure ChannelPoint -> ExceptT Failure m ChannelPoint
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except
        (Failure -> ReaderT SqlBackend m ())
-> (ChannelPoint -> ReaderT SqlBackend m ())
-> Either Failure ChannelPoint
-> ReaderT SqlBackend m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
          ( $(logTM) Severity
ErrorS (LogStr -> ReaderT SqlBackend m ())
-> (Failure -> LogStr) -> Failure -> 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) -> (Failure -> Text) -> Failure -> LogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"OpenChan procedure failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
              (Text -> Text) -> (Failure -> Text) -> Failure -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Failure -> Text
forall a. Out a => a -> Text
inspect
          )
          ( \ChannelPoint
cp ->
              Key SwapIntoLn
-> TxId 'Funding
-> Vout 'Funding
-> ReaderT SqlBackend m (Entity LnChan)
forall (m :: * -> *).
MonadIO m =>
Key SwapIntoLn
-> TxId 'Funding
-> Vout 'Funding
-> ReaderT SqlBackend m (Entity LnChan)
LnChan.createUpdateSql
                Key SwapIntoLn
swapKey
                (ChannelPoint -> TxId 'Funding
ChannelPoint.fundingTxId ChannelPoint
cp)
                (ChannelPoint -> Vout 'Funding
ChannelPoint.outputIndex ChannelPoint
cp)
                ReaderT SqlBackend m (Entity LnChan)
-> ReaderT SqlBackend m () -> ReaderT SqlBackend m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Key SwapIntoLn -> ReaderT SqlBackend m ()
forall (m :: * -> *).
MonadIO m =>
Key SwapIntoLn -> ReaderT SqlBackend m ()
SwapIntoLn.updateWaitingChanSql Key SwapIntoLn
swapKey
                ReaderT SqlBackend m ()
-> ReaderT SqlBackend m () -> ReaderT SqlBackend m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Key SwapIntoLn -> ReaderT SqlBackend m ()
forall (m :: * -> *).
MonadIO m =>
Key SwapIntoLn -> ReaderT SqlBackend m ()
SwapUtxo.updateSpentChanSwappedSql Key SwapIntoLn
swapKey
          )
          Either Failure ChannelPoint
cpEither
  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
"Channel opening failed 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