core, ui: make badge expiration non-optional (#7445)

* core, ui: make badge expiration non-optional

* update

* update bot types

* fix to use non-optional badge expiry

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>

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)
                 }

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
 }
 

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 = ""
 )
 

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(

bots/api/TYPES.md

@@ -399,7 +399,7 @@ BadSignature:
 
 **Record type**:
 - badgeType: [BadgeType](#badgetype)
-- badgeExpiry: UTCTime?
+- badgeExpiry: UTCTime
 - badgeExtra: string
 
 

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
 }
 

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):

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

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

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]

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

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 ()

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 <name> 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

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