change types

src/Simplex/Chat/Badges.hs

@@ -22,6 +22,7 @@ module Simplex.Chat.Badges
     verifyBadgeSignature,
     generateBadgeProof,
     verifyBadge,
+    verifyBadge_,
     mkBadgeStatus,
     localBadgeVerified,
     srvBadgePublicKey,
@@ -203,6 +204,9 @@ verifyBadge :: BBSPublicKey -> SupporterBadge -> IO Bool
 verifyBadge pk SupporterBadge {proof, presHeader, badgeExpiry, badgeType} =
   bbsProofVerify pk proof bbsBadgeHeader presHeader bbsBadgeDisclosedIndexes bbsBadgeMessageCount (badgeDisclosedMessages badgeExpiry badgeType)
 
+verifyBadge_ :: BBSPublicKey -> Maybe SupporterBadge -> IO Bool
+verifyBadge_ = maybe (pure False) . verifyBadge
+
 localBadgeVerified :: Maybe LocalBadge -> Maybe Bool
 localBadgeVerified = fmap $ \LocalBadge {badgeStatus} -> badgeStatus /= BSFailed
 
@@ -217,19 +221,17 @@ instance FromField BadgeType where fromField = fromTextField_ textDecode
 
 instance ToField BadgeType where toField = toField . textEncode
 
-type BadgeRow = (Maybe ByteString, Maybe ByteString, Maybe UTCTime, Maybe Text, Maybe BoolInt)
+type BadgeRow = (Maybe ByteString, Maybe ByteString, Maybe UTCTime, Maybe Text, BoolInt)
 
-badgeToRow :: Maybe SupporterBadge -> Maybe Bool -> BadgeRow
-badgeToRow Nothing _ = (Nothing, Nothing, Nothing, Nothing, Nothing)
+badgeToRow :: Maybe SupporterBadge -> Bool -> BadgeRow
 badgeToRow (Just SupporterBadge {proof = BBSProof p, presHeader = BBSPresHeader ph, badgeExpiry, badgeType}) verified =
-  (Just p, Just ph, badgeExpiry, Just (textEncode badgeType), BI <$> verified)
+  (Just p, Just ph, badgeExpiry, Just (textEncode badgeType), BI verified)
+badgeToRow _ _ = (Nothing, Nothing, Nothing, Nothing, BI False)
 
 rowToBadge :: UTCTime -> BadgeRow -> Maybe LocalBadge
-rowToBadge _ (Nothing, _, _, _, _) = Nothing
-rowToBadge now (Just p, Just ph, badgeExpiry, Just btText, verified_) = do
+rowToBadge now (Just p, Just ph, badgeExpiry, Just btText, (BI verified)) = do
   bt <- textDecode btText
   let b = SupporterBadge {proof = BBSProof p, presHeader = BBSPresHeader ph, badgeExpiry, badgeType = bt}
-      verified = maybe False unBI verified_
   Just LocalBadge {badgeStatus = mkBadgeStatus now verified b, badge = b}
 rowToBadge _ _ = Nothing
 

src/Simplex/Chat/Store/Connections.hs

@@ -124,7 +124,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
           (userId, contactId, CSActive)
     toContact' :: UTCTime -> Int64 -> Connection -> [ChatTagId] -> ContactRow' -> Contact
     toContact' currentTs contactId conn chatTags ((profileId, localDisplayName, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL) :. badgeRow) =
-      let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, badge = rowToBadge currentTs badgeRow, preferences, localAlias}
+      let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localBadge = rowToBadge currentTs badgeRow, preferences, localAlias}
           chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
           mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
           activeConn = Just conn

src/Simplex/Chat/Store/ContactRequest.hs

@@ -24,7 +24,7 @@ import Control.Monad.IO.Class
 import Crypto.Random (ChaChaDRG)
 import Data.Int (Int64)
 import Data.Time.Clock (getCurrentTime)
-import Simplex.Chat.Badges (badgeToRow, srvBadgePublicKey, verifyBadge)
+import Simplex.Chat.Badges (badgeToRow, srvBadgePublicKey, verifyBadge_)
 import Simplex.Chat.Protocol (MsgContent, businessChatsVersion)
 import Simplex.Chat.Store.Direct
 import Simplex.Chat.Store.Groups
@@ -161,7 +161,7 @@ createOrUpdateContactRequest
       createContactRequest :: ExceptT StoreError IO RequestStage
       createContactRequest = do
         currentTs <- liftIO $ getCurrentTime
-        badgeVerified <- liftIO $ forM badge $ verifyBadge srvBadgePublicKey
+        badgeVerified <- liftIO $ verifyBadge_ srvBadgePublicKey badge
         let (bProof, bPresHeader, bExpiry, bType, bVerified) = badgeToRow badge badgeVerified
         ExceptT $ withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do
           liftIO $
@@ -222,8 +222,8 @@ createOrUpdateContactRequest
       updateContactRequest :: UserContactRequest -> ExceptT StoreError IO RequestStage
       updateContactRequest ucr@UserContactRequest {contactRequestId, contactId_, localDisplayName = oldLdn, profile = Profile {displayName = oldDisplayName}} = do
         currentTs <- liftIO getCurrentTime
-        badgeVerified <- liftIO $ forM badge $ verifyBadge srvBadgePublicKey
-        let badgeRow@(bProof, bPresHeader, bExpiry, bType, bVerified) = badgeToRow badge badgeVerified
+        badgeVerified <- liftIO $ verifyBadge_ srvBadgePublicKey badge
+        let badgeRow = badgeToRow badge badgeVerified
         liftIO $ updateProfile currentTs badgeRow
         updateRequest currentTs
         ucr' <- getContactRequest db user contactRequestId

src/Simplex/Chat/Store/Direct.hs

@@ -700,12 +700,12 @@ setQuotaErrCounter db User {userId} Connection {connId} counter = do
   updatedAt <- getCurrentTime
   DB.execute db "UPDATE connections SET quota_err_counter = ?, updated_at = ? WHERE user_id = ? AND connection_id = ?" (counter, updatedAt, userId, connId)
 
-updateContactProfile_ :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> IO ()
+updateContactProfile_ :: DB.Connection -> UserId -> ProfileId -> Profile -> Bool -> IO ()
 updateContactProfile_ db userId profileId profile badgeVerified = do
   currentTs <- getCurrentTime
   updateContactProfile_' db userId profileId profile badgeVerified currentTs
 
-updateContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> UTCTime -> IO ()
+updateContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> Bool -> UTCTime -> IO ()
 updateContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge} badgeVerified updatedAt = do
   let (bProof, bPresHeader, bExpiry, bType, bVerified) = badgeToRow badge badgeVerified
   DB.execute
@@ -719,12 +719,12 @@ updateContactProfile_' db userId profileId Profile {displayName, fullName, short
     ((displayName, fullName, shortDescr, image, contactLink, preferences, peerType, updatedAt) :. (bProof, bPresHeader, bExpiry, bType, bVerified) :. (userId, profileId))
 
 -- update only member profile fields (when member doesn't have associated contact - we can reset contactLink and prefs)
-updateMemberContactProfileReset_ :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> IO ()
+updateMemberContactProfileReset_ :: DB.Connection -> UserId -> ProfileId -> Profile -> Bool -> IO ()
 updateMemberContactProfileReset_ db userId profileId profile badgeVerified = do
   currentTs <- getCurrentTime
   updateMemberContactProfileReset_' db userId profileId profile badgeVerified currentTs
 
-updateMemberContactProfileReset_' :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> UTCTime -> IO ()
+updateMemberContactProfileReset_' :: DB.Connection -> UserId -> ProfileId -> Profile -> Bool -> UTCTime -> IO ()
 updateMemberContactProfileReset_' db userId profileId Profile {displayName, fullName, shortDescr, image, badge} badgeVerified updatedAt = do
   let (bProof, bPresHeader, bExpiry, bType, bVerified) = badgeToRow badge badgeVerified
   DB.execute
@@ -738,12 +738,12 @@ updateMemberContactProfileReset_' db userId profileId Profile {displayName, full
     ((displayName, fullName, shortDescr, image, updatedAt) :. (bProof, bPresHeader, bExpiry, bType, bVerified) :. (userId, profileId))
 
 -- update only member profile fields (when member has associated contact - we keep contactLink and prefs)
-updateMemberContactProfile_ :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> IO ()
+updateMemberContactProfile_ :: DB.Connection -> UserId -> ProfileId -> Profile -> Bool -> IO ()
 updateMemberContactProfile_ db userId profileId profile badgeVerified = do
   currentTs <- getCurrentTime
   updateMemberContactProfile_' db userId profileId profile badgeVerified currentTs
 
-updateMemberContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> UTCTime -> IO ()
+updateMemberContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> Bool -> UTCTime -> IO ()
 updateMemberContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, badge} badgeVerified updatedAt = do
   let (bProof, bPresHeader, bExpiry, bType, bVerified) = badgeToRow badge badgeVerified
   DB.execute
@@ -860,7 +860,7 @@ createContactFromRequest db user@User {userId, profile = LocalProfile {preferenc
         Contact
           { contactId,
             localDisplayName,
-            profile = toLocalProfile profileId profile "" currentTs Nothing,
+            profile = toLocalProfile profileId profile "" currentTs False,
             activeConn = Just conn,
             contactUsed,
             contactStatus = CSActive,

src/Simplex/Chat/Store/Groups.hs

@@ -196,7 +196,7 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (NominalDiffTime, UTCTime (..), addUTCTime, getCurrentTime)
 import Data.Text.Encoding (encodeUtf8)
-import Simplex.Chat.Badges (BadgeRow, badgeToRow, srvBadgePublicKey, verifyBadge)
+import Simplex.Chat.Badges (BadgeRow, badgeToRow, srvBadgePublicKey, verifyBadge_)
 import Simplex.Chat.Messages
 import Simplex.Chat.Operators
 import Simplex.Chat.Protocol hiding (Binary)
@@ -1727,7 +1727,7 @@ createJoiningMember
   memberStatus
   memberKey_ = do
     currentTs <- liftIO getCurrentTime
-    badgeVerified <- liftIO $ forM badge $ verifyBadge srvBadgePublicKey
+    badgeVerified <- liftIO $ verifyBadge_ srvBadgePublicKey badge
     let (bProof, bPresHeader, bExpiry, bType, bVerified) = badgeToRow badge badgeVerified
     ExceptT . withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do
       liftIO $
@@ -2091,7 +2091,7 @@ createNewGroupMember db user gInfo invitingMember memInfo@MemberInfo {profile} m
 createNewMemberProfile_ :: DB.Connection -> User -> Profile -> UTCTime -> ExceptT StoreError IO (Text, ProfileId)
 createNewMemberProfile_ db User {userId} Profile {displayName, fullName, shortDescr, image, contactLink, badge, preferences} createdAt =
   ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
-    badgeVerified <- forM badge $ verifyBadge srvBadgePublicKey
+    badgeVerified <- verifyBadge_ srvBadgePublicKey badge
     let (bProof, bPresHeader, bExpiry, bType, bVerified) = badgeToRow badge badgeVerified
     DB.execute
       db
@@ -2153,7 +2153,7 @@ createNewMember_
           invitedBy,
           invitedByGroupMemberId = memInvitedByGroupMemberId,
           localDisplayName,
-          memberProfile = toLocalProfile memberContactProfileId memberProfile "" createdAt Nothing,
+          memberProfile = toLocalProfile memberContactProfileId memberProfile "" createdAt False,
           memberContactId,
           memberContactProfileId,
           activeConn,

src/Simplex/Chat/Store/Postgres/Migrations/M20260516_supporter_badges.hs

@@ -12,7 +12,7 @@ ALTER TABLE contact_profiles ADD COLUMN badge_proof BYTEA;
 ALTER TABLE contact_profiles ADD COLUMN badge_pres_header BYTEA;
 ALTER TABLE contact_profiles ADD COLUMN badge_expiry TEXT;
 ALTER TABLE contact_profiles ADD COLUMN badge_type TEXT;
-ALTER TABLE contact_profiles ADD COLUMN badge_verified BOOLEAN;
+ALTER TABLE contact_profiles ADD COLUMN badge_verified SMALLINT NOT NULL DEFAULT ;
 |]
 
 down_m20260516_supporter_badges :: Query

src/Simplex/Chat/Store/Profiles.hs

@@ -310,9 +310,9 @@ updateUserProfile :: DB.Connection -> User -> Profile -> ExceptT StoreError IO U
 updateUserProfile db user p'
   | displayName == newName = liftIO $ do
       currentTs <- getCurrentTime
-      updateContactProfile_' db userId profileId p' Nothing currentTs
+      updateContactProfile_' db userId profileId p' False currentTs
       userMemberProfileUpdatedAt' <- updateUserMemberProfileUpdatedAt_ currentTs
-      pure user {profile = toLocalProfile profileId p' localAlias currentTs Nothing, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
+      pure user {profile = toLocalProfile profileId p' localAlias currentTs False, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
   | otherwise =
       checkConstraint SEDuplicateName . liftIO $ do
         currentTs <- getCurrentTime
@@ -322,9 +322,9 @@ updateUserProfile db user p'
           db
           "INSERT INTO display_names (local_display_name, ldn_base, user_id, created_at, updated_at) VALUES (?,?,?,?,?)"
           (newName, newName, userId, currentTs, currentTs)
-        updateContactProfile_' db userId profileId p' Nothing currentTs
+        updateContactProfile_' db userId profileId p' False currentTs
         updateContactLDN_ db user userContactId localDisplayName newName currentTs
-        pure user {localDisplayName = newName, profile = toLocalProfile profileId p' localAlias currentTs Nothing, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
+        pure user {localDisplayName = newName, profile = toLocalProfile profileId p' localAlias currentTs False, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
   where
     updateUserMemberProfileUpdatedAt_ currentTs
       | userMemberProfileChanged = do

src/Simplex/Chat/Store/SQLite/Migrations/M20260516_supporter_badges.hs

@@ -12,7 +12,7 @@ ALTER TABLE contact_profiles ADD COLUMN badge_proof BLOB;
 ALTER TABLE contact_profiles ADD COLUMN badge_pres_header BLOB;
 ALTER TABLE contact_profiles ADD COLUMN badge_expiry TEXT;
 ALTER TABLE contact_profiles ADD COLUMN badge_type TEXT;
-ALTER TABLE contact_profiles ADD COLUMN badge_verified INTEGER;
+ALTER TABLE contact_profiles ADD COLUMN badge_verified INTEGER NOT NULL DEFAULT 0;
 |]
 
 down_m20260516_supporter_badges :: Query

src/Simplex/Chat/Store/Shared.hs

@@ -32,7 +32,7 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (UTCTime (..), getCurrentTime)
 import Data.Type.Equality
-import Simplex.Chat.Badges (BadgeRow, badgeToRow, rowToBadge, srvBadgePublicKey, verifyBadge)
+import Simplex.Chat.Badges (BadgeRow, badgeToRow, rowToBadge, srvBadgePublicKey, verifyBadge_)
 import Simplex.Chat.Messages
 import Simplex.Chat.Remote.Types
 import Simplex.Chat.Types
@@ -413,9 +413,9 @@ createContact db user profile = do
   void $ createContact_ db user profile emptyChatPrefs Nothing "" currentTs
 
 createContact_ :: DB.Connection -> User -> Profile -> Preferences -> Maybe (ACreatedConnLink, Maybe SharedMsgId) -> LocalAlias -> UTCTime -> ExceptT StoreError IO ContactId
-createContact_ db User {userId} p@Profile {displayName, fullName, shortDescr, image, contactLink, peerType, badge, preferences} ctUserPreferences prepared localAlias currentTs =
+createContact_ db User {userId} Profile {displayName, fullName, shortDescr, image, contactLink, peerType, badge, preferences} ctUserPreferences prepared localAlias currentTs =
   ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
-    badgeVerified <- forM badge $ verifyBadge srvBadgePublicKey
+    badgeVerified <- verifyBadge_ srvBadgePublicKey badge
     let (bProof, bPresHeader, bExpiry, bType, bVerified) = badgeToRow badge badgeVerified
     DB.execute
       db
@@ -493,7 +493,7 @@ type ContactRow = Only ContactId :. ContactRow'
 
 toContact :: UTCTime -> VersionRangeChat -> User -> [ChatTagId] -> ContactRow :. MaybeConnectionRow -> Contact
 toContact now vr user chatTags ((Only contactId :. (profileId, localDisplayName, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL) :. badgeRow) :. connRow) =
-  let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, badge = rowToBadge now badgeRow, preferences, localAlias}
+  let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localBadge = rowToBadge now badgeRow, preferences, localAlias}
       activeConn = toMaybeConnection vr connRow
       chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
       incognito = maybe False connIncognito activeConn
@@ -554,7 +554,7 @@ toUser :: (UserId, UserId, ContactId, ProfileId, BoolInt, Int64) :. (ContactName
 toUser ((userId, auId, userContactId, profileId, BI activeUser, activeOrder) :. (displayName, fullName, shortDescr, image, contactLink, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt, uiThemes, BI userChatRelay)) =
   User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, activeOrder, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, autoAcceptMemberContacts = BoolDef autoAcceptMemberContacts, viewPwdHash, userMemberProfileUpdatedAt, uiThemes, userChatRelay = BoolDef userChatRelay}
   where
-    profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, badge = Nothing, preferences = userPreferences, localAlias = ""}
+    profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localBadge = Nothing, preferences = userPreferences, localAlias = ""}
     fullPreferences = fullPreferences' userPreferences
     viewPwdHash = UserPwdHash <$> viewPwdHash_ <*> viewPwdSalt_
 
@@ -768,7 +768,7 @@ toContactMember now vr User {userContactId} (memberRow :. connRow) =
 
 rowToLocalProfile :: UTCTime -> ProfileRow -> LocalProfile
 rowToLocalProfile now ((profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, preferences) :. badgeRow) =
-  LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, badge = rowToBadge now badgeRow, localAlias, preferences}
+  LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localBadge = rowToBadge now badgeRow, localAlias, preferences}
 
 toBusinessChatInfo :: BusinessChatInfoRow -> Maybe BusinessChatInfo
 toBusinessChatInfo (Just chatType, Just businessId, Just customerId) = Just BusinessChatInfo {chatType, businessId, customerId}

src/Simplex/Chat/Types.hs

@@ -760,7 +760,7 @@ data LocalProfile = LocalProfile
     contactLink :: Maybe ConnLinkContact,
     preferences :: Maybe Preferences,
     peerType :: Maybe ChatPeerType,
-    badge :: Maybe LocalBadge,
+    localBadge :: Maybe LocalBadge,
     localAlias :: LocalAlias
   }
   deriving (Eq, Show)
@@ -768,26 +768,23 @@ data LocalProfile = LocalProfile
 localProfileId :: LocalProfile -> ProfileId
 localProfileId LocalProfile {profileId} = profileId
 
-toLocalProfile :: ProfileId -> Profile -> LocalAlias -> UTCTime -> Maybe Bool -> LocalProfile
-toLocalProfile profileId Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge} localAlias now verified_ =
-  LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge = mkLocalBadge, localAlias}
+toLocalProfile :: ProfileId -> Profile -> LocalAlias -> UTCTime -> Bool -> LocalProfile
+toLocalProfile profileId Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge} localAlias now verified =
+  LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, preferences, peerType, localBadge, localAlias}
   where
-    mkLocalBadge = do
-      b <- badge
-      verified <- verified_
-      pure LocalBadge {badgeStatus = mkBadgeStatus now verified b, badge = b}
+    localBadge = (\b -> LocalBadge {badgeStatus = mkBadgeStatus now verified b, badge = b}) <$> badge
 
 fromLocalProfile :: LocalProfile -> Profile
-fromLocalProfile LocalProfile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge} =
-  Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge = (\LocalBadge {badge = b} -> b) <$> badge}
+fromLocalProfile LocalProfile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, localBadge} =
+  Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge = (\LocalBadge {badge} -> badge) <$> localBadge}
 
-profileBadgeVerified :: LocalProfile -> Profile -> IO (Maybe Bool)
-profileBadgeVerified LocalProfile {badge = oldBadge} Profile {badge = newBadge} =
-  case (oldBadge, newBadge) of
-    (_, Nothing) -> pure Nothing
+profileBadgeVerified :: LocalProfile -> Profile -> IO Bool
+profileBadgeVerified LocalProfile {localBadge} Profile {badge = newBadge} =
+  case (localBadge, newBadge) of
+    (_, Nothing) -> pure False
     (Just LocalBadge {badge = oldB, badgeStatus}, Just newB)
-      | oldB == newB -> pure $ Just (badgeStatus /= BSFailed)
-    (_, Just newB) -> Just <$> verifyBadge srvBadgePublicKey newB
+      | oldB == newB -> pure (badgeStatus /= BSFailed)
+    (_, Just newB) -> verifyBadge srvBadgePublicKey newB
 
 data GroupType
   = GTChannel