diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index f0c2bfd8f..be1cd13bf 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/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 diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 9481ff7ff..b3308ccfe 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/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 diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index 70bb74183..164b18769 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/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 diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs index b4ffbc9ee..decb0c082 100644 --- a/src/Simplex/Messaging/Crypto.hs +++ b/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 diff --git a/tests/AgentTests.hs b/tests/AgentTests.hs index 4b8dcd95c..c2bdc5841 100644 --- a/tests/AgentTests.hs +++ b/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