{-# LANGUAGE TypeApplications #-}

module BtcLsp.Class.Env
  ( Env (..),
  )
where

import BtcLsp.Class.Storage
import BtcLsp.Data.Kind
import BtcLsp.Data.Type
import BtcLsp.Grpc.Combinator
import BtcLsp.Grpc.Orphan ()
import BtcLsp.Grpc.Server.LowLevel
import BtcLsp.Import.External
import Data.ProtoLens.Field
import qualified LndClient as Lnd
import qualified LndClient.Data.GetInfo as Lnd
import qualified LndClient.Data.WalletBalance as Lnd
import qualified LndClient.RPC.Katip as Lnd
import qualified Network.Bitcoin as Btc
import qualified Proto.BtcLsp.Data.HighLevel as Proto
import qualified Proto.BtcLsp.Data.HighLevel_Fields as Proto

class
  ( MonadUnliftIO m,
    KatipContext m,
    Storage m
  ) =>
  Env m
  where
  getGsEnv :: m GSEnv
  getSwapIntoLnMinAmt :: m (Money 'Usr 'OnChain 'Fund)
  getMsatPerByte :: m (Maybe MSat)
  getLspPubKeyVar :: m (MVar Lnd.NodePubKey)
  getLndP2PSocketAddress :: m SocketAddress
  getLndNodeUri :: m NodeUri
  getLspPubKey :: m Lnd.NodePubKey
  getLspLndEnv :: m Lnd.LndEnv
  getYesodLog :: m YesodLog
  getLndNodeUri =
    NodePubKey -> SocketAddress -> NodeUri
NodeUri (NodePubKey -> SocketAddress -> NodeUri)
-> m NodePubKey -> m (SocketAddress -> NodeUri)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m NodePubKey
forall (m :: * -> *). Env m => m NodePubKey
getLspPubKey m (SocketAddress -> NodeUri) -> m SocketAddress -> m NodeUri
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m SocketAddress
forall (m :: * -> *). Env m => m SocketAddress
getLndP2PSocketAddress
  getLspPubKey = do
    MVar NodePubKey
var <- m (MVar NodePubKey)
forall (m :: * -> *). Env m => m (MVar NodePubKey)
getLspPubKeyVar
    Maybe NodePubKey
mPubKey <- MVar NodePubKey -> m (Maybe NodePubKey)
forall (m :: * -> *) a. MonadIO m => MVar a -> m (Maybe a)
tryReadMVar MVar NodePubKey
var
    case Maybe NodePubKey
mPubKey of
      Just NodePubKey
pubKey ->
        NodePubKey -> m NodePubKey
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodePubKey
pubKey
      Maybe NodePubKey
Nothing -> do
        Either Failure GetInfoResponse
eRes <- (LndEnv -> m (Either LndError GetInfoResponse))
-> (m (Either LndError GetInfoResponse)
    -> m (Either LndError GetInfoResponse))
-> m (Either Failure GetInfoResponse)
forall (m :: * -> *) a b.
Env m =>
(LndEnv -> a)
-> (a -> m (Either LndError b)) -> m (Either Failure b)
withLnd LndEnv -> m (Either LndError GetInfoResponse)
forall (m :: * -> *).
(KatipContext m, MonadUnliftIO m) =>
LndEnv -> m (Either LndError GetInfoResponse)
Lnd.getInfo m (Either LndError GetInfoResponse)
-> m (Either LndError GetInfoResponse)
forall a. a -> a
id
        case Either Failure GetInfoResponse
eRes of
          Left Failure
e ->
            --
            -- NOTE : there is fatal failure here,
            -- because lnd-lsp is meaningless without
            -- operational lnd.
            --
            Text -> m NodePubKey
forall a. HasCallStack => Text -> a
error (Text -> m NodePubKey) -> Text -> m NodePubKey
forall a b. (a -> b) -> a -> b
$
              Text
"Fatal Lnd failure, can not get NodePubKey: "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Failure -> Text
forall a. Out a => a -> Text
inspectPlain Failure
e
          Right GetInfoResponse
res -> do
            let pubKey :: NodePubKey
pubKey = GetInfoResponse -> NodePubKey
Lnd.identityPubkey GetInfoResponse
res
            m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ MVar NodePubKey -> NodePubKey -> m Bool
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m Bool
tryPutMVar MVar NodePubKey
var NodePubKey
pubKey
            NodePubKey -> m NodePubKey
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodePubKey
pubKey
  setGrpcCtx ::
    ( HasField msg "ctx" Proto.Ctx
    ) =>
    msg ->
    m msg
  setGrpcCtx msg
message = do
    Nonce
nonce <- m Nonce
forall (m :: * -> *). MonadIO m => m Nonce
newNonce
    NodePubKey
pubKey <- m NodePubKey
forall (m :: * -> *). Env m => m NodePubKey
getLspPubKey
    msg -> m msg
forall (f :: * -> *) a. Applicative f => a -> f a
pure (msg -> m msg) -> msg -> m msg
forall a b. (a -> b) -> a -> b
$
      msg
message
        msg -> (msg -> msg) -> msg
forall a b. a -> (a -> b) -> b
& forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
field @"ctx"
          ((Ctx -> Identity Ctx) -> msg -> Identity msg) -> Ctx -> msg -> msg
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ( Ctx
forall msg. Message msg => msg
defMessage
                 Ctx -> (Ctx -> Ctx) -> Ctx
forall a b. a -> (a -> b) -> b
& LensLike' Identity Ctx Nonce
forall (f :: * -> *) s a.
(Functor f, HasField s "nonce" a) =>
LensLike' f s a
Proto.nonce
                   LensLike' Identity Ctx Nonce -> Nonce -> Ctx -> Ctx
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 @Nonce @Proto.Nonce Nonce
nonce
                 Ctx -> (Ctx -> Ctx) -> Ctx
forall a b. a -> (a -> b) -> b
& LensLike' Identity Ctx LnPubKey
forall (f :: * -> *) s a.
(Functor f, HasField s "lnPubKey" a) =>
LensLike' f s a
Proto.lnPubKey
                   LensLike' Identity Ctx LnPubKey -> LnPubKey -> Ctx -> Ctx
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 @Lnd.NodePubKey @Proto.LnPubKey NodePubKey
pubKey
             )
  setGrpcCtxT ::
    ( HasField msg "ctx" Proto.Ctx
    ) =>
    msg ->
    ExceptT Failure m msg
  setGrpcCtxT =
    m msg -> ExceptT Failure m msg
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m msg -> ExceptT Failure m msg)
-> (msg -> m msg) -> msg -> ExceptT Failure m msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. msg -> m msg
forall (m :: * -> *) msg.
(Env m, HasField msg "ctx" Ctx) =>
msg -> m msg
setGrpcCtx
  withLnd ::
    (Lnd.LndEnv -> a) ->
    (a -> m (Either Lnd.LndError b)) ->
    m (Either Failure b)
  withLndT ::
    (Lnd.LndEnv -> a) ->
    (a -> m (Either Lnd.LndError b)) ->
    ExceptT Failure m b
  withLndT LndEnv -> a
method =
    m (Either Failure b) -> ExceptT Failure m b
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Failure b) -> ExceptT Failure m b)
-> ((a -> m (Either LndError b)) -> m (Either Failure b))
-> (a -> m (Either LndError b))
-> ExceptT Failure m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LndEnv -> a)
-> (a -> m (Either LndError b)) -> m (Either Failure b)
forall (m :: * -> *) a b.
Env m =>
(LndEnv -> a)
-> (a -> m (Either LndError b)) -> m (Either Failure b)
withLnd LndEnv -> a
method
  withLndServerT ::
    ( GrpcRes res failure specific
    ) =>
    (Lnd.LndEnv -> a) ->
    (a -> m (Either Lnd.LndError b)) ->
    ExceptT res m b
  withLndServerT LndEnv -> a
method =
    (Failure -> res) -> ExceptT Failure m b -> ExceptT res m b
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT (res -> Failure -> res
forall a b. a -> b -> a
const (res -> Failure -> res) -> res -> Failure -> res
forall a b. (a -> b) -> a -> b
$ FailureInternal -> res
forall res failure specific.
GrpcRes res failure specific =>
FailureInternal -> res
newInternalFailure FailureInternal
FailureRedacted)
      (ExceptT Failure m b -> ExceptT res m b)
-> ((a -> m (Either LndError b)) -> ExceptT Failure m b)
-> (a -> m (Either LndError b))
-> ExceptT res m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LndEnv -> a)
-> (a -> m (Either LndError b)) -> ExceptT Failure m b
forall (m :: * -> *) a b.
Env m =>
(LndEnv -> a)
-> (a -> m (Either LndError b)) -> ExceptT Failure m b
withLndT LndEnv -> a
method
  withBtc ::
    (Btc.Client -> a) ->
    (a -> IO b) ->
    m (Either Failure b)
  withBtcT ::
    (Btc.Client -> a) ->
    (a -> IO b) ->
    ExceptT Failure m b
  withBtcT Client -> a
method =
    m (Either Failure b) -> ExceptT Failure m b
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Failure b) -> ExceptT Failure m b)
-> ((a -> IO b) -> m (Either Failure b))
-> (a -> IO b)
-> ExceptT Failure m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Client -> a) -> (a -> IO b) -> m (Either Failure b)
forall (m :: * -> *) a b.
Env m =>
(Client -> a) -> (a -> IO b) -> m (Either Failure b)
withBtc Client -> a
method
  monitorTotalExtOutgoingLiquidity :: Liquidity 'Outgoing -> m ()
  monitorTotalExtIncomingLiquidity :: Liquidity 'Incoming -> m ()
  monitorTotalOnChainLiquidity :: Lnd.WalletBalance -> m ()