clplug 0.1.0.0 → 0.2.0.0
raw patch · 11 files changed
+36/−746 lines, 11 filesdep +blitzdep −clplugdep −containersdep −directory
Dependencies added: blitz
Dependencies removed: clplug, containers, directory, fgl, fmt, format-numbers, lens, lens-aeson, time
Files
- README.md +0/−16
- clplug.cabal +6/−87
- examples/movelog/Main.hs +0/−84
- examples/routes/Main.hs +0/−149
- examples/routes/Paths.hs +0/−44
- examples/routes/Route.hs +0/−71
- examples/routes/Search.hs +0/−155
- examples/wallet/Main.hs +0/−119
- src/Control/Client.hs +17/−11
- src/Control/Plugin.hs +11/−8
- src/Data/Lightning/Notifications.hs +2/−2
README.md view
@@ -13,22 +13,6 @@ - `get/put` - polymorphic state - `yield` - stdout to core lightning -Several examples are included that are intended to be useful for (d)evelopers and node (o)perators -- **movelog**- - o - specify logfile= to create a log file with fees earned and other coin movements- - d - a notification is subscribed, an option is added, and the state monad is used-- **wallet** - - o - show available totals and channel balances: `lightning-cli wallet`- - d - a new rpc method is created-- **routes** - - o - generate routes: `lightning-cli route` - - d - network graph is loaded and several rpc parameters are used--Operators: the examples require option `allow-deprecated-apis=false`. To install a plugin you must: - - clone this repository- - `stack build` - - move or symlink the created executable file into the lightning directory (by default: `.lightning/plugins`) - 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
clplug.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.12 name: clplug-version: 0.1.0.0+version: 0.2.0.0 license: BSD3 license-file: LICENSE copyright: 2023 maintainer: taylorsingletonfookes@live.com author: Taylor Singleton-Fookes-homepage: https://github.com/AutonomousOrganization/clplug#readme-bug-reports: https://github.com/AutonomousOrganization/clplug/issues+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.@@ -20,7 +20,7 @@ source-repository head type: git- location: https://github.com/AutonomousOrganization/clplug+ location: https://github.com/AutonomousOrganization/blitz library exposed-modules:@@ -52,88 +52,7 @@ network <3.2, text <1.3 -executable movelog- main-is: Main.hs- hs-source-dirs: examples/movelog- 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,- bytestring <0.12,- clplug,- conduit <1.4,- directory <1.4,- fmt <0.7,- format-numbers <0.2,- mtl <2.3,- network <3.2,- text <1.3,- time <1.12--executable routes- main-is: Main.hs- hs-source-dirs: examples/routes- other-modules:- Paths- Route- Search- 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,- bytestring <0.12,- clplug,- conduit <1.4,- containers <0.7,- fgl <5.8,- lens <5.2,- lens-aeson <1.3,- mtl <2.3,- network <3.2,- text <1.3--executable wallet- main-is: Main.hs- hs-source-dirs: examples/wallet- 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,- bytestring <0.12,- clplug,- conduit <1.4,- fmt <0.7,- format-numbers <0.2,- mtl <2.3,- network <3.2,- text <1.3--test-suite clnplug-test+test-suite blitz-test type: exitcode-stdio-1.0 main-is: Spec.hs hs-source-dirs: test@@ -149,8 +68,8 @@ aeson <2.1, attoparsec <0.15, base >=4.7 && <5,+ blitz, bytestring <0.12,- clplug, conduit <1.4, mtl <2.3, network <3.2,
− examples/movelog/Main.hs
@@ -1,84 +0,0 @@-{-# LANGUAGE - OverloadedStrings- , RecordWildCards- , DuplicateRecordFields- , ViewPatterns- , NamedFieldPuns- , LambdaCase - , FlexibleContexts- , DeriveAnyClass-#-}--module Main where--import Control.Plugin-import Data.Lightning -import Control.Monad.Reader-import Control.Monad.State-import Control.Exception-import Data.Aeson -import Data.Aeson.Types-import Data.Maybe -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.IO as T -import System.Directory -import Fmt -import Data.Text.Format.Numbers-import Data.Time.LocalTime-import Data.Time.Format--main :: IO ()-main = plugin manifest start app --manifest = object [- "dynamic" .= True- , "subscriptions" .= (["coin_movement"] :: [Text] ) - , "options" .= ([- Option "logfile" "string" "" "file path for logs" False- ])- , "rpcmethods" .= ([- RpcMethod "catchcheck" "" "xd" Nothing False- ]) - ] --start :: PluginInit Msat-start _ = pure 0 --data MoveError = MissingFile deriving (Show, Exception) --app :: PluginApp Msat -app (Nothing, "coin_movement", fromJSON -> Success (CoinMovement{..})) = do - (Just filepath) <- asks getFile - fileExists <- liftIO $ doesFileExist filepath- if not fileExists then throw MissingFile else pure () - case tags of - ["routed"] -> if hasVal debit_msat && hasVal fees_msat then do - total <- state (accumulate now) - liftIO $ movelog filepath total now - else pure () - where - now = fromJust fees_msat- hasVal a = isJust a && ((> 0).fromJust) a- accumulate n t = (x,x) where x = n + t- otherMove -> liftIO $ T.appendFile filepath $ fmtLn . build $ otherMove-app (Just i, _, _) = release i-app _ = pure () --movelog :: FilePath -> Msat -> Msat -> IO () -movelog path tots now = do- timenow <- liftIO getTime- liftIO . (T.appendFile path) . fmtLn $ mlog timenow- where - mlog t = (build.(prettyI (Just ',')).(`div` 1000) $ tots) - +| " ~~ " - +| build t - +| " +"- +| build now-- getTime = do - zone <- getZonedTime - pure $ formatTime defaultTimeLocale "%H:%M" zone - -getFile :: PlugInfo -> Maybe FilePath -getFile (_, Init opts _) = parseMaybe (.: "logfile") opts
− examples/routes/Main.hs
@@ -1,149 +0,0 @@-{-# LANGUAGE - DuplicateRecordFields- , LambdaCase- , DeriveGeneric- , OverloadedStrings- , BangPatterns- , ViewPatterns-#-}-module Main where --import Numeric -import Data.Graph.Inductive.Graph-import Data.Graph.Inductive.PatriciaTree-import Data.Char -import Control.Plugin-import Data.Lightning -import Control.Client-import Data.Aeson-import Data.Aeson.Lens-import Control.Lens hiding ((.=))-import Control.Monad.IO.Class-import GHC.Generics -import Data.Text (Text)-import Data.Lightning -import Data.Lightning.Generic -import Control.Client -import Control.Conduit-import Control.Monad.State-import Control.Monad.Reader -import Control.Applicative (liftA2) -import Data.List -import Data.Foldable -import Route -import Search --type Gra = Gr () MyChan--main = plugin manifest start app--manifest = object [- "dynamic" .= True- , "options" .= ([] :: [Option])- , "rpcmethods" .= [- RpcMethod "route" "[n, m, a, l]" "l routes from n to m of a" Nothing False - , RpcMethod "network" "" "show metrics of loaded graph" Nothing False - ]- ]--start :: PluginInit Gra-start (h, Init o c) = do- Just (Res xd _) <- liftIO $ lightningCli h (Command "listnodes" nfilt noparams)- Just (Res yd _) <- liftIO $ lightningCli h (Command "listchannels" cfilt noparams)- case (fromJSON xd, fromJSON yd) :: (Result MyNodes, Result MyChans) of- (Success nx, Success cx) -> pure $ mkGraph - (map toLNode (_nodes nx)) (map toLEdge' (channels cx)) - _ -> pure empty- where toLNode ni = ((getNodeInt.nodeid) ni , ())- toLEdge' c = (- (getNodeInt.cSource) c- , (getNodeInt.cDest) c- , c- )--app (Just i, "route", v) =- let n = getNodeInt <$> v ^? nth 0 - m = getNodeInt <$> v ^? nth 1 - a = maybe 100000000 fromInteger $ v ^? nth 2 . _Integer- l = maybe 1 fromInteger $ v ^? nth 3 . _Integer- in do- g <- get- case valid g n m of- Just (n', m') -> do - r <- pure . map (createRoute a . toList) $ evalChans g n' m' l- respond (object ["routes" .= r ]) i - _ -> respond (object ["invalid nodid" .= True]) i - where --app (Just i, "network", _) = do - g <- get- respond (object [- "nodes" .= order g- , "edges" .= size g- , "capacity" .= capacity g 0- ]) i - where capacity g t - | isEmpty g = t - | True = case matchAny g of - (n, g') -> capacity g' $ t + (sum - . map _amount_msat- . map snd - . lsuc' $ n )--app (Just i, _, _) = release i-app _ = pure () ---valid g n m = case (n , m) of - (Just n', Just m') -> if gelem n' g && gelem m' g- then (Just (n', m'))- else Nothing - _ -> Nothing-noparams = object [] -nfilt = object ["nodes" .= [nField]] -nField = object ["nodeid" .= True] --data MyNodes = M {- _nodes :: [MyNode] - } deriving Generic -instance FromJSON MyNodes where- parseJSON = defaultParse-data MyNode = MyNode {- nodeid :: Text- } deriving Generic-instance FromJSON MyNode --cfilt = object ["channels" .= [object [- "source" .= True- , "destination" .= True- , "short_channel_id" .= True- , "delay" .= True- , "base_fee_millisatoshi" .= True - , "fee_per_millionth" .= True - , "amount_msat" .= True - ]]]--data MyChans = CC {- channels :: [MyChan] - } deriving Generic-instance FromJSON MyChans-data MyChan = MyChan {- _source :: Text- , _destination :: Text- , _short_channel_id :: Text- , _delay :: Int- , _base_fee_millisatoshi :: Msat- , _fee_per_millionth :: Int - , _amount_msat :: Msat - } deriving Generic-instance FromJSON MyChan where - parseJSON = defaultParse--- instance ToJSON MyChan-instance Channel MyChan where -- ? redundant?- basefee = _base_fee_millisatoshi- ppmrate = _fee_per_millionth- cDelay = _delay - cDest = _destination- cSource = _source- shortid = _short_channel_id-
− examples/routes/Paths.hs
@@ -1,44 +0,0 @@-{-# LANGUAGE - DuplicateRecordFields, - LambdaCase, - DeriveGeneric, - OverloadedStrings-#-}-module Paths where ----import Data.Lightning ---import GHC.Generics---import Data.Aeson------data PathInfo = P {--- cost :: Fee--- , neck :: Sat--- } deriving (Generic, Show)---instance ToJSON PathInfo ---instance Eq PathInfo where --- (==) a b = (base.cost $ a) == (base.cost $ b) && (ppm.cost $ a) == (ppm.cost $ b)---instance Ord PathInfo where --- compare a b = compare (cost a) (cost b) ------data Fee = Fee {--- base :: Int --- , ppm :: Int --- } deriving (Show, Generic, Eq) ---instance Ord Fee where --- compare a b = compare (base a + ppm a) (base b + ppm b)---instance ToJSON Fee------info :: [Channel] -> PathInfo---info = foldr pf (P (Fee 0 0) maxBound) --- where --- pf :: Channel -> PathInfo -> PathInfo --- pf e c = P --- (Fee ( (base.cost) c + base_fee_millisatoshi e )--- (((ppm.cost) c) + fee_per_millionth e ) --- )--- (case htlc_maximum_msat e of --- (Just x) -> minimum [(neck c), ((amount_msat::Channel->Msat) e), x]--- otherwise -> min (neck c) ((amount_msat::Channel->Msat) e) --- )------
− examples/routes/Route.hs
@@ -1,71 +0,0 @@-{-# LANGUAGE - DuplicateRecordFields- , OverloadedStrings- , DeriveGeneric #-} --module Route where --import Data.Lightning -import Numeric (readHex) -import Data.Aeson-import GHC.Generics-import Data.Text (Text) -import Control.Applicative --data Route = Route {- __id :: Text - , channel :: Text - , direction :: Int- , __amount_msat :: Msat - , __delay :: Int - , style :: Text- } deriving (Show, Generic, Eq) -instance ToJSON Route where- toJSON v = genericToJSON defaultOptions{fieldLabelModifier = dropWhile (=='_')} v --class Channel c where- basefee :: c -> Msat- ppmrate :: c -> Int - cDelay :: c -> Int- cDest :: c -> Text- cSource :: c -> Text- shortid :: c -> Text - -createRoute :: (Channel c) => Msat -> [c] -> [Route]-createRoute a c = foldr (addHop a) [] $ pairUp c- where- pairUp :: [c] -> [(c,c)]- pairUp [] = []- pairUp (a:[]) = [(a,a)]- pairUp (a:b) = (a,head b) : pairUp b-- -- addHop :: Msat -> (Channel, Channel) -> [Route] -> [Route]- addHop a (cp, c) r = Route- (cDest cp)- (shortid cp)- (liftA2 getDirect cSource cDest cp)- (getAmount a c r)- (getDelay c r)- "tlv"- : r-- -- getDirect :: String -> String -> Int- getDirect a b = if readHex (show a) < readHex (show b) then 0 else 1-- -- getDelay :: Channel -> [Route] -> Int- getDelay e [] = 9- getDelay e (r:_) = __delay r + cDelay e- - getAmount :: (Channel c) => Msat -> c -> [Route] -> Msat- getAmount a e [] = a- getAmount a e r =- let mil = 1000000 :: Integer- b = basefee e- p = ppmrate e- num = (mil * toInteger nextAmount * toInteger p)- denum = mil*mil- ppmfee = fromInteger $ div num denum -- inaccurate?>- nextAmount = maximum $ map __amount_msat r- in sum [ nextAmount, b, ppmfee ]--
− examples/routes/Search.hs
@@ -1,155 +0,0 @@-{-# LANGUAGE- LambdaCase, - DuplicateRecordFields, - TypeSynonymInstances, - FlexibleInstances-#-} -module Search (- Search- , Way- , evalTo- , evalRefs- , evalChans- , results'- , results- , search- , hydrate- , increment- , chop- , getNodeInt- )where -import Numeric -import Data.Char-import System.IO -import Data.Lightning -import Data.Graph.Inductive.Graph-import Data.Graph.Inductive.PatriciaTree-import Control.Monad.Reader-import Control.Monad.State-import Control.Concurrent-import Control.Concurrent.Chan-import qualified Data.Sequence as Q-import Data.Sequence (Seq(..),(<|),(|>),(><)) -import Data.Foldable -import Route --type Search b = Reader (Gr () b, Node, Node) -- from / to-type Way b = Q.Seq b -type Ref = Q.Seq Int -type Deref b = (Ref, Way b) -type Eebe b = Either (Deref b) (Way b)--evalTo :: Channel b => Gr () b -> Node -> Node -> Int -> [Ref]-evalTo = evalBy resLength--evalChans :: Channel b => Gr () b -> Node -> Node -> Int -> [Way b]-evalChans = evalBy results'-evalRefs :: Channel b => Gr () b -> Node -> Node -> Int -> [Ref]-evalRefs = evalBy results-evalBy s g n m l = (`runReader` (g, n, m)) . (`evalStateT` (Empty, [])) $ s l --results' :: Channel b => Int -> StateT (Ref, [Way b]) (Search b) [Way b] -results' x = do - (r , c) <- get- (w, r') <- lift $ search r- put (increment.chop $ r', w : c) - if x > length c - then results' x - else return c--results :: Channel b => Int -> StateT (Ref, [Ref]) (Search b) [Ref] -results x = do - (r , c) <- get- (_, r') <- lift $ search r- put (increment.chop $ r', r' : c) - if x > length c - then results x - else return c---resLength :: Channel b => Int -> StateT (Ref, [Ref]) (Search b) [Ref] -resLength j = do - (r, c) <- get- (_, r') <- lift $ search r- put (increment.chop $ r', r':c) - if j >= length r' - then resLength j- else return c--search :: Channel b => Ref -> Search b (Way b, Ref) -search r = (hydrate r) >>= \case- (Left x) -> do - search $ nextr r x- (Right y) -> do- (fin (r, y) ) >>= \case - Nothing -> search $ increment r- (Just z) -> lift $ pure z --fin :: Channel b => (Ref, Way b) -> Search b (Maybe (Way b, Ref)) -fin (r, w) = do - (g, n, v) <- ask - oo <- outgoing w - let {- f = dropWhile (not.(== v).fst) oo;- lo = length oo; - la = length f ;- rr = lo - la - }- case f of - [] -> pure Nothing - (x:_) -> pure $ Just ( w |> snd x, r |> rr) --nextr :: Channel b => Ref -> Deref b -> Ref -nextr r (r', c) - | z == Q.length r = extend.increment.chop $ r- | z == 0 = extendTo (Q.length r + 1) Empty- | otherwise = extendTo (Q.length r) $ increment $ Q.take z r- where z = Q.length c--hydrate :: Channel b => Ref -> (Search b) (Eebe b)-hydrate r = evalStateT h (r, Empty) - -h :: Channel b => StateT (Deref b) (Search b) (Eebe b)-h = get >>= \case - (Empty, c) -> return $ Right c- dr@(y :<| t, c) -> do - (g, n, v) <- lift ask - oo <- lift $ outgoing c- case oo !? y of - Nothing -> pure $ Left dr - Just (m, x) -> put (t, c |> x) >> h- -outgoing :: Channel b => Way b -> Search b [(Node, b)] -outgoing Empty = do - (g, n, v) <- ask - pure $ lsuc g n-outgoing (c :|> d) = do - (g, n, v) <- ask- pure $ lsuc g (toNode d) --increment :: Ref -> Ref-increment Empty = Q.singleton 0-increment (r :|> x) = r |> (x + 1) -extend :: Ref -> Ref-extend r = r |> 0-chop :: Ref -> Ref-chop Empty = Empty -chop (r :|> _) = r-extendTo :: Int -> Ref -> Ref -extendTo x r- | length r >= x = r - | otherwise = extendTo x $ extend r- -toNode :: Channel c => c -> Node-toNode = getNodeInt.cDest -getNodeInt s = case readHex.filter isHexDigit $ show s of- ([]) -> 0- (x:_)-> fst x--(!?) :: (Foldable t, Eq b, Num b) => t a -> b -> Maybe a-(!?) = foldr voo (const Nothing)- where - voo :: (Eq b, Num b) => a -> (b -> Maybe a) -> b -> Maybe a- voo x r k - | k == 0 = Just x- | otherwise = r $ k-1
− examples/wallet/Main.hs
@@ -1,119 +0,0 @@-{-# LANGUAGE- OverloadedStrings - , DeriveGeneric - , DuplicateRecordFields- , ViewPatterns #-}--module Main where --import Data.Lightning -import Data.Lightning.Generic -import Control.Plugin -import Control.Client -import Control.Conduit -import Data.Aeson-import Control.Monad.Reader-import Control.Monad.State-import Control.Monad.IO.Class -import GHC.Generics -import Data.Text (Text)-import qualified Data.Text as T -import Fmt -import Data.Text.Format.Numbers -import Data.List -import Data.Maybe--main = plugin manifest start app --manifest = object [- "dynamic" .= True- , "options" .= ([] :: [Option])- , "rpcmethods" .= [- RpcMethod "wallet" "" "print summary info" Nothing False - ]- ]--start :: PluginInit ()-start _ = pure () --app :: PluginApp () -app (Just i, "wallet", _) = do - (h, _) <- ask - Just (Res xd _) <- liftIO $ lightningCli h (Command "listfunds" fundFilter fundParams) - case fromJSON xd :: Result MyFundy of- (Success x) -> respond (summarizeFunds x) i - _ -> release i --summarizeFunds :: MyFundy -> Value-summarizeFunds myf = object [- "withdraw" .= (prettyI (Just ',') . (`div` 1000) . outSum . outputs $ myf)- , "pay" .= (prettyI (Just ',') (payable $ channels myf))- , "invoice" .= (prettyI (Just ',') $ recable (channels myf))- , "xchan" .= (map showChan $ sort $ channels myf)- ]- where outSum :: [Outy] -> Msat - outSum = sum . map __amount_msat . filter ((=="confirmed") . __status) - payable = sum . map our_amount_msat . filter ((=="CHANNELD_NORMAL") . _state)- recable = sum . map recable' . filter ((=="CHANNELD_NORMAL")._state) - recable' a = _amount_msat a - our_amount_msat a- showChan :: Chany -> Text- showChan (Chany a o s n i) = "" - +| (build $ T.justifyLeft 13 ' ' <$> i ) - +| " |" - +| (build $ evalState xd (o, ""))- +| "#"- +| (build $ evalState xd (a-o, "")) - +| "| " - +| (build $ T.take 6 n)- +| " "- +| if s /= "CHANNELD_NORMAL" then build s else "" - - xd :: State (Msat, Text) Text - xd = do - (m, t) <- get - put (m - 1000000000, T.append t "-" ) - if m > 0 && T.length t < 11 then xd else pure t--fundFilter = object [- "outputs" .= [outputFields]- , "channels" .= [chanFields]- ]-outputFields = object [- "amount_msat" .= True- , "status" .= True - ]-chanFields = object [- "amount_msat" .= True- , "our_amount_msat" .= True- , "state" .= True- , "peer_id" .= True- , "short_channel_id" .= True- ]--data MyFundy = MyFundy {- outputs :: [Outy]- , channels :: [Chany] - } deriving Generic -instance FromJSON MyFundy--data Outy = Outy {- __amount_msat :: Msat - , __status :: Text - } deriving Generic -instance FromJSON Outy where - parseJSON = defaultParse--data Chany = Chany {- _amount_msat :: Msat- , our_amount_msat :: Msat - , _state :: Text- , peer_id :: Text - , _short_channel_id :: Maybe Text - } deriving (Eq, Generic) -instance FromJSON Chany where - parseJSON = defaultParse-instance Ord Chany where - compare x y = compare (_short_channel_id x) (_short_channel_id y)-- -fundParams = object [ ]
src/Control/Client.hs view
@@ -8,6 +8,7 @@ module Control.Client ( lightningCli,+ lightningCliDebug, Command(..), PartialCommand ) @@ -17,30 +18,27 @@ import Control.Conduit import Data.Lightning import Data.ByteString.Lazy as L -import System.IO import System.IO.Unsafe import Data.IORef-import Network.Socket +import Control.Monad.Reader import Data.Conduit hiding (connect) import Data.Conduit.Combinators hiding (stdout, stderr, stdin) import Data.Aeson import Data.Text -type Cln a = IO (Maybe (ParseResult (Res a))) type PartialCommand = Id -> Command {-# 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 :: Value- -- ^ filter specifies which data fields you want to be retured. , params :: Value , ____id :: Value } deriving (Show) - instance ToJSON Command where toJSON (Command m f p i) = object [ "jsonrpc" .= ("2.0" :: Text)@@ -50,12 +48,20 @@ , "params" .= toJSON p ] --- | Function to interface with lightning-rpc commands. First argument is a Handle to rpcfile from the readerT, second is a Command withholding Id which will automatically increment. -lightningCli :: Handle -> PartialCommand -> IO (Maybe (Res Value))-lightningCli h v = do - i <- atomicModifyIORef idref $ (\x -> (x,x)).(+1)- L.hPutStr h . encode $ v (toJSON i) - runConduit $ sourceHandle h .| inConduit .| await >>= \case +-- interface with lightning-rpc. +lightningCli :: PartialCommand -> PluginMonad a (Maybe (Res Value))+lightningCli v = do + (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 :: (String -> IO ()) -> PartialCommand -> PluginMonad a (Maybe (Res Value))+lightningCliDebug logger v = do + res@(Just (Res x _)) <- lightningCli v + liftIO . logger . show $ x + pure res
src/Control/Plugin.hs view
@@ -21,7 +21,6 @@ import Data.Lightning import Control.Conduit import Control.Exception-import System.IO import Data.Conduit import Data.Conduit.Combinators (sourceHandle, sinkHandle) import qualified Data.ByteString as S@@ -34,17 +33,18 @@ import Control.Monad.Reader import Control.Concurrent hiding (yield) import Network.Socket as N+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) -- | Plugin stack contains ReaderT (ask - rpc handle & config), stateT (get/put - polymorphic state) and conduitT (yield - data exchange to core lightning.)-type PluginMonad a = ConduitT +type PluginMonad a b = ConduitT (Either (Res Value) PluginReq) (Res Value) (ReaderT PlugInfo (StateT a IO))- () + b -- | Handle connected to lightning-rpc file (use with Control.Client) & configuration object. type PlugInfo = (Handle, Init)@@ -89,7 +89,7 @@ InvalidReq -> yield $ Left $ Derp ("Request Error"::Text) Nothing ParseErr -> yield $ Left $ Derp ("Parser Err"::Text) Nothing ) -appInsert :: PluginApp a -> PluginMonad a+appInsert :: PluginApp a -> PluginMonad a () appInsert app = await >>= maybe mempty \case Left er -> yield er Right pr -> app pr @@ -104,13 +104,16 @@ socketToHandle soc ReadWriteMode -- | Helper function to allow node to continue. Hooks delay default node behaviour. -release :: Id -> PluginMonad a+release :: Id -> PluginMonad a () release = yield . Res continue -- | Respond with arbitrary Value, custom rpc hooks will pass back through to terminal.-respond :: Value -> Id -> PluginMonad a+respond :: Value -> Id -> PluginMonad a () respond = (yield .) . Res - continue :: Value continue = object ["result" .= ("continue" :: Text)]++++
src/Data/Lightning/Notifications.hs view
@@ -104,12 +104,12 @@ data SendPayFailure = SendPayFailure { code :: Int , message :: Text- , _data :: SPFData+ , _data :: FailData } deriving Generic instance FromJSON SendPayFailure where parseJSON = singleField "sendpay_failure" -data SPFData = SPFData {+data FailData = SPFData { _id :: Int , payment_hash :: Text , destination :: Text