diff options
Diffstat (limited to 'src/Ssb/Peer/TCP.hs')
-rw-r--r-- | src/Ssb/Peer/TCP.hs | 100 |
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 () |