module BtcLsp.Grpc.Client.LowLevel
  ( runUnary,
    GCEnv (..),
    GCPort (..),
  )
where

import BtcLsp.Grpc.Data
import BtcLsp.Grpc.Orphan ()
import qualified BtcLsp.Grpc.Sig as Sig
import BtcLsp.Import.Witch
import Data.Aeson
  ( FromJSON (..),
    withObject,
    withScientific,
    (.:),
    (.:?),
  )
import qualified Data.Binary.Builder as BS
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Lazy as BL
import qualified Data.CaseInsensitive as CI
import Data.Coerce (coerce)
import Data.ProtoLens (Message)
import Data.ProtoLens.Encoding (encodeMessage)
import Data.ProtoLens.Service.Types (HasMethod, HasMethodImpl (..))
import Data.Scientific (floatingOrInteger)
import GHC.TypeLits (Symbol)
import Network.GRPC.Client
import Network.GRPC.Client.Helpers
import qualified Network.GRPC.HTTP2.Encoding as G
import qualified Network.GRPC.HTTP2.ProtoLens as ProtoLens
import Network.HTTP2.Client2
import Text.PrettyPrint.GenericPretty
  ( Out,
  )
import Text.PrettyPrint.GenericPretty.Import
  ( inspectPlain,
  )
import Universum

data GCEnv = GCEnv
  { GCEnv -> String
gcEnvHost :: String,
    GCEnv -> GCPort
gcEnvPort :: GCPort,
    GCEnv -> Maybe Encryption
gcEnvEncryption :: Maybe Encryption,
    GCEnv -> SigHeaderName
gcEnvSigHeaderName :: SigHeaderName,
    GCEnv -> CompressMode
gcEnvCompressMode :: CompressMode,
    GCEnv -> MsgToSign -> IO (Maybe LndSig)
gcEnvSigner :: Sig.MsgToSign -> IO (Maybe Sig.LndSig)
  }
  deriving stock
    ( (forall x. GCEnv -> Rep GCEnv x)
-> (forall x. Rep GCEnv x -> GCEnv) -> Generic GCEnv
forall x. Rep GCEnv x -> GCEnv
forall x. GCEnv -> Rep GCEnv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GCEnv x -> GCEnv
$cfrom :: forall x. GCEnv -> Rep GCEnv x
Generic
    )

instance FromJSON GCEnv where
  parseJSON :: Value -> Parser GCEnv
parseJSON =
    String -> (Object -> Parser GCEnv) -> Value -> Parser GCEnv
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"GCEnv"
      ( \Object
x ->
          String
-> GCPort
-> Maybe Encryption
-> SigHeaderName
-> CompressMode
-> (MsgToSign -> IO (Maybe LndSig))
-> GCEnv
GCEnv
            (String
 -> GCPort
 -> Maybe Encryption
 -> SigHeaderName
 -> CompressMode
 -> (MsgToSign -> IO (Maybe LndSig))
 -> GCEnv)
-> Parser String
-> Parser
     (GCPort
      -> Maybe Encryption
      -> SigHeaderName
      -> CompressMode
      -> (MsgToSign -> IO (Maybe LndSig))
      -> GCEnv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
x Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"host"
            Parser
  (GCPort
   -> Maybe Encryption
   -> SigHeaderName
   -> CompressMode
   -> (MsgToSign -> IO (Maybe LndSig))
   -> GCEnv)
-> Parser GCPort
-> Parser
     (Maybe Encryption
      -> SigHeaderName
      -> CompressMode
      -> (MsgToSign -> IO (Maybe LndSig))
      -> GCEnv)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Text -> Parser GCPort
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"port"
            Parser
  (Maybe Encryption
   -> SigHeaderName
   -> CompressMode
   -> (MsgToSign -> IO (Maybe LndSig))
   -> GCEnv)
-> Parser (Maybe Encryption)
-> Parser
     (SigHeaderName
      -> CompressMode -> (MsgToSign -> IO (Maybe LndSig)) -> GCEnv)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Text -> Parser (Maybe Encryption)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"encryption"
            Parser
  (SigHeaderName
   -> CompressMode -> (MsgToSign -> IO (Maybe LndSig)) -> GCEnv)
-> Parser SigHeaderName
-> Parser
     (CompressMode -> (MsgToSign -> IO (Maybe LndSig)) -> GCEnv)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Text -> Parser SigHeaderName
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"sig_header_name"
            Parser (CompressMode -> (MsgToSign -> IO (Maybe LndSig)) -> GCEnv)
-> Parser CompressMode
-> Parser ((MsgToSign -> IO (Maybe LndSig)) -> GCEnv)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Text -> Parser CompressMode
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"compress_mode"
            Parser ((MsgToSign -> IO (Maybe LndSig)) -> GCEnv)
-> Parser (MsgToSign -> IO (Maybe LndSig)) -> Parser GCEnv
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MsgToSign -> IO (Maybe LndSig))
-> Parser (MsgToSign -> IO (Maybe LndSig))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO (Maybe LndSig) -> MsgToSign -> IO (Maybe LndSig)
forall a b. a -> b -> a
const (IO (Maybe LndSig) -> MsgToSign -> IO (Maybe LndSig))
-> IO (Maybe LndSig) -> MsgToSign -> IO (Maybe LndSig)
forall a b. (a -> b) -> a -> b
$ Maybe LndSig -> IO (Maybe LndSig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe LndSig
forall a. Maybe a
Nothing)
      )

newtype GCPort
  = GCPort PortNumber
  deriving newtype
    ( Int -> GCPort
GCPort -> Int
GCPort -> [GCPort]
GCPort -> GCPort
GCPort -> GCPort -> [GCPort]
GCPort -> GCPort -> GCPort -> [GCPort]
(GCPort -> GCPort)
-> (GCPort -> GCPort)
-> (Int -> GCPort)
-> (GCPort -> Int)
-> (GCPort -> [GCPort])
-> (GCPort -> GCPort -> [GCPort])
-> (GCPort -> GCPort -> [GCPort])
-> (GCPort -> GCPort -> GCPort -> [GCPort])
-> Enum GCPort
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GCPort -> GCPort -> GCPort -> [GCPort]
$cenumFromThenTo :: GCPort -> GCPort -> GCPort -> [GCPort]
enumFromTo :: GCPort -> GCPort -> [GCPort]
$cenumFromTo :: GCPort -> GCPort -> [GCPort]
enumFromThen :: GCPort -> GCPort -> [GCPort]
$cenumFromThen :: GCPort -> GCPort -> [GCPort]
enumFrom :: GCPort -> [GCPort]
$cenumFrom :: GCPort -> [GCPort]
fromEnum :: GCPort -> Int
$cfromEnum :: GCPort -> Int
toEnum :: Int -> GCPort
$ctoEnum :: Int -> GCPort
pred :: GCPort -> GCPort
$cpred :: GCPort -> GCPort
succ :: GCPort -> GCPort
$csucc :: GCPort -> GCPort
Enum,
      GCPort -> GCPort -> Bool
(GCPort -> GCPort -> Bool)
-> (GCPort -> GCPort -> Bool) -> Eq GCPort
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GCPort -> GCPort -> Bool
$c/= :: GCPort -> GCPort -> Bool
== :: GCPort -> GCPort -> Bool
$c== :: GCPort -> GCPort -> Bool
Eq,
      Enum GCPort
Real GCPort
Real GCPort
-> Enum GCPort
-> (GCPort -> GCPort -> GCPort)
-> (GCPort -> GCPort -> GCPort)
-> (GCPort -> GCPort -> GCPort)
-> (GCPort -> GCPort -> GCPort)
-> (GCPort -> GCPort -> (GCPort, GCPort))
-> (GCPort -> GCPort -> (GCPort, GCPort))
-> (GCPort -> Integer)
-> Integral GCPort
GCPort -> Integer
GCPort -> GCPort -> (GCPort, GCPort)
GCPort -> GCPort -> GCPort
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: GCPort -> Integer
$ctoInteger :: GCPort -> Integer
divMod :: GCPort -> GCPort -> (GCPort, GCPort)
$cdivMod :: GCPort -> GCPort -> (GCPort, GCPort)
quotRem :: GCPort -> GCPort -> (GCPort, GCPort)
$cquotRem :: GCPort -> GCPort -> (GCPort, GCPort)
mod :: GCPort -> GCPort -> GCPort
$cmod :: GCPort -> GCPort -> GCPort
div :: GCPort -> GCPort -> GCPort
$cdiv :: GCPort -> GCPort -> GCPort
rem :: GCPort -> GCPort -> GCPort
$crem :: GCPort -> GCPort -> GCPort
quot :: GCPort -> GCPort -> GCPort
$cquot :: GCPort -> GCPort -> GCPort
Integral,
      Integer -> GCPort
GCPort -> GCPort
GCPort -> GCPort -> GCPort
(GCPort -> GCPort -> GCPort)
-> (GCPort -> GCPort -> GCPort)
-> (GCPort -> GCPort -> GCPort)
-> (GCPort -> GCPort)
-> (GCPort -> GCPort)
-> (GCPort -> GCPort)
-> (Integer -> GCPort)
-> Num GCPort
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> GCPort
$cfromInteger :: Integer -> GCPort
signum :: GCPort -> GCPort
$csignum :: GCPort -> GCPort
abs :: GCPort -> GCPort
$cabs :: GCPort -> GCPort
negate :: GCPort -> GCPort
$cnegate :: GCPort -> GCPort
* :: GCPort -> GCPort -> GCPort
$c* :: GCPort -> GCPort -> GCPort
- :: GCPort -> GCPort -> GCPort
$c- :: GCPort -> GCPort -> GCPort
+ :: GCPort -> GCPort -> GCPort
$c+ :: GCPort -> GCPort -> GCPort
Num,
      Eq GCPort
Eq GCPort
-> (GCPort -> GCPort -> Ordering)
-> (GCPort -> GCPort -> Bool)
-> (GCPort -> GCPort -> Bool)
-> (GCPort -> GCPort -> Bool)
-> (GCPort -> GCPort -> Bool)
-> (GCPort -> GCPort -> GCPort)
-> (GCPort -> GCPort -> GCPort)
-> Ord GCPort
GCPort -> GCPort -> Bool
GCPort -> GCPort -> Ordering
GCPort -> GCPort -> GCPort
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 :: GCPort -> GCPort -> GCPort
$cmin :: GCPort -> GCPort -> GCPort
max :: GCPort -> GCPort -> GCPort
$cmax :: GCPort -> GCPort -> GCPort
>= :: GCPort -> GCPort -> Bool
$c>= :: GCPort -> GCPort -> Bool
> :: GCPort -> GCPort -> Bool
$c> :: GCPort -> GCPort -> Bool
<= :: GCPort -> GCPort -> Bool
$c<= :: GCPort -> GCPort -> Bool
< :: GCPort -> GCPort -> Bool
$c< :: GCPort -> GCPort -> Bool
compare :: GCPort -> GCPort -> Ordering
$ccompare :: GCPort -> GCPort -> Ordering
Ord,
      ReadPrec [GCPort]
ReadPrec GCPort
Int -> ReadS GCPort
ReadS [GCPort]
(Int -> ReadS GCPort)
-> ReadS [GCPort]
-> ReadPrec GCPort
-> ReadPrec [GCPort]
-> Read GCPort
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GCPort]
$creadListPrec :: ReadPrec [GCPort]
readPrec :: ReadPrec GCPort
$creadPrec :: ReadPrec GCPort
readList :: ReadS [GCPort]
$creadList :: ReadS [GCPort]
readsPrec :: Int -> ReadS GCPort
$creadsPrec :: Int -> ReadS GCPort
Read,
      Num GCPort
Ord GCPort
Num GCPort -> Ord GCPort -> (GCPort -> Rational) -> Real GCPort
GCPort -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: GCPort -> Rational
$ctoRational :: GCPort -> Rational
Real,
      Int -> GCPort -> ShowS
[GCPort] -> ShowS
GCPort -> String
(Int -> GCPort -> ShowS)
-> (GCPort -> String) -> ([GCPort] -> ShowS) -> Show GCPort
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GCPort] -> ShowS
$cshowList :: [GCPort] -> ShowS
show :: GCPort -> String
$cshow :: GCPort -> String
showsPrec :: Int -> GCPort -> ShowS
$cshowsPrec :: Int -> GCPort -> ShowS
Show
    )

instance FromJSON GCPort where
  parseJSON :: Value -> Parser GCPort
parseJSON =
    String -> (Scientific -> Parser GCPort) -> Value -> Parser GCPort
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
"GCPort" ((Scientific -> Parser GCPort) -> Value -> Parser GCPort)
-> (Scientific -> Parser GCPort) -> Value -> Parser GCPort
forall a b. (a -> b) -> a -> b
$ \Scientific
x0 ->
      case Scientific -> Either Double GCPort
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
x0 of
        Left (Double
_ :: Double) -> String -> Parser GCPort
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Non-integer"
        Right GCPort
x -> GCPort -> Parser GCPort
forall (f :: * -> *) a. Applicative f => a -> f a
pure GCPort
x

runUnary ::
  ( Out res,
    Show res,
    HasMethod s m,
    req ~ MethodInput s m,
    res ~ MethodOutput s m
  ) =>
  ProtoLens.RPC s (m :: Symbol) ->
  GCEnv ->
  (res -> ByteString -> CompressMode -> IO Bool) ->
  req ->
  IO (Either Text res)
runUnary :: forall res s (m :: Symbol) req.
(Out res, Show res, HasMethod s m, req ~ MethodInput s m,
 res ~ MethodOutput s m) =>
RPC s m
-> GCEnv
-> (res -> ByteString -> CompressMode -> IO Bool)
-> req
-> IO (Either Text res)
runUnary RPC s m
rpc GCEnv
env res -> ByteString -> CompressMode -> IO Bool
verifySig req
req = do
  Either ClientError (Either TooMuchConcurrency (RawReply res))
res <-
    ClientIO (Either TooMuchConcurrency (RawReply res))
-> IO
     (Either ClientError (Either TooMuchConcurrency (RawReply res)))
forall a. ClientIO a -> IO (Either ClientError a)
runClientIO (ClientIO (Either TooMuchConcurrency (RawReply res))
 -> IO
      (Either ClientError (Either TooMuchConcurrency (RawReply res))))
-> ClientIO (Either TooMuchConcurrency (RawReply res))
-> IO
     (Either ClientError (Either TooMuchConcurrency (RawReply res)))
forall a b. (a -> b) -> a -> b
$
      ExceptT ClientError IO GrpcClient
-> (GrpcClient -> ExceptT ClientError IO ())
-> (GrpcClient
    -> ClientIO (Either TooMuchConcurrency (RawReply res)))
-> ClientIO (Either TooMuchConcurrency (RawReply res))
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
        ( GCEnv -> req -> Bool -> ExceptT ClientError IO GrpcClient
forall req.
Message req =>
GCEnv -> req -> Bool -> ExceptT ClientError IO GrpcClient
makeClient GCEnv
env req
req
            (Bool -> ExceptT ClientError IO GrpcClient)
-> (Maybe Encryption -> Bool)
-> Maybe Encryption
-> ExceptT ClientError IO GrpcClient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> (Encryption -> Bool) -> Maybe Encryption -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Encryption -> Encryption -> Bool
forall a. Eq a => a -> a -> Bool
== Encryption
Encrypted)
            (Maybe Encryption -> ExceptT ClientError IO GrpcClient)
-> Maybe Encryption -> ExceptT ClientError IO GrpcClient
forall a b. (a -> b) -> a -> b
$ GCEnv -> Maybe Encryption
gcEnvEncryption GCEnv
env
        )
        GrpcClient -> ExceptT ClientError IO ()
close
        (\GrpcClient
grpc -> RPC s m
-> GrpcClient
-> req
-> ClientIO (Either TooMuchConcurrency (RawReply res))
forall r i o.
(GRPCInput r i, GRPCOutput r o) =>
r
-> GrpcClient
-> i
-> ClientIO (Either TooMuchConcurrency (RawReply o))
rawUnary RPC s m
rpc GrpcClient
grpc req
req)
  case Either ClientError (Either TooMuchConcurrency (RawReply res))
res of
    Right (Right (Right (CIHeaderList
h, Maybe CIHeaderList
mh, Right res
x))) ->
      case (Element CIHeaderList -> Bool)
-> CIHeaderList -> Maybe (Element CIHeaderList)
forall t.
Container t =>
(Element t -> Bool) -> t -> Maybe (Element t)
find (\Element CIHeaderList
header -> (CI ByteString, ByteString) -> CI ByteString
forall a b. (a, b) -> a
fst (CI ByteString, ByteString)
Element CIHeaderList
header CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== CI ByteString
sigHeaderName) (CIHeaderList -> Maybe (Element CIHeaderList))
-> CIHeaderList -> Maybe (Element CIHeaderList)
forall a b. (a -> b) -> a -> b
$ CIHeaderList
h CIHeaderList -> CIHeaderList -> CIHeaderList
forall a. Semigroup a => a -> a -> a
<> CIHeaderList -> Maybe CIHeaderList -> CIHeaderList
forall a. a -> Maybe a -> a
fromMaybe CIHeaderList
forall a. Monoid a => a
mempty Maybe CIHeaderList
mh of
        Maybe (Element CIHeaderList)
Nothing ->
          Either Text res -> IO (Either Text res)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text res -> IO (Either Text res))
-> (Text -> Either Text res) -> Text -> IO (Either Text res)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text res
forall a b. a -> Either a b
Left (Text -> IO (Either Text res)) -> Text -> IO (Either Text res)
forall a b. (a -> b) -> a -> b
$
            Text
"Client ==> missing server header "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CI ByteString -> Text
forall a. Out a => a -> Text
inspectPlain CI ByteString
sigHeaderName
        Just (CI ByteString
_, ByteString
b64sig) -> do
          let sigDer :: ByteString
sigDer = ByteString -> ByteString
B64.decodeLenient ByteString
b64sig
          Bool
isVerified <-
            res -> ByteString -> CompressMode -> IO Bool
verifySig res
x ByteString
sigDer (CompressMode -> IO Bool) -> CompressMode -> IO Bool
forall a b. (a -> b) -> a -> b
$
              GCEnv -> CompressMode
gcEnvCompressMode GCEnv
env
          Either Text res -> IO (Either Text res)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text res -> IO (Either Text res))
-> Either Text res -> IO (Either Text res)
forall a b. (a -> b) -> a -> b
$
            if Bool
isVerified
              then res -> Either Text res
forall a b. b -> Either a b
Right res
x
              else
                Text -> Either Text res
forall a b. a -> Either a b
Left (Text -> Either Text res) -> Text -> Either Text res
forall a b. (a -> b) -> a -> b
$
                  Text
"Client ==> server signature verification"
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" failed for raw bytes"
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from decoded payload "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> res -> Text
forall a. Out a => a -> Text
inspectPlain res
x
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with signature "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
forall a. Out a => a -> Text
inspectPlain ByteString
sigDer
    Either ClientError (Either TooMuchConcurrency (RawReply res))
x ->
      Either Text res -> IO (Either Text res)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text res -> IO (Either Text res))
-> (Text -> Either Text res) -> Text -> IO (Either Text res)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text res
forall a b. a -> Either a b
Left (Text -> IO (Either Text res)) -> Text -> IO (Either Text res)
forall a b. (a -> b) -> a -> b
$
        Text
"Client ==> server grpc failure "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Either ClientError (Either TooMuchConcurrency (RawReply res))
-> Text
forall b a. (Show a, IsString b) => a -> b
Universum.show Either ClientError (Either TooMuchConcurrency (RawReply res))
x
  where
    sigHeaderName :: CI ByteString
sigHeaderName = ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (ByteString -> CI ByteString)
-> (SigHeaderName -> ByteString) -> SigHeaderName -> CI ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigHeaderName -> ByteString
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from (SigHeaderName -> CI ByteString) -> SigHeaderName -> CI ByteString
forall a b. (a -> b) -> a -> b
$ GCEnv -> SigHeaderName
gcEnvSigHeaderName GCEnv
env

msgToSignBytes ::
  ( Message msg
  ) =>
  CompressMode ->
  msg ->
  ByteString
msgToSignBytes :: forall msg. Message msg => CompressMode -> msg -> ByteString
msgToSignBytes CompressMode
compressMode msg
msg = ByteString
header ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
body
  where
    rawBody :: ByteString
rawBody = msg -> ByteString
forall msg. Message msg => msg -> ByteString
encodeMessage msg
msg
    body :: ByteString
body =
      case CompressMode
compressMode of
        CompressMode
Compressed -> Compression -> ByteString -> ByteString
G._compressionFunction Compression
G.gzip ByteString
rawBody
        CompressMode
Uncompressed -> ByteString
rawBody
    header :: ByteString
header =
      [Word8] -> ByteString
BS.pack
        [ case CompressMode
compressMode of
            CompressMode
Compressed -> Word8
1
            CompressMode
Uncompressed -> Word8
0
        ]
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ( ByteString -> ByteString
BL.toStrict
               (ByteString -> ByteString)
-> (Int -> ByteString) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BS.toLazyByteString
               (Builder -> ByteString) -> (Int -> Builder) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Builder
BS.putWord32be
               (Word32 -> Builder) -> (Int -> Word32) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral -- Length is non-neg, it's fine.
               (Int -> ByteString) -> Int -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
body
           )

makeClient ::
  Message req =>
  GCEnv ->
  req ->
  UseTlsOrNot ->
  ClientIO GrpcClient
makeClient :: forall req.
Message req =>
GCEnv -> req -> Bool -> ExceptT ClientError IO GrpcClient
makeClient GCEnv
env req
req Bool
tlsEnabled = do
  Maybe LndSig
mSignature <- IO (Maybe LndSig) -> ExceptT ClientError IO (Maybe LndSig)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Maybe LndSig)
doSignature
  case Maybe LndSig
mSignature of
    Just LndSig
signature ->
      GrpcClientConfig -> ExceptT ClientError IO GrpcClient
setupGrpcClient (GrpcClientConfig -> ExceptT ClientError IO GrpcClient)
-> GrpcClientConfig -> ExceptT ClientError IO GrpcClient
forall a b. (a -> b) -> a -> b
$
        (String -> PortNumber -> Bool -> GrpcClientConfig
grpcClientConfigSimple (GCEnv -> String
gcEnvHost GCEnv
env) (GCPort -> PortNumber
coerce (GCPort -> PortNumber) -> GCPort -> PortNumber
forall a b. (a -> b) -> a -> b
$ GCEnv -> GCPort
gcEnvPort GCEnv
env) Bool
tlsEnabled)
          { _grpcClientConfigCompression :: Compression
_grpcClientConfigCompression = Compression
compression,
            _grpcClientConfigHeaders :: [(ByteString, ByteString)]
_grpcClientConfigHeaders =
              [ ( ByteString
sigHeaderName,
                  ByteString -> ByteString
B64.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ LndSig -> ByteString
Sig.unLndSig LndSig
signature
                )
              ]
          }
    Maybe LndSig
Nothing -> ClientError -> ExceptT ClientError IO GrpcClient
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ClientError
EarlyEndOfStream
  where
    signer :: MsgToSign -> IO (Maybe LndSig)
signer = GCEnv -> MsgToSign -> IO (Maybe LndSig)
gcEnvSigner GCEnv
env
    sigHeaderName :: ByteString
sigHeaderName = SigHeaderName -> ByteString
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from (SigHeaderName -> ByteString) -> SigHeaderName -> ByteString
forall a b. (a -> b) -> a -> b
$ GCEnv -> SigHeaderName
gcEnvSigHeaderName GCEnv
env
    compressMode :: CompressMode
compressMode = GCEnv -> CompressMode
gcEnvCompressMode GCEnv
env
    doSignature :: IO (Maybe LndSig)
doSignature =
      MsgToSign -> IO (Maybe LndSig)
signer (MsgToSign -> IO (Maybe LndSig))
-> (ByteString -> MsgToSign) -> ByteString -> IO (Maybe LndSig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> MsgToSign
Sig.MsgToSign (ByteString -> IO (Maybe LndSig))
-> ByteString -> IO (Maybe LndSig)
forall a b. (a -> b) -> a -> b
$
        CompressMode -> req -> ByteString
forall msg. Message msg => CompressMode -> msg -> ByteString
msgToSignBytes CompressMode
compressMode req
req
    compression :: Compression
compression =
      case CompressMode
compressMode of
        CompressMode
Compressed -> Compression
gzip
        CompressMode
Uncompressed -> Compression
uncompressed