implement r2

README.md

@@ -16,9 +16,9 @@
   x----------------------------------------x
 ```
 
-Both daemon (`pnetd`) and manager (`pnet`) implement recursive routing protocol called ipchains
+Both daemon (`pnetd`) and manager (`pnet`) implement recursive routing protocol called r2
 The manager provides transport for daemons via `pnet-connect` and transport for application layer programs via `pnet-tunnel`, with both subcommands sharing a similar interface.
-The daemon communicates to other nodes via connections brought by its managers and makes it's tunnel process an ipchains reachable node with a reserved address which for any daemon session always refers to a tunnel process spawned for that session
+The daemon communicates to other nodes via connections brought by its managers and makes it's tunnel process an r2 reachable node with a reserved address which for any daemon session always refers to a tunnel process spawned for that session
 
 `pnetd` and `pnet` communicate over a UNIX socket
 

cli/Pnet/Main.hs

@@ -3,6 +3,7 @@ import Data.ByteString.Base58.Internal
 import Data.ByteString.Char8 qualified as BC
 import Network.Socket hiding (close)
 import Pnet
+import Pnet.Routing
 import Pnet.Options
 import Polysemy hiding (run)
 import Polysemy.Async

common/Pnet.hs

@@ -1,8 +1,5 @@
-{-# OPTIONS_GHC -Wno-orphans #-}
-
 module Pnet
-  ( Node,
-    TunnelMessage (..),
+  ( TunnelMessage (..),
     NodeToManagerMessage (..),
     ManagerToNodeMessage (..),
     pnetSocketAddr,
@@ -18,18 +15,15 @@ where
 import Control.Applicative ((<|>))
 import Control.Exception
 import Data.ByteString (ByteString)
-import Data.DoubleWord
-import Data.Functor
 import Data.Maybe
 import Data.Serialize
 import Debug.Trace
 import GHC.Generics
 import Network.Socket
+import Pnet.Routing
 import System.Environment
 import System.Posix
 
-type Node = Int256
-
 data Transport
   = Stdio
   | Process String
@@ -87,12 +81,6 @@ pnetSocketAddr customPath = do
 withPnetSocket :: (Socket -> IO a) -> IO a
 withPnetSocket = bracket pnetSocket (`gracefulClose` timeout)
 
-instance Serialize Int128
-
-instance Serialize Word128
-
-instance Serialize Int256
-
 instance Serialize Transport
 
 instance Serialize TunnelMessage

common/Pnet/Routing.hs

@@ -0,0 +1,35 @@
+module Pnet.Routing (Node, R2Message, r2) where
+
+import Data.ByteString (ByteString)
+import Data.DoubleWord
+import Data.Serialize
+import GHC.Generics
+import Polysemy
+import Polysemy.Transport
+import Polysemy.Transport qualified as Transport
+
+type Node = Int256
+
+data R2Message = RouteTo
+  { routeToNode :: Node,
+    routeToData :: Maybe ByteString
+  }
+  deriving stock (Show, Generic)
+
+r2 :: (Members '[InputWithEOF R2Message, Output R2Message, Close] r) => Node -> InterpretersFor '[InputWithEOF ByteString, Output ByteString, Close] r
+r2 node =
+  interpret \case Transport.Close -> outputRouteTo Nothing
+    . interpret \case Output maybeStr -> outputRouteTo (Just maybeStr)
+    . interpret \case Input -> (>>= routeToNodeData) <$> input
+  where
+    routeToNodeData (RouteTo node' maybeStr) = if node' == node then maybeStr else Nothing
+    outputRouteTo :: (Member (Output R2Message) r) => Maybe ByteString -> Sem r ()
+    outputRouteTo = output . RouteTo node
+
+instance Serialize Int128
+
+instance Serialize Word128
+
+instance Serialize Int256
+
+instance Serialize R2Message

daemon/Pnet/Main.hs

@@ -4,6 +4,7 @@ import Network.Socket (bind, listen)
 import Pnet
 import Pnet.Node
 import Pnet.Options
+import Pnet.Routing
 import Polysemy hiding (run, send)
 import Polysemy.Async
 import Polysemy.AtomicState

daemon/Pnet/Node.hs

@@ -10,6 +10,7 @@ import Data.ByteString
 import Data.Serialize
 import GHC.Generics
 import Pnet
+import Pnet.Routing
 import Polysemy hiding (send)
 import Polysemy.Extra.Trace
 import Polysemy.Fail

pnet.cabal

@@ -21,15 +21,15 @@ common default
         -Wno-all-missed-specialisations -Wno-missed-specialisations
         -Wno-missing-local-signatures -Wno-monomorphism-restriction
         -Wno-implicit-prelude -threaded -Wno-missing-kind-signatures
-        -fplugin=Polysemy.Plugin
+        -fplugin=Polysemy.Plugin -Wno-orphans
     if flag(pedantic)
         ghc-options: -Werror -threaded
 
 library
     import: default
     hs-source-dirs: common
     build-depends: data-dword
-    exposed-modules: Polysemy.Socket, Pnet
+    exposed-modules: Polysemy.Socket, Pnet, Pnet.Routing
 
 executable pnetd
     import: default