agent schema/methods/types/store methods for notifications tokens (#348)

* agent schema/methods/types/store methods for notifications tokens

* register notification token on the server

* agent commands for notification tokens

* refactor initial servers from AgentConfig

* agent store functions for notification tokens

* server STM store methods for tokens

* fix protocol client for ntfs (use generic handshake), minimal server and agent tests

* server command to verify ntf token

src/Simplex/Messaging/Agent/Store/SQLite.hs

@@ -23,7 +23,6 @@ module Simplex.Messaging.Agent.Store.SQLite
     connectSQLiteStore,
     withConnection,
     withTransaction,
-    fromTextField_,
     firstRow,
   )
 where
@@ -41,14 +40,14 @@ import Data.Char (toLower)
 import Data.Functor (($>))
 import Data.List (find, foldl')
 import qualified Data.Map.Strict as M
+import Data.Maybe (listToMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
-import Database.SQLite.Simple (FromRow, NamedParam (..), Only (..), SQLData (..), SQLError, ToRow, field)
+import Data.Time.Clock (getCurrentTime)
+import Database.SQLite.Simple (FromRow, NamedParam (..), Only (..), SQLError, ToRow, field)
 import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.FromField
-import Database.SQLite.Simple.Internal (Field (..))
-import Database.SQLite.Simple.Ok (Ok (Ok))
 import Database.SQLite.Simple.QQ (sql)
 import Database.SQLite.Simple.ToField (ToField (..))
 import Simplex.Messaging.Agent.Protocol
@@ -59,7 +58,9 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet (RatchetX448, SkippedMsgDiff (..), SkippedMsgKeys)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (blobFieldParser)
+import Simplex.Messaging.Notifications.Client (NtfServer, NtfTknAction, NtfToken (..))
+import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus (..), NtfTokenId)
+import Simplex.Messaging.Parsers (blobFieldParser, fromTextField_)
 import Simplex.Messaging.Protocol (MsgBody, ProtocolServer (..))
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Util (bshow, liftIOEither)
@@ -565,6 +566,63 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
             forM_ (M.assocs mks) $ \(msgN, mk) ->
               DB.execute db "INSERT INTO skipped_messages (conn_id, header_key, msg_n, msg_key) VALUES (?, ?, ?, ?)" (connId, hk, msgN, mk)
 
+  createNtfToken :: SQLiteStore -> NtfToken -> m ()
+  createNtfToken st NtfToken {deviceToken = DeviceToken provider token, ntfServer = srv@ProtocolServer {host, port}, ntfTokenId, ntfPrivKey, ntfDhSecret, ntfTknStatus, ntfTknAction} =
+    liftIO . withTransaction st $ \db -> do
+      upsertNtfServer_ db srv
+      DB.execute
+        db
+        [sql|
+          INSERT INTO ntf_tokens
+            (provider, device_token, ntf_host, ntf_port, tkn_id, tkn_priv_key, tkn_dh_secret, tkn_status, tkn_action) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?)
+        |]
+        (provider, token, host, port, ntfTokenId, ntfPrivKey, ntfDhSecret, ntfTknStatus, ntfTknAction)
+
+  getDeviceNtfToken :: SQLiteStore -> DeviceToken -> m (Maybe NtfToken)
+  getDeviceNtfToken st t@(DeviceToken provider token) =
+    liftIO . withTransaction st $ \db ->
+      fmap ntfToken . listToMaybe
+        <$> DB.query
+          db
+          [sql|
+            SELECT s.ntf_host, s.ntf_port, s.ntf_key_hash,
+              t.tkn_id, t.tkn_priv_key, t.tkn_dh_secret, t.tkn_status, t.tkn_action
+            FROM ntf_tokens t
+            JOIN ntf_servers s USING (ntf_host, ntf_port)
+            WHERE t.provider = ? AND t.device_token = ?
+          |]
+          (provider, token)
+    where
+      ntfToken (host, port, keyHash, ntfTokenId, ntfPrivKey, ntfDhSecret, ntfTknStatus, ntfTknAction) =
+        let ntfServer = ProtocolServer {host, port, keyHash}
+         in NtfToken {deviceToken = t, ntfServer, ntfTokenId, ntfPrivKey, ntfDhSecret, ntfTknStatus, ntfTknAction}
+
+  updateNtfTokenRegistration :: SQLiteStore -> NtfToken -> NtfTokenId -> C.DhSecretX25519 -> m ()
+  updateNtfTokenRegistration st NtfToken {deviceToken = DeviceToken provider token, ntfServer = ProtocolServer {host, port}} tknId ntfDhSecret =
+    liftIO . withTransaction st $ \db -> do
+      updatedAt <- getCurrentTime
+      DB.execute
+        db
+        [sql|
+          UPDATE ntf_tokens
+          SET tkn_id = ?, tkn_dh_secret = ?, tkn_status = ?, tkn_action = ?, updated_at = ?
+          WHERE provider = ? AND device_token = ? AND ntf_host = ? AND ntf_port = ?
+        |]
+        (tknId, ntfDhSecret, NTRegistered, Nothing :: Maybe NtfTknAction, updatedAt, provider, token, host, port)
+
+  updateNtfToken :: SQLiteStore -> NtfToken -> NtfTknStatus -> Maybe NtfTknAction -> m ()
+  updateNtfToken st NtfToken {deviceToken = DeviceToken provider token, ntfServer = ProtocolServer {host, port}} tknStatus tknAction =
+    liftIO . withTransaction st $ \db -> do
+      updatedAt <- getCurrentTime
+      DB.execute
+        db
+        [sql|
+          UPDATE ntf_tokens
+          SET tkn_status = ?, tkn_action = ?, updated_at = ?
+          WHERE provider = ? AND device_token = ? AND ntf_host = ? AND ntf_port = ?
+        |]
+        (tknStatus, tknAction, updatedAt, provider, token, host, port)
+
 -- * Auxiliary helpers
 
 instance ToField QueueStatus where toField = toField . serializeQueueStatus
@@ -611,14 +669,6 @@ instance ToField (SConnectionMode c) where toField = toField . connMode
 
 instance FromField AConnectionMode where fromField = fromTextField_ $ fmap connMode' . connModeT
 
-fromTextField_ :: (E.Typeable a) => (Text -> Maybe a) -> Field -> Ok a
-fromTextField_ fromText = \case
-  f@(Field (SQLText t) _) ->
-    case fromText t of
-      Just x -> Ok x
-      _ -> returnError ConversionFailed f ("invalid text: " <> T.unpack t)
-  f -> returnError ConversionFailed f "expecting SQLText column type"
-
 listToEither :: e -> [a] -> Either e a
 listToEither _ (x : _) = Right x
 listToEither e _ = Left e
@@ -669,6 +719,19 @@ upsertServer_ dbConn ProtocolServer {host, port, keyHash} = do
     |]
     [":host" := host, ":port" := port, ":key_hash" := keyHash]
 
+upsertNtfServer_ :: DB.Connection -> NtfServer -> IO ()
+upsertNtfServer_ db ProtocolServer {host, port, keyHash} = do
+  DB.executeNamed
+    db
+    [sql|
+      INSERT INTO ntf_servers (ntf_host, ntf_port, ntf_key_hash) VALUES (:host,:port,:key_hash)
+      ON CONFLICT (ntf_host, ntf_port) DO UPDATE SET
+        ntf_host=excluded.ntf_host,
+        ntf_port=excluded.ntf_port,
+        ntf_key_hash=excluded.ntf_key_hash;
+    |]
+    [":host" := host, ":port" := port, ":key_hash" := keyHash]
+
 -- * createRcvConn helpers
 
 insertRcvQueue_ :: DB.Connection -> ConnId -> RcvQueue -> IO ()

src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220322_notifications.hs

@@ -8,40 +8,29 @@ import Database.SQLite.Simple.QQ (sql)
 m20220322_notifications :: Query
 m20220322_notifications =
   [sql|
-ALTER TABLE rcv_queues ADD COLUMN ntf_id BLOB;
-
-ALTER TABLE rcv_queues ADD COLUMN ntf_public_key BLOB;
-
-ALTER TABLE rcv_queues ADD COLUMN ntf_private_key BLOB;
-
-CREATE UNIQUE INDEX idx_rcv_queues_ntf ON rcv_queues (host, port, ntf_id);
-
 CREATE TABLE ntf_servers (
   ntf_host TEXT NOT NULL,
   ntf_port TEXT NOT NULL,
   ntf_key_hash BLOB NOT NULL,
-  created_at TEXT NOT NULL,
-  updated_at TEXT NOT NULL,
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT (datetime('now')),
   PRIMARY KEY (ntf_host, ntf_port)
 ) WITHOUT ROWID;
 
-CREATE TABLE ntf_subscriptions (
+CREATE TABLE ntf_tokens (
+  provider TEXT NOT NULL, -- apn
+  device_token TEXT NOT NULL,
   ntf_host TEXT NOT NULL,
   ntf_port TEXT NOT NULL,
-  ntf_sub_id BLOB NOT NULL,
-  ntf_sub_status TEXT NOT NULL, -- new, created, active, pending, error_auth
-  ntf_sub_action TEXT, -- if there is an action required on this subscription: create / check / token / delete
-  ntf_sub_action_ts TEXT, -- the earliest time for the action, e.g. checks can be scheduled every X hours
-  ntf_token TEXT NOT NULL, -- or BLOB?
-  smp_host TEXT NOT NULL,
-  smp_port TEXT NOT NULL,
-  smp_ntf_id BLOB NOT NULL,
-  created_at TEXT NOT NULL,
-  updated_at TEXT NOT NULL, -- this is to check subscription status periodically to know when it was last checked
-  PRIMARY KEY (ntf_host, ntf_port, ntf_sub_id),
+  tkn_id BLOB, -- token ID assigned by notifications server
+  tkn_priv_key BLOB NOT NULL, -- private key to sign token commands
+  tkn_dh_secret BLOB, -- DH secret for e2e encryption of notifications
+  tkn_status TEXT NOT NULL,
+  tkn_action BLOB,
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT (datetime('now')), -- this is to check token status periodically to know when it was last checked
+  PRIMARY KEY (provider, device_token, ntf_host, ntf_port),
   FOREIGN KEY (ntf_host, ntf_port) REFERENCES ntf_servers
-    ON DELETE RESTRICT ON UPDATE CASCADE,
-  FOREIGN KEY (smp_host, smp_port, smp_ntf_id) REFERENCES rcv_queues (host, port, ntf_id)
     ON DELETE RESTRICT ON UPDATE CASCADE
 ) WITHOUT ROWID;
 |]

src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220404_ntf_subscriptions_draft.hs

@@ -0,0 +1,38 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220404_ntf_subscriptions_draft where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20220404_ntf_subscriptions_draft :: Query
+m20220404_ntf_subscriptions_draft =
+  [sql|
+ALTER TABLE rcv_queues ADD COLUMN ntf_id BLOB;
+
+ALTER TABLE rcv_queues ADD COLUMN ntf_public_key BLOB;
+
+ALTER TABLE rcv_queues ADD COLUMN ntf_private_key BLOB;
+
+CREATE UNIQUE INDEX idx_rcv_queues_ntf ON rcv_queues (host, port, ntf_id);
+
+CREATE TABLE ntf_subscriptions (
+  ntf_host TEXT NOT NULL,
+  ntf_port TEXT NOT NULL,
+  ntf_sub_id BLOB NOT NULL,
+  ntf_sub_status TEXT NOT NULL, -- new, created, active, pending, error_auth
+  ntf_sub_action TEXT, -- if there is an action required on this subscription: create / check / token / delete
+  ntf_sub_action_ts TEXT, -- the earliest time for the action, e.g. checks can be scheduled every X hours
+  ntf_token TEXT NOT NULL, -- or BLOB?
+  smp_host TEXT NOT NULL,
+  smp_port TEXT NOT NULL,
+  smp_ntf_id BLOB NOT NULL,
+  created_at TEXT NOT NULL,
+  updated_at TEXT NOT NULL, -- this is to check subscription status periodically to know when it was last checked
+  PRIMARY KEY (ntf_host, ntf_port, ntf_sub_id),
+  FOREIGN KEY (ntf_host, ntf_port) REFERENCES ntf_servers
+    ON DELETE RESTRICT ON UPDATE CASCADE,
+  FOREIGN KEY (smp_host, smp_port, smp_ntf_id) REFERENCES rcv_queues (host, port, ntf_id)
+    ON DELETE RESTRICT ON UPDATE CASCADE
+) WITHOUT ROWID;
+|]