diff --git a/apps/ios/Shared/Views/Helpers/NameBadge.swift b/apps/ios/Shared/Views/Helpers/NameBadge.swift index 67f6d6d6b2..5a48e495a2 100644 --- a/apps/ios/Shared/Views/Helpers/NameBadge.swift +++ b/apps/ios/Shared/Views/Helpers/NameBadge.swift @@ -162,8 +162,8 @@ func showBadgeInfoAlert(_ name: String, _ badge: LocalBadge) { } else { // supporter, legend and unknown types use the supporter wording let supports = - if badge.status == .expired, let expiry = badge.badge.badgeExpiry { - String.localizedStringWithFormat(NSLocalizedString("%1$@ supported SimpleX Chat. The badge expired on %2$@.", comment: "badge alert"), name, expiry.formatted(date: .abbreviated, time: .omitted)) + if badge.status == .expired { + String.localizedStringWithFormat(NSLocalizedString("%1$@ supported SimpleX Chat. The badge expired on %2$@.", comment: "badge alert"), name, badge.badge.badgeExpiry.formatted(date: .abbreviated, time: .omitted)) } else { String.localizedStringWithFormat(NSLocalizedString("%@ supports SimpleX Chat.", comment: "badge alert"), name) } diff --git a/apps/ios/SimpleXChat/ChatTypes.swift b/apps/ios/SimpleXChat/ChatTypes.swift index 8f93ed8033..dee7ea6b32 100644 --- a/apps/ios/SimpleXChat/ChatTypes.swift +++ b/apps/ios/SimpleXChat/ChatTypes.swift @@ -302,7 +302,7 @@ public enum BadgeStatus: String, Codable { public struct BadgeInfo: Codable, Hashable { public var badgeType: BadgeType - public var badgeExpiry: Date? + public var badgeExpiry: Date public var badgeExtra: String } diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt index 64f74b6ba7..3ba5bcf6ad 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt @@ -2182,7 +2182,7 @@ enum class BadgeStatus { @Serializable data class BadgeInfo( val badgeType: BadgeType, - val badgeExpiry: Instant? = null, + val badgeExpiry: Instant, val badgeExtra: String = "" ) diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/ChatInfoImage.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/ChatInfoImage.kt index d2ee1db09c..31a6be5500 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/ChatInfoImage.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/ChatInfoImage.kt @@ -231,10 +231,9 @@ fun showBadgeInfoAlert(name: String, badge: LocalBadge, uriHandler: UriHandler) ) else -> { // Supporter, Legend and unknown types use the supporter wording - val expiry = badge.badge.badgeExpiry val supports = - if (badge.status == BadgeStatus.Expired && expiry != null) - String.format(generalGetString(MR.strings.badge_supported_simplex), name, localDate(expiry)) + if (badge.status == BadgeStatus.Expired) + String.format(generalGetString(MR.strings.badge_supported_simplex), name, localDate(badge.badge.badgeExpiry)) else String.format(generalGetString(MR.strings.badge_supports_simplex), name) AlertManager.shared.showAlertMsg( diff --git a/bots/api/TYPES.md b/bots/api/TYPES.md index 41c77b3bd2..203e790f1e 100644 --- a/bots/api/TYPES.md +++ b/bots/api/TYPES.md @@ -399,7 +399,7 @@ BadSignature: **Record type**: - badgeType: [BadgeType](#badgetype) -- badgeExpiry: UTCTime? +- badgeExpiry: UTCTime - badgeExtra: string diff --git a/packages/simplex-chat-client/types/typescript/src/types.ts b/packages/simplex-chat-client/types/typescript/src/types.ts index 73fa758ca3..09c88069e2 100644 --- a/packages/simplex-chat-client/types/typescript/src/types.ts +++ b/packages/simplex-chat-client/types/typescript/src/types.ts @@ -230,7 +230,7 @@ export interface AutoAccept { export interface BadgeInfo { badgeType: BadgeType - badgeExpiry?: string // ISO-8601 timestamp + badgeExpiry: string // ISO-8601 timestamp badgeExtra: string } diff --git a/packages/simplex-chat-python/src/simplex_chat/types/_types.py b/packages/simplex-chat-python/src/simplex_chat/types/_types.py index 22ac2cc200..25206c8654 100644 --- a/packages/simplex-chat-python/src/simplex_chat/types/_types.py +++ b/packages/simplex-chat-python/src/simplex_chat/types/_types.py @@ -170,7 +170,7 @@ class AutoAccept(TypedDict): class BadgeInfo(TypedDict): badgeType: "BadgeType" - badgeExpiry: NotRequired[str] # ISO-8601 timestamp + badgeExpiry: str # ISO-8601 timestamp badgeExtra: str class BadgeProof(TypedDict): diff --git a/src/Simplex/Chat/Badges.hs b/src/Simplex/Chat/Badges.hs index 4fa0ad8314..e926d34d0a 100644 --- a/src/Simplex/Chat/Badges.hs +++ b/src/Simplex/Chat/Badges.hs @@ -118,26 +118,29 @@ data BadgeStatus = BSActive | BSExpired | BSExpiredOld | BSFailed | BSUnknownKey data BadgeInfo = BadgeInfo { badgeType :: BadgeType, - badgeExpiry :: Maybe UTCTime, + badgeExpiry :: UTCTime, badgeExtra :: Text } deriving (Eq, Show) +-- a badge stays active for this long after its expiry, to allow for a delayed renewal +badgeGraceInterval :: NominalDiffTime +badgeGraceInterval = 7 * nominalDay + -- a badge expired longer than this ago is BSExpiredOld and is not shown in the UI badgeOldInterval :: NominalDiffTime -badgeOldInterval = 31 * nominalDay +badgeOldInterval = badgeGraceInterval + 31 * nominalDay -- the verification outcome of a received proof: Just True = verified, Just False = failed, -- Nothing = the proof's key index is not among this app version's configured keys (BSUnknownKey). mkBadgeStatus :: UTCTime -> Maybe Bool -> BadgeInfo -> BadgeStatus -mkBadgeStatus now verified BadgeInfo {badgeExpiry} = case verified of +mkBadgeStatus now verified BadgeInfo {badgeExpiry = e} = case verified of Nothing -> BSUnknownKey Just False -> BSFailed - Just True -> case badgeExpiry of - Just e - | addUTCTime badgeOldInterval e < now -> BSExpiredOld - | e < now -> BSExpired - _ -> BSActive + Just True + | addUTCTime badgeOldInterval e < now -> BSExpiredOld + | addUTCTime badgeGraceInterval e < now -> BSExpired + | otherwise -> BSActive -- A badge credential (own, secret) and a proof (a presentation) are independent records. -- badgeKeyIdx is the issuer key index: it tells verifiers which configured key to use. @@ -192,7 +195,7 @@ maxFileSizeLegend = gb 5 badgeServerCredential :: Maybe LocalBadge -> Maybe EntitlementCredential badgeServerCredential = \case Just (OwnBadge (BadgeCredential idx (BadgeMasterKey mk) sig BadgeInfo {badgeType, badgeExpiry, badgeExtra}) _) -> - (\e -> EntitlementCredential (fromIntegral idx) (MasterKey mk) (Entitlement e (textEncode badgeType) badgeExtra) sig) <$> badgeExpiry + Just $ EntitlementCredential (fromIntegral idx) (MasterKey mk) (Entitlement badgeExpiry (textEncode badgeType) badgeExtra) sig _ -> Nothing maxXFTPFileSize :: Maybe LocalBadge -> Int64 @@ -287,15 +290,12 @@ bbsBadgeDisclosedIndexes = [1, 2, 3] -- Message encoding -encodeExpiry :: Maybe UTCTime -> ByteString -encodeExpiry = maybe "lifetime" strEncode - badgeMessages :: BadgeMasterKey -> BadgeInfo -> [ByteString] badgeMessages (BadgeMasterKey ms) info = ms : badgeInfoMessages info badgeInfoMessages :: BadgeInfo -> [ByteString] badgeInfoMessages BadgeInfo {badgeType, badgeExpiry, badgeExtra} = - [encodeExpiry badgeExpiry, encodeUtf8 (textEncode badgeType), encodeUtf8 badgeExtra] + [strEncode badgeExpiry, encodeUtf8 (textEncode badgeType), encodeUtf8 badgeExtra] -- Payment verification (stub - always passes) @@ -364,11 +364,11 @@ badgeToRow badge verified = localBadgeToRow $ (`PeerBadge` st) <$> badge localBadgeToRow :: Maybe LocalBadge -> BadgeRow localBadgeToRow (Just lb) = case lb of OwnBadge (BadgeCredential idx (BadgeMasterKey mk) (BBSSignature sg) BadgeInfo {badgeType, badgeExpiry, badgeExtra}) st -> - (Nothing, Nothing, badgeExpiry, Just (textEncode badgeType), verifiedField st, Just badgeExtra, Just (Binary mk), Just (Binary sg), Just idx) + (Nothing, Nothing, Just badgeExpiry, Just (textEncode badgeType), verifiedField st, Just badgeExtra, Just (Binary mk), Just (Binary sg), Just idx) PeerBadge (BadgeProof idx (BBSPresHeader ph) (BBSProof p) BadgeInfo {badgeType, badgeExpiry, badgeExtra}) st -> - (Just (Binary p), Just (Binary ph), badgeExpiry, Just (textEncode badgeType), verifiedField st, Just badgeExtra, Nothing, Nothing, Just idx) + (Just (Binary p), Just (Binary ph), Just badgeExpiry, Just (textEncode badgeType), verifiedField st, Just badgeExtra, Nothing, Nothing, Just idx) ShownBadge BadgeInfo {badgeType, badgeExpiry, badgeExtra} st -> - (Nothing, Nothing, badgeExpiry, Just (textEncode badgeType), verifiedField st, Just badgeExtra, Nothing, Nothing, Nothing) + (Nothing, Nothing, Just badgeExpiry, Just (textEncode badgeType), verifiedField st, Just badgeExtra, Nothing, Nothing, Nothing) where verifiedField st = case st of BSFailed -> Just (BI False) @@ -377,9 +377,10 @@ localBadgeToRow (Just lb) = case lb of localBadgeToRow Nothing = (Nothing, Nothing, Nothing, Nothing, Just (BI False), Nothing, Nothing, Nothing, Nothing) rowToBadge :: UTCTime -> BadgeRow -> Maybe LocalBadge -rowToBadge now (p_, ph_, badgeExpiry, type_, verified_, extra_, mk_, sg_, idx_) = do +rowToBadge now (p_, ph_, expiry_, type_, verified_, extra_, mk_, sg_, idx_) = do btText <- type_ bt <- textDecode btText + badgeExpiry <- expiry_ let info = BadgeInfo {badgeType = bt, badgeExpiry, badgeExtra = maybe "" id extra_} -- NULL badge_verified means the key index was unknown when stored (Nothing) st = mkBadgeStatus now (unBI <$> verified_) info diff --git a/src/Simplex/Chat/Badges/CLI.hs b/src/Simplex/Chat/Badges/CLI.hs index 8a7cd84b61..af6d6ecc7e 100644 --- a/src/Simplex/Chat/Badges/CLI.hs +++ b/src/Simplex/Chat/Badges/CLI.hs @@ -28,7 +28,7 @@ bbsSecretLen = 32 data BadgeCommand = Keygen | MasterKey - | Sign Int BBSSecretKey BadgeMasterKey BadgeType (Maybe UTCTime) + | Sign Int BBSSecretKey BadgeMasterKey BadgeType UTCTime runBadgeCommand :: [String] -> IO () runBadgeCommand args = @@ -53,16 +53,14 @@ badgeCommandP = <*> option (eitherReader secretR) (long "secret" <> metavar "ISSUER_SECRET" <> help "issuer secret from keygen (base64url)") <*> option (eitherReader (strDecode . B.pack)) (long "master" <> metavar "MASTER" <> help "user master secret from master-key (base64url)") <*> option (eitherReader badgeTypeR) (long "type" <> metavar "TYPE" <> help "badge type (supporter, legend, investor)") - <*> option (eitherReader expireR) (long "expire" <> metavar "lifetime|YYYY-MM-DD" <> help "expiry date, or 'lifetime'") + <*> option (eitherReader expireR) (long "expire" <> metavar "YYYY-MM-DD" <> help "expiry date") secretR s = do sk@(BBSSecretKey b) <- strDecode (B.pack s) if B.length b == bbsSecretLen then Right sk else Left "bad issuer secret - use the 'secret' value from keygen" badgeTypeR = maybe (Left "invalid badge type") Right . textDecode . T.pack - expireR = \case - "lifetime" -> Right Nothing - s -> maybe (Left "use 'lifetime' or YYYY-MM-DD") (Right . Just) $ parseTimeM True defaultTimeLocale "%Y-%m-%d" s + expireR s = maybe (Left "use YYYY-MM-DD") Right $ parseTimeM True defaultTimeLocale "%Y-%m-%d" s keygen :: IO () keygen = @@ -78,7 +76,7 @@ genMasterKey = do mk <- generateMasterKey drg B.putStrLn $ strEncode mk -sign :: Int -> BBSSecretKey -> BadgeMasterKey -> BadgeType -> Maybe UTCTime -> IO () +sign :: Int -> BBSSecretKey -> BadgeMasterKey -> BadgeType -> UTCTime -> IO () sign keyIdx secretKey masterKey badgeType badgeExpiry = do let req = VerifiedBadgeRequest (BadgeRequest {masterKey, badgeInfo = BadgeInfo {badgeType, badgeExpiry, badgeExtra = ""}} :: BadgeRequest) issueBadge keyIdx secretKey req >>= \case diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 6731b62fd6..650157145b 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -1827,7 +1827,7 @@ viewContactBadge = maybe [] $ \lb -> BSExpiredOld -> "expired (old)" BSFailed -> "verification failed" BSUnknownKey -> "unknown key" - expiry = maybe "no expiry" (("expires " <>) . T.pack . formatTime defaultTimeLocale "%Y-%m-%d") badgeExpiry + expiry = "expires " <> T.pack (formatTime defaultTimeLocale "%Y-%m-%d" badgeExpiry) in [plain (textEncode badgeType <> " badge - " <> st), plain expiry] viewContactInfo :: Contact -> Maybe ConnectionStats -> Maybe Profile -> [StyledString] diff --git a/tests/BadgeTests.hs b/tests/BadgeTests.hs index 90e3e9ae7a..19ebd2818e 100644 --- a/tests/BadgeTests.hs +++ b/tests/BadgeTests.hs @@ -24,16 +24,12 @@ badgeTests = do it "should reject badge with wrong server key" testWrongKey it "should report a key index missing from configured keys" testUnknownKeyIdx it "should compute badge status correctly" testExpiryCheck - it "should treat lifetime badges as always active" testLifetimeBadge it "should accept unknown badge types" testUnknownBadgeType it "credential serializes to a paste-able token and back" testCredentialSerialization proofOf :: BadgeProof -> BBSProof proofOf (BadgeProof _ _ p _) = p -proofInfo :: BadgeProof -> BadgeInfo -proofInfo (BadgeProof _ _ _ i) = i - testKeyIdx :: Int testKeyIdx = 1 @@ -45,7 +41,7 @@ testFullWorkflow = do Right (pk, sk) <- bbsKeyGen drg <- C.newRandom mk <- generateMasterKey drg - let req = BadgeRequest {masterKey = mk, badgeInfo = BadgeInfo {badgeType = BTSupporter, badgeExpiry = Just futureTime, badgeExtra = ""}} + let req = BadgeRequest {masterKey = mk, badgeInfo = BadgeInfo {badgeType = BTSupporter, badgeExpiry = futureTime, badgeExtra = ""}} Just vreq <- verifyPayment (BPRedeemCode "TEST") req Right cred <- issueBadge testKeyIdx sk vreq let BadgeCredential idx mk' _ _ = cred @@ -63,23 +59,23 @@ testFullWorkflow = do testTamperedType :: IO () testTamperedType = do - (pk, BadgeProof idx ph p info) <- issueBadgeProof BTSupporter (Just futureTime) + (pk, BadgeProof idx ph p info) <- issueBadgeProof BTSupporter futureTime verifyBadge (keysFor pk) (BadgeProof idx ph p info {badgeType = BTLegend}) >>= (`shouldBe` Just False) testTamperedExpiry :: IO () testTamperedExpiry = do - (pk, BadgeProof idx ph p info) <- issueBadgeProof BTSupporter (Just futureTime) - verifyBadge (keysFor pk) (BadgeProof idx ph p info {badgeExpiry = Just pastTime}) >>= (`shouldBe` Just False) + (pk, BadgeProof idx ph p info) <- issueBadgeProof BTSupporter futureTime + verifyBadge (keysFor pk) (BadgeProof idx ph p info {badgeExpiry = pastTime}) >>= (`shouldBe` Just False) testWrongKey :: IO () testWrongKey = do - (_, badge) <- issueBadgeProof BTSupporter (Just futureTime) + (_, badge) <- issueBadgeProof BTSupporter futureTime Right (pk2, _) <- bbsKeyGen verifyBadge (keysFor pk2) badge >>= (`shouldBe` Just False) testUnknownKeyIdx :: IO () testUnknownKeyIdx = do - (pk, badge) <- issueBadgeProof BTSupporter (Just futureTime) + (pk, badge) <- issueBadgeProof BTSupporter futureTime -- a key index not in the configured keys cannot be verified at all (Nothing) verifyBadge (M.singleton (testKeyIdx + 1) pk) badge >>= (`shouldBe` Nothing) @@ -87,23 +83,23 @@ testExpiryCheck :: IO () testExpiryCheck = do now <- getCurrentTime let info expiry = BadgeInfo {badgeType = BTSupporter, badgeExpiry = expiry, badgeExtra = ""} - futureInfo = info (Just futureTime) + futureInfo = info futureTime + expiredAgo d = info $ addUTCTime (- (d * nominalDay)) now mkBadgeStatus now (Just True) futureInfo `shouldBe` BSActive - mkBadgeStatus now (Just True) (info (Just (addUTCTime (-nominalDay) now))) `shouldBe` BSExpired - mkBadgeStatus now (Just True) (info (Just pastTime)) `shouldBe` BSExpiredOld + -- the badge stays active for a week after its expiry + mkBadgeStatus now (Just True) (expiredAgo 1) `shouldBe` BSActive + mkBadgeStatus now (Just True) (expiredAgo 6) `shouldBe` BSActive + -- then it is shown as expired for 31 days + mkBadgeStatus now (Just True) (expiredAgo 8) `shouldBe` BSExpired + mkBadgeStatus now (Just True) (expiredAgo 37) `shouldBe` BSExpired + mkBadgeStatus now (Just True) (expiredAgo 39) `shouldBe` BSExpiredOld + mkBadgeStatus now (Just True) (info pastTime) `shouldBe` BSExpiredOld mkBadgeStatus now (Just False) futureInfo `shouldBe` BSFailed mkBadgeStatus now Nothing futureInfo `shouldBe` BSUnknownKey -testLifetimeBadge :: IO () -testLifetimeBadge = do - now <- getCurrentTime - (pk, badge) <- issueBadgeProof BTInvestor Nothing - verifyBadge (keysFor pk) badge >>= (`shouldBe` Just True) - mkBadgeStatus now (Just True) (proofInfo badge) `shouldBe` BSActive - testUnknownBadgeType :: IO () testUnknownBadgeType = do - (pk, badge) <- issueBadgeProof (BTUnknown "future_type") (Just futureTime) + (pk, badge) <- issueBadgeProof (BTUnknown "future_type") futureTime verifyBadge (keysFor pk) badge >>= (`shouldBe` Just True) testCredentialSerialization :: IO () @@ -114,10 +110,8 @@ testCredentialSerialization = do let mkCred expiry = do Right cred <- issueBadge testKeyIdx sk (VerifiedBadgeRequest BadgeRequest {masterKey = mk, badgeInfo = BadgeInfo {badgeType = BTSupporter, badgeExpiry = expiry, badgeExtra = ""}}) pure cred - dated <- mkCred (Just futureTime) - lifetime <- mkCred Nothing + dated <- mkCred futureTime J.eitherDecode (J.encode dated) `shouldBe` Right dated - J.eitherDecode (J.encode lifetime) `shouldBe` Right lifetime -- a decoded credential still verifies against the issuing key case J.eitherDecode (J.encode dated) of Right cred -> verifyCredential pk cred >>= (`shouldBe` True) @@ -131,7 +125,7 @@ futureTime = posixSecondsToUTCTime 4102444800 -- 2099-12-31 pastTime :: UTCTime pastTime = posixSecondsToUTCTime 1577836800 -- 2020-01-01 -issueBadgeProof :: BadgeType -> Maybe UTCTime -> IO (BBSPublicKey, BadgeProof) +issueBadgeProof :: BadgeType -> UTCTime -> IO (BBSPublicKey, BadgeProof) issueBadgeProof bt expiry = do Right (pk, sk) <- bbsKeyGen drg <- C.newRandom diff --git a/tests/ChatTests/ChatRelays.hs b/tests/ChatTests/ChatRelays.hs index 5d1abcfe21..a30546ed91 100644 --- a/tests/ChatTests/ChatRelays.hs +++ b/tests/ChatTests/ChatRelays.hs @@ -8,7 +8,7 @@ module ChatTests.ChatRelays where import ChatClient import ChatTests.DBUtils import ChatTests.Groups (memberJoinChannel, memberJoinChannel', prepareChannel, prepareChannel', prepareChannel1Relay, setupRelay) -import ChatTests.Profiles (addTestBadge, issueTestBadge, testBadgeKeys) +import ChatTests.Profiles (addTestBadge, futureDate, issueTestBadge, testBadgeKeys) import ChatTests.Utils import Control.Concurrent (threadDelay) import qualified Data.Aeson as J @@ -67,8 +67,8 @@ testChannelMemberBadges ps = do withNewTestChatCfgOpts ps cfg testOpts "alice" aliceProfile $ \alice -> withNewTestChatCfgOpts ps cfg relayTestOpts "bob" bobProfile $ \bob -> withNewTestChatCfgOpts ps cfg testOpts "cath" cathProfile $ \cath -> do - addTestBadge alice =<< issueTestBadge sk Nothing - addTestBadge cath =<< issueTestBadge sk Nothing + addTestBadge alice =<< issueTestBadge sk futureDate + addTestBadge cath =<< issueTestBadge sk futureDate (shortLink, fullLink) <- prepareChannel1Relay "team" alice bob memberJoinChannel "team" [bob] [alice] shortLink fullLink cath -- a channel message lets the relay-forwarded member profiles settle on both sides @@ -81,13 +81,13 @@ testChannelMemberBadges ps = do alice <## "group ID: 1" alice <##. "member ID: " alice <## "supporter badge - active" - alice <## "no expiry" + alice <## "expires 2100-01-01" alice <## "member not connected" cath ##> "/i #team alice" cath <## "group ID: 1" cath <##. "member ID: " cath <## "supporter badge - active" - cath <## "no expiry" + cath <## "expires 2100-01-01" cath <## "member not connected" testGetSetChatRelays :: HasCallStack => TestParams -> IO () diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index ce62b300e4..efe2097504 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -276,8 +276,11 @@ testMemberDescriptionRedacted = testBadgeKeys :: BBSPublicKey -> M.Map Int BBSPublicKey testBadgeKeys = M.singleton 1 +futureDate :: UTCTime +futureDate = posixSecondsToUTCTime 4102444800 -- 2100-01-01 + -- issue a supporter badge credential with the given expiry (test issuer) -issueTestBadge :: BBSSecretKey -> Maybe UTCTime -> IO BadgeCredential +issueTestBadge :: BBSSecretKey -> UTCTime -> IO BadgeCredential issueTestBadge sk badgeExpiry = do drg <- C.newRandom mk <- generateMasterKey drg @@ -299,7 +302,7 @@ testUserBadgeBroadcast ps = do where test sk alice bob = do connectUsers alice bob - addTestBadge alice =<< issueTestBadge sk Nothing + addTestBadge alice =<< issueTestBadge sk futureDate -- own badge is shown (add succeeded) alice ##> "/p" alice <## "user profile: alice (Alice, * supporter)" @@ -314,7 +317,7 @@ testUserBadgeOnConnect ps = do testChatCfg2 (testCfg {badgePublicKeys = testBadgeKeys pk}) aliceProfile bobProfile (test sk) ps where test sk alice bob = do - addTestBadge alice =<< issueTestBadge sk Nothing + addTestBadge alice =<< issueTestBadge sk futureDate -- a contact connecting after the badge is attached receives it in the connection handshake alice ##> "/c" inv <- getInvitation alice @@ -326,7 +329,7 @@ testUserBadgeOnConnect ps = do bob ##> "/i alice" bob <## "contact ID: 2" bob <## "supporter badge - active" - bob <## "no expiry" + bob <## "expires 2100-01-01" bob <## "receiving messages via: localhost" bob <## "sending messages via: localhost" bob <## "you've shared main profile with this contact" @@ -340,7 +343,7 @@ testUserBadgeGroupLink ps = do testChatCfg2 (testCfg {badgePublicKeys = testBadgeKeys pk}) aliceProfile bobProfile (test sk) ps where test sk alice bob = do - addTestBadge alice =<< issueTestBadge sk Nothing + addTestBadge alice =<< issueTestBadge sk futureDate alice ##> "/g team" alice <## "group #team is created" alice <## "to add members use /a team or /create link #team" @@ -364,7 +367,7 @@ testUserBadgeGroupLink ps = do bob <## "group ID: 1" bob <##. "member ID: " bob <## "supporter badge - active" - bob <## "no expiry" + bob <## "expires 2100-01-01" bob <## "receiving messages via: localhost" bob <## "sending messages via: localhost" bob <## "connection not verified, use /code command to see security code" @@ -376,7 +379,7 @@ testUserBadgeContactAddress ps = do testChatCfg2 (testCfg {badgePublicKeys = testBadgeKeys pk}) aliceProfile bobProfile (test sk) ps where test sk alice bob = do - addTestBadge alice =<< issueTestBadge sk Nothing + addTestBadge alice =<< issueTestBadge sk futureDate alice ##> "/ad" (shortLink, cLink) <- getContactLinks alice True -- the address link data carries the badge proof; the connect plan returns it verified, without crypto @@ -396,7 +399,7 @@ testUserBadgeContactAddress ps = do bob ##> "/i alice" bob <## "contact ID: 2" bob <## "supporter badge - active" - bob <## "no expiry" + bob <## "expires 2100-01-01" bob <## "receiving messages via: localhost" bob <## "sending messages via: localhost" bob <## "you've shared main profile with this contact" @@ -407,12 +410,12 @@ testUserBadgeContactAddress ps = do testUserBadgeExpired :: HasCallStack => TestParams -> IO () testUserBadgeExpired ps = do Right (pk, sk) <- bbsKeyGen - -- expired recently (within 31 days), so the badge is still presented and shown as expired - expiry <- addUTCTime (-2 * nominalDay) <$> getCurrentTime + -- expired past the grace period but within the old interval, so the badge is still presented and shown as expired + expiry <- addUTCTime (-10 * nominalDay) <$> getCurrentTime testChatCfg2 (testCfg {badgePublicKeys = testBadgeKeys pk}) aliceProfile bobProfile (test sk expiry) ps where test sk expiry alice bob = do - addTestBadge alice =<< issueTestBadge sk (Just expiry) + addTestBadge alice =<< issueTestBadge sk expiry -- expired badge: no star alice ##> "/p" alice <## "user profile: alice (Alice)" @@ -435,7 +438,7 @@ testUserBadgeExpiredOld ps = do testChatCfg2 (testCfg {badgePublicKeys = testBadgeKeys pk}) aliceProfile bobProfile (test sk) ps where test sk alice bob = do - addTestBadge alice =<< issueTestBadge sk (Just pastDate) + addTestBadge alice =<< issueTestBadge sk pastDate -- a badge that expired over a month ago is not presented to contacts at all connectUsers alice bob bob ##> "/i alice" @@ -454,7 +457,7 @@ testUserBadgeIncognito ps = do testChatCfg2 (testCfg {badgePublicKeys = testBadgeKeys pk}) aliceProfile bobProfile (test sk) ps where test sk alice bob = do - addTestBadge alice =<< issueTestBadge sk Nothing + addTestBadge alice =<< issueTestBadge sk futureDate -- an incognito identity must not carry the badge bob ##> "/connect" inv <- getInvitation bob diff --git a/tests/MobileTests.hs b/tests/MobileTests.hs index 4e3ddbc0fa..e6aecfd295 100644 --- a/tests/MobileTests.hs +++ b/tests/MobileTests.hs @@ -322,7 +322,8 @@ testBadgeKeygenIssueCApi _ = do g <- C.newRandom IssuerKeyPair {publicKey, secretKey} <- ffiResult =<< (peekCString =<< cChatBadgeKeygen) mk <- generateMasterKey g - let req = BadgeIssueReq {badgeKeyIdx = 1, secretKey, request = BadgeRequest {masterKey = mk, badgeInfo = BadgeInfo {badgeType = BTSupporter, badgeExpiry = Nothing, badgeExtra = ""}}} + badgeExpiry <- getCurrentTime + let req = BadgeIssueReq {badgeKeyIdx = 1, secretKey, request = BadgeRequest {masterKey = mk, badgeInfo = BadgeInfo {badgeType = BTSupporter, badgeExpiry, badgeExtra = ""}}} cred <- ffiResult =<< (peekCString =<< cChatBadgeIssue =<< newCString (LB.unpack (J.encode req))) verifyCredential publicKey cred `shouldReturn` True