~haskell-guy/ssb-haskell

ref: 41cde99ec6189dbecca6803a5aa4f6f18142e8ba ssb-haskell/src/Ssb/Peer/TCP.hs -rw-r--r-- 3.4 KiB
41cde99e — Haskell Guy initial commit 10 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
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 ()