Merge branch 'master' into v5

src/Simplex/Messaging/Agent.hs

@@ -338,7 +338,7 @@ subscribeConnection' c connId =
         Active -> throwError $ CONN SIMPLEX
         _ -> throwError $ INTERNAL "unexpected queue status"
     SomeConn _ (RcvConnection _ rq) -> subscribeQueue c rq connId
-    SomeConn _ (ContactConnection _ _rq) -> pure ()
+    SomeConn _ (ContactConnection _ rq) -> subscribeQueue c rq connId
   where
     verifyKey :: SndQueue -> C.APublicVerifyKey
     verifyKey = C.publicKey . signKey

src/Simplex/Messaging/Agent/Protocol.hs

@@ -395,7 +395,7 @@ serializeConnReq' = \case
           CMContact -> "contact"
         queryStr = renderSimpleQuery True [("smp", queues), ("e2e", key)]
         queues = B.intercalate "," . map serializeSMPQueueUri $ L.toList crSmpQueues
-        key = C.serializeKey crEncryptKey
+        key = C.serializeKeyUri crEncryptKey
 
 connReqP' :: forall m. ConnectionModeI m => Parser (ConnectionRequest m)
 connReqP' = do
@@ -410,7 +410,7 @@ connReqP = do
   crMode <- "/" *> mode <* "#/?"
   query <- parseSimpleQuery <$> A.takeTill (\c -> c == ' ' || c == '\n')
   crSmpQueues <- paramP "smp" smpQueues query
-  crEncryptKey <- paramP "e2e" C.strKeyP query
+  crEncryptKey <- paramP "e2e" C.strKeyUriP query
   let cReq = ConnReqData {crScheme, crSmpQueues, crEncryptKey}
   pure $ case crMode of
     CMInvitation -> ACR SCMInvitation $ CRInvitation cReq

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

@@ -40,7 +40,7 @@ import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
-import Database.SQLite.Simple (FromRow, NamedParam (..), Only (..), SQLData (..), SQLError, field)
+import Database.SQLite.Simple (FromRow, NamedParam (..), Only (..), SQLData (..), SQLError, ToRow, field)
 import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.FromField
 import Database.SQLite.Simple.Internal (Field (..))
@@ -371,6 +371,7 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
             SELECT contact_conn_id, cr_invitation, recipient_conn_info, own_conn_info, accepted
             FROM conn_invitations
             WHERE invitation_id = ?
+              AND accepted = 0
           |]
           (Only invitationId)
     where
@@ -572,6 +573,22 @@ instance (FromField a, FromField b, FromField c, FromField d, FromField e,
   fromRow = (,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
                          <*> field <*> field <*> field <*> field <*> field
                          <*> field
+
+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
+          FromField f, FromField g, FromField h, FromField i, FromField j,
+          FromField k, FromField l) =>
+  FromRow (a,b,c,d,e,f,g,h,i,j,k,l) where
+  fromRow = (,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
+                          <*> field <*> field <*> field <*> field <*> field
+                          <*> field <*> field
+
+instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
+          ToField g, ToField h, ToField i, ToField j, ToField k, ToField l) =>
+  ToRow (a,b,c,d,e,f,g,h,i,j,k,l) where
+  toRow (a,b,c,d,e,f,g,h,i,j,k,l) =
+    [ toField a, toField b, toField c, toField d, toField e, toField f,
+      toField g, toField h, toField i, toField j, toField k, toField l
+    ]
 {- ORMOLU_ENABLE -}
 
 -- * Server upsert helper

src/Simplex/Messaging/Crypto.hs

@@ -121,6 +121,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (bimap, first)
 import qualified Data.ByteArray as BA
 import Data.ByteString.Base64 (decode, encode)
+import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.ByteString.Internal (c2w, w2c)
@@ -134,7 +135,7 @@ import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
 import GHC.TypeLits (ErrorMessage (..), TypeError)
 import Network.Transport.Internal (decodeWord32, encodeWord32)
-import Simplex.Messaging.Parsers (base64P, blobFieldParser, parseAll, parseString)
+import Simplex.Messaging.Parsers (base64P, base64UriP, blobFieldParser, parseAll, parseString)
 import Simplex.Messaging.Util (liftEitherError, (<$?>))
 
 -- | Cryptographic algorithms.
@@ -343,12 +344,18 @@ class CryptoKey k where
   -- | base64 X509 key encoding with algorithm prefix
   serializeKey :: k -> ByteString
 
+  -- | base64url X509 key encoding with algorithm prefix
+  serializeKeyUri :: k -> ByteString
+
   -- | binary X509 key encoding
   encodeKey :: k -> ByteString
 
   -- | base64 X509 (with algorithm prefix) key parser
   strKeyP :: Parser k
 
+  -- | base64url X509 (with algorithm prefix) key parser
+  strKeyUriP :: Parser k
+
   -- | binary X509 key parser
   binaryKeyP :: Parser k
 
@@ -357,22 +364,29 @@ instance CryptoKey APublicKey where
   keySize (APublicKey _ k) = keySize k
   validKeySize (APublicKey _ k) = validKeySize k
   serializeKey (APublicKey _ k) = serializeKey k
+  serializeKeyUri (APublicKey _ k) = serializeKeyUri k
   encodeKey (APublicKey _ k) = encodeKey k
-  strKeyP = do
-    Alg a <- algP <* A.char ':'
-    k@(APublicKey a' _) <- decodePubKey <$?> base64P
-    case testEquality a a' of
-      Just Refl -> pure k
-      _ -> fail $ "public key algorithm " <> show a <> " does not match prefix"
+  strKeyP = strPublicKeyP_ base64P
+  strKeyUriP = strPublicKeyP_ base64UriP
   binaryKeyP = decodePubKey <$?> A.takeByteString
 
+strPublicKeyP_ :: Parser ByteString -> Parser APublicKey
+strPublicKeyP_ b64P = do
+  Alg a <- algP <* A.char ':'
+  k@(APublicKey a' _) <- decodePubKey <$?> b64P
+  case testEquality a a' of
+    Just Refl -> pure k
+    _ -> fail $ "public key algorithm " <> show a <> " does not match prefix"
+
 -- | X509 encoding of signature public key.
 instance CryptoKey APublicVerifyKey where
   keySize (APublicVerifyKey _ k) = keySize k
   validKeySize (APublicVerifyKey _ k) = validKeySize k
   serializeKey (APublicVerifyKey _ k) = serializeKey k
+  serializeKeyUri (APublicVerifyKey _ k) = serializeKeyUri k
   encodeKey (APublicVerifyKey _ k) = encodeKey k
   strKeyP = pubVerifyKey <$?> strKeyP
+  strKeyUriP = pubVerifyKey <$?> strKeyUriP
   binaryKeyP = pubVerifyKey <$?> binaryKeyP
 
 -- | X509 encoding of encryption public key.
@@ -380,8 +394,10 @@ instance CryptoKey APublicEncryptKey where
   keySize (APublicEncryptKey _ k) = keySize k
   validKeySize (APublicEncryptKey _ k) = validKeySize k
   serializeKey (APublicEncryptKey _ k) = serializeKey k
+  serializeKeyUri (APublicEncryptKey _ k) = serializeKeyUri k
   encodeKey (APublicEncryptKey _ k) = encodeKey k
   strKeyP = pubEncryptKey <$?> strKeyP
+  strKeyUriP = pubEncryptKey <$?> strKeyUriP
   binaryKeyP = pubEncryptKey <$?> binaryKeyP
 
 -- | X509 encoding of 'PublicKey'.
@@ -396,8 +412,10 @@ instance forall a. AlgorithmI a => CryptoKey (PublicKey a) where
     PublicKeyRSA k -> validRSAKeySize $ R.public_size k
     _ -> True
   serializeKey k = algorithmPrefix k <> ":" <> encode (encodeKey k)
+  serializeKeyUri k = algorithmPrefix k <> ":" <> U.encode (encodeKey k)
   encodeKey = encodeASNKey . publicToX509
   strKeyP = pubKey' <$?> strKeyP
+  strKeyUriP = pubKey' <$?> strKeyUriP
   binaryKeyP = pubKey' <$?> binaryKeyP
 
 -- | X509 encoding of any private key.
@@ -405,22 +423,29 @@ instance CryptoKey APrivateKey where
   keySize (APrivateKey _ k) = keySize k
   validKeySize (APrivateKey _ k) = validKeySize k
   serializeKey (APrivateKey _ k) = serializeKey k
+  serializeKeyUri (APrivateKey _ k) = serializeKeyUri k
   encodeKey (APrivateKey _ k) = encodeKey k
-  strKeyP = do
-    Alg a <- algP <* A.char ':'
-    k@(APrivateKey a' _) <- decodePrivKey <$?> base64P
-    case testEquality a a' of
-      Just Refl -> pure k
-      _ -> fail $ "private key algorithm " <> show a <> " does not match prefix"
+  strKeyP = strPrivateKeyP_ base64P
+  strKeyUriP = strPrivateKeyP_ base64UriP
   binaryKeyP = decodePrivKey <$?> A.takeByteString
 
+strPrivateKeyP_ :: Parser ByteString -> Parser APrivateKey
+strPrivateKeyP_ b64P = do
+  Alg a <- algP <* A.char ':'
+  k@(APrivateKey a' _) <- decodePrivKey <$?> b64P
+  case testEquality a a' of
+    Just Refl -> pure k
+    _ -> fail $ "private key algorithm " <> show a <> " does not match prefix"
+
 -- | X509 encoding of signature private key.
 instance CryptoKey APrivateSignKey where
   keySize (APrivateSignKey _ k) = keySize k
   validKeySize (APrivateSignKey _ k) = validKeySize k
   serializeKey (APrivateSignKey _ k) = serializeKey k
+  serializeKeyUri (APrivateSignKey _ k) = serializeKeyUri k
   encodeKey (APrivateSignKey _ k) = encodeKey k
   strKeyP = privSignKey <$?> strKeyP
+  strKeyUriP = privSignKey <$?> strKeyUriP
   binaryKeyP = privSignKey <$?> binaryKeyP
 
 -- | X509 encoding of encryption private key.
@@ -428,8 +453,10 @@ instance CryptoKey APrivateDecryptKey where
   keySize (APrivateDecryptKey _ k) = keySize k
   validKeySize (APrivateDecryptKey _ k) = validKeySize k
   serializeKey (APrivateDecryptKey _ k) = serializeKey k
+  serializeKeyUri (APrivateDecryptKey _ k) = serializeKeyUri k
   encodeKey (APrivateDecryptKey _ k) = encodeKey k
   strKeyP = privDecryptKey <$?> strKeyP
+  strKeyUriP = privDecryptKey <$?> strKeyUriP
   binaryKeyP = privDecryptKey <$?> binaryKeyP
 
 -- | X509 encoding of 'PrivateKey'.
@@ -444,8 +471,10 @@ instance AlgorithmI a => CryptoKey (PrivateKey a) where
     PrivateKeyRSA k -> validRSAKeySize $ rsaPrivateKeySize k
     _ -> True
   serializeKey k = algorithmPrefix k <> ":" <> encode (encodeKey k)
+  serializeKeyUri k = algorithmPrefix k <> ":" <> U.encode (encodeKey k)
   encodeKey = encodeASNKey . privateToX509
   strKeyP = privKey' <$?> strKeyP
+  strKeyUriP = privKey' <$?> strKeyUriP
   binaryKeyP = privKey' <$?> binaryKeyP
 
 type family PublicKeyType pk where

tests/AgentTests.hs

@@ -334,7 +334,7 @@ connect (h1, name1) (h2, name2) = do
 --   pure (conn1, conn2)
 
 samplePublicKey :: ByteString
-samplePublicKey = "rsa:MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAtn1NI2tPoOGSGfad0aUg0tJ0kG2nzrIPGLiz8wb3dQSJC9xkRHyzHhEE8Kmy2cM4q7rNZIlLcm4M7oXOTe7SC4x59bLQG9bteZPKqXu9wk41hNamV25PWQ4zIcIRmZKETVGbwN7jFMpH7wxLdI1zzMArAPKXCDCJ5ctWh4OWDI6OR6AcCtEj+toCI6N6pjxxn5VigJtwiKhxYpoUJSdNM60wVEDCSUrZYBAuDH8pOxPfP+Tm4sokaFDTIG3QJFzOjC+/9nW4MUjAOFll9PCp9kaEFHJ/YmOYKMWNOCCPvLS6lxA83i0UaardkNLNoFS5paWfTlroxRwOC2T6PwO2ywKBgDjtXcSED61zK1seocQMyGRINnlWdhceD669kIHju/f6kAayvYKW3/lbJNXCmyinAccBosO08/0sUxvtuniIo18kfYJE0UmP1ReCjhMP+O+yOmwZJini/QelJk/Pez8IIDDWnY1qYQsN/q7ocjakOYrpGG7mig6JMFpDJtD6istR"
+samplePublicKey = "rsa:MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAtn1NI2tPoOGSGfad0aUg0tJ0kG2nzrIPGLiz8wb3dQSJC9xkRHyzHhEE8Kmy2cM4q7rNZIlLcm4M7oXOTe7SC4x59bLQG9bteZPKqXu9wk41hNamV25PWQ4zIcIRmZKETVGbwN7jFMpH7wxLdI1zzMArAPKXCDCJ5ctWh4OWDI6OR6AcCtEj-toCI6N6pjxxn5VigJtwiKhxYpoUJSdNM60wVEDCSUrZYBAuDH8pOxPfP-Tm4sokaFDTIG3QJFzOjC-_9nW4MUjAOFll9PCp9kaEFHJ_YmOYKMWNOCCPvLS6lxA83i0UaardkNLNoFS5paWfTlroxRwOC2T6PwO2ywKBgDjtXcSED61zK1seocQMyGRINnlWdhceD669kIHju_f6kAayvYKW3_lbJNXCmyinAccBosO08_0sUxvtuniIo18kfYJE0UmP1ReCjhMP-O-yOmwZJini_QelJk_Pez8IIDDWnY1qYQsN_q7ocjakOYrpGG7mig6JMFpDJtD6istR"
 
 syntaxTests :: forall c. Transport c => TProxy c -> Spec
 syntaxTests t = do