initial commit

1 files changed, 100 insertions, 0 deletions

diff --git a/src/Ssb/Peer/TCP.hs b/src/Ssb/Peer/TCP.hs
new file mode 100644
index 0000000..27e3f07
--- /dev/null
+++ b/src/Ssb/Peer/TCP.hs
@@ -0,0 +1,100 @@
+-- | This module implements basic TCP connectivity for Scuttlebutt.
+
+module Ssb.Peer.TCP where
+
+import           Protolude               hiding ( Identity )
+import           Data.Maybe                     ( fromJust )
+import qualified Network.Simple.TCP            as TCP
+
+import           Ssb.Aux
+import qualified Ssb.Identity                  as Ssb
+import           Ssb.Network
+import           Ssb.Peer
+import qualified Ssb.Peer.BoxStream            as BoxStream
+import qualified Ssb.Peer.SecretHandshake      as SH
+import qualified Ssb.Peer.RPC                  as RPC
+
+connectBoxStream
+  :: Host
+  -> Port
+  -> NetworkIdentifier
+  -> Ssb.Identity
+  -> Ssb.Identity
+  -> (BoxStream.Conn -> IO ())
+  -> IO (Either Text ())
+connectBoxStream host port networkID id peer cmd =
+  TCP.connect (toS host) (toS port) $ \(socket, addr) -> do
+    res <- SH.startHandshake (TCP.send socket)
+                                       (TCP.recv socket)
+                                       networkID
+                                       id
+                                       (Ssb.publicKey peer)
+    case res of
+        Left err -> return $ Left ("client handshake error: " <> err)
+        Right sharedSecrets -> do
+          conn <- BoxStream.connectServer socket sharedSecrets
+          case conn of
+            Left  err  -> return (Left err)
+            Right conn -> return <$> cmd conn
+
+serveBoxStream
+  :: Host
+  -> Port
+  -> NetworkIdentifier
+  -> Ssb.Identity
+  -> (BoxStream.Conn -> Ssb.Identity -> IO ())
+  -> IO ()
+serveBoxStream host port networkID id cmd =
+  TCP.serve (TCP.Host $ toS host) (toS port) $ \(socket, remoteAddr) -> do
+    res <- SH.welcomeHandshake (TCP.send socket)
+                                         (TCP.recv socket)
+                                         networkID
+                                         id
+    case res of
+        Left err -> print $ "client handshake error: " <> err
+        Right sharedSecrets -> do
+            let peerID = (fromMaybe undefined $ SH.secretA sharedSecrets)
+            conn <- BoxStream.connectServer socket sharedSecrets
+            case conn of
+              Left  err  -> print $ "client error: " <> err
+              Right conn -> cmd conn (Ssb.Identity Nothing peerID)
+
+connectRPC
+  :: RPC.Handler a
+  => a
+  -> Host
+  -> Port
+  -> NetworkIdentifier
+  -> Ssb.Identity
+  -> Ssb.Identity
+  -> (RPC.ConnState -> IO ())
+  -> IO (Either Text ())
+connectRPC handler host port networkID id peer cmd =
+  TCP.connect (toS host) (toS port) $ \(socket, addr) -> do
+    res <- SH.startHandshake (TCP.send socket)
+                                       (TCP.recv socket)
+                                       networkID
+                                       id
+                                       (Ssb.publicKey peer)
+    case res of
+        Left err -> return $ error ("client handshake error: " <> err)
+        Right sharedSecrets -> do
+            conn <- BoxStream.connectClient socket sharedSecrets
+            case conn of
+              Left  err  -> return $ Left err
+              Right conn -> RPC.connect conn handler (Ssb.publicKey peer) cmd
+
+serveRPC
+  :: RPC.Handler a
+  => a
+  -> Host
+  -> Port
+  -> NetworkIdentifier
+  -> Ssb.Identity
+  -> IO ()
+serveRPC handler host port networkID id =
+  serveBoxStream host port networkID id $ \conn peer -> do
+    res <- RPC.connect conn handler (Ssb.publicKey peer) (\_ -> return ())
+    case res of
+      Left  err -> print $ "RPC error serving client: " <> err
+      Right _   -> return ()