change types

src/Simplex/Chat/Badges.hs

@@ -270,7 +270,7 @@ maxSndXFTPFileSize lims now = \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 | PHChatTag | PHFileInvTag | PHFileDescrTag | PHRequestTag | PHUnknownTag Char
+data ProofPresHeaderTag = PHTestTag | PHChatTag | PHFileInvTag | PHFileDescrTag | PHRequestTag | PHLinkTag | PHUnknownTag Char
 
 instance StrEncoding ProofPresHeaderTag where
   strEncode = B.singleton . \case
@@ -279,6 +279,7 @@ instance StrEncoding ProofPresHeaderTag where
     PHFileInvTag -> 'F'
     PHFileDescrTag -> 'D'
     PHRequestTag -> 'R'
+    PHLinkTag -> 'L'
     PHUnknownTag c -> c
   strP = tag <$> A.anyChar
     where
@@ -288,6 +289,7 @@ instance StrEncoding ProofPresHeaderTag where
         'F' -> PHFileInvTag
         'D' -> PHFileDescrTag
         'R' -> PHRequestTag
+        'L' -> PHLinkTag
         c -> PHUnknownTag c
 
 data ProofPresHeader
@@ -296,6 +298,7 @@ data ProofPresHeader
   | PHFileInv {chatBinding :: ByteString, fileSize :: Int64}
   | PHFileDescr {chatBinding :: ByteString, fileSize :: Int64, descrHash :: ByteString, fileExpires :: Maybe UTCTime}
   | PHRequest ByteString
+  | PHLink ByteString
   | PHUnknown Char ByteString
   deriving (Eq, Show)
   deriving (ToJSON, FromJSON) via (StrJSON "ProofPresHeader" ProofPresHeader)
@@ -309,6 +312,7 @@ instance StrEncoding ProofPresHeader where
     PHFileDescr {chatBinding, fileSize, descrHash, fileExpires} ->
       strEncode PHFileDescrTag <> smpEncode (chatBinding, fileSize, descrHash, utcToSystemTime <$> fileExpires)
     PHRequest code -> strEncode PHRequestTag <> code
+    PHLink linkKey -> strEncode PHLinkTag <> linkKey
     PHUnknown c b -> strEncode (PHUnknownTag c) <> b
   strP =
     strP >>= \case
@@ -321,6 +325,7 @@ instance StrEncoding ProofPresHeader where
         (chatBinding, fileSize, descrHash, expires_) <- smpP
         pure PHFileDescr {chatBinding, fileSize, descrHash, fileExpires = systemToUTCTime <$> expires_}
       PHRequestTag -> PHRequest <$> A.takeByteString
+      PHLinkTag -> PHLink <$> A.takeByteString
       PHUnknownTag c -> PHUnknown c <$> A.takeByteString
 
 acceptedProof :: Maybe ProofPresHeader -> BadgeProof -> Bool

src/Simplex/Chat/Library/Internal.hs

@@ -2254,7 +2254,7 @@ directPresHeader = \case
   CRBRequest code -> PHRequest code
 
 linkPresHeader :: LinkKey -> ProofPresHeader
-linkPresHeader (LinkKey key) = PHChat $ encodeChatBinding CBLink key
+linkPresHeader (LinkKey key) = PHLink key
 
 invitationPresHeader :: ConnReqInvitation -> ProofPresHeader
 invitationPresHeader = PHRequest . invitationRequestCode

src/Simplex/Chat/Protocol.hs

@@ -313,7 +313,7 @@ data AChatMessage = forall e. MsgEncodingI e => ACMsg (SMsgEncoding e) (ChatMess
 data KeyRef = KRMember
   deriving (Eq, Show)
 
-data ChatBinding = CBGroup | CBDirect | CBChannel | CBLink
+data ChatBinding = CBGroup | CBDirect | CBChannel
   deriving (Eq, Show)
 
 data MsgSignature = MsgSignature KeyRef C.ASignature
@@ -410,13 +410,11 @@ instance Encoding ChatBinding where
     CBGroup -> "G"
     CBDirect -> "D"
     CBChannel -> "C"
-    CBLink -> "L"
   smpP =
     A.anyChar >>= \case
       'G' -> pure CBGroup
       'D' -> pure CBDirect
       'C' -> pure CBChannel
-      'L' -> pure CBLink
       c -> fail $ "invalid ChatBinding: " <> show c
 
 instance ToField ChatBinding where toField = toField . decodeLatin1 . smpEncode

tests/BadgeTests.hs

@@ -208,6 +208,7 @@ testPresHeaderEncoding =
       PHFileDescr {chatBinding = aliceBinding, fileSize = 139737, descrHash = "descr-hash", fileExpires = Nothing},
       PHFileDescr {chatBinding = aliceBinding, fileSize = 139737, descrHash = "descr-hash", fileExpires = Just futureTime},
       PHRequest requestCode,
+      PHLink "link-key",
       PHUnknown 'Z' "payload"
     ]
 

tests/ChatTests/Profiles.hs

@@ -857,7 +857,7 @@ testUserBadgeAddressCard ps = do
       _ <- getTermLine bob
       lastItemContent bob >>= (`shouldContain` "\"badgeType\":\"supporter\"")
       cred <- issueTestBadge sk futureDate
-      Right otherProof <- badgeProof pk cred (PHChat $ encodeChatBinding CBLink "other link")
+      Right otherProof <- badgeProof pk cred (PHLink "other link")
       let cLink = either error id $ strDecode (B.pack bLink)
           mc = MCChat (T.pack bLink) (MCLContact cLink (profileFromName "alice") {badge = Just otherProof} False) Nothing
       bob ##> ("/_send @3 json [{\"msgContent\":" <> T.unpack (encodeJSON mc) <> "}]")

tests/ChatTests/Utils.hs

@@ -757,6 +757,7 @@ storedBadgeHeader LocalProfile {localBadge} = case localBadge of
     headerTag = \case
       Right (PHChat b) -> 'C' : take 1 (B.unpack b)
       Right (PHRequest _) -> "R"
+      Right (PHLink _) -> "L"
       Right (PHTest _) -> "T"
       _ -> "?"