{-# LANGUAGE
      LambdaCase
    , OverloadedStrings
    , DeriveGeneric
    , DeriveAnyClass
    , GeneralizedNewtypeDeriving
    , FlexibleContexts
    #-}

module Control.Client (
    lightningCli,
    lightningCliDebug,
    Command(..),
    PartialCommand, 
    Res(..)
    ) 
    where 

import Control.Plugin
import Control.Internal.Conduit
import Data.Lightning 
import Data.ByteString.Lazy as L 
import System.IO.Unsafe
import Data.IORef
import Control.Monad.Reader
import Data.Conduit hiding (connect) 
import Data.Conduit.Combinators hiding (stdout, stderr, stdin) 
import Data.Aeson
import Data.Text

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

-- | commands to core lightning are defined by the set of plugins and version of core lightning so this is generic and you should refer to lightning-cli help <command> for the details of the command you are interested in. A filter object is used to specify the data you desire returned (i.e. {"id":True}) and params are the named fields of the command. 
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
               ]

-- | interface with lightning-rpc.  
lightningCli :: (MonadReader PlugInfo m, MonadIO m) => PartialCommand -> m (Maybe (Res Value))
lightningCli :: forall (m :: * -> *).
(MonadReader PlugInfo m, MonadIO m) =>
PartialCommand -> m (Maybe (Res Value))
lightningCli PartialCommand
v = do 
    (Handle
h, Init
_) <- forall r (m :: * -> *). MonadReader r m => m r
ask
    Int
i <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 

-- | log wrapper for easier debugging during development.
lightningCliDebug :: (String -> IO ()) -> PartialCommand -> PluginMonad a (Maybe (Res Value))
lightningCliDebug :: forall a.
(String -> IO ())
-> PartialCommand -> PluginMonad a (Maybe (Res Value))
lightningCliDebug String -> IO ()
logger PartialCommand
v = do 
    res :: Maybe (Res Value)
res@(Just (Res Value
x Value
_)) <- forall (m :: * -> *).
(MonadReader PlugInfo m, MonadIO m) =>
PartialCommand -> m (Maybe (Res Value))
lightningCli PartialCommand
v 
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
logger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Value
x 
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Res Value)
res