From 08ddfb1c4efe532ba10fdf594626a3ad794bb65e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sun, 9 Aug 2020 22:26:47 +0200
Subject: Contact: shared state and service

---
 src/Main.hs | 24 ++++++++++++++++++++++++
 1 file changed, 24 insertions(+)

(limited to 'src/Main.hs')

diff --git a/src/Main.hs b/src/Main.hs
index c961f4f..96186a8 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -25,6 +25,7 @@ import System.Console.Haskeline
 import System.Environment
 
 import Attach
+import Contact
 import Identity
 import Message
 import Network
@@ -100,6 +101,7 @@ interactiveLoop st bhost = runInputT defaultSettings $ do
         startServer erebosHead extPrintLn bhost
             [ SomeService @AttachService Proxy
             , SomeService @SyncService Proxy
+            , SomeService @ContactService Proxy
             , SomeService @DirectMessage Proxy
             ]
 
@@ -190,6 +192,9 @@ commands =
     , ("update-identity", cmdUpdateIdentity)
     , ("attach", cmdAttach)
     , ("attach-accept", cmdAttachAccept)
+    , ("contacts", cmdContacts)
+    , ("contact-add", cmdContactAdd)
+    , ("contact-accept", cmdContactAccept)
     ]
 
 cmdUnknown :: String -> Command
@@ -252,3 +257,22 @@ cmdAttachAccept = join $ attachAccept
     <$> asks ciPrint
     <*> asks ciHead
     <*> (maybe (throwError "no peer selected") return =<< gets csPeer)
+
+cmdContacts :: Command
+cmdContacts = do
+    ehead <- asks ciHead
+    let contacts = contactView $ lookupSharedValue $ lsShared $ headObject ehead
+    forM_ (zip [1..] contacts) $ \(i :: Int, c) -> do
+        liftIO $ putStrLn $ show i ++ ": " ++ T.unpack (displayIdentity $ contactIdentity c)
+
+cmdContactAdd :: Command
+cmdContactAdd = join $ contactRequest
+    <$> asks ciPrint
+    <*> asks (headLocalIdentity . ciHead)
+    <*> (maybe (throwError "no peer selected") return =<< gets csPeer)
+
+cmdContactAccept :: Command
+cmdContactAccept = join $ contactAccept
+    <$> asks ciPrint
+    <*> asks ciHead
+    <*> (maybe (throwError "no peer selected") return =<< gets csPeer)
-- 
cgit v1.2.3