initial commit

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