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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
module Main where
import Protolude hiding ( Identity )
import Data.Default
import System.Directory ( doesFileExist )
import qualified Data.ByteString.Base64 as Base64
import Data.Either.Combinators ( mapLeft
, mapRight
)
import qualified Data.Map.Strict as Map
import Ssb
import Ssb.Aux
import Ssb.Identity as Ssb
import Ssb.Peer as Peer
import Ssb.Peer.BoxStream as BoxStream
import Ssb.Peer.RPC as RPC
import Ssb.Peer.TCP as TCP
import Ssb.Pub as Ssb
import Ssb.Feed as Feed
import qualified Ssb.Peer.SecretHandshake as SH
import qualified Ssb.Peer.RPC.Gossip as Gossip
import qualified Ssb.Peer.RPC.Room as Room
import qualified Ssb.Peer.RPC.WhoAmI as WhoAmI
import Data.Aeson as Aeson
import qualified Network.Simple.TCP as TCP
import qualified Turtle.Options as Options
import qualified Turtle
data Command
= Connect Text | HostRoom Text Text Text deriving (Show)
aboutMessage :: Ssb.Identity -> Text -> Aeson.Value
aboutMessage id name =
Aeson.toJSON (Map.fromList
[ ("type" , "about")
, ("about", Ssb.formatPublicKey (Ssb.publicKey id))
, ("name" , name)
] :: Map Text Text
)
postMessage :: Text -> Aeson.Value
postMessage post =
Aeson.toJSON (Map.fromList [("type", "post"), ("text", post)] :: Map Text Text)
-- Avoid using RPC.Router as it is currently buggy.
defaultHandler :: IO (Gossip.Gossiper Aeson.Value)
defaultHandler = Gossip.newGossiper
-- `withM` (Gossip.newGossiper :: IO (Gossip.Gossiper Aeson.Value))
-- `withM` (pure WhoAmI.newHandler)
must :: Either a b -> b
must = fromRight undefined
haskellGuy = must
$ Feed.parseFeedID "@f5ABjSMAR95ajlGST63/xx+XUoty53mlSZZ3GhGbQeE=.ed25519"
solarPunkNetwork =
must
$ Peer.parseMultiAddress
"net:pub.solarpunk.network:8008~shs:vU/bDokQrQro6t835MkjGct+dmygIv4zkd4oV3UNhgc="
connectCMD :: Text -> IO ()
connectCMD peer = do
me <- loadOrCreateIdentity
let peerAddr = must $ Peer.parseMultiAddress peer
let peerID = Peer.id peerAddr
router <- defaultHandler
res <-
TCP.connectRPC router
(Peer.host peerAddr)
(Peer.port peerAddr)
mainNet
me
peerID
$ \conn -> do
let req = (Gossip.newRequest haskellGuy) { Gossip.keys = False
, Gossip.live = Just True
, Gossip.old = Just True
}
let myFeed = Feed.empty peerID :: Feed Aeson.Value
resp <- Gossip.createHistoryStream conn req myFeed $ \feed msg -> do
putStrLn (Feed.vmSignedPayload msg)
return $ Feed.append feed msg
case resp of
Left err -> print err
Right f ->
-- Print out the response
forM_ f print
return ()
case res of
Left err -> print err
Right _ -> return ()
hostRoomCMD :: Text -> Text -> Text -> IO ()
hostRoomCMD name desc hostname = do
me <- loadOrCreateIdentity
let roomInvite =
Room.Invite { host = hostname, port = "8008", key = publicKey me }
putStrLn $ "Hosting room for '" <> Room.formatInvite roomInvite <> "'"
router <- defaultHandler
TCP.serveRPC router hostname (Room.port roomInvite) mainNet me
parser :: Options.Parser Command
parser =
Options.subcommand
"connect"
"connect to a peer"
(Connect <$> Options.argText "peer" "whom to connect to, not really useful now")
<|> Options.subcommand
"host-room"
"host a room"
( HostRoom
<$> Options.argText "name" "what's the room called"
<*> Options.argText "description" "summary of room's purpose"
<*> Options.argText "hostname" "IP address or Domain Name to host on. The Domain Name must resolve."
)
-- | keysFile is where the encryption keys are stored.
keysFile = "keys.json"
loadOrCreateIdentity :: IO Ssb.Identity
loadOrCreateIdentity = do
unlessM (doesFileExist keysFile) $ do
i <- newIdentity
Aeson.encodeFile keysFile i
i <- Aeson.decodeFileStrict keysFile
case i of
Nothing -> die "badly formatted key file"
Just i -> return i
main :: IO ()
main = do
ssbInit
-- Use an external command to support SSB legacy message serialization.
-- initV8Encoder "ssb-message-encoder"
id <- loadOrCreateIdentity
x <- Options.options "Secure Scuttlebutt" parser
case x of
Connect peer -> connectCMD peer
HostRoom name desc hostname -> hostRoomCMD name desc hostname
|
