module BtcLsp.Psbt.Utils ( swapUtxoToPsbtUtxo, psbtShim, fundPsbtReq, openChannelReq, psbtVerifyReq, psbtFinalizeReq, finalizePsbt, unspendUtxoLookup, shimCancelReq, releaseUtxosPsbtLocks, releaseUtxosLocks, newLockId, lockUtxo, lockUtxos, ) where import BtcLsp.Import import qualified Data.ByteString.Lazy as L import qualified Data.Digest.Pure.SHA as SHA ( bytestringDigest, sha256, ) import qualified Data.Map as M import qualified LndClient as Lnd import qualified LndClient.Data.FinalizePsbt as FNP import qualified LndClient.Data.FundPsbt as FP import qualified LndClient.Data.FundingPsbtFinalize as FPF import qualified LndClient.Data.FundingPsbtVerify as FSS import qualified LndClient.Data.FundingShimCancel as FSC import qualified LndClient.Data.FundingStateStep as FSS import qualified LndClient.Data.LeaseOutput as LO import qualified LndClient.Data.ListUnspent as LU import qualified LndClient.Data.OpenChannel as Lnd import qualified LndClient.Data.OutPoint as OP import qualified LndClient.Data.PsbtShim as PS import qualified LndClient.Data.ReleaseOutput as RO import qualified LndClient.RPC.Katip as Lnd import qualified Universum swapUtxoToPsbtUtxo :: SwapUtxo -> PsbtUtxo swapUtxoToPsbtUtxo :: SwapUtxo -> PsbtUtxo swapUtxoToPsbtUtxo SwapUtxo x = OutPoint -> MSat -> Maybe UtxoLockId -> PsbtUtxo PsbtUtxo ( ByteString -> Word32 -> OutPoint OP.OutPoint (TxId 'Funding -> ByteString coerce (TxId 'Funding -> ByteString) -> TxId 'Funding -> ByteString forall a b. (a -> b) -> a -> b $ SwapUtxo -> TxId 'Funding swapUtxoTxid SwapUtxo x) (Vout 'Funding -> Word32 coerce (Vout 'Funding -> Word32) -> Vout 'Funding -> Word32 forall a b. (a -> b) -> a -> b $ SwapUtxo -> Vout 'Funding swapUtxoVout SwapUtxo x) ) (Money 'Usr 'OnChain 'Fund -> MSat coerce (Money 'Usr 'OnChain 'Fund -> MSat) -> Money 'Usr 'OnChain 'Fund -> MSat forall a b. (a -> b) -> a -> b $ SwapUtxo -> Money 'Usr 'OnChain 'Fund swapUtxoAmount SwapUtxo x) (SwapUtxo -> Maybe UtxoLockId swapUtxoLockId SwapUtxo x) psbtShim :: Lnd.PendingChannelId -> PS.PsbtShim psbtShim :: PendingChannelId -> PsbtShim psbtShim PendingChannelId pcid = PsbtShim :: PendingChannelId -> Maybe Psbt -> Bool -> PsbtShim PS.PsbtShim { pendingChanId :: PendingChannelId PS.pendingChanId = PendingChannelId pcid, basePsbt :: Maybe Psbt PS.basePsbt = Maybe Psbt forall a. Maybe a Nothing, noPublish :: Bool PS.noPublish = Bool False } fundPsbtReq :: [OP.OutPoint] -> Map Text MSat -> FP.FundPsbtRequest fundPsbtReq :: [OutPoint] -> Map Text MSat -> FundPsbtRequest fundPsbtReq [OutPoint] inputs Map Text MSat outputs = FundPsbtRequest :: Text -> TxTemplate -> Int32 -> Bool -> Fee -> FundPsbtRequest FP.FundPsbtRequest { account :: Text FP.account = Text "", template :: TxTemplate FP.template = [OutPoint] -> Map Text MSat -> TxTemplate FP.TxTemplate [OutPoint] inputs Map Text MSat outputs, minConfs :: Int32 FP.minConfs = Int32 0, spendUnconfirmed :: Bool FP.spendUnconfirmed = Bool True, fee :: Fee FP.fee = Word64 -> Fee FP.SatPerVbyte Word64 1 } openChannelReq :: Lnd.PendingChannelId -> Lnd.NodePubKey -> Money 'Lsp 'Ln 'Gain -> Money 'Usr 'Ln 'Gain -> Privacy -> Lnd.OpenChannelRequest openChannelReq :: PendingChannelId -> NodePubKey -> Money 'Lsp 'Ln 'Gain -> Money 'Usr 'Ln 'Gain -> Privacy -> OpenChannelRequest openChannelReq PendingChannelId pcid NodePubKey toNode Money 'Lsp 'Ln 'Gain totalFundAmt Money 'Usr 'Ln 'Gain pushAmt Privacy private = OpenChannelRequest :: NodePubKey -> MSat -> Maybe MSat -> Maybe Int32 -> Maybe MSat -> Maybe Bool -> Maybe MSat -> Maybe Word32 -> Maybe Int32 -> Maybe Bool -> Maybe Text -> Maybe PsbtShim -> OpenChannelRequest Lnd.OpenChannelRequest { nodePubkey :: NodePubKey Lnd.nodePubkey = NodePubKey toNode, localFundingAmount :: MSat Lnd.localFundingAmount = Money 'Lsp 'Ln 'Gain -> MSat coerce Money 'Lsp 'Ln 'Gain totalFundAmt, pushMSat :: Maybe MSat Lnd.pushMSat = MSat -> Maybe MSat forall a. a -> Maybe a Just (MSat -> Maybe MSat) -> MSat -> Maybe MSat forall a b. (a -> b) -> a -> b $ Money 'Usr 'Ln 'Gain -> MSat coerce Money 'Usr 'Ln 'Gain pushAmt, targetConf :: Maybe Int32 Lnd.targetConf = Maybe Int32 forall a. Maybe a Nothing, mSatPerByte :: Maybe MSat Lnd.mSatPerByte = Maybe MSat forall a. Maybe a Nothing, private :: Maybe Bool Lnd.private = Bool -> Maybe Bool forall a. a -> Maybe a Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool forall a b. (a -> b) -> a -> b $ Privacy private Privacy -> Privacy -> Bool forall a. Eq a => a -> a -> Bool == Privacy Private, minHtlcMsat :: Maybe MSat Lnd.minHtlcMsat = Maybe MSat forall a. Maybe a Nothing, remoteCsvDelay :: Maybe Word32 Lnd.remoteCsvDelay = Maybe Word32 forall a. Maybe a Nothing, minConfs :: Maybe Int32 Lnd.minConfs = Maybe Int32 forall a. Maybe a Nothing, spendUnconfirmed :: Maybe Bool Lnd.spendUnconfirmed = Maybe Bool forall a. Maybe a Nothing, closeAddress :: Maybe Text Lnd.closeAddress = Maybe Text forall a. Maybe a Nothing, fundingShim :: Maybe PsbtShim Lnd.fundingShim = PsbtShim -> Maybe PsbtShim forall a. a -> Maybe a Just (PendingChannelId -> PsbtShim psbtShim PendingChannelId pcid) } psbtVerifyReq :: Lnd.PendingChannelId -> Lnd.Psbt -> FSS.FundingStateStepRequest psbtVerifyReq :: PendingChannelId -> Psbt -> FundingStateStepRequest psbtVerifyReq PendingChannelId pcid Psbt fp = FundingPsbtVerify -> FundingStateStepRequest FSS.FundingStateStepPsbtVerifyRequest (FundingPsbtVerify -> FundingStateStepRequest) -> FundingPsbtVerify -> FundingStateStepRequest forall a b. (a -> b) -> a -> b $ FundingPsbtVerify :: Psbt -> PendingChannelId -> Bool -> FundingPsbtVerify FSS.FundingPsbtVerify { pendingChanId :: PendingChannelId FSS.pendingChanId = PendingChannelId pcid, fundedPsbt :: Psbt FSS.fundedPsbt = Psbt fp, skipFinalize :: Bool FSS.skipFinalize = Bool False } psbtFinalizeReq :: Lnd.PendingChannelId -> Lnd.Psbt -> FSS.FundingStateStepRequest psbtFinalizeReq :: PendingChannelId -> Psbt -> FundingStateStepRequest psbtFinalizeReq PendingChannelId pcid Psbt sp = FundingPsbtFinalize -> FundingStateStepRequest FSS.FundingStateStepPsbtFinalizeRequest (FundingPsbtFinalize -> FundingStateStepRequest) -> FundingPsbtFinalize -> FundingStateStepRequest forall a b. (a -> b) -> a -> b $ FundingPsbtFinalize :: Psbt -> PendingChannelId -> RawTx -> FundingPsbtFinalize FPF.FundingPsbtFinalize { signedPsbt :: Psbt FPF.signedPsbt = Psbt sp, pendingChanId :: PendingChannelId FPF.pendingChanId = PendingChannelId pcid, finalRawTx :: RawTx FPF.finalRawTx = ByteString -> RawTx Lnd.RawTx ByteString "" } shimCancelReq :: Lnd.PendingChannelId -> FSS.FundingStateStepRequest shimCancelReq :: PendingChannelId -> FundingStateStepRequest shimCancelReq PendingChannelId pcid = FundingShimCancel -> FundingStateStepRequest FSS.FundingStateStepShimCancelRequest (FundingShimCancel -> FundingStateStepRequest) -> FundingShimCancel -> FundingStateStepRequest forall a b. (a -> b) -> a -> b $ FundingShimCancel :: PendingChannelId -> FundingShimCancel FSC.FundingShimCancel {pendingChanId :: PendingChannelId FSC.pendingChanId = PendingChannelId pcid} finalizePsbt :: (Env m) => Lnd.Psbt -> ExceptT Failure m FNP.FinalizePsbtResponse finalizePsbt :: forall (m :: * -> *). Env m => Psbt -> ExceptT Failure m FinalizePsbtResponse finalizePsbt Psbt psbt = (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 (Psbt -> ByteString coerce Psbt psbt) Text "") unspendUtxoLookup :: (Env m) => ExceptT Failure m (Map OP.OutPoint LU.Utxo) unspendUtxoLookup :: forall (m :: * -> *). Env m => ExceptT Failure m (Map OutPoint Utxo) unspendUtxoLookup = do [Utxo] allUtxos <- ListUnspentResponse -> [Utxo] LU.utxos (ListUnspentResponse -> [Utxo]) -> ExceptT Failure m ListUnspentResponse -> ExceptT Failure m [Utxo] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (LndEnv -> ListUnspentRequest -> m (Either LndError ListUnspentResponse)) -> ((ListUnspentRequest -> m (Either LndError ListUnspentResponse)) -> m (Either LndError ListUnspentResponse)) -> ExceptT Failure m ListUnspentResponse forall (m :: * -> *) a b. Env m => (LndEnv -> a) -> (a -> m (Either LndError b)) -> ExceptT Failure m b withLndT LndEnv -> ListUnspentRequest -> m (Either LndError ListUnspentResponse) forall (m :: * -> *). (KatipContext m, MonadUnliftIO m) => LndEnv -> ListUnspentRequest -> m (Either LndError ListUnspentResponse) Lnd.listUnspent ((ListUnspentRequest -> m (Either LndError ListUnspentResponse)) -> ListUnspentRequest -> m (Either LndError ListUnspentResponse) forall a b. (a -> b) -> a -> b $ Int32 -> Int32 -> Text -> ListUnspentRequest LU.ListUnspentRequest Int32 0 Int32 forall a. Bounded a => a maxBound Text "") Map OutPoint Utxo -> ExceptT Failure m (Map OutPoint Utxo) forall (f :: * -> *) a. Applicative f => a -> f a pure (Map OutPoint Utxo -> ExceptT Failure m (Map OutPoint Utxo)) -> Map OutPoint Utxo -> ExceptT Failure m (Map OutPoint Utxo) forall a b. (a -> b) -> a -> b $ (Element [Utxo] -> Map OutPoint Utxo -> Map OutPoint Utxo) -> Map OutPoint Utxo -> [Utxo] -> Map OutPoint Utxo forall t b. Container t => (Element t -> b -> b) -> b -> t -> b foldr (\Element [Utxo] u Map OutPoint Utxo acc -> OutPoint -> Utxo -> Map OutPoint Utxo -> Map OutPoint Utxo forall k a. Ord k => k -> a -> Map k a -> Map k a M.insert (Utxo -> OutPoint LU.outpoint Element [Utxo] Utxo u) Element [Utxo] Utxo u Map OutPoint Utxo acc) Map OutPoint Utxo forall k a. Map k a M.empty [Utxo] allUtxos releaseUtxosPsbtLocks :: ( Env m ) => [PsbtUtxo] -> ExceptT Failure m () releaseUtxosPsbtLocks :: forall (m :: * -> *). Env m => [PsbtUtxo] -> ExceptT Failure m () releaseUtxosPsbtLocks = (Element [PsbtUtxo] -> ExceptT Failure m ()) -> [PsbtUtxo] -> ExceptT Failure m () forall t (m :: * -> *) b. (Container t, Monad m) => (Element t -> m b) -> t -> m () mapM_ ( \Element [PsbtUtxo] refUtxo -> Maybe UtxoLockId -> (UtxoLockId -> ExceptT Failure m ()) -> ExceptT Failure m () forall (f :: * -> *) a. Applicative f => Maybe a -> (a -> f ()) -> f () whenJust (PsbtUtxo -> Maybe UtxoLockId getLockId Element [PsbtUtxo] PsbtUtxo refUtxo) ( \UtxoLockId lid -> ExceptT Failure m ReleaseOutputResponse -> ExceptT Failure m () forall (f :: * -> *) a. Functor f => f a -> f () void (ExceptT Failure m ReleaseOutputResponse -> ExceptT Failure m ()) -> ExceptT Failure m ReleaseOutputResponse -> ExceptT Failure m () forall a b. (a -> b) -> a -> b $ (LndEnv -> ReleaseOutputRequest -> m (Either LndError ReleaseOutputResponse)) -> ((ReleaseOutputRequest -> m (Either LndError ReleaseOutputResponse)) -> m (Either LndError ReleaseOutputResponse)) -> ExceptT Failure m ReleaseOutputResponse forall (m :: * -> *) a b. Env m => (LndEnv -> a) -> (a -> m (Either LndError b)) -> ExceptT Failure m b withLndT LndEnv -> ReleaseOutputRequest -> m (Either LndError ReleaseOutputResponse) forall (m :: * -> *). (KatipContext m, MonadUnliftIO m) => LndEnv -> ReleaseOutputRequest -> m (Either LndError ReleaseOutputResponse) Lnd.releaseOutput ( (ReleaseOutputRequest -> m (Either LndError ReleaseOutputResponse)) -> ReleaseOutputRequest -> m (Either LndError ReleaseOutputResponse) forall a b. (a -> b) -> a -> b $ ByteString -> Maybe OutPoint -> ReleaseOutputRequest RO.ReleaseOutputRequest (UtxoLockId -> ByteString coerce UtxoLockId lid) (OutPoint -> Maybe OutPoint forall a. a -> Maybe a Just (OutPoint -> Maybe OutPoint) -> OutPoint -> Maybe OutPoint forall a b. (a -> b) -> a -> b $ PsbtUtxo -> OutPoint getOutPoint Element [PsbtUtxo] PsbtUtxo refUtxo) ) ) ) releaseUtxosLocks :: ( Env m ) => [FP.UtxoLease] -> ExceptT Failure m () releaseUtxosLocks :: forall (m :: * -> *). Env m => [UtxoLease] -> ExceptT Failure m () releaseUtxosLocks = (Element [UtxoLease] -> ExceptT Failure m ReleaseOutputResponse) -> [UtxoLease] -> ExceptT Failure m () forall t (m :: * -> *) b. (Container t, Monad m) => (Element t -> m b) -> t -> m () mapM_ (\Element [UtxoLease] r -> (LndEnv -> ReleaseOutputRequest -> m (Either LndError ReleaseOutputResponse)) -> ((ReleaseOutputRequest -> m (Either LndError ReleaseOutputResponse)) -> m (Either LndError ReleaseOutputResponse)) -> ExceptT Failure m ReleaseOutputResponse forall (m :: * -> *) a b. Env m => (LndEnv -> a) -> (a -> m (Either LndError b)) -> ExceptT Failure m b withLndT LndEnv -> ReleaseOutputRequest -> m (Either LndError ReleaseOutputResponse) forall (m :: * -> *). (KatipContext m, MonadUnliftIO m) => LndEnv -> ReleaseOutputRequest -> m (Either LndError ReleaseOutputResponse) Lnd.releaseOutput ((ReleaseOutputRequest -> m (Either LndError ReleaseOutputResponse)) -> ReleaseOutputRequest -> m (Either LndError ReleaseOutputResponse) forall a b. (a -> b) -> a -> b $ UtxoLease -> ReleaseOutputRequest toROR Element [UtxoLease] UtxoLease r)) where toROR :: UtxoLease -> ReleaseOutputRequest toROR (FP.UtxoLease ByteString id' OutPoint op Word64 _) = ByteString -> Maybe OutPoint -> ReleaseOutputRequest RO.ReleaseOutputRequest ByteString id' (OutPoint -> Maybe OutPoint forall a. a -> Maybe a Just OutPoint op) newLockId :: OP.OutPoint -> UtxoLockId newLockId :: OutPoint -> UtxoLockId newLockId OutPoint u = ByteString -> UtxoLockId UtxoLockId (ByteString -> UtxoLockId) -> (ByteString -> ByteString) -> ByteString -> UtxoLockId forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> ByteString L.toStrict (ByteString -> ByteString) -> (ByteString -> ByteString) -> ByteString -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . Digest SHA256State -> ByteString forall t. Digest t -> ByteString SHA.bytestringDigest (Digest SHA256State -> ByteString) -> (ByteString -> Digest SHA256State) -> ByteString -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> Digest SHA256State SHA.sha256 (ByteString -> UtxoLockId) -> ByteString -> UtxoLockId forall a b. (a -> b) -> a -> b $ ByteString txid ByteString -> ByteString -> ByteString forall a. Semigroup a => a -> a -> a <> ByteString ":" ByteString -> ByteString -> ByteString forall a. Semigroup a => a -> a -> a <> ByteString vout where txid :: ByteString txid = ByteString -> ByteString L.fromStrict (ByteString -> ByteString) -> (ByteString -> ByteString) -> ByteString -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> ByteString coerce (ByteString -> ByteString) -> ByteString -> ByteString forall a b. (a -> b) -> a -> b $ OutPoint -> ByteString OP.txid OutPoint u vout :: ByteString vout = Word32 -> ByteString forall b a. (Show a, IsString b) => a -> b Universum.show (Word32 -> ByteString) -> Word32 -> ByteString forall a b. (a -> b) -> a -> b $ OutPoint -> Word32 OP.outputIndex OutPoint u lockUtxo :: (Env m) => OP.OutPoint -> ExceptT Failure m FP.UtxoLease lockUtxo :: forall (m :: * -> *). Env m => OutPoint -> ExceptT Failure m UtxoLease lockUtxo OutPoint op = do ExceptT Failure m LeaseOutputResponse -> ExceptT Failure m () forall (f :: * -> *) a. Functor f => f a -> f () void (ExceptT Failure m LeaseOutputResponse -> ExceptT Failure m ()) -> ExceptT Failure m LeaseOutputResponse -> ExceptT Failure m () forall a b. (a -> b) -> a -> b $ (LndEnv -> LeaseOutputRequest -> m (Either LndError LeaseOutputResponse)) -> ((LeaseOutputRequest -> m (Either LndError LeaseOutputResponse)) -> m (Either LndError LeaseOutputResponse)) -> ExceptT Failure m LeaseOutputResponse forall (m :: * -> *) a b. Env m => (LndEnv -> a) -> (a -> m (Either LndError b)) -> ExceptT Failure m b withLndT LndEnv -> LeaseOutputRequest -> m (Either LndError LeaseOutputResponse) forall (m :: * -> *). (KatipContext m, MonadUnliftIO m) => LndEnv -> LeaseOutputRequest -> m (Either LndError LeaseOutputResponse) Lnd.leaseOutput ((LeaseOutputRequest -> m (Either LndError LeaseOutputResponse)) -> LeaseOutputRequest -> m (Either LndError LeaseOutputResponse) forall a b. (a -> b) -> a -> b $ ByteString -> Maybe OutPoint -> Word64 -> LeaseOutputRequest LO.LeaseOutputRequest (UtxoLockId -> ByteString coerce UtxoLockId lockId) (OutPoint -> Maybe OutPoint forall a. a -> Maybe a Just OutPoint op) Word64 expS) UtxoLease -> ExceptT Failure m UtxoLease forall (f :: * -> *) a. Applicative f => a -> f a pure UtxoLease :: ByteString -> OutPoint -> Word64 -> UtxoLease FP.UtxoLease { id :: ByteString FP.id = UtxoLockId -> ByteString coerce UtxoLockId lockId, expiration :: Word64 FP.expiration = Word64 expS, outpoint :: OutPoint FP.outpoint = OutPoint op } where Word64 expS :: Word64 = Word64 3600 Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a * Word64 24 Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a * Word64 365 Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a * Word64 10 lockId :: UtxoLockId lockId = OutPoint -> UtxoLockId newLockId OutPoint op lockUtxos :: (Env m) => [OP.OutPoint] -> ExceptT Failure m [FP.UtxoLease] lockUtxos :: forall (m :: * -> *). Env m => [OutPoint] -> ExceptT Failure m [UtxoLease] lockUtxos = (OutPoint -> ExceptT Failure m UtxoLease) -> [OutPoint] -> ExceptT Failure m [UtxoLease] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM OutPoint -> ExceptT Failure m UtxoLease forall (m :: * -> *). Env m => OutPoint -> ExceptT Failure m UtxoLease lockUtxo