Client.hs

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

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

import Plugin.Connect
import Plugin.Internal.Conduit
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
import Data.Maybe
import Control.Concurrent.STM.TVar
import Control.Monad.STM


-- | Use with a text object for method only, a tuple for method and params, or a partialCommand (no ID) to specify a filter of the response.   
class Cli a where 
    lightningCli :: (MonadReader Plug m, MonadIO m) => 
                     a -> m (Maybe Res)

instance Cli Text where 
    lightningCli m = lightningCli_ (Command m Nothing Nothing)

instance Cli (Text, Value) where 
    lightningCli (m, p) = lightningCli_ (Command m (Just p) Nothing)

instance Cli PartialCommand where 
    lightningCli = lightningCli_

-- | Withhold the ID for use with lightningCli 
type PartialCommand = Int -> Command 
instance Show PartialCommand where 
    show x = show . x $ -1 
    
data Command = Command { 
      method :: Text
    , params :: Maybe Value 
    , reqFilter :: Maybe Value
    , ____id :: Int 
    } deriving (Show) 

instance ToJSON Command where 
    toJSON (Command m p Nothing i) = 
        object [ "jsonrpc" .= ("2.0" :: Text)
               , "id" .= i
               , "method"  .= m 
               , "params" .= fromMaybe (object []) p
               ]
    toJSON (Command m p (Just f) i) = 
        object [ "jsonrpc" .= ("2.0" :: Text)
               , "id" .= i
               , "filter" .= f
               , "method"  .= m 
               , "params" .= fromMaybe (object []) p
               ]


lightningCli_ :: (MonadReader Plug m, MonadIO m) => 
                 PartialCommand -> m (Maybe Res)
lightningCli_ v = do 
    Plug h _ _ tv <- ask
    i <- liftIO . atomically $ stateTVar tv (\s -> (s, s + 1))
    liftIO $ L.hPutStr h . encode $ v i 
    liftIO $ runConduit $ sourceHandle h .| inConduit .| await >>= \case 
        (Just (Correct x)) -> pure $ Just x
        _ -> pure Nothing 

-- | provide a log function (that doesn't hit stdin/out) for debugging
lightningCliDebug :: (MonadReader Plug m, MonadIO m, Cli c, Show c) => 
                     (String -> IO ()) -> c -> m (Maybe Res)
lightningCliDebug logger v = do 
    log' v
    res <- lightningCli v 
    log' res 
    pure res 
    where 
        log' :: (Show a, MonadIO m) => a -> m () 
        log' = liftIO . logger . show