Client.hs

{-# 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 x = show $ (x "") 


{-# NOINLINE idref #-} 
idref :: IORef Int
idref = unsafePerformIO $ newIORef 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 { 
      method :: Text
    , reqFilter :: Maybe Value
    , params :: Value 
    , ____id :: Value 
    } deriving (Show) 
instance ToJSON Command where 
    toJSON (Command m Nothing p i) = 
        object [ "jsonrpc" .= ("2.0" :: Text)
               , "id" .= i
               , "method"  .= m 
               , "params" .= toJSON p
               ]
    toJSON (Command m (Just f) p i) = 
        object [ "jsonrpc" .= ("2.0" :: Text)
               , "id" .= i
               , "filter" .= toJSON f
               , "method"  .= m 
               , "params" .= toJSON p
               ]

-- | interface with lightning-rpc.  
lightningCli :: (MonadReader Plug m, MonadIO m) => 
                 PartialCommand -> m (Maybe (Res Value))
lightningCli v = do 
    (Plug h _ _) <- ask
    i <- liftIO $ atomicModifyIORef idref $ (\x -> (x,x)).(+1)
    liftIO $ L.hPutStr h . encode $ v (toJSON i) 
    liftIO $ runConduit $ sourceHandle h .| inConduit .| await >>= \case 
        (Just (Correct x)) -> pure $ Just x
        _ -> pure Nothing 

-- | log wrapper for easier debugging during development.
lightningCliDebug :: (MonadReader Plug m, MonadIO m) => 
                     (String -> IO ()) -> PartialCommand -> m (Maybe (Res Value))
lightningCliDebug logger v = do 
    liftIO . logger . show $ v
    res <- lightningCli v 
    liftIO . logger . show $ res 
    pure res