ntf server: allow retries when creating subscriptions, prohibit subscriptions with the same queue but another notifier key or token (#1525)

* ntf server: allow retries when creating subscriptions, prohibit subscriptions with the same queue but another notifier key or token

* sync files in the test

* refactor

Author: epoberezkin

src/Simplex/Messaging/Notifications/Server.hs

@@ -537,7 +537,8 @@ runNtfClientTransport th@THandle {params} = do
   s <- asks subscriber
   ps <- asks pushServer
   expCfg <- asks $ inactiveClientExpiration . config
-  raceAny_ ([liftIO $ send th c, client c s ps, receive th c] <> disconnectThread_ c expCfg)
+  st <- asks store
+  raceAny_ ([liftIO $ send th c, client c s ps, liftIO $ receive st th c] <> disconnectThread_ c expCfg)
     `finally` liftIO (clientDisconnected c)
   where
     disconnectThread_ c (Just expCfg) = [liftIO $ disconnectTransport th (rcvActiveAt c) (sndActiveAt c) expCfg (pure True)]
@@ -546,10 +547,10 @@ runNtfClientTransport th@THandle {params} = do
 clientDisconnected :: NtfServerClient -> IO ()
 clientDisconnected NtfServerClient {connected} = atomically $ writeTVar connected False
 
-receive :: Transport c => THandleNTF c 'TServer -> NtfServerClient -> M ()
-receive th@THandle {params = THandleParams {thAuth}} NtfServerClient {rcvQ, sndQ, rcvActiveAt} = forever $ do
-  ts <- L.toList <$> liftIO (tGet th)
-  atomically . (writeTVar rcvActiveAt $!) =<< liftIO getSystemTime
+receive :: Transport c => NtfPostgresStore -> THandleNTF c 'TServer -> NtfServerClient -> IO ()
+receive st th@THandle {params = THandleParams {thAuth}} NtfServerClient {rcvQ, sndQ, rcvActiveAt} = forever $ do
+  ts <- L.toList <$> tGet th
+  atomically . (writeTVar rcvActiveAt $!) =<< getSystemTime
   (errs, cmds) <- partitionEithers <$> mapM cmdAction ts
   write sndQ errs
   write rcvQ cmds
@@ -560,70 +561,60 @@ receive th@THandle {params = THandleParams {thAuth}} NtfServerClient {rcvQ, sndQ
           logError $ "invalid client request: " <> tshow e
           pure $ Left (corrId, entId, NRErr e)
         Right cmd ->
-          verified =<< verifyNtfTransmission ((,C.cbNonce (SMP.bs corrId)) <$> thAuth) t cmd
+          verified =<< verifyNtfTransmission st ((,C.cbNonce (SMP.bs corrId)) <$> thAuth) t cmd
           where
             verified = \case
               VRVerified req -> pure $ Right req
-              VRFailed -> do
+              VRFailed e -> do
                 logError "unauthorized client request"
-                pure $ Left (corrId, entId, NRErr AUTH)
+                pure $ Left (corrId, entId, NRErr e)
     write q = mapM_ (atomically . writeTBQueue q) . L.nonEmpty
 
 send :: Transport c => THandleNTF c 'TServer -> NtfServerClient -> IO ()
 send h@THandle {params} NtfServerClient {sndQ, sndActiveAt} = forever $ do
   ts <- atomically $ readTBQueue sndQ
-  void . liftIO $ tPut h $ L.map (\t -> Right (Nothing, encodeTransmission params t)) ts
-  atomically . (writeTVar sndActiveAt $!) =<< liftIO getSystemTime
-
-data VerificationResult = VRVerified NtfRequest | VRFailed
-
-verifyNtfTransmission :: Maybe (THandleAuth 'TServer, C.CbNonce) -> SignedTransmission ErrorType NtfCmd -> NtfCmd -> M VerificationResult
-verifyNtfTransmission auth_ (tAuth, authorized, (corrId, entId, _)) cmd = do
-  st <- asks store
-  case cmd of
-    -- TODO [ntfdb] this looks suspicious, as if it can prevent repeated registrations
-    NtfCmd SToken c@(TNEW tkn@(NewNtfTkn _ k _)) -> do
-      r_ <- liftIO $ getNtfTokenRegistration st tkn
-      pure $
-        if verifyCmdAuthorization auth_ tAuth authorized k
-          then case r_ of
-            Right t@NtfTknRec {tknVerifyKey}
-              -- keys will be the same because of condition in `getNtfTokenRegistration`
-              | k == tknVerifyKey -> VRVerified $ tknCmd t c
-              | otherwise -> VRFailed
-            Left _ -> VRVerified (NtfReqNew corrId (ANE SToken tkn))
-          else VRFailed
-    NtfCmd SToken c -> do
-      t_ <- liftIO $ getNtfToken st entId
-      verifyToken_' t_ (`tknCmd` c)
-    NtfCmd SSubscription c@(SNEW sub@(NewNtfSub tknId smpQueue _)) ->
-      liftIO $ verify <$> findNtfSubscription st tknId smpQueue
-      where
-        verify = \case
-          Right (t, s_) -> verifyToken t $ case s_ of
-            Nothing -> NtfReqNew corrId (ANE SSubscription sub)
-            Just s -> subCmd s c
-          -- TODO [ntfdb] it should simply return error if it is not AUTH
-          Left _ -> maybe False (dummyVerifyCmd auth_ authorized) tAuth `seq` VRFailed
-    NtfCmd SSubscription PING -> pure $ VRVerified $ NtfReqPing corrId entId
-    NtfCmd SSubscription c -> liftIO $ verify <$> getNtfSubscription st entId
-      where
-        verify = \case
-          Right (t, s) -> verifyToken t $ subCmd s c
-          -- TODO [ntfdb] it should simply return error if it is not AUTH
-          Left _ -> maybe False (dummyVerifyCmd auth_ authorized) tAuth `seq` VRFailed
+  void $ tPut h $ L.map (\t -> Right (Nothing, encodeTransmission params t)) ts
+  atomically . (writeTVar sndActiveAt $!) =<< getSystemTime
+
+data VerificationResult = VRVerified NtfRequest | VRFailed ErrorType
+
+verifyNtfTransmission :: NtfPostgresStore -> Maybe (THandleAuth 'TServer, C.CbNonce) -> SignedTransmission ErrorType NtfCmd -> NtfCmd -> IO VerificationResult
+verifyNtfTransmission st auth_ (tAuth, authorized, (corrId, entId, _)) = \case
+  NtfCmd SToken c@(TNEW tkn@(NewNtfTkn _ k _))
+    | verifyCmdAuthorization auth_ tAuth authorized k ->
+        result <$> findNtfTokenRegistration st tkn
+    | otherwise -> pure $ VRFailed AUTH
+    where
+      result = \case
+        Right (Just t@NtfTknRec {tknVerifyKey})
+          -- keys will be the same because of condition in `findNtfTokenRegistration`
+          | k == tknVerifyKey -> VRVerified $ tknCmd t c
+          | otherwise -> VRFailed AUTH
+        Right Nothing -> VRVerified (NtfReqNew corrId (ANE SToken tkn))
+        Left e -> VRFailed e
+  NtfCmd SToken c -> either err verify <$> getNtfToken st entId
+    where
+      verify t = verifyToken t $ tknCmd t c
+  NtfCmd SSubscription c@(SNEW sub@(NewNtfSub tknId smpQueue _)) ->
+    either err verify <$> findNtfSubscription st tknId smpQueue
+    where
+      verify (t, s_) = verifyToken t $ case s_ of
+        Nothing -> NtfReqNew corrId (ANE SSubscription sub)
+        Just s -> subCmd s c
+  NtfCmd SSubscription PING -> pure $ VRVerified $ NtfReqPing corrId entId
+  NtfCmd SSubscription c -> either err verify <$> getNtfSubscription st entId
+    where
+      verify (t, s) = verifyToken t $ subCmd s c
   where
     tknCmd t c = NtfReqCmd SToken (NtfTkn t) (corrId, entId, c)
     subCmd s c = NtfReqCmd SSubscription (NtfSub s) (corrId, entId, c)
-    verifyToken_' :: Either ErrorType NtfTknRec -> (NtfTknRec -> NtfRequest) -> M VerificationResult
-    verifyToken_' t_ result = pure $ case t_ of
-      Right t -> verifyToken t $ result t
-      -- TODO [ntfdb] it should simply return error if it is not AUTH
-      Left _ -> maybe False (dummyVerifyCmd auth_ authorized) tAuth `seq` VRFailed
     verifyToken :: NtfTknRec -> NtfRequest -> VerificationResult
     verifyToken NtfTknRec {tknVerifyKey} r
       | verifyCmdAuthorization auth_ tAuth authorized tknVerifyKey = VRVerified r
-      | otherwise = VRFailed
+      | otherwise = VRFailed AUTH
+    err = \case -- signature verification for AUTH errors mitigates timing attacks for existence checks
+      AUTH -> maybe False (dummyVerifyCmd auth_ authorized) tAuth `seq` VRFailed AUTH
+      e -> VRFailed e
 
 client :: NtfServerClient -> NtfSubscriber -> NtfPushServer -> M ()
 client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPushServer {pushQ, intervalNotifiers} =
@@ -669,9 +660,6 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
                   pure NROk
             | otherwise -> do
                 logDebug "TVFY - incorrect code or token status"
-                liftIO $ print tkn
-                let NtfRegCode c = code
-                liftIO $ print $ B64.encode c
                 pure $ NRErr AUTH
           TCHK -> do
             logDebug "TCHK"
@@ -732,17 +720,15 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
               atomically $ writeTBQueue newSubQ (srv, [sub])
               incNtfStat subCreated
               pure $ NRSubId subId
-            -- TODO [ntfdb] we must allow repeated inserts that don't change credentials
             False -> pure $ NRErr AUTH
         pure (corrId, NoEntity, resp)
-      NtfReqCmd SSubscription (NtfSub NtfSubRec {smpQueue = SMPQueueNtf {smpServer, notifierId}, notifierKey = registeredNKey, subStatus}) (corrId, subId, cmd) -> do
+      NtfReqCmd SSubscription (NtfSub NtfSubRec {ntfSubId, smpQueue = SMPQueueNtf {smpServer, notifierId}, notifierKey = registeredNKey, subStatus}) (corrId, subId, cmd) -> do
         (corrId,subId,) <$> case cmd of
           SNEW (NewNtfSub _ _ notifierKey) -> do
             logDebug "SNEW - existing subscription"
-            -- possible improvement: retry if subscription failed, if pending or AUTH do nothing
             pure $
               if notifierKey == registeredNKey
-                then NRSubId subId
+                then NRSubId ntfSubId
                 else NRErr AUTH
           SCHK -> do
             logDebug "SCHK"

src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs

@@ -145,18 +145,20 @@ ntfTknToRow NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhPrivKey, t
    in (ntfTknId, pp, Binary ppToken, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, Binary regCode, tknCronInterval, tknUpdatedAt)
 
 getNtfToken :: NtfPostgresStore -> NtfTokenId -> IO (Either ErrorType NtfTknRec)
-getNtfToken st tknId = getNtfToken_ st " WHERE token_id = ?" (Only tknId)
+getNtfToken st tknId =
+  (maybe (Left AUTH) Right =<<) <$>
+    getNtfToken_ st " WHERE token_id = ?" (Only tknId)
 
-getNtfTokenRegistration :: NtfPostgresStore -> NewNtfEntity 'Token -> IO (Either ErrorType NtfTknRec)
-getNtfTokenRegistration st (NewNtfTkn (DeviceToken pp ppToken) tknVerifyKey _) =
+findNtfTokenRegistration :: NtfPostgresStore -> NewNtfEntity 'Token -> IO (Either ErrorType (Maybe NtfTknRec))
+findNtfTokenRegistration st (NewNtfTkn (DeviceToken pp ppToken) tknVerifyKey _) =
   getNtfToken_ st " WHERE push_provider = ? AND push_provider_token = ? AND verify_key = ?" (pp, Binary ppToken, tknVerifyKey)
 
-getNtfToken_ :: ToRow q => NtfPostgresStore -> Query -> q -> IO (Either ErrorType NtfTknRec)
+getNtfToken_ :: ToRow q => NtfPostgresStore -> Query -> q -> IO (Either ErrorType (Maybe NtfTknRec))
 getNtfToken_ st cond params =
-  withDB "getNtfToken" st $ \db -> runExceptT $ do
-    tkn <- ExceptT $ firstRow rowToNtfTkn AUTH $ DB.query db (ntfTknQuery <> cond) params
-    liftIO $ updateTokenDate st db tkn
-    pure tkn
+  withDB' "getNtfToken" st $ \db -> do
+    tkn_ <- maybeFirstRow rowToNtfTkn $ DB.query db (ntfTknQuery <> cond) params
+    mapM_ (updateTokenDate st db) tkn_
+    pure tkn_
 
 updateTokenDate :: NtfPostgresStore -> DB.Connection -> NtfTknRec -> IO ()
 updateTokenDate st db NtfTknRec {ntfTknId, tknUpdatedAt} = do
@@ -269,26 +271,28 @@ foldNtfSubscriptions st srv fetchCount state action =
     toNtfSub (ntfSubId, tokenId, nId, subStatus, notifierKey) =
       NtfSubRec {ntfSubId, tokenId, smpQueue = SMPQueueNtf srv nId, subStatus, notifierKey}
 
+-- Returns token and subscription.
+-- If subscription exists but belongs to another token, returns Left AUTH
 findNtfSubscription :: NtfPostgresStore -> NtfTokenId -> SMPQueueNtf -> IO (Either ErrorType (NtfTknRec, Maybe NtfSubRec))
-findNtfSubscription st tknId q@(SMPQueueNtf srv nId) =
+findNtfSubscription st tknId q =
   withDB "findNtfSubscription" st $ \db -> runExceptT $ do
-    r@(tkn@NtfTknRec {tknStatus}, _) <-
-      ExceptT $ firstRow (rowToNtfTknMaybeSub q) AUTH $
+    tkn@NtfTknRec {ntfTknId, tknStatus} <- ExceptT $ getNtfToken st tknId
+    unless (allowNtfSubCommands tknStatus) $ throwE AUTH
+    liftIO $ updateTokenDate st db tkn
+    sub_ <-
+      liftIO $ maybeFirstRow (rowToNtfSub q) $
         DB.query
           db
           [sql|
-            SELECT t.token_id, t.push_provider, t.push_provider_token, t.status, t.verify_key, t.dh_priv_key, t.dh_secret, t.reg_code, t.cron_interval, t.updated_at,
-              s.subscription_id, s.smp_notifier_key, s.status
-            FROM tokens t
-            LEFT JOIN subscriptions s ON s.token_id = t.token_id AND s.smp_notifier_id = ?
-            LEFT JOIN smp_servers p ON p.smp_server_id = s.smp_server_id
-              AND p.smp_host = ? AND p.smp_port = ? AND p.smp_keyhash = ?
-            WHERE t.token_id = ?
-          |]          
-          (Only nId :. srvToRow srv :. Only tknId)
-    liftIO $ updateTokenDate st db tkn
-    unless (allowNtfSubCommands tknStatus) $ throwE AUTH
-    pure r
+            SELECT s.token_id, s.subscription_id, s.smp_notifier_key, s.status
+            FROM subscriptions s
+            JOIN smp_servers p ON p.smp_server_id = s.smp_server_id
+            WHERE p.smp_host = ? AND p.smp_port = ? AND p.smp_keyhash = ?
+              AND s.smp_notifier_id = ?
+          |]
+          (smpQueueToRow q)
+    forM_ sub_ $ \NtfSubRec {tokenId} -> unless (ntfTknId == tokenId) $ throwE AUTH
+    pure (tkn, sub_)
 
 getNtfSubscription :: NtfPostgresStore -> NtfSubscriptionId -> IO (Either ErrorType (NtfTknRec, NtfSubRec))
 getNtfSubscription st subId =
@@ -313,22 +317,15 @@ getNtfSubscription st subId =
 
 type NtfSubRow = (NtfSubscriptionId, NtfPrivateAuthKey, NtfSubStatus)
 
-type MaybeNtfSubRow = (Maybe NtfSubscriptionId, Maybe NtfPrivateAuthKey, Maybe NtfSubStatus)
-
 rowToNtfTknSub :: NtfTknRow :. NtfSubRow :. SMPQueueNtfRow -> (NtfTknRec, NtfSubRec)
 rowToNtfTknSub (tknRow :. (ntfSubId, notifierKey, subStatus) :. qRow)  =
   let tkn@NtfTknRec {ntfTknId = tokenId} = rowToNtfTkn tknRow
       smpQueue = rowToSMPQueue qRow
    in (tkn, NtfSubRec {ntfSubId, tokenId, smpQueue, notifierKey, subStatus})
 
-rowToNtfTknMaybeSub :: SMPQueueNtf -> NtfTknRow :. MaybeNtfSubRow -> (NtfTknRec, Maybe NtfSubRec)
-rowToNtfTknMaybeSub smpQueue (tknRow :. subRow)  =
-  let tkn@NtfTknRec {ntfTknId = tokenId} = rowToNtfTkn tknRow
-      sub_ = case subRow of
-        (Just ntfSubId, Just notifierKey, Just subStatus) ->
-          Just NtfSubRec {ntfSubId, tokenId, smpQueue, notifierKey, subStatus}
-        _ -> Nothing
-   in (tkn, sub_)
+rowToNtfSub :: SMPQueueNtf -> Only NtfTokenId :. NtfSubRow -> NtfSubRec
+rowToNtfSub smpQueue (Only tokenId :. (ntfSubId, notifierKey, subStatus)) =
+  NtfSubRec {ntfSubId, tokenId, smpQueue, notifierKey, subStatus}
 
 mkNtfSubRec :: NtfSubscriptionId -> NewNtfEntity 'Subscription -> NtfSubRec
 mkNtfSubRec ntfSubId (NewNtfSub tokenId smpQueue notifierKey) =

tests/AgentTests/NotificationTests.hs

@@ -79,6 +79,7 @@ import Simplex.Messaging.Protocol (ErrorType (AUTH), MsgFlags (MsgFlags), NtfSer
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server.Env.STM (AStoreType (..), ServerConfig (..))
 import Simplex.Messaging.Transport (ATransport)
+import System.Process (callCommand)
 import Test.Hspec
 import UnliftIO
 #if defined(dbPostgres)
@@ -569,15 +570,15 @@ testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {ag
   threadDelay 500000
   suspendAgent alice 0
   closeDBStore store
-  threadDelay 1500000
+  callCommand "sync"
   putStrLn "before opening the database from another agent"
 
   -- aliceNtf client doesn't have subscription and is allowed to get notification message
   withAgent 3 aliceCfg initAgentServers testDB $ \aliceNtf -> do
     (Just SMPMsgMeta {msgFlags = MsgFlags True}) :| _ <- getConnectionMessages aliceNtf [cId]
     pure ()
 
-  threadDelay 1500000
+  callCommand "sync"
   putStrLn "after closing the database in another agent"
   reopenDBStore store
   foregroundAgent alice

tests/NtfServerTests.hs

@@ -13,7 +13,6 @@
 module NtfServerTests where
 
 import Control.Concurrent (threadDelay)
-import Control.Monad (void)
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Types as JT
 import Data.Bifunctor (first)
@@ -52,6 +51,7 @@ ntfServerTests t = do
   describe "Notifications server protocol syntax" $ ntfSyntaxTests t
   describe "Notification subscriptions (NKEY)" $ testNotificationSubscription t createNtfQueueNKEY
   -- describe "Notification subscriptions (NEW with ntf creds)" $ testNotificationSubscription t createNtfQueueNEW
+  describe "Retried notification subscription" $ testRetriedNtfSubscription t
 
 ntfSyntaxTests :: ATransport -> Spec
 ntfSyntaxTests (ATransport t) = do
@@ -179,6 +179,38 @@ testNotificationSubscription (ATransport t) createQueue =
           smpServer3 `shouldBe` srv
           notifierId3 `shouldBe` nId
 
+testRetriedNtfSubscription :: ATransport -> Spec
+testRetriedNtfSubscription (ATransport t) =
+  it "should allow retrying to create notification subscription with the same token and key" $ do
+    g <- C.newRandom
+    (sPub, _sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+    (nPub, nKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+    withAPNSMockServer $ \apns ->
+      smpTest' t $ \h ->
+        ntfTest t $ \nh -> do
+          ((_sId, _rId, _rKey, _rcvDhSecret), nId, _rcvNtfDhSecret) <- createNtfQueueNKEY h sPub nPub
+          (tknKey, _dhSecret, tId, regCode) <- registerToken nh apns "abcd"
+          let srv = SMPServer SMP.testHost SMP.testPort SMP.testKeyHash
+              q = SMPQueueNtf srv nId
+          -- fails creating subscription until token is verified
+          RespNtf "2" NoEntity (NRErr AUTH) <- signSendRecvNtf nh tknKey ("2", NoEntity, SNEW $ NewNtfSub tId q nKey)
+          -- verify token
+          RespNtf "3" tId1 NROk <- signSendRecvNtf nh tknKey ("3", tId, TVFY regCode)
+          tId1 `shouldBe` tId
+          -- create subscription
+          RespNtf "4" NoEntity (NRSubId subId) <- signSendRecvNtf nh tknKey ("4", NoEntity, SNEW $ NewNtfSub tId q nKey)
+          -- allow retry
+          RespNtf "4a" NoEntity (NRSubId subId') <- signSendRecvNtf nh tknKey ("4a", NoEntity, SNEW $ NewNtfSub tId q nKey)
+          subId' `shouldBe` subId
+          -- fail with another key
+          (_nPub, nKey') <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+          RespNtf "5" NoEntity (NRErr AUTH) <- signSendRecvNtf nh tknKey ("5", NoEntity, SNEW $ NewNtfSub tId q nKey')
+          -- fail with another token
+          (tknKey', _dhSecret, tId', regCode') <- registerToken nh apns "efgh"
+          RespNtf "6" _ NROk <- signSendRecvNtf nh tknKey' ("6", tId', TVFY regCode')
+          RespNtf "7" NoEntity (NRErr AUTH) <- signSendRecvNtf nh tknKey' ("7", NoEntity, SNEW $ NewNtfSub tId' q nKey)
+          pure ()
+
 type CreateQueueFunc =
   forall c.
   Transport c =>
@@ -197,6 +229,24 @@ createNtfQueueNKEY h sPub nPub = do
   let rcvNtfDhSecret = C.dh' rcvNtfSrvPubDhKey rcvNtfPrivDhKey
   pure ((sId, rId, rKey, rcvDhSecret), nId, rcvNtfDhSecret)
 
+registerToken :: Transport c => THandleNTF c 'TClient -> APNSMockServer -> ByteString -> IO (C.APrivateAuthKey, C.DhSecretX25519, NtfEntityId, NtfRegCode)
+registerToken nh apns token = do
+  g <- C.newRandom
+  (tknPub, tknKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+  (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+  let tkn = DeviceToken PPApnsTest token
+  RespNtf "1" NoEntity (NRTknId tId ntfDh) <- signSendRecvNtf nh tknKey ("1", NoEntity, TNEW $ NewNtfTkn tkn tknPub dhPub)
+  APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
+    getMockNotification apns tkn
+  let dhSecret = C.dh' ntfDh dhPriv
+      decryptCode nd =
+        let Right verification = nd .-> "verification"
+            Right nonce = C.cbNonce <$> nd .-> "nonce"
+            Right pt = C.cbDecrypt dhSecret nonce verification
+          in NtfRegCode pt
+  let code = decryptCode ntfData
+  pure (tknKey, dhSecret, tId, code)
+
 -- TODO [notifications]
 -- createNtfQueueNEW :: CreateQueueFunc
 -- createNtfQueueNEW h sPub nPub = do

tests/SMPClient.hs

@@ -360,6 +360,9 @@ smpServerTest _ t = runSmpTest (ASType SQSMemory SMSJournal) $ \h -> tPut' h t >
 smpTest :: (HasCallStack, Transport c) => TProxy c -> AStoreType -> (HasCallStack => THandleSMP c 'TClient -> IO ()) -> Expectation
 smpTest _ msType test' = runSmpTest msType test' `shouldReturn` ()
 
+smpTest' :: forall c. (HasCallStack, Transport c) => TProxy c -> (HasCallStack => THandleSMP c 'TClient -> IO ()) -> Expectation
+smpTest' = (`smpTest` ASType SQSMemory SMSJournal)
+
 smpTestN :: (HasCallStack, Transport c) => AStoreType -> Int -> (HasCallStack => [THandleSMP c 'TClient] -> IO ()) -> Expectation
 smpTestN msType n test' = runSmpTestN msType n test' `shouldReturn` ()