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

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 
instance Show PartialCommand where 
    show :: PartialCommand -> String
show PartialCommand
x = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ (PartialCommand
x Id
"") 


{-# 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 -> Maybe Id
reqFilter :: Maybe Value
    , Command -> Id
params :: Value 
    , Command -> Id
____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 -> Id
toJSON (Command Text
m Maybe Id
Nothing Id
p Id
i) = 
        [Pair] -> Id
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
.= Id
i
               , 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 -> Id
toJSON Id
p
               ]
    toJSON (Command Text
m (Just Id
f) Id
p Id
i) = 
        [Pair] -> Id
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
.= Id
i
               , Key
"filter" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Id
toJSON Id
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 -> Id
toJSON Id
p
               ]

-- | interface with lightning-rpc.  
lightningCli :: (MonadReader Plug m, MonadIO m) => 
                 PartialCommand -> m (Maybe (Res Value))
lightningCli :: forall (m :: * -> *).
(MonadReader Plug m, MonadIO m) =>
PartialCommand -> m (Maybe (Res Id))
lightningCli PartialCommand
v = do 
    (Plug Handle
h Handle
_ 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 -> Id
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 Id
x)) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Res Id
x
        Maybe (ParseResult (Res Id))
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing 

-- | log wrapper for easier debugging during development.
lightningCliDebug :: (MonadReader Plug m, MonadIO m) => 
                     (String -> IO ()) -> PartialCommand -> m (Maybe (Res Value))
lightningCliDebug :: forall (m :: * -> *).
(MonadReader Plug m, MonadIO m) =>
(String -> IO ()) -> PartialCommand -> m (Maybe (Res Id))
lightningCliDebug String -> IO ()
logger PartialCommand
v = do 
    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
$ PartialCommand
v
    Maybe (Res Id)
res <- forall (m :: * -> *).
(MonadReader Plug m, MonadIO m) =>
PartialCommand -> m (Maybe (Res Id))
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
$ Maybe (Res Id)
res 
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Res Id)
res