diff options
Diffstat (limited to 'app/Main.hs')
| -rw-r--r-- | app/Main.hs | 155 |
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 |