establish connection using user profiles (#69)

* establish connection using user profiles (TODO: delete contact and send message) * delete contact and send message with the updated schema * comment * refactor, remove old code
2026-05-14 21:15:37 +00:00 · 2021-07-05 19:54:44 +01:00
parent 2f604d91ba
commit 58889be83d
9 changed files with 400 additions and 192 deletions
@@ -35,7 +35,7 @@ chatOpts appDir =
          <> value (L.fromList ["smp1.simplex.im#pLdiGvm0jD1CMblnov6Edd/391OrYsShw+RgdfR0ChA="])
      )
  where
-    defaultDbFilePath = combine appDir "smp-chat.db"
+    defaultDbFilePath = combine appDir "simplex"

 parseSMPServer :: ReadM (NonEmpty SMPServer)
 parseSMPServer = eitherReader $ parseAll servers . B.pack
@@ -42,10 +42,11 @@ main :: IO ()
 main = do
  ChatOpts {dbFile, smpServers} <- welcomeGetOpts
  st <- createStore (dbFile <> ".chat.db") 4
+  user <- getCreateActiveUser st
  ct <- newChatTerminal
  a <- getSMPAgentClient cfg {dbFile = dbFile <> ".agent.db", smpServers}
  notify <- initializeNotifications
-  cc <- atomically $ newChatController a ct st notify $ tbqSize cfg
+  cc <- atomically $ newChatController a ct st user notify $ tbqSize cfg
  -- setLogLevel LogInfo -- LogError
  -- withGlobalLogging logCfg $ do
  runReaderT simplexChat cc
@@ -9,18 +9,20 @@

 module Simplex.Chat where

-import Control.Applicative (optional, (<|>))
+import Control.Applicative ((<|>))
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
+import qualified Data.Aeson as J
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Functor (($>))
 import Data.List (find)
-import Data.Maybe (fromMaybe)
+import Data.Maybe (isJust)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
@@ -37,14 +39,17 @@ import Simplex.Notification
 import Simplex.Store
 import Simplex.Terminal
 import Simplex.View
+import System.Exit (exitFailure)
+import System.IO (hFlush, stdout)
+import Text.Read (readMaybe)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM

 data ChatCommand
  = ChatHelp
  | MarkdownHelp
-  | AddContact (Maybe ContactRef)
-  | Connect (Maybe ContactRef) SMPQueueInfo
+  | AddContact
+  | Connect SMPQueueInfo
  | DeleteContact ContactRef
  | SendMessage ContactRef ByteString
  deriving (Show)
@@ -71,38 +76,35 @@ inputSubscriber = do
            case cmd of
              SendMessage c msg -> showSentMessage c msg
              _ -> printToView [plain s]
-            runExceptT (processChatCommand cmd) >>= \case
+            user <- asks currentUser
+            runExceptT (processChatCommand user cmd) >>= \case
              Left e -> showChatError e
              _ -> pure ()

-processChatCommand :: ChatMonad m => ChatCommand -> m ()
-processChatCommand = \case
+processChatCommand :: ChatMonad m => User -> ChatCommand -> m ()
+processChatCommand User {userId, profile} = \case
  ChatHelp -> printToView chatHelpInfo
  MarkdownHelp -> printToView markdownInfo
-  AddContact cRef -> do
-    (connId, qInfo) <- withAgent (fromMaybe "" cRef) createConnection
-    userId <- asks currentUserId
-    contact <- withStore $ \st -> createDirectContact st userId connId cRef
-    showInvitation (localContactRef contact) qInfo
-  Connect cRef qInfo -> do
-    userId <- asks currentUserId
-    connId <- withAgent (fromMaybe "" cRef) $ \agent -> joinConnection agent qInfo "user profile here"
-    void $ withStore $ \st -> createDirectContact st userId connId cRef
+  AddContact -> do
+    (connId, qInfo) <- withAgent createConnection
+    withStore $ \st -> createDirectConnection st userId connId
+    showInvitation qInfo
+  Connect qInfo -> do
+    connId <- withAgent $ \agent -> joinConnection agent qInfo $ LB.toStrict (J.encode profile)
+    withStore $ \st -> createDirectConnection st userId connId
  DeleteContact cRef -> do
-    userId <- asks currentUserId
    conns <- withStore $ \st -> getContactConnections st userId cRef
-    withAgent cRef $ \smp -> forM_ conns $ \Connection {agentConnId} ->
+    withAgent $ \smp -> forM_ conns $ \Connection {agentConnId} ->
      deleteConnection smp agentConnId `catchError` \(_ :: AgentErrorType) -> pure ()
-    void $ withStore $ \st -> deleteContact st userId cRef
+    withStore $ \st -> deleteContact st userId cRef
    unsetActive $ ActiveC cRef
    when (null conns) . throwError . ChatErrorContact $ CENotFound cRef
    showContactDeleted cRef
  SendMessage cRef msg -> do
-    userId <- asks currentUserId
    Connection {agentConnId} <- withStore $ \st -> getContactConnection st userId cRef
    let body = MsgBodyContent {contentType = SimplexContentType XCText, contentHash = Nothing, contentData = MBFull $ MsgData msg}
        rawMsg = rawChatMessage ChatMessage {chatMsgId = Nothing, chatMsgEvent = XMsgNew MTText, chatMsgBody = [body], chatDAGIdx = Nothing}
-    void . withAgent cRef $ \smp -> sendMessage smp agentConnId $ serializeRawChatMessage rawMsg
+    void . withAgent $ \smp -> sendMessage smp agentConnId $ serializeRawChatMessage rawMsg
    setActive $ ActiveC cRef

 agentSubscriber :: (MonadUnliftIO m, MonadReader ChatController m) => m ()
@@ -111,7 +113,7 @@ agentSubscriber = do
  cQ <- asks chatQ
  forever $ do
    (_, agentConnId, resp) <- atomically (readTBQueue aQ)
-    userId <- asks currentUserId
+    User {userId} <- asks currentUser
    runExceptT (withStore $ \st -> getConnectionChatDirection st userId agentConnId) >>= \case
      -- TODO handle errors
      Left e -> liftIO $ print e
@@ -128,7 +130,8 @@ agentSubscriber = do
 chatSubscriber :: (MonadUnliftIO m, MonadReader ChatController m) => m ()
 chatSubscriber = do
  cQ <- asks chatQ
-  forever $
+  forever $ do
+    User {userId, profile} <- asks currentUser
    atomically (readTBQueue cQ) >>= \case
      ChatTransmission
        { agentMsgMeta = meta,
@@ -145,12 +148,19 @@ chatSubscriber = do
                  setActive $ ActiveC c
                _ -> pure ()
            _ -> pure ()
-      AgentTransmission {agentConnId, chatDirection = ReceivedDirectMessage Contact {localContactRef = c}, agentMessage} ->
+      AgentTransmission {agentConnId, chatDirection = ReceivedDirectMessage NewContact {activeConn}, agentMessage} ->
+        void . runExceptT $ case agentMessage of
+          CONF confId connInfo -> do
+            -- TODO update connection status
+            saveContact userId activeConn connInfo
+            withAgent $ \a -> allowConnection a agentConnId confId $ LB.toStrict (J.encode profile)
+          INFO connInfo ->
+            saveContact userId activeConn connInfo
+          _ -> pure ()
+      AgentTransmission {chatDirection = ReceivedDirectMessage Contact {localContactRef = c}, agentMessage} ->
        case agentMessage of
-          CONF confId _ ->
-            -- TODO save profile? Show confirmation?
-            void . runExceptT . withAgent c $ \a -> allowConnection a agentConnId confId "user profile here"
          CON -> do
+            -- TODO update connection status
            showContactConnected c
            showToast ("@" <> c) "connected"
            setActive $ ActiveC c
@@ -160,6 +170,68 @@ chatSubscriber = do
            unsetActive $ ActiveC c
          _ -> pure ()
      _ -> pure ()
+  where
+    saveContact userId activeConn connInfo = do
+      p <- liftEither . first (ChatErrorContact . CEProfile) $ J.eitherDecodeStrict' connInfo
+      withStore $ \st -> createDirectContact st userId activeConn p
+
+getCreateActiveUser :: SQLiteStore -> IO User
+getCreateActiveUser st = do
+  user <-
+    getUsers st >>= \case
+      [] -> newUser
+      users -> maybe (selectUser users) pure (find activeUser users)
+  putStrLn $ "Current user: " <> userStr user
+  pure user
+  where
+    newUser :: IO User
+    newUser = do
+      putStrLn
+        "No user profiles found, it will be created now.\n\
+        \Please choose your alias and your profile name.\n\
+        \They will be sent to your contacts when you connect.\n\
+        \They are only stored on your device and you can change them later."
+      loop
+      where
+        loop = do
+          contactRef <- getContactRef
+          displayName <- T.pack <$> getWithPrompt "profile name (optional)"
+          liftIO (runExceptT $ createUser st Profile {contactRef, displayName} True) >>= \case
+            Left SEDuplicateContactRef -> do
+              putStrLn "chosen alias already used by another profile on this device, choose another one"
+              loop
+            Left e -> putStrLn ("database error " <> show e) >> exitFailure
+            Right user -> pure user
+    selectUser :: [User] -> IO User
+    selectUser [user] = do
+      liftIO $ setActiveUser st (userId user)
+      pure user
+    selectUser users = do
+      putStrLn "Select user profile: "
+      forM_ (zip [1 ..] users) $ \(n :: Int, user) -> putStrLn $ show n <> " - " <> userStr user
+      loop
+      where
+        loop = do
+          nStr <- getWithPrompt $ "user profile number (1 .. " <> show (length users) <> ")"
+          case readMaybe nStr :: Maybe Int of
+            Nothing -> putStrLn "invalid user number" >> loop
+            Just n
+              | n <= 0 || n > length users -> putStrLn "invalid user number" >> loop
+              | otherwise -> do
+                let user = users !! (n - 1)
+                liftIO $ setActiveUser st (userId user)
+                pure user
+    userStr :: User -> String
+    userStr User {localContactRef, profile = Profile {displayName}} =
+      T.unpack $ localContactRef <> if T.null displayName then "" else " (" <> displayName <> ")"
+    getContactRef :: IO ContactRef
+    getContactRef = do
+      contactRef <- getWithPrompt "alias (no spaces)"
+      if null contactRef || isJust (find (== ' ') contactRef)
+        then putStrLn "alias has space(s), choose another one" >> getContactRef
+        else pure $ T.pack contactRef
+    getWithPrompt :: String -> IO String
+    getWithPrompt s = putStr (s <> ": ") >> hFlush stdout >> getLine

 showToast :: (MonadUnliftIO m, MonadReader ChatController m) => Text -> Text -> m ()
 showToast title text = atomically . (`writeTBQueue` Notification {title, text}) =<< asks notifyQ
@@ -169,11 +241,11 @@ notificationSubscriber = do
  ChatController {notifyQ, sendNotification} <- ask
  forever $ atomically (readTBQueue notifyQ) >>= liftIO . sendNotification

-withAgent :: ChatMonad m => ContactRef -> (AgentClient -> ExceptT AgentErrorType m a) -> m a
-withAgent c action =
+withAgent :: ChatMonad m => (AgentClient -> ExceptT AgentErrorType m a) -> m a
+withAgent action =
  asks smpAgent
    >>= runExceptT . action
-    >>= liftEither . first (ChatErrorAgent c)
+    >>= liftEither . first ChatErrorAgent

 withStore ::
  ChatMonad m =>
@@ -197,11 +269,10 @@ withStore action = do
 chatCommandP :: Parser ChatCommand
 chatCommandP =
  ("/help" <|> "/h") $> ChatHelp
-    <|> ("/add" <|> "/a") *> (AddContact <$> optional (A.space *> contactRef))
-    <|> ("/connect" <|> "/c") *> ((Connect <$> optional (A.space *> contactRef) <*> qInfo) <|> (Connect Nothing <$> qInfo))
+    <|> ("/add" <|> "/a") $> AddContact
+    <|> ("/connect " <|> "/c ") *> (Connect <$> smpQueueInfoP)
    <|> ("/delete " <|> "/d ") *> (DeleteContact <$> contactRef)
    <|> A.char '@' *> (SendMessage <$> contactRef <*> (A.space *> A.takeByteString))
    <|> ("/markdown" <|> "/m") $> MarkdownHelp
  where
    contactRef = safeDecodeUtf8 <$> A.takeTill (== ' ')
-    qInfo = A.space *> smpQueueInfoP
@@ -1,7 +1,9 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}

 module Simplex.Chat.Controller where

@@ -21,7 +23,7 @@ import Simplex.Terminal
 import UnliftIO.STM

 data ChatController = ChatController
-  { currentUserId :: UserId,
+  { currentUser :: User,
    smpAgent :: AgentClient,
    chatTerminal :: ChatTerminal,
    chatStore :: SQLiteStore,
@@ -35,21 +37,21 @@ data InputEvent = InputCommand String | InputControl Char

 data ChatError
  = ChatErrorContact ContactError
-  | ChatErrorAgent ContactRef AgentErrorType
+  | ChatErrorAgent AgentErrorType
  | ChatErrorStore StoreError
  deriving (Show, Exception)

-newtype ContactError = CENotFound ContactRef
+data ContactError = CENotFound ContactRef | CEProfile String
  deriving (Show, Exception)

 type ChatMonad m = (MonadUnliftIO m, MonadReader ChatController m, MonadError ChatError m)

-newChatController :: AgentClient -> ChatTerminal -> SQLiteStore -> (Notification -> IO ()) -> Natural -> STM ChatController
-newChatController smpAgent chatTerminal chatStore sendNotification qSize = do
+newChatController :: AgentClient -> ChatTerminal -> SQLiteStore -> User -> (Notification -> IO ()) -> Natural -> STM ChatController
+newChatController smpAgent chatTerminal chatStore currentUser sendNotification qSize = do
  inputQ <- newTBQueue qSize
  notifyQ <- newTBQueue qSize
  chatQ <- newTBQueue qSize
-  pure ChatController {currentUserId = 1, smpAgent, chatTerminal, chatStore, chatQ, inputQ, notifyQ, sendNotification}
+  pure ChatController {currentUser, smpAgent, chatTerminal, chatStore, chatQ, inputQ, notifyQ, sendNotification}

 setActive :: (MonadUnliftIO m, MonadReader ChatController m) => ActiveTo -> m ()
 setActive to = asks (activeTo . chatTerminal) >>= atomically . (`writeTVar` to)
@@ -13,6 +13,10 @@ module Simplex.Store
  ( SQLiteStore,
    StoreError (..),
    createStore,
+    createUser,
+    getUsers,
+    setActiveUser,
+    createDirectConnection,
    createDirectContact,
    deleteContact,
    getContactConnection,
@@ -21,7 +25,8 @@ module Simplex.Store
  )
 where

-import Control.Exception
+import Control.Exception (Exception)
+import qualified Control.Exception as E
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Data.ByteString.Char8 (ByteString)
@@ -29,10 +34,12 @@ import Data.FileEmbed (embedDir, makeRelativeToProject)
 import Data.Function (on)
 import Data.Int (Int64)
 import Data.List (sortBy)
-import Data.Maybe (fromMaybe)
+import Data.Maybe (listToMaybe)
 import Data.Text (Text)
+import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8)
-import Database.SQLite.Simple (NamedParam (..), Only (..))
+import Data.Time.Clock (UTCTime)
+import Database.SQLite.Simple (NamedParam (..), Only (..), SQLError)
 import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.QQ (sql)
 import Simplex.Chat.Protocol
@@ -40,7 +47,7 @@ import Simplex.Chat.Types
 import Simplex.Messaging.Agent.Protocol (AParty (..), ConnId)
 import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), createSQLiteStore, withTransaction)
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
-import Simplex.Messaging.Util (liftIOEither)
+import Simplex.Messaging.Util (bshow, liftIOEither, (<$$>))
 import System.FilePath (takeBaseName, takeExtension)

 -- | The list of migrations in ascending order by date
@@ -55,33 +62,122 @@ migrations =
 createStore :: FilePath -> Int -> IO SQLiteStore
 createStore dbFilePath poolSize = createSQLiteStore dbFilePath poolSize migrations

+checkConstraint :: StoreError -> IO (Either StoreError a) -> IO (Either StoreError a)
+checkConstraint err action = action `E.catch` (pure . Left . handleSQLError err)
+
+handleSQLError :: StoreError -> SQLError -> StoreError
+handleSQLError err e
+  | DB.sqlError e == DB.ErrorConstraint = err
+  | otherwise = SEInternal $ bshow e
+
 insertedRowId :: DB.Connection -> IO Int64
 insertedRowId db = fromOnly . head <$> DB.query_ db "SELECT last_insert_rowid();"

-createDirectContact :: MonadUnliftIO m => SQLiteStore -> UserId -> ConnId -> Maybe Text -> m Contact
-createDirectContact st userId agentConnId contactRef =
-  liftIO . withTransaction st $ \db -> do
-    DB.execute db "INSERT INTO connections (user_id, agent_conn_id, conn_status) VALUES (?,?,?);" (userId, agentConnId, ConnNew)
-    connId <- insertedRowId db
-    let activeConn = Connection {connId, agentConnId, connLevel = 0, viaContact = Nothing, connStatus = ConnNew}
-    -- TODO support undefined localContactRef (Nothing) - currently it would fail
-    let localContactRef = fromMaybe "" contactRef
-    DB.execute db "INSERT INTO contacts (user_id, local_contact_ref) VALUES (?,?);" (userId, localContactRef)
+createUser :: (MonadUnliftIO m, MonadError StoreError m) => SQLiteStore -> Profile -> Bool -> m User
+createUser st Profile {contactRef, displayName} activeUser =
+  liftIOEither . checkConstraint SEDuplicateContactRef . withTransaction st $ \db -> do
+    DB.execute db "INSERT INTO contact_profiles (contact_ref, display_name) VALUES (?, ?);" (contactRef, displayName)
+    profileId <- insertedRowId db
+    DB.execute db "INSERT INTO users (contact_id, active_user) VALUES (0, ?);" (Only activeUser)
+    userId <- insertedRowId db
+    DB.execute
+      db
+      "INSERT INTO contacts (contact_profile_id, local_contact_ref, lcr_base, user_id, user) VALUES (?, ?, ?, ?, 1);"
+      (profileId, contactRef, contactRef, userId)
    contactId <- insertedRowId db
-    DB.execute db "INSERT INTO contact_connections (connection_id, contact_id, active) VALUES (?,?,1);" (connId, contactId)
-    pure Contact {contactId, localContactRef, profile = Nothing, activeConn}
+    DB.execute db "UPDATE users SET contact_id = ? WHERE user_id = ?;" (contactId, userId)
+    pure . Right $ toUser (userId, activeUser, contactRef, displayName)
+
+getUsers :: SQLiteStore -> IO [User]
+getUsers st =
+  withTransaction st $ \db ->
+    map toUser
+      <$> DB.query_
+        db
+        [sql|
+          SELECT u.user_id, u.active_user, c.local_contact_ref, p.display_name
+          FROM users u
+          JOIN contacts c ON u.contact_id = c.contact_id
+          JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
+        |]
+
+toUser :: (UserId, Bool, ContactRef, Text) -> User
+toUser (userId, activeUser, contactRef, displayName) =
+  let profile = Profile {contactRef, displayName}
+   in User {userId, localContactRef = contactRef, profile, activeUser}
+
+setActiveUser :: MonadUnliftIO m => SQLiteStore -> UserId -> m ()
+setActiveUser st userId = do
+  liftIO . withTransaction st $ \db -> do
+    DB.execute_ db "UPDATE users SET active_user = 0;"
+    DB.execute db "UPDATE users SET active_user = 1 WHERE user_id = ?;" (Only userId)
+
+createDirectConnection :: MonadUnliftIO m => SQLiteStore -> UserId -> ConnId -> m ()
+createDirectConnection st userId agentConnId =
+  liftIO . withTransaction st $ \db ->
+    DB.execute
+      db
+      [sql|
+        INSERT INTO connections
+          (user_id, agent_conn_id, conn_status, conn_type) VALUES (?,?,?,?);
+      |]
+      (userId, agentConnId, ConnNew, ConnContact)
+
+createDirectContact ::
+  (MonadUnliftIO m, MonadError StoreError m) => SQLiteStore -> UserId -> Connection -> Profile -> m ()
+createDirectContact st userId Connection {connId} Profile {contactRef, displayName} =
+  liftIOEither . withTransaction st $ \db -> do
+    DB.execute db "INSERT INTO contact_profiles (contact_ref, display_name) VALUES (?, ?);" (contactRef, displayName)
+    profileId <- insertedRowId db
+    lcrSuffix <- getLcrSuffix db
+    create db profileId lcrSuffix 20
+  where
+    getLcrSuffix :: DB.Connection -> IO Int
+    getLcrSuffix db =
+      maybe 0 ((+ 1) . fromOnly) . listToMaybe
+        <$> DB.queryNamed
+          db
+          [sql|
+            SELECT lcr_suffix FROM contacts
+            WHERE user_id = :user_id AND lcr_base = :contact_ref
+            ORDER BY lcr_suffix DESC
+            LIMIT 1;
+          |]
+          [":user_id" := userId, ":contact_ref" := contactRef]
+    create :: DB.Connection -> Int64 -> Int -> Int -> IO (Either StoreError ())
+    create _ _ _ 0 = pure $ Left SEDuplicateContactRef
+    create db profileId lcrSuffix attempts = do
+      let lcr = localContactRef' lcrSuffix
+      E.try (insertUser lcr) >>= \case
+        Right () -> do
+          contactId <- insertedRowId db
+          DB.execute db "UPDATE connections SET contact_id = ? WHERE connection_id = ?" (contactId, connId)
+          pure $ Right ()
+        Left e
+          | DB.sqlError e == DB.ErrorConstraint -> create db profileId (lcrSuffix + 1) (attempts - 1)
+          | otherwise -> E.throwIO e
+      where
+        localContactRef' 0 = contactRef
+        localContactRef' n = contactRef <> T.pack ('_' : show n)
+        insertUser lcr =
+          DB.execute
+            db
+            [sql|
+              INSERT INTO contacts
+                (contact_profile_id, local_contact_ref, lcr_base, lcr_suffix, user_id) VALUES (?, ?, ?, ?, ?)
+            |]
+            (profileId, lcr, contactRef, lcrSuffix, userId)

 deleteContact :: MonadUnliftIO m => SQLiteStore -> UserId -> ContactRef -> m ()
 deleteContact st userId contactRef =
  liftIO . withTransaction st $ \db ->
    forM_
      [ [sql|
-          DELETE FROM connections
-          WHERE user_id = :user_id AND connection_id IN (
-            SELECT cc.connection_id
-            FROM contact_connections AS cc
-            JOIN contacts AS cs ON cs.contact_id = cc.contact_id
-            WHERE local_contact_ref = :contact_ref
+          DELETE FROM connections WHERE connection_id IN (
+            SELECT connection_id
+            FROM connections c
+            JOIN contacts cs ON c.contact_id = cs.contact_id
+            WHERE cs.user_id = :user_id AND cs.local_contact_ref = :contact_ref
          );
        |],
        [sql|
@@ -91,21 +187,25 @@ deleteContact st userId contactRef =
      ]
      $ \q -> DB.executeNamed db q [":user_id" := userId, ":contact_ref" := contactRef]

-getContactConnection :: (MonadUnliftIO m, MonadError StoreError m) => SQLiteStore -> UserId -> ContactRef -> m Connection
+-- TODO return the last connection that is ready, not any last connection
+-- requires updating connection status
+getContactConnection ::
+  (MonadUnliftIO m, MonadError StoreError m) => SQLiteStore -> UserId -> ContactRef -> m Connection
 getContactConnection st userId contactRef =
  liftIOEither . withTransaction st $ \db ->
    connection
      <$> DB.queryNamed
        db
        [sql|
-          SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.conn_status
-          FROM connections AS c
-          JOIN contact_connections AS cc ON cc.connection_id == c.connection_id
-          JOIN contacts AS cs ON cc.contact_id == cs.contact_id
+          SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
+            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.created_at
+          FROM connections c
+          JOIN contacts cs ON c.contact_id == cs.contact_id
          WHERE c.user_id = :user_id
            AND cs.user_id = :user_id
            AND cs.local_contact_ref == :contact_ref
-            AND cc.active == 1;
+          ORDER BY c.connection_id DESC
+          LIMIT 1;
        |]
        [":user_id" := userId, ":contact_ref" := contactRef]
  where
@@ -119,61 +219,71 @@ getContactConnections st userId contactRef =
      <$> DB.queryNamed
        db
        [sql|
-          SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.conn_status
-          FROM connections AS c
-          JOIN contact_connections AS cc ON cc.connection_id == c.connection_id
-          JOIN contacts AS cs ON cc.contact_id == cs.contact_id
+          SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
+            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.created_at
+          FROM connections c
+          JOIN contacts cs ON c.contact_id == cs.contact_id
          WHERE c.user_id = :user_id
            AND cs.user_id = :user_id
-            AND cs.local_contact_ref == :contact_ref
-            AND cc.active == 1;
+            AND cs.local_contact_ref == :contact_ref;
        |]
        [":user_id" := userId, ":contact_ref" := contactRef]

-toConnection :: (Int64, ConnId, Int, Maybe Int64, ConnStatus) -> Connection
-toConnection (connId, agentConnId, connLevel, viaContact, connStatus) =
-  Connection {connId, agentConnId, connLevel, viaContact, connStatus}
+toConnection ::
+  (Int64, ConnId, Int, Maybe Int64, ConnStatus, ConnType, Maybe Int64, Maybe Int64, UTCTime) -> Connection
+toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, createdAt) =
+  let entityId = entityId_ connType
+   in Connection {connId, agentConnId, connLevel, viaContact, connStatus, connType, entityId, createdAt}
+  where
+    entityId_ :: ConnType -> Maybe Int64
+    entityId_ ConnContact = contactId
+    entityId_ ConnMember = groupMemberId

 getConnectionChatDirection ::
  (MonadUnliftIO m, MonadError StoreError m) => SQLiteStore -> UserId -> ConnId -> m (ChatDirection 'Agent)
 getConnectionChatDirection st userId agentConnId =
-  liftIOEither . withTransaction st $ \db ->
-    chatDirection
-      <$> DB.queryNamed
-        db
-        [sql|
-          SELECT
-            cs.contact_id, cs.local_contact_ref,
-            a.connection_id, a.conn_level, a.via_contact, a.conn_status,
-            p.contact_profile_id, p.contact_ref, p.display_name
-          FROM contacts AS cs
-          JOIN contact_connections AS cc ON cs.contact_id = cc.contact_id
-          JOIN contact_connections AS ac ON cs.contact_id = ac.contact_id
-          JOIN connections AS c ON c.connection_id = cc.connection_id
-          JOIN connections AS a ON a.connection_id = ac.connection_id
-          LEFT JOIN contact_profiles AS p ON p.contact_profile_id = cs.contact_profile_id
-          WHERE cs.user_id = :user_id
-            AND c.agent_conn_id = :agent_conn_id
-            AND ac.active = 1
-        |]
-        [":user_id" := userId, ":agent_conn_id" := agentConnId]
+  liftIOEither . withTransaction st $ \db -> do
+    getConnection db >>= \case
+      Left e -> pure $ Left e
+      Right c@Connection {connType, entityId} -> case connType of
+        ConnMember -> pure . Left $ SEInternal "group members not supported yet"
+        ConnContact ->
+          ReceivedDirectMessage <$$> case entityId of
+            Nothing -> pure $ Right NewContact {activeConn = c}
+            Just cId -> getContact db cId c
  where
-    chatDirection :: [ChatDirRow] -> Either StoreError (ChatDirection 'Agent)
-    chatDirection [d] = Right $ toChatDirection agentConnId d
-    chatDirection _ = Left SEConnectionNotFound
-
-type ChatDirRow = (Int64, Text, Int64, Int, Maybe Int64, ConnStatus, Maybe Int64, Maybe ContactRef, Maybe Text)
-
-toChatDirection :: ConnId -> ChatDirRow -> ChatDirection 'Agent
-toChatDirection
-  agentConnId
-  (contactId, localContactRef, connId, connLevel, viaContact, connStatus, profileId, contactRef, displayName) =
-    let profile = Profile <$> profileId <*> contactRef <*> displayName
-        activeConn = Connection {connId, agentConnId, connLevel, viaContact, connStatus}
-     in ReceivedDirectMessage $ Contact {contactId, localContactRef, profile, activeConn}
+    getConnection db =
+      connection
+        <$> DB.query
+          db
+          [sql|
+            SELECT connection_id, agent_conn_id, conn_level, via_contact,
+              conn_status, conn_type, contact_id, group_member_id, created_at
+            FROM connections
+            WHERE user_id = ? AND agent_conn_id = ?;
+          |]
+          (userId, agentConnId)
+    connection (connRow : _) = Right $ toConnection connRow
+    connection _ = Left $ SEConnectionNotFound agentConnId
+    getContact db contactId c =
+      toContact contactId c
+        <$> DB.query
+          db
+          [sql|
+            SELECT c.local_contact_ref, p.contact_ref, p.display_name
+            FROM contacts c
+            JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
+            WHERE c.user_id = ? AND c.contact_id = ?
+          |]
+          (userId, contactId)
+    toContact contactId c [(localContactRef, contactRef, displayName)] =
+      let profile = Profile {contactRef, displayName}
+       in Right Contact {contactId, localContactRef, profile, activeConn = c}
+    toContact _ _ _ = Left $ SEInternal "referenced contact not found"

 data StoreError
-  = SEContactNotFound ContactRef
-  | SEConnectionNotFound
+  = SEDuplicateContactRef
+  | SEContactNotFound ContactRef
+  | SEConnectionNotFound ConnId
  | SEInternal ByteString
  deriving (Show, Exception)
@@ -19,7 +19,6 @@ where
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
 import Data.ByteString.Char8 (ByteString)
-import Data.Composition ((.:))
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (DiffTime, UTCTime)
@@ -36,8 +35,8 @@ import System.Console.ANSI.Types

 type ChatReader m = (MonadUnliftIO m, MonadReader ChatController m)

-showInvitation :: ChatReader m => ContactRef -> SMPQueueInfo -> m ()
-showInvitation = printToView .: invitation
+showInvitation :: ChatReader m => SMPQueueInfo -> m ()
+showInvitation = printToView . invitation

 showChatError :: ChatReader m => ChatError -> m ()
 showChatError = printToView . chatError
@@ -57,9 +56,9 @@ showReceivedMessage c utcTime msg mOk = printToView =<< liftIO (receivedMessage
 showSentMessage :: ChatReader m => ContactRef -> ByteString -> m ()
 showSentMessage c msg = printToView =<< liftIO (sentMessage c msg)

-invitation :: ContactRef -> SMPQueueInfo -> [StyledString]
-invitation c qInfo =
-  [ "pass this invitation to your contact " <> ttyContact c <> " (via any channel): ",
+invitation :: SMPQueueInfo -> [StyledString]
+invitation qInfo =
+  [ "pass this invitation to your contact (via another channel): ",
    "",
    (bPlain . serializeSmpQueueInfo) qInfo,
    "",
@@ -117,12 +116,13 @@ chatError :: ChatError -> [StyledString]
 chatError = \case
  ChatErrorContact e -> case e of
    CENotFound c -> ["no contact " <> ttyContact c]
-  ChatErrorAgent c err -> case err of
-    CONN e -> case e of
-      -- TODO replace with ChatErrorContact errors, these errors should never happen
-      NOT_FOUND -> ["no contact " <> ttyContact c]
-      DUPLICATE -> ["contact " <> ttyContact c <> " already exists"]
-      SIMPLEX -> ["contact " <> ttyContact c <> " did not accept invitation yet"]
+    CEProfile s -> ["invalid profile: " <> plain s]
+  ChatErrorAgent err -> case err of
+    -- CONN e -> case e of
+    --   -- TODO replace with ChatErrorContact errors, these errors should never happen
+    --   NOT_FOUND -> ["no contact " <> ttyContact c]
+    --   DUPLICATE -> ["contact " <> ttyContact c <> " already exists"]
+    --   SIMPLEX -> ["contact " <> ttyContact c <> " did not accept invitation yet"]
    e -> ["smp agent error: " <> plain (show e)]
  e -> ["chat error: " <> plain (show e)]

@@ -1,21 +1,29 @@
 CREATE TABLE contact_profiles ( -- remote user profile
  contact_profile_id INTEGER PRIMARY KEY,
  contact_ref TEXT NOT NULL, -- contact name set by remote user (not unique), this name must not contain spaces
-  display_name TEXT NOT NULL DEFAULT '',
+  display_name TEXT NOT NULL,
  properties TEXT NOT NULL DEFAULT '{}' -- JSON with contact profile properties
 );

-- the first record (id = 1) is reserved for the first local user
-INSERT INTO contact_profiles (contact_profile_id, contact_ref) VALUES (1, '');
-
-
 CREATE TABLE users (
  user_id INTEGER PRIMARY KEY,
-  contact_profile_id INTEGER NOT NULL UNIQUE REFERENCES contact_profiles -- user's profile
+  contact_id INTEGER NOT NULL UNIQUE REFERENCES contacts ON DELETE CASCADE
+    DEFERRABLE INITIALLY DEFERRED,
+  active_user INTEGER -- 1 for active user
 );

-- the first record (id = 1) is reserved for the first local user
-INSERT INTO users (user_id, contact_profile_id) VALUES (1, 1);
+CREATE TABLE contacts (
+  contact_id INTEGER PRIMARY KEY,
+  contact_profile_id INTEGER UNIQUE REFERENCES contact_profiles, -- NULL if it's an incognito profile
+  local_contact_ref TEXT NOT NULL,
+  lcr_base TEXT NOT NULL,
+  lcr_suffix INTEGER NOT NULL DEFAULT 0,
+  user_id INTEGER NOT NULL REFERENCES users,
+  user INTEGER, -- 1 if this contact is a user
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  UNIQUE (user_id, local_contact_ref) ON CONFLICT FAIL,
+  UNIQUE (user_id, lcr_base, lcr_suffix) ON CONFLICT FAIL
+);

 CREATE TABLE known_servers(
  server_id INTEGER PRIMARY KEY,
@@ -26,36 +34,13 @@ CREATE TABLE known_servers(
  UNIQUE (user_id, host, port)
 ) WITHOUT ROWID;

-CREATE TABLE contacts (
-  contact_id INTEGER PRIMARY KEY,
-  local_contact_ref TEXT NOT NULL UNIQUE, -- contact name set by local user - must be unique
-  local_properties TEXT NOT NULL DEFAULT '{}', -- JSON set by local user
-  contact_profile_id INTEGER UNIQUE REFERENCES contact_profiles, -- profile sent by remote contact, NULL for incognito contacts
-  user_id INTEGER NOT NULL REFERENCES users
-);
-
-CREATE TABLE connections ( -- all SMP agent connections
-  connection_id INTEGER PRIMARY KEY,
-  agent_conn_id BLOB NOT NULL UNIQUE,
-  conn_level INTEGER NOT NULL DEFAULT 0,
-  via_contact INTEGER REFERENCES contacts (contact_id),
-  conn_status TEXT NOT NULL,
-  user_id INTEGER NOT NULL REFERENCES users
-);
-
-CREATE TABLE contact_connections ( -- connections only for direct messages, many per contact
-  connection_id INTEGER NOT NULL UNIQUE REFERENCES connections ON DELETE CASCADE,
-  contact_id INTEGER REFERENCES contacts ON DELETE RESTRICT, -- connection must be removed first via the agent
-  active INTEGER NOT NULL DEFAULT 0
-);
-
-CREATE TABLE contact_invitations (
-  invitation_id INTEGER PRIMARY KEY,
-  agent_inv_id BLOB UNIQUE,
-  invitation TEXT,
-  contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE RESTRICT,
-  invitation_status TEXT NOT NULL DEFAULT ''
-);
+-- CREATE TABLE contact_invitations (
+--   invitation_id INTEGER PRIMARY KEY,
+--   agent_inv_id BLOB UNIQUE,
+--   invitation TEXT,
+--   contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE RESTRICT,
+--   invitation_status TEXT NOT NULL DEFAULT ''
+-- );

 CREATE TABLE group_profiles ( -- shared group profiles
  group_profile_id INTEGER PRIMARY KEY,
@@ -71,8 +56,6 @@ CREATE TABLE groups (
  local_group_ref TEXT NOT NULL UNIQUE, -- local group name without spaces
  local_properties TEXT NOT NULL, -- local JSON group properties
  group_profile_id INTEGER REFERENCES group_profiles, -- shared group profile
-  user_group_member_details_id INTEGER NOT NULL
-    REFERENCES group_member_details (group_member_details_id) ON DELETE RESTRICT,
  user_id INTEGER NOT NULL REFERENCES users,
  UNIQUE (invited_by, external_group_id)
 );
@@ -80,21 +63,27 @@ CREATE TABLE groups (
 CREATE TABLE group_members ( -- group members, excluding the local user
  group_member_id INTEGER PRIMARY KEY,
  group_id INTEGER NOT NULL REFERENCES groups ON DELETE RESTRICT,
-  group_member_details_id INTEGER NOT NULL REFERENCES group_member_details ON DELETE RESTRICT,
-  contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE RESTRICT,
-  connection_id INTEGER UNIQUE REFERENCES connections
-);
-
-CREATE TABLE group_member_details (
-  group_member_details_id INTEGER PRIMARY KEY,
-  group_id INTEGER NOT NULL REFERENCES groups ON DELETE RESTRICT,
  member_id BLOB NOT NULL, -- shared member ID, unique per group
  member_role TEXT NOT NULL DEFAULT '', -- owner, admin, moderator, ''
  member_status TEXT NOT NULL DEFAULT '', -- inv | con | full | off
-  invited_by INTEGER REFERENCES contacts ON DELETE RESTRICT, -- NULL for the members who joined before the current user and for the group creator
+  invited_by INTEGER REFERENCES contacts (contact_id) ON DELETE RESTRICT, -- NULL for the members who joined before the current user and for the group creator
+  contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE RESTRICT,
  UNIQUE (group_id, member_id)
 );

+CREATE TABLE connections ( -- all SMP agent connections
+  connection_id INTEGER PRIMARY KEY,
+  agent_conn_id BLOB NOT NULL UNIQUE,
+  conn_level INTEGER NOT NULL DEFAULT 0,
+  via_contact INTEGER REFERENCES contacts (contact_id),
+  conn_status TEXT NOT NULL,
+  conn_type TEXT NOT NULL, -- contact, member
+  contact_id INTEGER REFERENCES contacts ON DELETE RESTRICT,
+  group_member_id INTEGER REFERENCES group_members ON DELETE RESTRICT,
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  user_id INTEGER NOT NULL REFERENCES users
+);
+
 CREATE TABLE events ( -- messages received by the agent, append only
  event_id INTEGER PRIMARY KEY,
  agent_msg_id INTEGER NOT NULL, -- internal message ID
@@ -12,6 +12,7 @@ extra-source-files:
  - README.md

 dependencies:
+  - aeson == 1.5.*
  - ansi-terminal == 0.10.*
  - attoparsec == 0.13.*
  - base >= 4.7 && < 5
@@ -21,6 +22,7 @@ dependencies:
  - simplexmq == 0.3.*
  - sqlite-simple == 0.4.*
  - text == 1.2.*
+  - time == 1.9.*

 library:
  source-dirs: src
@@ -1,30 +1,39 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}

 module Simplex.Chat.Types where

+import Data.Aeson (FromJSON, ToJSON)
+import qualified Data.Aeson as J
 import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
 import Data.Text (Text)
+import Data.Time.Clock (UTCTime)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
+import GHC.Generics
 import Simplex.Messaging.Agent.Protocol (ConnId)
 import Simplex.Messaging.Agent.Store.SQLite (fromTextField_)

 data User = User
  { userId :: UserId,
-    profile :: Profile
+    localContactRef :: ContactRef,
+    profile :: Profile,
+    activeUser :: Bool
  }

 type UserId = Int64

-data Contact = Contact
-  { contactId :: Int64,
-    localContactRef :: ContactRef,
-    profile :: Maybe Profile,
-    activeConn :: Connection
-  }
+data Contact
+  = Contact
+      { contactId :: Int64,
+        localContactRef :: ContactRef,
+        profile :: Profile,
+        activeConn :: Connection
+      }
+  | NewContact {activeConn :: Connection}
  deriving (Eq, Show)

 type ContactRef = Text
@@ -36,18 +45,24 @@ data Group = Group
  deriving (Eq, Show)

 data Profile = Profile
-  { profileId :: Int64,
-    contactRef :: ContactRef,
+  { contactRef :: ContactRef,
    displayName :: Text
  }
-  deriving (Eq, Show)
+  deriving (Generic, Eq, Show)
+
+instance ToJSON Profile where toEncoding = J.genericToEncoding J.defaultOptions
+
+instance FromJSON Profile

 data Connection = Connection
  { connId :: Int64,
    agentConnId :: ConnId,
    connLevel :: Int,
    viaContact :: Maybe Int64,
-    connStatus :: ConnStatus
+    connType :: ConnType,
+    connStatus :: ConnStatus,
+    entityId :: Maybe Int64, -- contact or group member ID
+    createdAt :: UTCTime
  }
  deriving (Eq, Show)

@@ -60,18 +75,36 @@ instance ToField ConnStatus where toField = toField . serializeConnStatus

 connStatusT :: Text -> Maybe ConnStatus
 connStatusT = \case
-  "NEW" -> Just ConnNew
-  "CONF" -> Just ConnConfirmed
-  "ACPT" -> Just ConnAccepted
-  "READY" -> Just ConnReady
+  "new" -> Just ConnNew
+  "confirmed" -> Just ConnConfirmed
+  "accepted" -> Just ConnAccepted
+  "ready" -> Just ConnReady
  _ -> Nothing

 serializeConnStatus :: ConnStatus -> Text
 serializeConnStatus = \case
-  ConnNew -> "NEW"
-  ConnConfirmed -> "CONF"
-  ConnAccepted -> "ACPT"
-  ConnReady -> "READY"
+  ConnNew -> "new"
+  ConnConfirmed -> "confirmed"
+  ConnAccepted -> "accepted"
+  ConnReady -> "ready"
+
+data ConnType = ConnContact | ConnMember
+  deriving (Eq, Show)
+
+instance FromField ConnType where fromField = fromTextField_ connTypeT
+
+instance ToField ConnType where toField = toField . serializeConnType
+
+connTypeT :: Text -> Maybe ConnType
+connTypeT = \case
+  "contact" -> Just ConnContact
+  "member" -> Just ConnMember
+  _ -> Nothing
+
+serializeConnType :: ConnType -> Text
+serializeConnType = \case
+  ConnContact -> "contact"
+  ConnMember -> "member"

 data NewConnection = NewConnection
  { agentConnId :: ByteString,