{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
module BtcLsp.Grpc.Server.HighLevel
( swapIntoLn,
swapIntoLnT,
getCfg,
)
where
import qualified BtcLsp.Data.Smart as Smart
import BtcLsp.Import
import qualified BtcLsp.Math.Swap as Math
import qualified BtcLsp.Storage.Model.SwapIntoLn as SwapIntoLn
import qualified LndClient as Lnd
import qualified LndClient.Data.NewAddress as Lnd
import qualified LndClient.RPC.Katip as Lnd
import qualified Proto.BtcLsp.Data.HighLevel as Grpc
import qualified Proto.BtcLsp.Data.HighLevel_Fields as Grpc
import qualified Proto.BtcLsp.Method.GetCfg as GetCfg
import qualified Proto.BtcLsp.Method.GetCfg_Fields as GetCfg
import qualified Proto.BtcLsp.Method.SwapIntoLn as SwapIntoLn
import qualified Proto.BtcLsp.Method.SwapIntoLn_Fields as SwapIntoLn
swapIntoLn ::
( Env m
) =>
Entity User ->
SwapIntoLn.Request ->
m SwapIntoLn.Response
swapIntoLn :: forall (m :: * -> *). Env m => Entity User -> Request -> m Response
swapIntoLn Entity User
userEnt Request
req = do
Either Response (Entity SwapIntoLn)
res <- ExceptT Response m (Entity SwapIntoLn)
-> m (Either Response (Entity SwapIntoLn))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Response m (Entity SwapIntoLn)
-> m (Either Response (Entity SwapIntoLn)))
-> ExceptT Response m (Entity SwapIntoLn)
-> m (Either Response (Entity SwapIntoLn))
forall a b. (a -> b) -> a -> b
$ do
Privacy
privacy <-
ReversedFieldLocation
-> Maybe Privacy -> ExceptT Response m Privacy
forall a b res failure specific (m :: * -> *).
(From a b, 'False ~ (a == b), GrpcRes res failure specific,
Monad m) =>
ReversedFieldLocation -> Maybe a -> ExceptT res m b
fromReqT
$( mkFieldLocation
@SwapIntoLn.Request
[ "privacy"
]
)
(Maybe Privacy -> ExceptT Response m Privacy)
-> Maybe Privacy -> ExceptT Response m Privacy
forall a b. (a -> b) -> a -> b
$ Request
req Request -> Getting (First Privacy) Request Privacy -> Maybe Privacy
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Privacy) Request Privacy
forall (f :: * -> *) s a.
(Functor f, HasField s "privacy" a) =>
LensLike' f s a
SwapIntoLn.privacy
UnsafeOnChainAddress 'Refund
unsafeRefundAddr <-
ReversedFieldLocation
-> Maybe RefundOnChainAddress
-> ExceptT Response m (UnsafeOnChainAddress 'Refund)
forall a b res failure specific (m :: * -> *).
(From a b, 'False ~ (a == b), GrpcRes res failure specific,
Monad m) =>
ReversedFieldLocation -> Maybe a -> ExceptT res m b
fromReqT
$( mkFieldLocation
@SwapIntoLn.Request
[ "refund_on_chain_address"
]
)
(Maybe RefundOnChainAddress
-> ExceptT Response m (UnsafeOnChainAddress 'Refund))
-> Maybe RefundOnChainAddress
-> ExceptT Response m (UnsafeOnChainAddress 'Refund)
forall a b. (a -> b) -> a -> b
$ Request
req Request
-> Getting
(Maybe RefundOnChainAddress) Request (Maybe RefundOnChainAddress)
-> Maybe RefundOnChainAddress
forall s a. s -> Getting a s a -> a
^. Getting
(Maybe RefundOnChainAddress) Request (Maybe RefundOnChainAddress)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'refundOnChainAddress" a) =>
LensLike' f s a
SwapIntoLn.maybe'refundOnChainAddress
Entity User
-> UnsafeOnChainAddress 'Refund
-> Privacy
-> ExceptT Response m (Entity SwapIntoLn)
forall (m :: * -> *).
Env m =>
Entity User
-> UnsafeOnChainAddress 'Refund
-> Privacy
-> ExceptT Response m (Entity SwapIntoLn)
swapIntoLnT
Entity User
userEnt
UnsafeOnChainAddress 'Refund
unsafeRefundAddr
Privacy
privacy
Response -> m Response
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ case Either Response (Entity SwapIntoLn)
res of
Left Response
e -> Response
e
Right (Entity Key SwapIntoLn
_ SwapIntoLn
swap) ->
Response
forall msg. Message msg => msg
defMessage
Response -> (Response -> Response) -> Response
forall a b. a -> (a -> b) -> b
& LensLike' Identity Response Response'Success
forall (f :: * -> *) s a.
(Functor f, HasField s "success" a) =>
LensLike' f s a
SwapIntoLn.success
LensLike' Identity Response Response'Success
-> Response'Success -> Response -> Response
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ( Response'Success
forall msg. Message msg => msg
defMessage
Response'Success
-> (Response'Success -> Response'Success) -> Response'Success
forall a b. a -> (a -> b) -> b
& LensLike' Identity Response'Success FundOnChainAddress
forall (f :: * -> *) s a.
(Functor f, HasField s "fundOnChainAddress" a) =>
LensLike' f s a
SwapIntoLn.fundOnChainAddress
LensLike' Identity Response'Success FundOnChainAddress
-> FundOnChainAddress -> Response'Success -> Response'Success
forall s t a b. ASetter s t a b -> b -> s -> t
.~ OnChainAddress 'Fund -> FundOnChainAddress
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from (SwapIntoLn -> OnChainAddress 'Fund
swapIntoLnFundAddress SwapIntoLn
swap)
Response'Success
-> (Response'Success -> Response'Success) -> Response'Success
forall a b. a -> (a -> b) -> b
& LensLike' Identity Response'Success FundMoney
forall (f :: * -> *) s a.
(Functor f, HasField s "minFundMoney" a) =>
LensLike' f s a
SwapIntoLn.minFundMoney
LensLike' Identity Response'Success FundMoney
-> FundMoney -> Response'Success -> Response'Success
forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from @MSat
( Money 'Usr 'Ln 'Fund -> MSat
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from (SwapIntoLn -> Money 'Usr 'Ln 'Fund
swapIntoLnChanCapUser SwapIntoLn
swap)
MSat -> MSat -> MSat
forall a. Num a => a -> a -> a
+ Money 'Lsp 'OnChain 'Gain -> MSat
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from (SwapIntoLn -> Money 'Lsp 'OnChain 'Gain
swapIntoLnFeeLsp SwapIntoLn
swap)
)
)
swapIntoLnT ::
( Env m
) =>
Entity User ->
UnsafeOnChainAddress 'Refund ->
Privacy ->
ExceptT SwapIntoLn.Response m (Entity SwapIntoLn)
swapIntoLnT :: forall (m :: * -> *).
Env m =>
Entity User
-> UnsafeOnChainAddress 'Refund
-> Privacy
-> ExceptT Response m (Entity SwapIntoLn)
swapIntoLnT Entity User
userEnt UnsafeOnChainAddress 'Refund
unsafeRefundAddr Privacy
chanPrivacy = do
OnChainAddress 'Refund
refundAddr <-
(Failure -> Response)
-> ExceptT Failure m (OnChainAddress 'Refund)
-> ExceptT Response m (OnChainAddress 'Refund)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT
( \case
FailureInp FailureInput
FailureNonce ->
InputFailureKind -> ReversedFieldLocation -> Response
forall res failure specific.
GrpcRes res failure specific =>
InputFailureKind -> ReversedFieldLocation -> res
newGenFailure
InputFailureKind
Grpc.VERIFICATION_FAILED
$( mkFieldLocation
@SwapIntoLn.Request
[ "ctx",
"nonce"
]
)
FailureInp FailureInput
FailureNonSegwitAddr ->
Response'Failure'InputFailure -> Response
forall res failure specific.
GrpcRes res failure specific =>
specific -> res
newSpecFailure Response'Failure'InputFailure
SwapIntoLn.Response'Failure'REFUND_ON_CHAIN_ADDRESS_IS_NOT_SEGWIT
FailureInp FailureInput
FailureNonValidAddr ->
Response'Failure'InputFailure -> Response
forall res failure specific.
GrpcRes res failure specific =>
specific -> res
newSpecFailure Response'Failure'InputFailure
SwapIntoLn.Response'Failure'REFUND_ON_CHAIN_ADDRESS_IS_NOT_VALID
FailureInt FailureInternal
e ->
FailureInternal -> Response
forall res failure specific.
GrpcRes res failure specific =>
FailureInternal -> res
newInternalFailure FailureInternal
e
)
(ExceptT Failure m (OnChainAddress 'Refund)
-> ExceptT Response m (OnChainAddress 'Refund))
-> ExceptT Failure m (OnChainAddress 'Refund)
-> ExceptT Response m (OnChainAddress 'Refund)
forall a b. (a -> b) -> a -> b
$ UnsafeOnChainAddress 'Refund
-> ExceptT Failure m (OnChainAddress 'Refund)
forall (m :: * -> *) (mrel :: MoneyRelation).
Env m =>
UnsafeOnChainAddress mrel
-> ExceptT Failure m (OnChainAddress mrel)
Smart.newOnChainAddressT UnsafeOnChainAddress 'Refund
unsafeRefundAddr
OnChainAddress 'Fund
fundAddr <-
NewAddressResponse -> OnChainAddress 'Fund
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from
(NewAddressResponse -> OnChainAddress 'Fund)
-> ExceptT Response m NewAddressResponse
-> ExceptT Response m (OnChainAddress 'Fund)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LndEnv
-> NewAddressRequest -> m (Either LndError NewAddressResponse))
-> ((NewAddressRequest -> m (Either LndError NewAddressResponse))
-> m (Either LndError NewAddressResponse))
-> ExceptT Response m NewAddressResponse
forall (m :: * -> *) res failure specific a b.
(Env m, GrpcRes res failure specific) =>
(LndEnv -> a) -> (a -> m (Either LndError b)) -> ExceptT res m b
withLndServerT
LndEnv
-> NewAddressRequest -> m (Either LndError NewAddressResponse)
forall (m :: * -> *).
(KatipContext m, MonadUnliftIO m) =>
LndEnv
-> NewAddressRequest -> m (Either LndError NewAddressResponse)
Lnd.newAddress
( (NewAddressRequest -> m (Either LndError NewAddressResponse))
-> NewAddressRequest -> m (Either LndError NewAddressResponse)
forall a b. (a -> b) -> a -> b
$
NewAddressRequest :: AddressType -> Maybe String -> NewAddressRequest
Lnd.NewAddressRequest
{ addrType :: AddressType
Lnd.addrType = AddressType
Lnd.WITNESS_PUBKEY_HASH,
account :: Maybe String
Lnd.account = Maybe String
forall a. Maybe a
Nothing
}
)
NewAddressResponse
feeAndChangeAddr <-
(LndEnv
-> NewAddressRequest -> m (Either LndError NewAddressResponse))
-> ((NewAddressRequest -> m (Either LndError NewAddressResponse))
-> m (Either LndError NewAddressResponse))
-> ExceptT Response m NewAddressResponse
forall (m :: * -> *) res failure specific a b.
(Env m, GrpcRes res failure specific) =>
(LndEnv -> a) -> (a -> m (Either LndError b)) -> ExceptT res m b
withLndServerT
LndEnv
-> NewAddressRequest -> m (Either LndError NewAddressResponse)
forall (m :: * -> *).
(KatipContext m, MonadUnliftIO m) =>
LndEnv
-> NewAddressRequest -> m (Either LndError NewAddressResponse)
Lnd.newAddress
( (NewAddressRequest -> m (Either LndError NewAddressResponse))
-> NewAddressRequest -> m (Either LndError NewAddressResponse)
forall a b. (a -> b) -> a -> b
$
NewAddressRequest :: AddressType -> Maybe String -> NewAddressRequest
Lnd.NewAddressRequest
{ addrType :: AddressType
Lnd.addrType = AddressType
Lnd.WITNESS_PUBKEY_HASH,
account :: Maybe String
Lnd.account = Maybe String
forall a. Maybe a
Nothing
}
)
UTCTime
expAt <-
Seconds -> ExceptT Response m UTCTime
forall (m :: * -> *). MonadIO m => Seconds -> m UTCTime
getFutureTime
(Seconds -> ExceptT Response m UTCTime)
-> (Word64 -> Seconds) -> Word64 -> ExceptT Response m UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Seconds
Lnd.Seconds
(Word64 -> ExceptT Response m UTCTime)
-> Word64 -> ExceptT Response m UTCTime
forall a b. (a -> b) -> a -> b
$ Word64
7 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
24 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
60 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
60
m (Entity SwapIntoLn) -> ExceptT Response m (Entity SwapIntoLn)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
(m (Entity SwapIntoLn) -> ExceptT Response m (Entity SwapIntoLn))
-> (Privacy -> m (Entity SwapIntoLn))
-> Privacy
-> ExceptT Response m (Entity SwapIntoLn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT SqlBackend m (Entity SwapIntoLn) -> m (Entity SwapIntoLn)
forall (m :: * -> *) a. Storage m => ReaderT SqlBackend m a -> m a
runSql
(ReaderT SqlBackend m (Entity SwapIntoLn) -> m (Entity SwapIntoLn))
-> (Privacy -> ReaderT SqlBackend m (Entity SwapIntoLn))
-> Privacy
-> m (Entity SwapIntoLn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity User
-> OnChainAddress 'Fund
-> OnChainAddress 'Gain
-> OnChainAddress 'Refund
-> UTCTime
-> Privacy
-> ReaderT SqlBackend m (Entity SwapIntoLn)
forall (m :: * -> *).
MonadIO m =>
Entity User
-> OnChainAddress 'Fund
-> OnChainAddress 'Gain
-> OnChainAddress 'Refund
-> UTCTime
-> Privacy
-> ReaderT SqlBackend m (Entity SwapIntoLn)
SwapIntoLn.createIgnoreSql
Entity User
userEnt
OnChainAddress 'Fund
fundAddr
(NewAddressResponse -> OnChainAddress 'Gain
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from NewAddressResponse
feeAndChangeAddr)
OnChainAddress 'Refund
refundAddr
UTCTime
expAt
(Privacy -> ExceptT Response m (Entity SwapIntoLn))
-> Privacy -> ExceptT Response m (Entity SwapIntoLn)
forall a b. (a -> b) -> a -> b
$ Privacy
chanPrivacy
getCfg ::
( Env m
) =>
Entity User ->
GetCfg.Request ->
m GetCfg.Response
getCfg :: forall (m :: * -> *). Env m => Entity User -> Request -> m Response
getCfg Entity User
_ Request
_ = do
NodePubKey
pub <- m NodePubKey
forall (m :: * -> *). Env m => m NodePubKey
getLspPubKey
SocketAddress
sa <- m SocketAddress
forall (m :: * -> *). Env m => m SocketAddress
getLndP2PSocketAddress
Money 'Usr 'OnChain 'Fund
swapMinAmt <- m (Money 'Usr 'OnChain 'Fund)
forall (m :: * -> *). Env m => m (Money 'Usr 'OnChain 'Fund)
getSwapIntoLnMinAmt
Response -> m Response
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$
Response
forall msg. Message msg => msg
defMessage
Response -> (Response -> Response) -> Response
forall a b. a -> (a -> b) -> b
& LensLike' Identity Response Response'Success
forall (f :: * -> *) s a.
(Functor f, HasField s "success" a) =>
LensLike' f s a
GetCfg.success
LensLike' Identity Response Response'Success
-> Response'Success -> Response -> Response
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ( Response'Success
forall msg. Message msg => msg
defMessage
Response'Success
-> (Response'Success -> Response'Success) -> Response'Success
forall a b. a -> (a -> b) -> b
& LensLike' Identity Response'Success [LnPeer]
forall (f :: * -> *) s a.
(Functor f, HasField s "lspLnNodes" a) =>
LensLike' f s a
GetCfg.lspLnNodes
LensLike' Identity Response'Success [LnPeer]
-> [LnPeer] -> Response'Success -> Response'Success
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ LnPeer
forall msg. Message msg => msg
defMessage
LnPeer -> (LnPeer -> LnPeer) -> LnPeer
forall a b. a -> (a -> b) -> b
& LensLike' Identity LnPeer LnPubKey
forall (f :: * -> *) s a.
(Functor f, HasField s "pubKey" a) =>
LensLike' f s a
Grpc.pubKey
LensLike' Identity LnPeer LnPubKey -> LnPubKey -> LnPeer -> LnPeer
forall s t a b. ASetter s t a b -> b -> s -> t
.~ NodePubKey -> LnPubKey
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from NodePubKey
pub
LnPeer -> (LnPeer -> LnPeer) -> LnPeer
forall a b. a -> (a -> b) -> b
& LensLike' Identity LnPeer LnHost
forall (f :: * -> *) s a.
(Functor f, HasField s "host" a) =>
LensLike' f s a
Grpc.host
LensLike' Identity LnPeer LnHost -> LnHost -> LnPeer -> LnPeer
forall s t a b. ASetter s t a b -> b -> s -> t
.~ String -> LnHost
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from (SocketAddress -> String
socketAddressHost SocketAddress
sa)
LnPeer -> (LnPeer -> LnPeer) -> LnPeer
forall a b. a -> (a -> b) -> b
& LensLike' Identity LnPeer LnPort
forall (f :: * -> *) s a.
(Functor f, HasField s "port" a) =>
LensLike' f s a
Grpc.port
LensLike' Identity LnPeer LnPort -> LnPort -> LnPeer -> LnPeer
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PortNumber -> LnPort
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from (SocketAddress -> PortNumber
socketAddressPort SocketAddress
sa)
]
Response'Success
-> (Response'Success -> Response'Success) -> Response'Success
forall a b. a -> (a -> b) -> b
& LensLike' Identity Response'Success LocalBalance
forall (f :: * -> *) s a.
(Functor f, HasField s "swapIntoLnMinAmt" a) =>
LensLike' f s a
GetCfg.swapIntoLnMinAmt
LensLike' Identity Response'Success LocalBalance
-> LocalBalance -> Response'Success -> Response'Success
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Money 'Usr 'OnChain 'Fund -> LocalBalance
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from Money 'Usr 'OnChain 'Fund
swapMinAmt
Response'Success
-> (Response'Success -> Response'Success) -> Response'Success
forall a b. a -> (a -> b) -> b
& LensLike' Identity Response'Success LocalBalance
forall (f :: * -> *) s a.
(Functor f, HasField s "swapIntoLnMaxAmt" a) =>
LensLike' f s a
GetCfg.swapIntoLnMaxAmt
LensLike' Identity Response'Success LocalBalance
-> LocalBalance -> Response'Success -> Response'Success
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Money 'Usr Any 'Fund -> LocalBalance
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from Money 'Usr Any 'Fund
forall (btcl :: BitcoinLayer). Money 'Usr btcl 'Fund
Math.swapLnMaxAmt
Response'Success
-> (Response'Success -> Response'Success) -> Response'Success
forall a b. a -> (a -> b) -> b
& LensLike' Identity Response'Success LocalBalance
forall (f :: * -> *) s a.
(Functor f, HasField s "swapFromLnMinAmt" a) =>
LensLike' f s a
GetCfg.swapFromLnMinAmt
LensLike' Identity Response'Success LocalBalance
-> LocalBalance -> Response'Success -> Response'Success
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Money 'Usr 'OnChain 'Fund -> LocalBalance
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from Money 'Usr 'OnChain 'Fund
swapMinAmt
Response'Success
-> (Response'Success -> Response'Success) -> Response'Success
forall a b. a -> (a -> b) -> b
& LensLike' Identity Response'Success LocalBalance
forall (f :: * -> *) s a.
(Functor f, HasField s "swapFromLnMaxAmt" a) =>
LensLike' f s a
GetCfg.swapFromLnMaxAmt
LensLike' Identity Response'Success LocalBalance
-> LocalBalance -> Response'Success -> Response'Success
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Money 'Usr Any 'Fund -> LocalBalance
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from Money 'Usr Any 'Fund
forall (btcl :: BitcoinLayer). Money 'Usr btcl 'Fund
Math.swapLnMaxAmt
Response'Success
-> (Response'Success -> Response'Success) -> Response'Success
forall a b. a -> (a -> b) -> b
& LensLike' Identity Response'Success FeeRate
forall (f :: * -> *) s a.
(Functor f, HasField s "swapLnFeeRate" a) =>
LensLike' f s a
GetCfg.swapLnFeeRate
LensLike' Identity Response'Success FeeRate
-> FeeRate -> Response'Success -> Response'Success
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FeeRate -> FeeRate
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from FeeRate
Math.swapLnFeeRate
Response'Success
-> (Response'Success -> Response'Success) -> Response'Success
forall a b. a -> (a -> b) -> b
& LensLike' Identity Response'Success FeeMoney
forall (f :: * -> *) s a.
(Functor f, HasField s "swapLnMinFee" a) =>
LensLike' f s a
GetCfg.swapLnMinFee
LensLike' Identity Response'Success FeeMoney
-> FeeMoney -> Response'Success -> Response'Success
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Money 'Lsp Any 'Gain -> FeeMoney
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from Money 'Lsp Any 'Gain
forall (btcl :: BitcoinLayer). Money 'Lsp btcl 'Gain
Math.swapLnMinFee
)