clplug 0.3.0.0 → 0.3.1.0

raw patch · 7 files changed

+253/−309 lines, 7 filesdep ~aesondep ~attoparsecdep ~bytestringPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson, attoparsec, bytestring, conduit, mtl, network, text

API changes (from Hackage documentation)

Files

• README.md +49/−51
• clplug.cabal +66/−63
• src/Control/Client.hs +8/−6
• src/Control/Conduit.hs +0/−104
• src/Control/Internal/Conduit.hs +103/−0
• src/Control/Plugin.hs +25/−24
• test/Spec.hs +2/−61

@@ -1,66 +1,64 @@  ## Core Lightning Plug -Core lightning is a daemon ([lightningd](https://lightning.readthedocs.io/PLUGINS.html)) that operates payment channels that allow you to send and receive bitcoin nearly instantly, with nearly zero fees with a high level of privacy. It does not compromise on any of the strengths of layer 1 bitcoin: no censorship, free speech, individual sovereignty, and impossible debasement. In fact it strengthens bitcoin because it encourages the operation of fully validating nodes, lightningd requires bitcoind. Clplug is a Haskell library that allows you to easily create extensions (called plugins) that extend or augment its functionality. --To create a plugin you only need to define three arguments:-- `Manifest :: Value` - configuration of the interface with core lightning.-- `PluginInit :: PlugInfo -> IO a` - startup function that returns the starting state-- `PluginApp ::  (Maybe Id, Method, Params) -> PluginMonad` - data handler function+Create core lightning ([lightningd](https://lightning.readthedocs.io/PLUGINS.html)) plugins in haskell.  -The transformer stack contains: -- `ask` - a handle to lightning-rpc and environment info.-- `get/put` - polymorphic state-- `yield` - stdout to core lightning+To get started you need to import the Library. It is on hackage as [clplug](https://hackage.haskell.org/package/clplug) or you can load it from github in the stack.yaml: +```+extra-deps:+- git: https://github.com/autonomousorganization/blitz.git+  commit: a916dd3d74780e1023b161b4e85773ccc06051d4+```+Once the library is imported there are two external modules. Data.Lightning is all of the data types for the manifest, the notification and the hooks. Control.Plugin contains the monadic context and interface to your node.  -The main exports from the Library are `Control.Plugin`, `Control.Client`, and `Data.Lightning`. An upload and link to hackage is pending. This is a basic usage example: -```haskell  -{-# LANGUAGE -      OverloadedStrings -    , FlexibleContexts -    , ViewPatterns-    , RecordWildCards-#-} +A [manifest](https://lightning.readthedocs.io/PLUGINS.html#the-getmanifest-method) defines the interface your plugin will have with core lightning.  -module Main (main) where+```+import Data.Aeson+import Data.Lightning+manifest = object [+       "dynamic" .= True+     , "subscriptions" .= ([] :: [Text] )+     , "options" .= ([]::[Option])+     , "rpcmethods" .= ([+         , RpcMethod "command" "[label]" "description" Nothing False+         ])+     , "hooks" .= ([Hook "invoice_payment" Nothing])+     , "featurebits" .= object [ ]+     , "notifications" .= ([]::[Notification])+     ]+``` --- from clplug-import Data.Lightning -import Control.Plugin  -import Control.Conduit---+A start function runs in the InitMonad, it has access to a reader (ask) and to lightningCli. The data that returns from this function will initialize the state that is shared in the PluginMonad. If you want to run a service fork a thread within this function. +The lightningCli function interfaces to core lightnings rpc. The available functions depend on your version of core lightning and the set of plugins you have installed. You need to pass a Command that defines the data you want returned in a [filter](https://lightning.readthedocs.io/lightningd-rpc.7.html?highlight=filter#field-filtering).  -import Data.Conduit -import Data.Aeson-import Data.Text+```+import Control.Plugin +import Control.Client+start = do +    (rpcHandle, Init options config) <- ask+    Just response <- lightningCli (Command "getinfo" filter params)+    _ <- liftIO . forkIO $ < service > +    return < state >+``` -main = plugin manifest appState app+An app function runs every time data comes in from the plugin. You define handlers that processes the data. If an id is present that means that core lightning is expecting a response and default node operation or the operation of other plugins may be pending your response. Use release to allow default to continue, reject to abort default behavior, and respond to send a custom response which in the case of custom rpcmethods will pass through back to the user.  -manifest :: Value -manifest = object [-      "dynamic" .= True-    , "subscriptions" .= (["channel_opened"] :: [Text] ) -    , "options" .= ([]::[Option])-    , "rpcmethods" .= ([]) -    , "hooks" .= ([]::[Hook])-    , "featurebits" .= object [ ]-    , "notifications" .= ([]::[Notification])-    ] +```+app :: (Maybe Id, Method, Params) -> PluginMonad a b+app (Just i, "method", params) = +    if contition +        then release i +        else reject i      +```  -app :: PluginApp () -app (Nothing, "channel_opened", fromJSON -> Success (ChannelOpened {..})) = do-    doublespend funding_txid -    where doublespend _ = pure ()+Finally use the plugin function to create an executable that can be installed as a plugin!  -appState = pure () -```      +```+main :: IO ()+main = plugin manifest start app -Useful areas of  exploration and research are:-- fee optimization-- route selection-- economic rebalancing-- accidental channel closes+``` -##### Donation bitcoin addr: bc1q5xx9mathvsl0unfwa3jlph379n46vu9cletshr+##### tipjar: bc1q5xx9mathvsl0unfwa3jlph379n46vu9cletshr -lightning only scales bitcoin if people run nodes

@@ -1,73 +1,76 @@-cabal-version: 1.12---- This file has been generated from package.yaml by hpack version 0.35.1.------ see: https://github.com/sol/hpack+cabal-version:      1.12+name:               clplug+version:            0.3.1.0+license:            BSD3+license-file:       LICENSE+copyright:          2023+maintainer:         taylorsingletonfookes@live.com+author:             Taylor Singleton-Fookes+homepage:           https://github.com/AutonomousOrganization/blitz#readme+bug-reports:        https://github.com/AutonomousOrganization/blitz/issues+synopsis:           Create Core Lightning Plugins+description:+    Library to create plugins to extend the functionality of Core Lightning daemon. -name:           clplug-version:        0.3.0.0-synopsis:       Create Core Lightning Plugins-description:    Library to create plugins to extend the functionality of Core Lightning daemon.-category:       bitcoin, lightning, plugin-homepage:       https://github.com/AutonomousOrganization/blitz#readme-bug-reports:    https://github.com/AutonomousOrganization/blitz/issues-author:         Taylor Singleton-Fookes-maintainer:     taylorsingletonfookes@live.com-copyright:      2023-license:        BSD3-license-file:   LICENSE-build-type:     Simple+category:           bitcoin, lightning, plugin+build-type:         Simple extra-source-files:     README.md     CHANGELOG.md  source-repository head-  type: git-  location: https://github.com/AutonomousOrganization/blitz+    type:     git+    location: https://github.com/AutonomousOrganization/blitz  library-  exposed-modules:-      Control.Client-      Control.Conduit-      Control.Plugin-      Data.Lightning-      Data.Lightning.Generic-      Data.Lightning.Hooks-      Data.Lightning.Manifest-      Data.Lightning.Notifications-      Data.Lightning.Util-  other-modules:-      Paths_clplug-  hs-source-dirs:-      src-  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints-  build-depends:-      aeson-    , attoparsec-    , base >=4.7 && <5-    , bytestring-    , conduit-    , mtl-    , network-    , text-  default-language: Haskell2010+    exposed-modules:+        Control.Client+        Control.Internal.Conduit+        Control.Plugin+        Data.Lightning+        Data.Lightning.Generic+        Data.Lightning.Hooks+        Data.Lightning.Manifest+        Data.Lightning.Notifications+        Data.Lightning.Util +    hs-source-dirs:   src+    other-modules:    Paths_clplug+    default-language: Haskell2010+    ghc-options:+        -Wall -Wcompat -Widentities -Wincomplete-record-updates+        -Wincomplete-uni-patterns -Wmissing-export-lists+        -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints++    build-depends:+        aeson <2.1,+        attoparsec <0.15,+        base >=4.7 && <5,+        bytestring <0.12,+        conduit <1.4,+        mtl <2.3,+        network <3.2,+        text <1.3+ test-suite blitz-test-  type: exitcode-stdio-1.0-  main-is: Spec.hs-  other-modules:-      Paths_clplug-  hs-source-dirs:-      test-  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N-  build-depends:-      aeson-    , attoparsec-    , base >=4.7 && <5-    , blitz-    , bytestring-    , conduit-    , mtl-    , network-    , text-  default-language: Haskell2010+    type:             exitcode-stdio-1.0+    main-is:          Spec.hs+    hs-source-dirs:   test+    other-modules:    Paths_clplug+    default-language: Haskell2010+    ghc-options:+        -Wall -Wcompat -Widentities -Wincomplete-record-updates+        -Wincomplete-uni-patterns -Wmissing-export-lists+        -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+        -threaded -rtsopts -with-rtsopts=-N++    build-depends:+        aeson <2.1,+        attoparsec <0.15,+        base >=4.7 && <5,+        blitz,+        bytestring <0.12,+        conduit <1.4,+        mtl <2.3,+        network <3.2,+        text <1.3

@@ -4,18 +4,20 @@     , DeriveGeneric     , DeriveAnyClass     , GeneralizedNewtypeDeriving+    , FlexibleContexts     #-}  module Control.Client (     lightningCli,     lightningCliDebug,     Command(..),-    PartialCommand+    PartialCommand, +    Res(..)     )      where   import Control.Plugin-import Control.Conduit+import Control.Internal.Conduit import Data.Lightning  import Data.ByteString.Lazy as L  import System.IO.Unsafe@@ -32,7 +34,7 @@ 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. +-- | 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 :: Value@@ -48,8 +50,8 @@                , "params" .= toJSON p                ] --- interface with lightning-rpc.  -lightningCli :: PartialCommand -> PluginMonad a (Maybe (Res Value))+-- | interface with lightning-rpc.  +lightningCli :: (MonadReader PlugInfo m, MonadIO m) => PartialCommand -> m (Maybe (Res Value)) lightningCli v = do      (h, _) <- ask     i <- liftIO $ atomicModifyIORef idref $ (\x -> (x,x)).(+1)@@ -58,7 +60,7 @@         (Just (Correct x)) -> pure $ Just x         _ -> pure Nothing  --- log wrapper for easier debugging during development.+-- | log wrapper for easier debugging during development. lightningCliDebug :: (String -> IO ()) -> PartialCommand -> PluginMonad a (Maybe (Res Value)) lightningCliDebug logger v = do      res@(Just (Res x _)) <- lightningCli v 

@@ -1,104 +0,0 @@-{-# LANGUAGE-      LambdaCase-    , FlexibleInstances -    , FlexibleContexts-    , DeriveGeneric  -    , OverloadedStrings - #-}--module Control.Conduit (-    inConduit, -    ParseResult(..), -    Res(..), -    Req(..) -    ) where --import Data.Lightning -import GHC.Generics-import Data.Text (Text)-import Control.Applicative  ((<|>))-import Control.Monad.State.Lazy-import Data.Aeson.Types hiding ( parse )-import Data.Aeson -import qualified Data.ByteString as S-import Data.Conduit -import Data.Attoparsec.ByteString --inConduit :: (Monad n) => (FromJSON a) => ConduitT S.ByteString (ParseResult a) n ()-inConduit = evalStateT l Nothing-    where -    l = lift await >>= maybe (lift mempty) (r >=> h)-    r i = get  >>= \case-        Nothing -> pure $ parse json' i-        Just k  ->  pure $ k i -    h = \case-        Fail{} -> lift (yield ParseErr) -        Partial i -> put (Just i) >> l-        Done _ v -> lift $ yield $ fin $ parseMaybe parseJSON v -    fin = \case-        Nothing -> InvalidReq-        Just c -> Correct c--data ParseResult x = -    Correct !x |-    InvalidReq | -    ParseErr -    deriving (Show, Generic) -instance ToJSON a => ToJSON (ParseResult a) where -    toJSON = genericToJSON defaultOptions -instance FromJSON a => FromJSON (ParseResult a) -data Req x = Req { -   getMethod :: Text,-   getParams :: x,-   getReqId :: Maybe Value }-   deriving (Show) -   -data Res a =-    Res { getResBody :: a,-          getResId :: Value }-    | Derp  {-          errMsg :: Text,-          errId :: Maybe Value }-    deriving (Show, Generic)--instance FromJSON (Req Value) where-    parseJSON (Object v) = do-        version <- v .: "jsonrpc"-        guard (version == ("2.0" :: Text))-        Req <$> v .:  "method"-            <*> (v .:? "params") .!= emptyArray-            <*> v .:?  "id"-    parseJSON _ = mempty--instance FromJSON a => FromJSON (Res a) where-    parseJSON (Object v) = do-        version <- v .: "jsonrpc"-        guard (version == ("2.0" :: Text))-        fromResult <|> fromError-        where-            fromResult = Res <$> (v .: "result" >>= parseJSON)-                             <*> v .: "id"-            fromError = do-                err <- v .: "error"-                Derp  <$> err .: "message"-                      <*> v   .: "id"-    parseJSON (Array a) = mempty-    parseJSON _ = mempty--instance ToJSON a => ToJSON (Req a) where-    toJSON (Req m ps i) =-        object [ "jsonrpc" .= ("2.0" :: Text)-               , "method"  .= m-               , "params"  .= toJSON ps-               , "id"      .= i ]--instance ToJSON (Res Value) where-    toJSON (Res x i) = object [ -        "jsonrpc" .= ("2.0" :: Text),-        "result"  .= x,-        "id"      .= i ]-    toJSON (Derp msg i) = object [ -        "jsonrpc" .= ("2.0" :: Text),-        "error"   .= object ["message" .= msg],-        "id"      .= i ]-

@@ -0,0 +1,103 @@+{-# LANGUAGE+      LambdaCase+    , FlexibleInstances +    , FlexibleContexts+    , DeriveGeneric  +    , OverloadedStrings +    #-}+module Control.Internal.Conduit (+    inConduit, +    ParseResult(..), +    Res(..), +    Req(..) +    ) where ++import GHC.Generics+import Data.Text (Text)+import Control.Applicative  ((<|>))+import Control.Monad.State.Lazy+import Data.Aeson.Types hiding ( parse )+import Data.Aeson +import qualified Data.ByteString as S+import Data.Conduit +import Data.Attoparsec.ByteString ++-- | Decode from bytestring into a JSON object. Simplified from hackage package: json-rpc +inConduit :: (Monad n) => (FromJSON a) => ConduitT S.ByteString (ParseResult a) n ()+inConduit = evalStateT l Nothing+    where +    l = lift await >>= maybe (lift mempty) (r >=> h)+    r i = get  >>= \case+        Nothing -> pure $ parse json' i+        Just k  ->  pure $ k i +    h = \case+        Fail{} -> lift (yield ParseErr) +        Partial i -> put (Just i) >> l+        Done _ v -> lift $ yield $ fin $ parseMaybe parseJSON v +    fin = \case+        Nothing -> InvalidReq+        Just c -> Correct c++data ParseResult x = +    Correct !x |+    InvalidReq | +    ParseErr +    deriving (Show, Generic) +instance ToJSON a => ToJSON (ParseResult a) where +    toJSON = genericToJSON defaultOptions +instance FromJSON a => FromJSON (ParseResult a) +data Req x = Req { +   getMethod :: Text,+   getParams :: x,+   getReqId :: Maybe Value }+   deriving (Show) +   +data Res a =+    Res { getResBody :: a,+          getResId :: Value }+    | ErrRes  {+          errMsg :: Text,+          errId :: Maybe Value }+    deriving (Show, Generic)++instance FromJSON (Req Value) where+    parseJSON (Object v) = do+        version <- v .: "jsonrpc"+        guard (version == ("2.0" :: Text))+        Req <$> v .:  "method"+            <*> (v .:? "params") .!= emptyArray+            <*> v .:?  "id"+    parseJSON _ = mempty++instance FromJSON a => FromJSON (Res a) where+    parseJSON (Object v) = do+        version <- v .: "jsonrpc"+        guard (version == ("2.0" :: Text))+        fromResult <|> fromError+        where+            fromResult = Res <$> (v .: "result" >>= parseJSON)+                             <*> v .: "id"+            fromError = do+                err <- v .: "error"+                ErrRes  <$> err .: "message"+                      <*> v   .: "id"+    parseJSON (Array a) = mempty+    parseJSON _ = mempty++instance ToJSON a => ToJSON (Req a) where+    toJSON (Req m ps i) =+        object [ "jsonrpc" .= ("2.0" :: Text)+               , "method"  .= m+               , "params"  .= toJSON ps+               , "id"      .= i ]++instance ToJSON (Res Value) where+    toJSON (Res x i) = object [ +        "jsonrpc" .= ("2.0" :: Text),+        "result"  .= x,+        "id"      .= i ]+    toJSON (ErrRes msg i) = object [ +        "jsonrpc" .= ("2.0" :: Text),+        "error"   .= object ["message" .= msg],+        "id"      .= i ]+

@@ -10,16 +10,17 @@ module Control.Plugin (     plugin,      release, +    reject,     respond,      PluginApp,      PluginMonad,-    PluginInit,+    InitMonad,     PluginReq,      PlugInfo     ) where   import Data.Lightning-import Control.Conduit+import Control.Internal.Conduit import Control.Exception import Data.Conduit import Data.Conduit.Combinators (sourceHandle, sinkHandle) @@ -36,9 +37,12 @@ import System.IO  -- | Function called on every event subscribed to in the manifest.-type PluginApp a = PluginReq -> PluginMonad a () +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+ -- | 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) @@ -49,13 +53,10 @@ -- | Handle connected to lightning-rpc file (use with Control.Client) & configuration object.   type PlugInfo = (Handle, Init) --- | Function called on initialization, returned value is the initial state.-type PluginInit a = PlugInfo -> IO a- data StartErr = ExpectManifest | ExpectInit deriving (Show, Exception)   -- | Create main executable that can be installed as core lightning plugin. -plugin :: Value -> PluginInit s -> PluginApp s -> IO ()+plugin :: Value -> InitMonad s -> PluginApp s -> IO () plugin manifest start app = do      liftIO $ mapM_ (`hSetBuffering` LineBuffering) [stdin,stdout]      runOnce $ await >>= \case @@ -65,18 +66,21 @@         (Just (Right (Just i, "init", v))) -> case fromJSON v of              Success xi@(Init{..}) -> do                  h  <- liftIO $ getrpc $ getRpcPath configuration-                s' <- liftIO $ start (h, xi)+                s' <- liftIO $ runStartup (h, xi) start                 _ <- liftIO.forkIO $ runPlugin (h, xi) s' app -                yield $ Res continue i+                release i             _ -> throw ExpectInit              where getRpcPath conf = lightning5dir conf <> "/" <> rpc5file conf+        _ -> throw ExpectInit      threadDelay maxBound +runStartup :: PlugInfo -> InitMonad a -> IO a +runStartup re = (`runReaderT` re)  + runPlugin :: PlugInfo -> 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 +    where+    runner app = sourceHandle stdin .| inConduit .| entry .| appInsert app .| exit .| sinkHandle stdout   runOnce :: ConduitT (Either (Res Value) PluginReq) (Res Value) IO () -> IO () runOnce = runConduit.runner@@ -86,8 +90,8 @@ 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 $ Derp ("Request Error"::Text) Nothing  -    ParseErr -> yield $ Left $ Derp ("Parser Err"::Text) Nothing )+    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  @@ -103,17 +107,14 @@     N.connect soc $ SockAddrUnix $ unpack d     socketToHandle soc ReadWriteMode --- | Helper function to allow node to continue. Hooks delay default node behaviour. -release :: Id -> PluginMonad a ()-release = yield . Res continue+-- | 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)]) +-- | Helper function to prevent node default behaviour. +reject :: Monad m => Id -> ConduitT i (Res Value) m ()  +reject = yield . Res (object ["result" .= ("reject" :: Text)])+ -- | Respond with arbitrary Value, custom rpc hooks will pass back through to terminal. respond :: Value -> Id -> PluginMonad a () respond = (yield .) . Res--continue :: Value -continue = object ["result" .= ("continue" :: Text)]----

@@ -1,62 +1,3 @@ -{-# LANGUAGE -      OverloadedStrings -    , FlexibleContexts -#-} --module Tally (main) where---import Data.Lightning -import Control.Conduit -import Control.Plugin  -import Control.Client (getinfo) -import Data.Aeson-import Data.Text-import Data.Conduit -import Control.Monad.Trans.Class -import Control.Monad.IO.Class -import Control.Monad.Trans.State.Lazy -import Control.Monad.Reader---- plugin function to build core lightning plugin-main :: IO () -main = plugin manifest appState app---- define plugin options:  -manifest :: Value -manifest = object [-      "dynamic" .= True-    , "subscriptions" .= (["channel_opened"] :: [Text] ) -    , "options" .= ([]::[Option])-    , "rpcmethods" .= ([ RpcMethod "firethemissiles" "" "" Nothing False ]::[RpcMethod]) -    , "hooks" .= ([]::[Hook])-    , "featurebits" .= object [ ]-    , "notifications" .= ([]::[Notification])-    ] ---- can pattern match on tuple of data from plugin-app :: PluginApp () -app (Nothing, "channel_opened", v) = do-    -- -    -- -- state any type-    -- tea <- lift.lift $ get -    -- -- reader Handle connected to cln-rpc-    -- rpc <- lift ask-    -- -    -- liftIO $ getinfo rpc-    pure () ---- if id then core lightning is expecting a response, use yield from conduit  -app (Just i, "firethemissiles", v) = do-    -- if handling hook allow default behavior to continue: -    yield $ Res (object ["result" .= ("continue" :: Text)]) i---app _ = pure () --- polymorphic -appState = () --  --+module Todo where+main = undefined