verify name proof

cabal.project

@@ -21,7 +21,7 @@ constraints: zip +disable-bzip2 +disable-zstd
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/simplexmq.git
-    tag: 209f7826cbebfb60e2ec1831948582b00f44e7c8
+    tag: 477486c18fdbe5ff6dbb305a7b5690e9d0cc2034
 
 source-repository-package
     type: git

src/Simplex/Chat/Badges.hs

@@ -30,7 +30,6 @@ module Simplex.Chat.Badges
     maxFileSizeLegend,
     ProofPresHeaderTag (..),
     ProofPresHeader (..),
-    proofPresHeaderLink,
     BadgePurchase (..),
     BadgeMasterKey (..),
     BadgeRequest (..),
@@ -67,7 +66,7 @@ import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8)
 import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, nominalDay)
 import Simplex.FileTransfer.Description (gb, maxFileSize)
-import Simplex.Messaging.Agent.Protocol (AConnShortLink (..), OwnerId)
+import Simplex.Messaging.Agent.Protocol (OwnerId)
 import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..), fromTextField_)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.BBS
@@ -202,25 +201,20 @@ maxXFTPFileSize = \case
 -- presentation, not bound to any context; the 'T' tag marks it so master rejects it.
 -- PHUnknown is the forward-compat catch-all for tags this version does not interpret.
 
-data ProofPresHeaderTag = PHTestTag | PHSimplexLinkTag | PHUnknownTag Char
+data ProofPresHeaderTag = PHTestTag | PHUnknownTag Char
 
 instance StrEncoding ProofPresHeaderTag where
   strEncode = B.singleton . \case
     PHTestTag -> 'T'
-    PHSimplexLinkTag -> 'L'
     PHUnknownTag c -> c
   strP = tag <$> A.anyChar
     where
       tag = \case
         'T' -> PHTestTag
-        'L' -> PHSimplexLinkTag
         c -> PHUnknownTag c
 
--- PHSimplexLink binds the proof to the link it is presented through (a 1-time
--- invitation or a contact address), making it non-replayable across links.
 data ProofPresHeader
   = PHTest ByteString
-  | PHSimplexLink AConnShortLink
   | PHUnknown Char ByteString
   deriving (Eq, Show)
   deriving (ToJSON, FromJSON) via (StrJSON "ProofPresHeader" ProofPresHeader)
@@ -228,26 +222,18 @@ data ProofPresHeader
 instance StrEncoding ProofPresHeader where
   strEncode = \case
     PHTest nonce -> strEncode PHTestTag <> nonce
-    PHSimplexLink lnk -> strEncode PHSimplexLinkTag <> strEncode lnk
     PHUnknown c b -> strEncode (PHUnknownTag c) <> b
   strP =
     strP >>= \case
       PHTestTag -> PHTest <$> A.takeByteString
-      PHSimplexLinkTag -> PHSimplexLink <$> strP
       PHUnknownTag c -> PHUnknown c <$> A.takeByteString
 
 -- v6.5.x accepts both; v7 will reject PHTest/PHUnknown
 proofPresHeaderAccepted :: ProofPresHeader -> Bool
 proofPresHeaderAccepted = \case
   PHTest _ -> True
-  PHSimplexLink _ -> True
   PHUnknown _ _ -> True
 
-proofPresHeaderLink :: ProofPresHeader -> Maybe AConnShortLink
-proofPresHeaderLink = \case
-  PHSimplexLink lnk -> Just lnk
-  _ -> Nothing
-
 -- Payment proof
 
 data BadgePurchase

src/Simplex/Chat/Library/Commands.hs

@@ -56,8 +56,8 @@ import Data.Type.Equality
 import qualified Data.UUID as UUID
 import qualified Data.UUID.V4 as V4
 import Simplex.Chat.Library.Subscriber
-import Simplex.Chat.Badges (BadgeCredential (..), LocalBadge (..), ProofPresHeader (..), maxXFTPFileSize, mkBadgeStatus, proofPresHeaderLink, verifyCredential)
-import Simplex.Chat.Names (NameClaimProof (..), SimplexNameClaim (..), claimName, claimProof, mkSimplexNameClaim, signNameProof, verifyNameProofSig)
+import Simplex.Chat.Badges (BadgeCredential (..), LocalBadge (..), ProofPresHeader (..), maxXFTPFileSize, mkBadgeStatus, verifyCredential)
+import Simplex.Chat.Names (NameClaimProof (..), SimplexNameClaim (..), claimName, claimProof, mkSimplexNameClaim, verifyNameProofSig)
 import Simplex.Chat.Call
 import Simplex.Chat.Controller
 import Simplex.Chat.Delivery (DeliveryJobScope (..), DeliveryJobSpec (..), DeliveryWorkerScope (..))
@@ -4792,46 +4792,37 @@ nameResolvesTo sLnk = any (either (const False) (sameShortLinkContact sLnk) . st
 verifyName :: User -> NetworkRequestMode -> SimplexNameInfo -> Maybe AConnShortLink -> Maybe NameClaimProof -> CM (Maybe Bool, Maybe Text)
 verifyName user nm claim connLink_ proof_ = case (proof_, connLink_) of
   (Nothing, _) -> pure (Nothing, Just "no name proof to verify")
-  (_, Nothing) -> pure (Nothing, Just "no connection link to check the name proof against")
-  (Just proof, Just connLink)
-    | not (proofBoundTo proof connLink) ->
-        pure (Just False, Just "the name proof is bound to a different link than the one used to connect")
-    | otherwise -> do
-        let SimplexNameInfo {nameType, nameDomain} = claim
-        NameRecord {nrSimplexContact, nrSimplexChannel} <-
-          withAgent $ \a -> resolveSimplexName a nm (aUserId user) nameDomain
-        let resolvedLinks = case nameType of
-              NTContact -> nrSimplexContact
-              NTPublicGroup -> nrSimplexChannel
-        if null resolvedLinks
-          then pure (Just False, Just "the name is not registered (it does not resolve to any address)")
-          else do
-            ok <- or <$> mapM (verifyProofKey nm user claim proof) resolvedLinks
-            pure $
-              if ok
-                then (Just True, Nothing)
-                else (Just False, Just "the name resolves to a different address — its owner did not sign this name proof")
+  (_, Nothing) -> pure (Nothing, Just "no connection link to check the name against")
+  (Just proof, Just (ACSL SCMContact profileSLnk)) -> do
+    let SimplexNameInfo {nameType, nameDomain} = claim
+    NameRecord {nrSimplexContact, nrSimplexChannel} <-
+      withAgent $ \a -> resolveSimplexName a nm (aUserId user) nameDomain
+    let resolvedLinks = case nameType of
+          NTContact -> nrSimplexContact
+          NTPublicGroup -> nrSimplexChannel
+    if not (nameResolvesTo profileSLnk resolvedLinks)
+      then pure (Just False, Just "the name does not resolve to this address")
+      else do
+        ok <- verifyProofKey nm user profileSLnk claim proof
+        pure $
+          if ok
+            then (Just True, Nothing)
+            else (Just False, Just "the name proof was not signed by this address's owner")
+  (Just _, Just _) -> pure (Nothing, Just "unexpected connection link type for name verification")
 
-proofBoundTo :: NameClaimProof -> AConnShortLink -> Bool
-proofBoundTo NameClaimProof {presHeader} connLink =
-  maybe False (`sameConnShortLink` connLink) (proofPresHeaderLink presHeader)
-
--- verify the proof signature against the resolved name's owner key;
+-- verify the proof signature against the profile address's owner key;
 -- getShortLinkConnReq's network/agent error propagates (UI can retry), not recorded as a verdict
-verifyProofKey :: NetworkRequestMode -> User -> SimplexNameInfo -> NameClaimProof -> Text -> CM Bool
-verifyProofKey nm user claim proof resolvedText =
-  case strDecode (encodeUtf8 resolvedText) :: Either String AConnectionLink of
-    Right (ACL SCMContact (CLShort sLnk)) -> do
-      (FixedLinkData {rootKey}, ContactLinkData _ UserContactData {owners}) <- getShortLinkConnReq nm user sLnk
-      pure $ proofSignedByOwner rootKey owners claim proof
-    _ -> pure False
+verifyProofKey :: NetworkRequestMode -> User -> ShortLinkContact -> SimplexNameInfo -> NameClaimProof -> CM Bool
+verifyProofKey nm user sLnk claim proof = do
+  (FixedLinkData {rootKey}, ContactLinkData _ UserContactData {owners}) <- getShortLinkConnReq nm user sLnk
+  pure $ proofSignedByOwner rootKey owners sLnk claim proof
 
-proofSignedByOwner :: C.PublicKeyEd25519 -> [OwnerAuth] -> SimplexNameInfo -> NameClaimProof -> Bool
-proofSignedByOwner rootKey owners claim proof@NameClaimProof {linkOwnerId} =
+proofSignedByOwner :: C.PublicKeyEd25519 -> [OwnerAuth] -> ShortLinkContact -> SimplexNameInfo -> NameClaimProof -> Bool
+proofSignedByOwner rootKey owners sLnk claim proof@NameClaimProof {linkOwnerId} =
   let key_ = case linkOwnerId of
         Nothing -> Just rootKey
         Just (StrJSON oid) -> ownerKey <$> find (\OwnerAuth {ownerId} -> ownerId == oid) owners
-   in maybe False (\key -> verifyNameProofSig key claim proof) key_
+   in maybe False (\key -> verifyNameProofSig key claim sLnk proof) key_
 
 -- connecting by name resolves the name to this address, so it is verified without checking the proof
 verifyNameClaim :: SimplexNameInfo -> Maybe SimplexNameInfo -> CM (Maybe Bool)

src/Simplex/Chat/Names.hs

@@ -14,7 +14,6 @@ module Simplex.Chat.Names
     claimProof,
     setClaimProof,
     NameClaimProof (..),
-    signNameProof,
     verifyNameProofSig,
   )
 where
@@ -22,7 +21,7 @@ where
 import qualified Data.Aeson.TH as JQ
 import Data.ByteString.Char8 (ByteString)
 import Simplex.Chat.Badges (ProofPresHeader)
-import Simplex.Messaging.Agent.Protocol (OwnerId)
+import Simplex.Messaging.Agent.Protocol (ConnShortLink (..), ConnectionMode (..), OwnerId)
 import Simplex.Messaging.Agent.Store.DB (fromTextField_)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
@@ -39,7 +38,7 @@ import Database.SQLite.Simple.ToField (ToField (..))
 
 -- A name claim proof: signed by the address owner's key (linkOwnerId = Just oid when a channel
 -- owner other than the address signs, Nothing when the address's own root key signs) over
--- strEncode name <> strEncode presHeader, tied to the link it is shown through.
+-- the name-proof payload, binding the name to the address (see nameProofPayload).
 data NameClaimProof = NameClaimProof
   { linkOwnerId :: Maybe (StrJSON "OwnerId" OwnerId),
     presHeader :: ProofPresHeader,
@@ -47,24 +46,13 @@ data NameClaimProof = NameClaimProof
   }
   deriving (Eq, Show)
 
-nameProofPayload :: SimplexNameInfo -> ProofPresHeader -> ByteString
-nameProofPayload name presHeader = strEncode name <> strEncode presHeader
+nameProofPayload :: SimplexNameInfo -> ProofPresHeader -> ConnShortLink 'CMContact -> ByteString
+nameProofPayload name presHeader (CSLContact _ ct srv key) =
+  strEncode (Str "simplex_names_v1", presHeader, name, ct, srv, key)
 
--- linkOwnerId names the signing owner in the link's owner chain (Nothing = root key for a contact address).
-signNameProof :: C.PrivateKeyEd25519 -> Maybe OwnerId -> SimplexNameInfo -> ProofPresHeader -> NameClaimProof
-signNameProof key linkOwnerId name presHeader =
-  NameClaimProof
-    { linkOwnerId = StrJSON <$> linkOwnerId,
-      presHeader,
-      signature = C.sign' key (nameProofPayload name presHeader)
-    }
-
--- verify a name proof's signature against the resolved address owner key. The caller must
--- SEPARATELY check the proof's presHeader link is the one it was shown through, so a proof made
--- for one link can't be reused on another.
-verifyNameProofSig :: C.PublicKeyEd25519 -> SimplexNameInfo -> NameClaimProof -> Bool
-verifyNameProofSig ownerKey name NameClaimProof {presHeader, signature} =
-  C.verify' ownerKey signature (nameProofPayload name presHeader)
+verifyNameProofSig :: C.PublicKeyEd25519 -> SimplexNameInfo -> ConnShortLink 'CMContact -> NameClaimProof -> Bool
+verifyNameProofSig ownerKey name sLnk NameClaimProof {presHeader, signature} =
+  C.verify' ownerKey signature (nameProofPayload name presHeader sLnk)
 
 $(JQ.deriveJSON defaultJSON ''NameClaimProof)