clplug 0.3.2.0 → 0.3.3.0

raw patch · 4 files changed

+50/−33 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• clplug.cabal +1/−1
• src/Control/Client.hs +3/−3
• src/Control/Plugin.hs +44/−28
• src/Data/Lightning/Hooks.hs +2/−1

@@ -1,6 +1,6 @@ cabal-version:      1.12 name:               clplug-version:            0.3.2.0+version:            0.3.3.0 license:            BSD3 license-file:       LICENSE copyright:          2023

@@ -63,10 +63,10 @@                ]  -- | interface with lightning-rpc.  -lightningCli :: (MonadReader PlugInfo m, MonadIO m) => +lightningCli :: (MonadReader Plug m, MonadIO m) =>                   PartialCommand -> m (Maybe (Res Value)) lightningCli v = do -    (h, _) <- ask+    (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 @@ -74,7 +74,7 @@         _ -> pure Nothing   -- | log wrapper for easier debugging during development.-lightningCliDebug :: (MonadReader PlugInfo m, MonadIO m) => +lightningCliDebug :: (MonadReader Plug m, MonadIO m) =>                       (String -> IO ()) -> PartialCommand -> m (Maybe (Res Value)) lightningCliDebug logger v = do      liftIO . logger . show $ v

@@ -5,6 +5,7 @@     , RecordWildCards     , DuplicateRecordFields     , DeriveAnyClass+    , FlexibleContexts     #-}  module Control.Plugin (@@ -16,7 +17,7 @@     PluginMonad,     InitMonad,     PluginReq, -    PlugInfo+    Plug(..)     ) where   import Data.Lightning@@ -35,23 +36,24 @@ import Control.Concurrent hiding (yield)  import Network.Socket as N import System.IO+import Data.Conduit.Combinators (sinkNull)   -- | Function called on every event subscribed to in the manifest. type PluginApp a = PluginReq -> PluginMonad a () type PluginReq = (Maybe Id, Method, Params)  -- | Function called on initialization, returned value is the initial state.-type InitMonad a = ReaderT PlugInfo IO a+type InitMonad a = ReaderT Plug IO a --- | Plugin stack contains ReaderT (ask - rpc handle & config), stateT (get/put - polymorphic state) and conduitT (yield - data exchange to core lightning.)-type PluginMonad a b = ConduitT -    (Either (Res Value) PluginReq) -    (Res Value) -    (ReaderT PlugInfo (StateT a IO))-    b+-- | Plugin stack contains ReaderT (ask - rpc handle & config), stateT (get/put - polymorphic state) +type PluginMonad a = ReaderT Plug (StateT a IO) --- | Handle connected to lightning-rpc file (use with Control.Client) & configuration object.  -type PlugInfo = (Handle, Init)+-- | Handles to lightning-rpc file and stdout plugin & configuration object.  +data Plug = Plug {+      rpc :: Handle+    , out :: Handle+    , conf :: Init+    }  data StartErr = ExpectManifest | ExpectInit deriving (Show, Exception)  @@ -66,38 +68,42 @@         (Just (Right (Just i, "init", v))) -> case fromJSON v of              Success xi@(Init{..}) -> do                  h  <- liftIO $ getrpc $ getRpcPath configuration-                s' <- liftIO $ runStartup (h, xi) start-                _ <- liftIO.forkIO $ runPlugin (h, xi) s' app -                release i+                let plug = (Plug h stdout xi) +                s' <- liftIO $ runStartup plug start+                _ <- liftIO.forkIO $ runPlugin plug s' app +                yield . Res (object ["result" .= ("continue" :: Text)]) $ i +                where             _ -> throw ExpectInit -            where getRpcPath conf = lightning5dir conf <> "/" <> rpc5file conf         _ -> throw ExpectInit      threadDelay maxBound -runStartup :: PlugInfo -> InitMonad a -> IO a +runStartup :: Plug -> InitMonad a -> IO a  runStartup re = (`runReaderT` re)   -runPlugin :: PlugInfo -> s -> PluginApp s -> IO () +runPlugin :: Plug -> s -> PluginApp s -> IO ()  runPlugin re st = (`evalStateT` st) . (`runReaderT` re) . forever . runConduit . runner     where-    runner app = sourceHandle stdin .| inConduit .| entry .| appInsert app .| exit .| sinkHandle stdout +    runner app = sourceHandle stdin .| inConduit .| entry .| appInsert app -- .| _ -- sinkNull-- .| exit .| sinkHandle stdout  -runOnce :: ConduitT (Either (Res Value) PluginReq) (Res Value) IO () -> IO ()+runOnce :: ConduitT (Either (Res Value) PluginReq) (Res Value) IO () -> IO ()  runOnce = runConduit.runner     where      runner d = sourceHandle stdin .| inConduit .| entry .| d .| exit .| sinkHandle stdout -entry :: (Monad n) => ConduitT (ParseResult (Req Value)) (Either (Res Value) PluginReq)  n () +entry :: (Monad n) => ConduitT (ParseResult (Req Value)) (Either (Res Value) PluginReq) n ()  entry = await >>= maybe mempty (\case       Correct v -> yield $ Right (getReqId v, getMethod v, getParams v)      InvalidReq -> yield $ Left $ ErrRes ("Request Error"::Text) Nothing       ParseErr -> yield $ Left $ ErrRes ("Parser Err"::Text) Nothing ) -appInsert :: PluginApp a -> PluginMonad a ()-appInsert app =  await >>= maybe mempty \case  -    Left er -> yield er  -    Right pr -> app pr +appInsert :: PluginApp a -> ConduitT (Either (Res Value) PluginReq) Void (PluginMonad a) () +appInsert app = await >>= maybe mempty \case  +    Left fail -> pure () +    Right req -> lift (app req) >> pure ()  +runRes :: Handle -> Res Value -> IO ()+runRes o r = runConduit $ (yield r) .| exit .| sinkHandle o+ exit :: (Monad n) => ConduitT (Res Value) S.ByteString n ()  exit = await >>= maybe mempty (yield. L.toStrict . encode)  @@ -108,13 +114,23 @@     socketToHandle soc ReadWriteMode  -- | Helper function to allow node to continue default behaviour. -release :: Monad m => Id -> ConduitT i (Res Value) m () -release = yield . Res (object ["result" .= ("continue" :: Text)])+release :: Id -> PluginMonad a ()+release i = do +    Plug _ out _ <- ask+    liftIO $ runRes out $ Res (object ["result" .= ("continue" :: Text)]) i  -- | Helper function to prevent node default behaviour. -reject :: Monad m => Id -> ConduitT i (Res Value) m ()  -reject = yield . Res (object ["result" .= ("reject" :: Text)])+reject :: Id -> PluginMonad a ()+reject i = do +    Plug _ out _ <- ask+    liftIO $ runRes out $ Res (object ["result" .= ("reject" :: Text)]) i  -- | Respond with arbitrary Value, custom rpc hooks will pass back through to terminal. respond :: Value -> Id -> PluginMonad a ()-respond = (yield .) . Res+respond v i = do +    Plug _ out _ <- ask+    liftIO $ runRes out $ Res v i ++getRpcPath conf = lightning5dir conf <> "/" <> rpc5file conf++

@@ -67,7 +67,8 @@ data InvoicePayment = InvoicePayment {       label :: Text      , preimage :: Text -    , amount_msat :: Msat+    , msat :: Text+    , extratlvs :: Value     } deriving Generic  instance FromJSON InvoicePayment where      parseJSON = singleField "payment"