store: merge name link profiles

# Conflicts:
#	apps/simplex-store-service/src/StoreService/Names/Env.hs
#	simplex-chat.cabal
#	tests/Test.hs

apps/simplex-store-service/src/StoreService/Names/Env.hs

@@ -8,6 +8,7 @@ import Simplex.Messaging.Agent.Store.Common (DBStore)
 import StoreService.Config (NamesConfig (..))
 import StoreService.Names.Chain (ChainClient, newChainClient)
 import StoreService.Names.Phases (Phases, newPhases)
+import StoreService.Names.Profiles (Profiles, chatProfile, defaultProfileLimits, monotonicSeconds, newProfiles, systemResolver)
 import StoreService.Names.Turns (Turns, newTurns)
 
 data NamesEnv = NamesEnv
@@ -17,7 +18,8 @@ data NamesEnv = NamesEnv
     neStore :: DBStore,
     nePhases :: Phases,
     neTurns :: Turns,
-    neChain :: ChainClient
+    neChain :: ChainClient,
+    neProfiles :: Profiles
   }
 
 newNamesEnv :: ChatController -> UserId -> NamesConfig -> DBStore -> IO NamesEnv
@@ -25,4 +27,5 @@ newNamesEnv neChat@ChatController {random} neUserId neConfig@NamesConfig {nChain
   nePhases <- newPhases
   neTurns <- newTurns
   neChain <- newChainClient random nChain
-  pure NamesEnv {neChat, neUserId, neConfig, neStore, nePhases, neTurns, neChain}
+  neProfiles <- newProfiles defaultProfileLimits monotonicSeconds (chatProfile neChat neUserId) systemResolver
+  pure NamesEnv {neChat, neUserId, neConfig, neStore, nePhases, neTurns, neChain, neProfiles}

apps/simplex-store-service/src/StoreService/Names/Profiles.hs

@@ -0,0 +1,334 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | The host rule is best effort: the chat core resolves a host again when it connects, so the deployment's egress rule is the real guard.
+module StoreService.Names.Profiles
+  ( Profiles,
+    ProfileLimits (..),
+    ProfileFetcher,
+    HostResolver,
+    EntityType (..),
+    ChatKind (..),
+    LinkProfile (..),
+    ProfileRead (..),
+    Preview (..),
+    Entity (..),
+    defaultProfileLimits,
+    newProfiles,
+    monotonicSeconds,
+    chatProfile,
+    systemResolver,
+    planProfile,
+    hostsFetchable,
+    linkEntity,
+    linkPreview,
+  )
+where
+
+import Control.Concurrent (forkFinally)
+import Control.Concurrent.STM
+import Control.Exception (bracket_)
+import Data.Aeson ((.=))
+import qualified Data.Aeson as J
+import qualified Data.Aeson.Types as JT
+import Data.Bits (shiftL, shiftR, (.|.))
+import Data.Char (toLower)
+import Data.Int (Int64)
+import Data.List (dropWhileEnd, isSuffixOf)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import Data.Maybe (fromMaybe, mapMaybe)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
+import Data.Word (Word32, Word64, Word8)
+import GHC.Clock (getMonotonicTimeNSec)
+import Network.Socket (AddrInfo (..), HostName, SockAddr (..), SocketType (..), defaultHints, getAddrInfo, hostAddressToTuple)
+import Simplex.Chat.Controller (ChatResponse (..), ChatCommand (APIConnectPlan), ChatController, ConnectionPlan (..), ContactAddressPlan (..), GroupLinkPlan (..), PlanResolveMode (..))
+import Simplex.Chat.Core (sendChatCmd)
+import Simplex.Chat.Protocol (ContactShortLinkData (..), GroupShortLinkData (..), PublicGroupData (..))
+import Simplex.Chat.Types (AConnectTarget (..), ChatPeerType (..), Contact (..), ContactNameOrLink (..), ConnectTarget (..), GroupInfo (..), GroupProfile (..), GroupSummary (..), ImageData (..), Profile (..), User (..), fromLocalProfile)
+import Simplex.Messaging.Agent.Protocol (ConnShortLink, ConnectionMode (..), SConnectionMode (..), UserId, simplexShortLink)
+import Simplex.Messaging.Encoding.String (strDecode, strEncode)
+import Simplex.Messaging.Transport.Client (TransportHost (..))
+import Simplex.Messaging.Util (anyM, safeDecodeUtf8)
+import System.Timeout (timeout)
+
+data ProfileLimits = ProfileLimits
+  { searchFetchSlots :: Int,
+    previewFetchSlots :: Int,
+    -- | Microseconds for one fetch, the wait for its slot and its host check included.
+    fetchTimeout :: Int,
+    cacheSeconds :: Word64,
+    maxCachedProfiles :: Int
+  }
+
+defaultProfileLimits :: ProfileLimits
+defaultProfileLimits =
+  ProfileLimits
+    { searchFetchSlots = 4,
+      previewFetchSlots = 2,
+      fetchTimeout = 3000000,
+      cacheSeconds = 600,
+      maxCachedProfiles = 2048
+    }
+
+-- | Nothing when the link data could not be read.
+type ProfileFetcher = ConnShortLink 'CMContact -> IO (Maybe LinkProfile)
+
+-- | The addresses a name resolves to, none when it does not resolve.
+type HostResolver = HostName -> IO [TransportHost]
+
+data Profiles = Profiles
+  { limits :: ProfileLimits,
+    clock :: IO Word64,
+    fetchLink :: ProfileFetcher,
+    resolveHost :: HostResolver,
+    searchSlots :: TVar Int,
+    previewSlots :: TVar Int,
+    cache :: TVar (Map Text (Word64, LinkProfile))
+  }
+
+newProfiles :: ProfileLimits -> IO Word64 -> ProfileFetcher -> HostResolver -> IO Profiles
+newProfiles limits@ProfileLimits {searchFetchSlots, previewFetchSlots} clock fetchLink resolveHost = do
+  searchSlots <- newTVarIO searchFetchSlots
+  previewSlots <- newTVarIO previewFetchSlots
+  cache <- newTVarIO Map.empty
+  pure Profiles {limits, clock, fetchLink, resolveHost, searchSlots, previewSlots, cache}
+
+monotonicSeconds :: IO Word64
+monotonicSeconds = (`div` 1000000000) <$> getMonotonicTimeNSec
+
+-- | The record a link came from: @simplex.contact@ or @simplex.channel@.
+data EntityType = ETAddress | ETChannel
+  deriving (Eq, Show)
+
+data ChatKind = CKContact | CKBusiness | CKBot | CKChannel
+  deriving (Eq, Show)
+
+data LinkProfile = LinkProfile
+  { kind :: ChatKind,
+    displayName :: Text,
+    fullName :: Text,
+    image :: Maybe Text,
+    subscribers :: Maybe Int64
+  }
+  deriving (Eq, Show)
+
+data ProfileRead = ProfileOk LinkProfile | ProfileUnread | ProfileUnavailable
+  deriving (Eq, Show)
+
+data Preview = Preview {previewType :: EntityType, previewProfile :: ProfileRead}
+  deriving (Eq, Show)
+
+data Entity = Entity {entityPreview :: Preview, link :: Text, deepLink :: Text}
+  deriving (Eq, Show)
+
+instance J.ToJSON Preview where
+  toJSON = J.object . previewPairs
+
+instance J.ToJSON Entity where
+  toJSON Entity {entityPreview, link, deepLink} = J.object $ previewPairs entityPreview <> ["link" .= link, "deepLink" .= deepLink]
+
+previewPairs :: Preview -> [JT.Pair]
+previewPairs (Preview t r) =
+  [ "type" .= entityTypeText t,
+    "kind" .= chatKindText kind,
+    "displayName" .= displayName,
+    "fullName" .= fullName,
+    "image" .= image,
+    "subscribers" .= subscribers,
+    "profile" .= readText
+  ]
+  where
+    (LinkProfile {kind, displayName, fullName, image, subscribers}, readText) = case r of
+      ProfileOk p -> (p, "ok" :: Text)
+      ProfileUnread -> (emptyProfile, "unread")
+      ProfileUnavailable -> (emptyProfile, "unavailable")
+    emptyProfile = LinkProfile {kind = linkKind t, displayName = "", fullName = "", image = Nothing, subscribers = Nothing}
+    linkKind = \case
+      ETAddress -> CKContact
+      ETChannel -> CKChannel
+
+entityTypeText :: EntityType -> Text
+entityTypeText = \case
+  ETAddress -> "address"
+  ETChannel -> "channel"
+
+chatKindText :: ChatKind -> Text
+chatKindText = \case
+  CKContact -> "contact"
+  CKBusiness -> "business"
+  CKBot -> "bot"
+  CKChannel -> "channel"
+
+-- | A search answer's entity, within the search bound. The hosts are the link's servers, every one of which must pass the host rule.
+-- The deep link is the core's @simplex:/@ form, which carries the server; a link the core cannot parse keeps its own text.
+linkEntity :: Profiles -> EntityType -> [TransportHost] -> Text -> IO Entity
+linkEntity ps@Profiles {searchSlots} t hosts link = do
+  r <- boundedProfile ps searchSlots hosts link sl_
+  pure Entity {entityPreview = Preview t r, link, deepLink = maybe link (safeDecodeUtf8 . strEncode . simplexShortLink) sl_}
+  where
+    sl_ = parseShortLink link
+
+-- | A link preview, within the preview bound.
+linkPreview :: Profiles -> EntityType -> [TransportHost] -> Text -> IO Preview
+linkPreview ps@Profiles {previewSlots} t hosts link = Preview t <$> boundedProfile ps previewSlots hosts link (parseShortLink link)
+
+parseShortLink :: Text -> Maybe (ConnShortLink 'CMContact)
+parseShortLink = either (const Nothing) Just . strDecode . encodeUtf8
+
+-- | A link the chat core cannot parse names no server it could fetch from, so it is not fetched.
+boundedProfile :: Profiles -> TVar Int -> [TransportHost] -> Text -> Maybe (ConnShortLink 'CMContact) -> IO ProfileRead
+boundedProfile Profiles {limits = ProfileLimits {fetchTimeout, cacheSeconds, maxCachedProfiles}, clock, fetchLink, resolveHost, cache} slots hosts link sl_ =
+  cached >>= \case
+    Just p -> pure $ ProfileOk p
+    Nothing -> case sl_ of
+      Nothing -> pure ProfileUnavailable
+      Just sl -> fromMaybe ProfileUnread <$> timeout fetchTimeout (checkAndFetch sl)
+  where
+    cached = do
+      now <- clock
+      (\m -> case Map.lookup link m of Just (expiry, p) | expiry > now -> Just p; _ -> Nothing) <$> readTVarIO cache
+    checkAndFetch sl =
+      hostsFetchable resolveHost hosts >>= \case
+        False -> pure ProfileUnavailable
+        True -> withSlot (fetchLink sl) >>= maybe (pure ProfileUnread) (\p -> ProfileOk p <$ remember p)
+    withSlot =
+      bracket_
+        (atomically $ readTVar slots >>= \n -> check (n > 0) >> writeTVar slots (n - 1))
+        (atomically $ modifyTVar' slots (+ 1))
+    remember p = do
+      now <- clock
+      atomically $ modifyTVar' cache $ Map.insert link (now + cacheSeconds, p) . makeRoom now
+    makeRoom now m
+      | Map.size m < maxCachedProfiles || Map.member link m = m
+      | otherwise =
+          let live = Map.filter ((> now) . fst) m
+           in if Map.size live < maxCachedProfiles then live else maybe live (`Map.delete` live) (soonestExpiry live)
+    soonestExpiry = fmap fst . Map.foldrWithKey (\k (e, _) acc -> if maybe True ((e <) . snd) acc then Just (k, e) else acc) Nothing
+
+-- | Runs the connect plan, which reads the link data without connecting. A known chat answers with its stored profile.
+chatProfile :: ChatController -> UserId -> ProfileFetcher
+chatProfile cc userId sl =
+  sendChatCmd cc (APIConnectPlan userId (Just $ ACTarget SCMContact $ CTShortContact $ CTLink sl) PRMUnknown Nothing) >>= \case
+    Right CRConnectionPlan {user = User {profile}, connectionPlan} -> pure $ planProfile (fromLocalProfile profile) connectionPlan
+    _ -> pure Nothing
+
+-- | The first argument is the profile of the user who ran the plan, which their own address shows.
+planProfile :: Profile -> ConnectionPlan -> Maybe LinkProfile
+planProfile own = \case
+  CPContactAddress plan _ -> case plan of
+    CAPOk {contactSLinkData_} -> (\ContactShortLinkData {profile, business} -> contactProfile business profile) <$> contactSLinkData_
+    CAPOwnLink -> Just $ contactProfile False own
+    CAPConnectingConfirmReconnect -> Nothing
+    CAPConnectingProhibit {contact} -> Just $ knownContact contact
+    CAPKnown {contact} -> Just $ knownContact contact
+    CAPContactViaAddress {contact} -> Just $ knownContact contact
+  CPGroupLink plan _ -> case plan of
+    GLPOk {groupSLinkData_} -> channelProfile <$> groupSLinkData_
+    GLPNoRelays {groupSLinkData_} -> channelProfile <$> groupSLinkData_
+    GLPUpdateRequired {groupSLinkData_} -> channelProfile <$> groupSLinkData_
+    GLPOwnLink {groupInfo} -> Just $ knownGroup groupInfo
+    GLPConnectingConfirmReconnect -> Nothing
+    GLPConnectingProhibit {groupInfo_} -> knownGroup <$> groupInfo_
+    GLPKnown {groupInfo} -> Just $ knownGroup groupInfo
+  CPInvitationLink _ -> Nothing
+  CPError _ -> Nothing
+  where
+    knownContact Contact {profile} = contactProfile False (fromLocalProfile profile)
+    channelProfile GroupShortLinkData {groupProfile, publicGroupData} =
+      groupProfileOf CKChannel groupProfile ((\PublicGroupData {publicMemberCount} -> publicMemberCount) <$> publicGroupData)
+    knownGroup GroupInfo {groupProfile, businessChat, groupSummary = GroupSummary {publicMemberCount}} = case businessChat of
+      Just _ -> groupProfileOf CKBusiness groupProfile Nothing
+      Nothing -> groupProfileOf CKChannel groupProfile publicMemberCount
+
+contactProfile :: Bool -> Profile -> LinkProfile
+contactProfile business Profile {displayName, fullName, image, peerType} =
+  LinkProfile {kind, displayName, fullName, image = image >>= imageURI, subscribers = Nothing}
+  where
+    kind
+      | business || peerType == Just CPTBusiness = CKBusiness
+      | peerType == Just CPTBot = CKBot
+      | otherwise = CKContact
+
+groupProfileOf :: ChatKind -> GroupProfile -> Maybe Int64 -> LinkProfile
+groupProfileOf kind GroupProfile {displayName, fullName, image} subscribers =
+  LinkProfile {kind, displayName, fullName, image = image >>= imageURI, subscribers}
+
+-- | A profile image the page can show as it is.
+imageURI :: ImageData -> Maybe Text
+imageURI (ImageData uri)
+  | "data:image/" `T.isPrefixOf` uri = Just uri
+  | otherwise = Nothing
+
+-- | False when any host is an onion address, does not resolve, or is or resolves to an address outside the public internet.
+hostsFetchable :: HostResolver -> [TransportHost] -> IO Bool
+hostsFetchable resolve hosts
+  | null hosts = pure False
+  | otherwise = not <$> anyM (map refused hosts)
+  where
+    refused = \case
+      THDomainName name
+        | onionName name -> pure True
+        | otherwise -> (\addresses -> null addresses || not (all publicAddress addresses)) <$> resolve name
+      host -> pure $ not $ publicAddress host
+    onionName name = ".onion" `isSuffixOf` dropWhileEnd (== '.') (map toLower name)
+
+publicAddress :: TransportHost -> Bool
+publicAddress = \case
+  THIPv4 a -> publicIPv4 (ipv4Word a)
+  THIPv6 a -> publicIPv6 a
+  _ -> False
+
+-- | Unspecified ("this network"), private, CGNAT, loopback, link-local and multicast.
+refusedIPv4 :: [(Word32, Int)]
+refusedIPv4 =
+  [ (ipv4Word (0, 0, 0, 0), 8),
+    (ipv4Word (10, 0, 0, 0), 8),
+    (ipv4Word (100, 64, 0, 0), 10),
+    (ipv4Word (127, 0, 0, 0), 8),
+    (ipv4Word (169, 254, 0, 0), 16),
+    (ipv4Word (172, 16, 0, 0), 12),
+    (ipv4Word (192, 168, 0, 0), 16),
+    (ipv4Word (224, 0, 0, 0), 4)
+  ]
+
+-- | Unique-local, link-local and multicast, as prefixes of the address's first 32 bits.
+refusedIPv6 :: [(Word32, Int)]
+refusedIPv6 = [(0xfc000000, 7), (0xfe800000, 10), (0xff000000, 8)]
+
+-- | The third 32-bit word of an IPv4-mapped IPv6 address, @::ffff:a.b.c.d@.
+ipv4MappedWord :: Word32
+ipv4MappedWord = 0xffff
+
+publicIPv4 :: Word32 -> Bool
+publicIPv4 a = not $ any (inPrefix a) refusedIPv4
+
+publicIPv6 :: (Word32, Word32, Word32, Word32) -> Bool
+publicIPv6 (w0, w1, w2, w3)
+  | w0 == 0 && w1 == 0 && w2 == ipv4MappedWord = publicIPv4 w3
+  | w0 == 0 && w1 == 0 && w2 == 0 && w3 <= 1 = False
+  | otherwise = not $ any (inPrefix w0) refusedIPv6
+
+inPrefix :: Word32 -> (Word32, Int) -> Bool
+inPrefix a (net, len) = a `shiftR` (32 - len) == net `shiftR` (32 - len)
+
+ipv4Word :: (Word8, Word8, Word8, Word8) -> Word32
+ipv4Word (a, b, c, d) = fromIntegral a `shiftL` 24 .|. fromIntegral b `shiftL` 16 .|. fromIntegral c `shiftL` 8 .|. fromIntegral d
+
+-- | getAddrInfo is a foreign call that a timeout cannot interrupt, so it runs in its own thread, which a timed-out caller leaves to finish.
+systemResolver :: HostResolver
+systemResolver name = do
+  result <- newEmptyTMVarIO
+  _ <- forkFinally (getAddrInfo (Just defaultHints {addrSocketType = Stream}) (Just name) Nothing) $
+    atomically . putTMVar result . either (const []) (mapMaybe (sockHost . addrAddress))
+  atomically $ readTMVar result
+  where
+    sockHost = \case
+      SockAddrInet _ a -> Just $ THIPv4 $ hostAddressToTuple a
+      SockAddrInet6 _ _ a _ -> Just $ THIPv6 a
+      SockAddrUnix _ -> Nothing

simplex-chat.cabal

@@ -448,6 +448,7 @@ executable simplex-store-service
       StoreService.Names.Label
       StoreService.Names.Links
       StoreService.Names.Phases
+      StoreService.Names.Profiles
       StoreService.Names.Registration
       StoreService.Names.Revert
       StoreService.Names.Signatures
@@ -754,6 +755,7 @@ test-suite simplex-chat-test
       Bots.StoreService.NamesChainTests
       Bots.StoreService.NamesLabelTests
       Bots.StoreService.NamesLinksTests
+      Bots.StoreService.NamesProfilesTests
       Bots.StoreService.NamesSignatureTests
       Bots.StoreService.NamesStoreTests
       Bots.StoreService.NamesWiringTests
@@ -784,6 +786,7 @@ test-suite simplex-chat-test
       StoreService.Names.Label
       StoreService.Names.Links
       StoreService.Names.Phases
+      StoreService.Names.Profiles
       StoreService.Names.Registration
       StoreService.Names.Revert
       StoreService.Names.Signatures

tests/Bots/StoreService/NamesProfilesTests.hs

@@ -0,0 +1,466 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
+
+module Bots.StoreService.NamesProfilesTests (namesProfilesTests, namesProfilesChatTests) where
+
+import ChatClient (TestCC (..), testChat2)
+import ChatTests.DBUtils (TestParams)
+import ChatTests.Groups (prepareChannel1Relay)
+import ChatTests.Utils (aliceProfile, bobProfile, getContactLinks, withRelay, (##>))
+import qualified ChatTests.Utils as CU
+import Control.Concurrent (threadDelay)
+import Control.Concurrent.Async (async, concurrently, replicateConcurrently, wait)
+import Control.Concurrent.STM
+import Control.Exception (uninterruptibleMask_)
+import Control.Monad (replicateM_)
+import qualified Data.Aeson as J
+import Data.Int (Int64)
+import qualified Data.ByteString.Base64.URL as B64URL
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy.Char8 as LB
+import qualified Data.Map.Strict as Map
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+import Data.Time.Clock (diffUTCTime, getCurrentTime)
+import Data.Word (Word32, Word64)
+import Simplex.Chat.Controller (ChatErrorType (..), ChatError (..), ConnectionPlan (..), ContactAddressPlan (..), GroupLinkPlan (..))
+import Simplex.Chat.Protocol (ContactShortLinkData (..), GroupShortLinkData (..), PublicGroupData (..))
+import Simplex.Chat.Types (ChatPeerType (..), GroupProfile (..), ImageData (..), Profile (..))
+import Simplex.Messaging.Agent.Protocol (ConnShortLink (..), ConnectionMode (..), simplexShortLink)
+import Simplex.Messaging.Encoding.String (strDecode, strEncode)
+import Simplex.Messaging.Protocol (SMPServer)
+import Simplex.Messaging.Transport.Client (TransportHost (..))
+import StoreService.Names.Profiles
+import Test.Hspec hiding (it)
+import qualified Test.Hspec as H
+
+namesProfilesTests :: Spec
+namesProfilesTests = describe "StoreService names: profiles" $ do
+  describe "plan to profile" $ do
+    H.it "reads a contact address's link data as a contact" testPlanContact
+    H.it "reads a business address by its flag or by its profile's peer type" testPlanBusiness
+    H.it "reads a bot address by its profile's peer type" testPlanBot
+    H.it "reads a channel with its subscriber count, also when it has no relays or needs an update" testPlanChannel
+    H.it "reads the user's own address from the user's profile" testPlanOwnLink
+    H.it "reads nothing from an error, missing link data or a connection being made" testPlanNothing
+    H.it "drops an image that is not a data:image URI" testPlanImage
+  describe "JSON" $ do
+    H.it "encodes a contact entity as the contract's example" testEntityContactJSON
+    H.it "encodes a channel entity with subscribers and a simplex:/ deep link" testEntityChannelJSON
+    H.it "encodes previews without a profile as empty, kind from the link" testPreviewEmptyJSON
+    H.it "gives a deep link that parses back in the core with the link's server" testDeepLinkParses
+  describe "bounds and cache" $ do
+    H.it "answers a link again from the cache, and fetches it again once the cache expires" testCacheExpiry
+    H.it "does not cache a failed fetch" testFailureNotCached
+    H.it "evicts the entry that expires soonest when the cache is full" testCacheBound
+    H.it "gives up a fetch that takes longer than the timeout, freeing its slot" testFetchTimeout
+    H.it "fills the preview bound while search still fetches, and a preview with no slot in time is unread" testPreviewBound
+    H.it "fills the search bound while previews still fetch" testSearchBound
+    H.it "lets a fetch wait for a slot that frees within the timeout" testSlotFreesInTime
+    H.it "answers a link the chat core cannot parse unavailable without fetching" testUnparseableLink
+  describe "host rule" $ do
+    H.it "passes public IP literals and a name resolving to public addresses" testPublicHosts
+    H.it "refuses private, loopback, CGNAT, link-local and unique-local literals" testPrivateLiterals
+    H.it "refuses names resolving to those addresses" testPrivateNames
+    H.it "refuses unspecified, multicast and IPv4-mapped private addresses" testOtherRefused
+    H.it "refuses .onion hosts without resolving them, and unresolvable names" testOnionUnresolvable
+    H.it "refuses a link with one public and one private host, and a name with one private address" testMixedHosts
+    H.it "answers a refused link unavailable without fetching it" testRefusedNotFetched
+
+namesProfilesChatTests :: SpecWith TestParams
+namesProfilesChatTests =
+  describe "StoreService names: profiles" $
+    CU.it "reads an address and a channel through the chat core, and the owner's own from its store" testChatProfiles
+
+-- Plans
+
+ownProfile :: Profile
+ownProfile = linkDataProfile "store" "SimpleX store" Nothing
+
+contactData :: Bool -> Profile -> ConnectionPlan
+contactData business profile =
+  CPContactAddress CAPOk {contactSLinkData_ = Just ContactShortLinkData {profile, message = Nothing, business, localBadge = Nothing}, ownerVerification = Nothing} Nothing
+
+channelData :: Maybe Int64 -> GroupShortLinkData
+channelData count =
+  GroupShortLinkData
+    { groupProfile = GroupProfile {displayName = "news", fullName = "Bakery news", shortDescr = Nothing, description = Nothing, image = Nothing, publicGroup = Nothing, groupPreferences = Nothing, memberAdmission = Nothing},
+      publicGroupData = PublicGroupData <$> count
+    }
+
+alice :: Profile
+alice = bakeryWith (Just (ImageData jpeg))
+
+bakeryWith :: Maybe ImageData -> Profile
+bakeryWith = linkDataProfile "Alice's Bakery" "Sourdough and pastries, Lisbon"
+
+linkDataProfile :: Text -> Text -> Maybe ImageData -> Profile
+linkDataProfile displayName fullName image =
+  Profile {displayName, fullName, shortDescr = Nothing, description = Nothing, image, contactLink = Nothing, preferences = Nothing, peerType = Nothing, badge = Nothing, contactDomain = Nothing}
+
+jpeg :: Text
+jpeg = "data:image/jpeg;base64,/9j/4AAQSkZJRg=="
+
+testPlanContact :: IO ()
+testPlanContact =
+  planProfile ownProfile (contactData False alice)
+    `shouldBe` Just LinkProfile {kind = CKContact, displayName = "Alice's Bakery", fullName = "Sourdough and pastries, Lisbon", image = Just jpeg, subscribers = Nothing}
+
+testPlanBusiness :: IO ()
+testPlanBusiness = do
+  kindOf (contactData True alice) `shouldBe` Just CKBusiness
+  kindOf (contactData False alice {peerType = Just CPTBusiness}) `shouldBe` Just CKBusiness
+  kindOf (contactData False alice {peerType = Just CPTHuman}) `shouldBe` Just CKContact
+
+testPlanBot :: IO ()
+testPlanBot = do
+  kindOf (contactData False alice {peerType = Just CPTBot}) `shouldBe` Just CKBot
+  kindOf (contactData True alice {peerType = Just CPTBot}) `shouldBe` Just CKBusiness
+
+testPlanChannel :: IO ()
+testPlanChannel = do
+  let news count = Just LinkProfile {kind = CKChannel, displayName = "news", fullName = "Bakery news", image = Nothing, subscribers = count}
+  planProfile ownProfile (CPGroupLink GLPOk {groupSLinkInfo_ = Nothing, groupSLinkData_ = Just (channelData (Just 1204)), ownerVerification = Nothing} Nothing) `shouldBe` news (Just 1204)
+  planProfile ownProfile (CPGroupLink GLPOk {groupSLinkInfo_ = Nothing, groupSLinkData_ = Just (channelData Nothing), ownerVerification = Nothing} Nothing) `shouldBe` news Nothing
+  planProfile ownProfile (CPGroupLink (GLPNoRelays (Just (channelData (Just 3)))) Nothing) `shouldBe` news (Just 3)
+  planProfile ownProfile (CPGroupLink (GLPUpdateRequired (Just (channelData (Just 4)))) Nothing) `shouldBe` news (Just 4)
+
+testPlanOwnLink :: IO ()
+testPlanOwnLink =
+  planProfile ownProfile (CPContactAddress CAPOwnLink Nothing)
+    `shouldBe` Just LinkProfile {kind = CKContact, displayName = "store", fullName = "SimpleX store", image = Nothing, subscribers = Nothing}
+
+testPlanNothing :: IO ()
+testPlanNothing = do
+  planProfile ownProfile (CPError (ChatError CEInvalidConnReq)) `shouldBe` Nothing
+  planProfile ownProfile (CPContactAddress CAPOk {contactSLinkData_ = Nothing, ownerVerification = Nothing} Nothing) `shouldBe` Nothing
+  planProfile ownProfile (CPGroupLink GLPOk {groupSLinkInfo_ = Nothing, groupSLinkData_ = Nothing, ownerVerification = Nothing} Nothing) `shouldBe` Nothing
+  planProfile ownProfile (CPContactAddress CAPConnectingConfirmReconnect Nothing) `shouldBe` Nothing
+  planProfile ownProfile (CPGroupLink GLPConnectingConfirmReconnect Nothing) `shouldBe` Nothing
+  planProfile ownProfile (CPGroupLink (GLPConnectingProhibit Nothing) Nothing) `shouldBe` Nothing
+
+testPlanImage :: IO ()
+testPlanImage = do
+  let imageOf p = planProfile ownProfile (contactData False p) >>= \LinkProfile {image} -> image
+  imageOf (bakeryWith (Just (ImageData "javascript:alert(1)"))) `shouldBe` Nothing
+  imageOf (bakeryWith (Just (ImageData "https://example.com/a.png"))) `shouldBe` Nothing
+  imageOf alice `shouldBe` Just jpeg
+
+kindOf :: ConnectionPlan -> Maybe ChatKind
+kindOf plan = (\LinkProfile {kind} -> kind) <$> planProfile ownProfile plan
+
+-- JSON
+
+bakeryLink, newsLink :: Text
+bakeryLink = "https://smp8.simplex.im/a#Y8m3qT0vLw2Ab7cD9eF1gH3jK5mN7pQ9rSAAAAAAAAA"
+newsLink = "https://smp9.simplex.im/c#Rk27xN4pDe9Tz1Wb3Yc5Vd7Xf9Hg2Jk4LmAAAAAAAAA"
+
+shouldEncodeAs :: J.ToJSON a => a -> LB.ByteString -> Expectation
+shouldEncodeAs v expected = Just (J.toJSON v) `shouldBe` J.decode expected
+
+testEntityContactJSON :: IO ()
+testEntityContactJSON = do
+  ps <- quietProfiles (pure . Just . const bakery) publicResolver
+  e <- linkEntity ps ETAddress [publicHost] bakeryLink
+  e
+    `shouldEncodeAs` "{\"type\": \"address\", \"kind\": \"contact\", \"displayName\": \"Alice's Bakery\", \"fullName\": \"Sourdough and pastries, Lisbon\",\
+                     \ \"image\": \"data:image/jpeg;base64,/9j/4AAQSkZJRg==\", \"subscribers\": null, \"profile\": \"ok\",\
+                     \ \"link\": \"https://smp8.simplex.im/a#Y8m3qT0vLw2Ab7cD9eF1gH3jK5mN7pQ9rSAAAAAAAAA\", \"deepLink\": \"simplex:/a#Y8m3qT0vLw2Ab7cD9eF1gH3jK5mN7pQ9rSAAAAAAAAA?h=smp8.simplex.im\"}"
+  where
+    bakery = LinkProfile {kind = CKContact, displayName = "Alice's Bakery", fullName = "Sourdough and pastries, Lisbon", image = Just jpeg, subscribers = Nothing}
+
+testEntityChannelJSON :: IO ()
+testEntityChannelJSON = do
+  ps <- quietProfiles (pure . Just . const news) publicResolver
+  e <- linkEntity ps ETChannel [publicHost] newsLink
+  e
+    `shouldEncodeAs` "{\"type\": \"channel\", \"kind\": \"channel\", \"displayName\": \"Bakery news\", \"fullName\": \"Daily bakes and opening hours\",\
+                     \ \"image\": null, \"subscribers\": 1204, \"profile\": \"ok\",\
+                     \ \"link\": \"https://smp9.simplex.im/c#Rk27xN4pDe9Tz1Wb3Yc5Vd7Xf9Hg2Jk4LmAAAAAAAAA\", \"deepLink\": \"simplex:/c#Rk27xN4pDe9Tz1Wb3Yc5Vd7Xf9Hg2Jk4LmAAAAAAAAA?h=smp9.simplex.im\"}"
+  let simplexLink = "simplex:/c#Rk27xN4pDe9Tz1Wb3Yc5Vd7Xf9Hg2Jk4LmAAAAAAAAA?h=smp9.simplex.im"
+  Entity {link, deepLink} <- linkEntity ps ETChannel [publicHost] simplexLink
+  (link, deepLink) `shouldBe` (simplexLink, simplexLink)
+  where
+    news = LinkProfile {kind = CKChannel, displayName = "Bakery news", fullName = "Daily bakes and opening hours", image = Nothing, subscribers = Just 1204}
+
+testDeepLinkParses :: IO ()
+testDeepLinkParses = do
+  ps <- quietProfiles answerAll publicResolver
+  mapM_ (deepLinkKeepsServer ps) [bakeryLink, keyedLink, twoHostLink]
+  Entity {deepLink} <- linkEntity ps ETAddress [] "https://smp8.simplex.im/a#x"
+  deepLink `shouldBe` "https://smp8.simplex.im/a#x"
+  where
+    keyedLink = "https://smp.example.com/a#Y8m3qT0vLw2Ab7cD9eF1gH3jK5mN7pQ9rSAAAAAAAAA?p=5224&c=LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI"
+    twoHostLink = "simplex:/c#Rk27xN4pDe9Tz1Wb3Yc5Vd7Xf9Hg2Jk4LmAAAAAAAAA?h=a.example.com%2Cb.example.com"
+    deepLinkKeepsServer ps l = do
+      Entity {deepLink} <- linkEntity ps ETAddress [publicHost] l
+      let original = parseLink l
+          reparsed = parseLink deepLink
+      ("simplex:/" `T.isPrefixOf` deepLink, serverOf <$> reparsed) `shouldBe` (True, serverOf <$> original)
+      reparsed `shouldBe` (simplexShortLink <$> original)
+    parseLink :: Text -> Either String (ConnShortLink 'CMContact)
+    parseLink = strDecode . encodeUtf8
+    serverOf :: ConnShortLink 'CMContact -> SMPServer
+    serverOf (CSLContact _ _ srv _) = srv
+
+testPreviewEmptyJSON :: IO ()
+testPreviewEmptyJSON = do
+  Preview ETChannel ProfileUnread
+    `shouldEncodeAs` "{\"type\": \"channel\", \"kind\": \"channel\", \"displayName\": \"\", \"fullName\": \"\", \"image\": null, \"subscribers\": null, \"profile\": \"unread\"}"
+  Preview ETAddress ProfileUnavailable
+    `shouldEncodeAs` "{\"type\": \"address\", \"kind\": \"contact\", \"displayName\": \"\", \"fullName\": \"\", \"image\": null, \"subscribers\": null, \"profile\": \"unavailable\"}"
+  Preview ETAddress (ProfileOk LinkProfile {kind = CKBot, displayName = "helper", fullName = "", image = Nothing, subscribers = Nothing})
+    `shouldEncodeAs` "{\"type\": \"address\", \"kind\": \"bot\", \"displayName\": \"helper\", \"fullName\": \"\", \"image\": null, \"subscribers\": null, \"profile\": \"ok\"}"
+
+-- Bounds and cache
+
+-- | Long enough that a fetch which should have been answered from a slot or the cache would be seen waiting on it.
+testTimeout :: Int
+testTimeout = 500000
+
+testLimits :: ProfileLimits
+testLimits = defaultProfileLimits {fetchTimeout = testTimeout}
+
+data Fake = Fake {profiles :: Profiles, clockAt :: TVar Word64, fetched :: TVar [Text]}
+
+-- | A fetcher that records each link it is asked for, then answers with @answer@.
+newFake :: ProfileLimits -> (Text -> IO (Maybe LinkProfile)) -> HostResolver -> IO Fake
+newFake limits answer resolver = do
+  clockAt <- newTVarIO 0
+  fetched <- newTVarIO []
+  let fetcher sl = do
+        let l = linkText sl
+        atomically $ modifyTVar' fetched (l :)
+        answer l
+  profiles <- newProfiles limits (readTVarIO clockAt) fetcher resolver
+  pure Fake {profiles, clockAt, fetched}
+
+quietProfiles :: (Text -> IO (Maybe LinkProfile)) -> HostResolver -> IO Profiles
+quietProfiles answer resolver = (\Fake {profiles} -> profiles) <$> newFake testLimits answer resolver
+
+linkText :: ConnShortLink 'CMContact -> Text
+linkText = decodeUtf8 . strEncode
+
+-- | A contact address link with a distinct canonical key, so it round-trips through the chat core's parser.
+addressLink :: Int -> Text
+addressLink n = "https://smp8.simplex.im/a#" <> decodeUtf8 (B64URL.encodeUnpadded (B.pack (take 32 (show n <> repeat '.'))))
+
+profileFor :: Text -> LinkProfile
+profileFor l = LinkProfile {kind = CKContact, displayName = T.takeEnd 8 l, fullName = "", image = Nothing, subscribers = Nothing}
+
+answerAll :: Text -> IO (Maybe LinkProfile)
+answerAll = pure . Just . profileFor
+
+fetchCount :: Fake -> IO Int
+fetchCount Fake {fetched} = length <$> readTVarIO fetched
+
+preview :: Fake -> Text -> IO ProfileRead
+preview Fake {profiles} l = (\(Preview _ r) -> r) <$> linkPreview profiles ETAddress [publicHost] l
+
+search :: Fake -> Text -> IO ProfileRead
+search Fake {profiles} l = (\Entity {entityPreview = Preview _ r} -> r) <$> linkEntity profiles ETAddress [publicHost] l
+
+testCacheExpiry :: IO ()
+testCacheExpiry = do
+  fake@Fake {clockAt} <- newFake testLimits answerAll publicResolver
+  let l = addressLink 1
+  preview fake l `shouldReturn` ProfileOk (profileFor l)
+  search fake l `shouldReturn` ProfileOk (profileFor l)
+  fetchCount fake `shouldReturn` 1
+  atomically $ writeTVar clockAt 599
+  preview fake l `shouldReturn` ProfileOk (profileFor l)
+  fetchCount fake `shouldReturn` 1
+  atomically $ writeTVar clockAt 600
+  preview fake l `shouldReturn` ProfileOk (profileFor l)
+  fetchCount fake `shouldReturn` 2
+
+testFailureNotCached :: IO ()
+testFailureNotCached = do
+  failing <- newTVarIO True
+  fake <- newFake testLimits (\l -> readTVarIO failing >>= \f -> pure $ if f then Nothing else Just (profileFor l)) publicResolver
+  let l = addressLink 1
+  preview fake l `shouldReturn` ProfileUnread
+  atomically $ writeTVar failing False
+  preview fake l `shouldReturn` ProfileOk (profileFor l)
+  fetchCount fake `shouldReturn` 2
+
+testCacheBound :: IO ()
+testCacheBound = do
+  fake@Fake {clockAt} <- newFake testLimits {maxCachedProfiles = 2} answerAll publicResolver
+  let a = addressLink 1
+      b = addressLink 2
+      c = addressLink 3
+  mapM_ (\(t, l) -> atomically (writeTVar clockAt t) >> preview fake l) [(0, a), (1, b), (2, c)]
+  fetchCount fake `shouldReturn` 3
+  preview fake b `shouldReturn` ProfileOk (profileFor b)
+  preview fake c `shouldReturn` ProfileOk (profileFor c)
+  fetchCount fake `shouldReturn` 3
+  preview fake a `shouldReturn` ProfileOk (profileFor a)
+  fetchCount fake `shouldReturn` 4
+
+testFetchTimeout :: IO ()
+testFetchTimeout = do
+  gate <- newEmptyTMVarIO
+  fake <- newFake testLimits (\l -> if l == addressLink 0 then atomically (readTMVar gate) >> answerAll l else answerAll l) publicResolver
+  start <- getCurrentTime
+  replicateConcurrently 2 (preview fake (addressLink 0)) `shouldReturn` [ProfileUnread, ProfileUnread]
+  elapsed <- (`diffUTCTime` start) <$> getCurrentTime
+  elapsed `shouldSatisfy` (< 2 * micros testTimeout)
+  -- Both preview slots were taken by the timed-out fetches; they must be free again.
+  replicateConcurrently 2 (preview fake (addressLink 1)) `shouldReturn` replicate 2 (ProfileOk (profileFor (addressLink 1)))
+  where
+    micros n = fromIntegral n / 1000000
+
+-- | A fetcher for which links numbered below 100 report that they started, then hold their slot until the gate opens, past their timeout.
+gatedFake :: IO (Fake, TQueue (), TMVar ())
+gatedFake = do
+  started <- newTQueueIO
+  gate <- newEmptyTMVarIO
+  let answer l
+        | l `elem` map addressLink [0 .. 99] = atomically (writeTQueue started ()) >> uninterruptibleMask_ (atomically $ readTMVar gate) >> answerAll l
+        | otherwise = answerAll l
+  fake <- newFake testLimits answer publicResolver
+  pure (fake, started, gate)
+
+testPreviewBound :: IO ()
+testPreviewBound = do
+  (fake, started, gate) <- gatedFake
+  held <- mapM (async . preview fake . addressLink) [0, 1]
+  replicateM_ 2 (atomically $ readTQueue started)
+  (searched, waited) <- concurrently (search fake (addressLink 100)) (preview fake (addressLink 101))
+  searched `shouldBe` ProfileOk (profileFor (addressLink 100))
+  waited `shouldBe` ProfileUnread
+  readTVarIO (fetched fake) >>= (`shouldNotContain` [addressLink 101])
+  atomically $ putTMVar gate ()
+  mapM wait held >>= (`shouldSatisfy` all (`elem` [ProfileUnread, ProfileOk (profileFor (addressLink 0)), ProfileOk (profileFor (addressLink 1))]))
+
+testSearchBound :: IO ()
+testSearchBound = do
+  (fake, started, gate) <- gatedFake
+  held <- mapM (async . search fake . addressLink) [0 .. 3]
+  replicateM_ 4 (atomically $ readTQueue started)
+  (waited, previewed) <- concurrently (search fake (addressLink 100)) (preview fake (addressLink 101))
+  waited `shouldBe` ProfileUnread
+  previewed `shouldBe` ProfileOk (profileFor (addressLink 101))
+  readTVarIO (fetched fake) >>= (`shouldNotContain` [addressLink 100])
+  atomically $ putTMVar gate ()
+  mapM_ wait held
+
+testSlotFreesInTime :: IO ()
+testSlotFreesInTime = do
+  (fake, started, gate) <- gatedFake
+  held <- mapM (async . preview fake . addressLink) [0, 1]
+  replicateM_ 2 (atomically $ readTQueue started)
+  waiting <- async $ preview fake (addressLink 100)
+  threadDelay (testTimeout `div` 5)
+  atomically $ putTMVar gate ()
+  wait waiting `shouldReturn` ProfileOk (profileFor (addressLink 100))
+  mapM wait held `shouldReturn` map (ProfileOk . profileFor . addressLink) [0, 1]
+
+testUnparseableLink :: IO ()
+testUnparseableLink = do
+  fake <- newFake testLimits answerAll publicResolver
+  mapM_ (\l -> preview fake l `shouldReturn` ProfileUnavailable) ["https://smp8.simplex.im/a#x", "simplex:/c#Rk27xN4pDe9Tz1Wb3Yc5Vd7Xf9Hg2Jk4Lm"]
+  fetchCount fake `shouldReturn` 0
+
+-- Host rule
+
+publicHost :: TransportHost
+publicHost = "smp8.simplex.im"
+
+-- | Resolves the names of these tests; any other name does not resolve.
+stubResolver :: TVar [String] -> HostResolver
+stubResolver asked name = do
+  atomically $ modifyTVar' asked (name :)
+  pure $ Map.findWithDefault [] name addresses
+  where
+    addresses =
+      Map.fromList
+        [ ("smp8.simplex.im", ["1.1.1.1", "2606:4700::1111"]),
+          ("loopback.test", ["127.0.0.1"]),
+          ("private.test", ["10.0.0.1"]),
+          ("cgnat.test", ["100.64.0.1"]),
+          ("link-local.test", ["fe80::1"]),
+          ("unique-local.test", ["fd00::1"]),
+          ("mixed.test", ["1.1.1.1", "192.168.1.1"])
+        ]
+
+publicResolver :: HostResolver
+publicResolver _ = pure ["1.1.1.1"]
+
+fetchable :: [TransportHost] -> IO Bool
+fetchable hosts = newTVarIO [] >>= \asked -> hostsFetchable (stubResolver asked) hosts
+
+testPublicHosts :: IO ()
+testPublicHosts = do
+  fetchable ["1.1.1.1"] `shouldReturn` True
+  fetchable ["2606:4700::1111"] `shouldReturn` True
+  fetchable ["smp8.simplex.im"] `shouldReturn` True
+  fetchable ["smp8.simplex.im", "8.8.8.8"] `shouldReturn` True
+
+testPrivateLiterals :: IO ()
+testPrivateLiterals =
+  mapM_ (\h -> (h,) <$> fetchable [h] `shouldReturn` (h, False)) ["127.0.0.1", "10.0.0.1", "172.16.5.4", "192.168.1.1", "100.64.0.1", "169.254.1.1", "::1", "fe80::1", "fd00::1"]
+
+testPrivateNames :: IO ()
+testPrivateNames =
+  mapM_ (\h -> (h,) <$> fetchable [h] `shouldReturn` (h, False)) ["loopback.test", "private.test", "cgnat.test", "link-local.test", "unique-local.test"]
+
+testOtherRefused :: IO ()
+testOtherRefused = do
+  mapM_ (\h -> (h,) <$> fetchable [h] `shouldReturn` (h, False)) ["0.0.0.0", "::", "224.0.0.1", "ff02::1", mapped (127, 0, 0, 1), mapped (10, 0, 0, 1)]
+  fetchable [mapped (1, 1, 1, 1)] `shouldReturn` True
+  fetchable [] `shouldReturn` False
+
+testOnionUnresolvable :: IO ()
+testOnionUnresolvable = do
+  asked <- newTVarIO []
+  hostsFetchable (stubResolver asked) ["abcdefghij234567.onion"] `shouldReturn` False
+  hostsFetchable (stubResolver asked) [THDomainName "abcdefghij234567.ONION."] `shouldReturn` False
+  readTVarIO asked `shouldReturn` []
+  hostsFetchable (stubResolver asked) ["unknown.test"] `shouldReturn` False
+  readTVarIO asked `shouldReturn` ["unknown.test"]
+
+-- | An IPv4-mapped IPv6 address, @::ffff:a.b.c.d@.
+mapped :: (Word32, Word32, Word32, Word32) -> TransportHost
+mapped (a, b, c, d) = THIPv6 (0, 0, 0xffff, a * 0x1000000 + b * 0x10000 + c * 0x100 + d)
+
+testMixedHosts :: IO ()
+testMixedHosts = do
+  fetchable ["smp8.simplex.im", "10.0.0.1"] `shouldReturn` False
+  fetchable ["1.1.1.1", "loopback.test"] `shouldReturn` False
+  fetchable ["mixed.test"] `shouldReturn` False
+
+testRefusedNotFetched :: IO ()
+testRefusedNotFetched = do
+  asked <- newTVarIO []
+  fake@Fake {profiles} <- newFake testLimits answerAll (stubResolver asked)
+  let l = addressLink 1
+  (\(Preview _ r) -> r) <$> linkPreview profiles ETAddress ["smp8.simplex.im", "private.test"] l `shouldReturn` ProfileUnavailable
+  (\Entity {entityPreview = Preview _ r} -> r) <$> linkEntity profiles ETAddress ["127.0.0.1"] l `shouldReturn` ProfileUnavailable
+  fetchCount fake `shouldReturn` 0
+  (\(Preview _ r) -> r) <$> linkPreview profiles ETAddress ["smp8.simplex.im"] l `shouldReturn` ProfileOk (profileFor l)
+  fetchCount fake `shouldReturn` 1
+
+-- Through the chat core
+
+testChatProfiles :: TestParams -> IO ()
+testChatProfiles ps = testChat2 aliceProfile bobProfile test ps
+  where
+    test alice' bob = withRelay ps $ \relay -> do
+      bob ##> "/ad"
+      (address, _) <- getContactLinks bob True
+      (channel, _) <- prepareChannel1Relay "news" bob relay
+      let fetch TestCC {chatController} l = either error (chatProfile chatController 1) (strDecode (B.pack l))
+          Profile {image = bobImage} = bobProfile
+          bobLinkProfile = Just LinkProfile {kind = CKContact, displayName = "bob", fullName = "", image = (\(ImageData i) -> i) <$> bobImage, subscribers = Nothing}
+          news = Just LinkProfile {kind = CKChannel, displayName = "news", fullName = "", image = Nothing, subscribers = Just 1}
+      fetch alice' address `shouldReturn` bobLinkProfile
+      fetch alice' channel `shouldReturn` news
+      fetch bob address `shouldReturn` bobLinkProfile
+      fetch bob channel `shouldReturn` news

tests/Test.hs

@@ -13,6 +13,7 @@ import Bots.StoreService.NameRegistrationTests
 import Bots.StoreService.NamesChainTests
 import Bots.StoreService.NamesLabelTests
 import Bots.StoreService.NamesLinksTests
+import Bots.StoreService.NamesProfilesTests
 import Bots.StoreService.NamesSignatureTests
 import Bots.StoreService.NamesStoreTests
 import Bots.StoreService.NamesWiringTests
@@ -96,6 +97,7 @@ main = do
       namesChainTests
       namesLabelTests
       namesLinksTests
+      namesProfilesTests
       namesSignatureTests
       namesStoreTests
       namesWiringTests
@@ -130,6 +132,7 @@ main = do
             storeServiceTests
             describe "managed group" badgeGroupIntegrationTests
           describe "StoreService names: boot" namesBootTests
+          namesProfilesChatTests
           describe "Remote session" remoteTests
 #if !defined(dbPostgres)
           sequential $ xdescribe'' "Save query plans" saveQueryPlans