{-# LANGUAGE
LambdaCase
, OverloadedStrings
, DeriveGeneric
, DeriveAnyClass
, GeneralizedNewtypeDeriving
#-}
module Control.Client (
lightningCli,
Command(..),
PartialCommand
)
where
import Control.Plugin
import Control.Conduit
import Data.Lightning
import Data.ByteString.Lazy as L
import System.IO
import System.IO.Unsafe
import Data.IORef
import Network.Socket
import Data.Conduit hiding (connect)
import Data.Conduit.Combinators hiding (stdout, stderr, stdin)
import Data.Aeson
import Data.Text
type Cln a = IO (Maybe (ParseResult (Res a)))
type PartialCommand = Id -> Command
{-# NOINLINE idref #-}
idref :: IORef Int
idref :: IORef Int
idref = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Int
1
data Command = Command {
Command -> Text
method :: Text
, Command -> Value
reqFilter :: Value
, Command -> Value
params :: Value
, Command -> Value
____id :: Value
} deriving (Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show)
instance ToJSON Command where
toJSON :: Command -> Value
toJSON (Command Text
m Value
f Value
p Value
i) =
[Pair] -> Value
object [ Key
"jsonrpc" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"2.0" :: Text)
, Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
i
, Key
"filter" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Value
f
, Key
"method" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
m
, Key
"params" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Value
p
]
lightningCli :: Handle -> PartialCommand -> IO (Maybe (Res Value))
lightningCli :: Handle -> PartialCommand -> IO (Maybe (Res Value))
lightningCli Handle
h PartialCommand
v = do
Int
i <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef Int
idref forall a b. (a -> b) -> a -> b
$ (\Int
x -> (Int
x,Int
x))forall b c a. (b -> c) -> (a -> b) -> a -> c
.(forall a. Num a => a -> a -> a
+Int
1)
Handle -> ByteString -> IO ()
L.hPutStr Handle
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$ PartialCommand
v (forall a. ToJSON a => a -> Value
toJSON Int
i)
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) i.
MonadIO m =>
Handle -> ConduitT i ByteString m ()
sourceHandle Handle
h forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (n :: * -> *) a.
(Monad n, FromJSON a) =>
ConduitT ByteString (ParseResult a) n ()
inConduit forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(Just (Correct Res Value
x)) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Res Value
x
Maybe (ParseResult (Res Value))
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing