Main.hs

{-# 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