aboutsummaryrefslogtreecommitdiff
path: root/app
diff options
context:
space:
mode:
authorHaskell Guy <haskell.guy@localhost>2020-05-26 13:07:50 +0200
committerHaskell Guy <haskell.guy@localhost>2020-05-26 13:37:29 +0200
commit41cde99ec6189dbecca6803a5aa4f6f18142e8ba (patch)
tree7a0ceab0d516b8c3b7b49313100ae50c97e875c3 /app
downloadssb-haskell-41cde99ec6189dbecca6803a5aa4f6f18142e8ba.tar.xz
initial commit
Diffstat (limited to 'app')
-rw-r--r--app/Main.hs155
1 files changed, 155 insertions, 0 deletions
diff --git a/app/Main.hs b/app/Main.hs
new file mode 100644
index 0000000..74670ba
--- /dev/null
+++ b/app/Main.hs
@@ -0,0 +1,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