From 7012005feb34f1290643137de23c8eec1e7011b5 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Mon, 4 Apr 2022 19:51:49 +0100 Subject: [PATCH] core: MsgContent for link previews, API to parse markdown (#504) --- src/Simplex/Chat.hs | 4 +++- src/Simplex/Chat/Controller.hs | 5 ++++- src/Simplex/Chat/Protocol.hs | 23 ++++++++++++++++++++++- src/Simplex/Chat/Store.hs | 16 ++++++++-------- src/Simplex/Chat/Types.hs | 20 ++++++++++---------- src/Simplex/Chat/View.hs | 1 + tests/ChatTests.hs | 4 ++-- tests/ProtocolTests.hs | 5 ++++- 8 files changed, 54 insertions(+), 24 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index bbe08d593..8464195b4 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -301,6 +301,7 @@ processChatCommand = \case withAgent $ \a -> rejectContact a connId invId pure $ CRContactRequestRejected cReq APIUpdateProfile profile -> withUser (`updateProfile` profile) + APIParseMarkdown text -> pure . CRApiParsedMarkdown $ parseMaybeMarkdownList text GetUserSMPServers -> CRUserSMPServers <$> withUser (\user -> withStore (`getSMPServers` user)) SetUserSMPServers smpServers -> withUser $ \user -> withChatLock $ do withStore $ \st -> overwriteSMPServers st user smpServers @@ -1662,6 +1663,7 @@ chatCommandP = <|> "/_accept " *> (APIAcceptContact <$> A.decimal) <|> "/_reject " *> (APIRejectContact <$> A.decimal) <|> "/_profile " *> (APIUpdateProfile <$> jsonP) + <|> "/_parse " *> (APIParseMarkdown . safeDecodeUtf8 <$> A.takeByteString) <|> "/smp_servers default" $> SetUserSMPServers [] <|> "/smp_servers " *> (SetUserSMPServers <$> smpServersP) <|> "/smp_servers" $> GetUserSMPServers @@ -1707,7 +1709,7 @@ chatCommandP = <|> ("/reject @" <|> "/reject " <|> "/rc @" <|> "/rc ") *> (RejectContact <$> displayName) <|> ("/markdown" <|> "/m") $> ChatHelp HSMarkdown <|> ("/welcome" <|> "/w") $> Welcome - <|> "/profile_image " *> (UpdateProfileImage . Just . ProfileImage <$> imageP) + <|> "/profile_image " *> (UpdateProfileImage . Just . ImageData <$> imageP) <|> "/profile_image" $> UpdateProfileImage Nothing <|> ("/profile " <|> "/p ") *> (uncurry UpdateProfile <$> userNames) <|> ("/profile" <|> "/p") $> ShowProfile diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 132cc5ef5..99a9fb1f7 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -25,6 +25,7 @@ import Data.Version (showVersion) import GHC.Generics (Generic) import Numeric.Natural import qualified Paths_simplex_chat as SC +import Simplex.Chat.Markdown (MarkdownList) import Simplex.Chat.Messages import Simplex.Chat.Protocol import Simplex.Chat.Store (StoreError) @@ -102,6 +103,7 @@ data ChatCommand | APIAcceptContact Int64 | APIRejectContact Int64 | APIUpdateProfile Profile + | APIParseMarkdown Text | GetUserSMPServers | SetUserSMPServers [SMPServer] | ChatHelp HelpSection @@ -142,7 +144,7 @@ data ChatCommand | FileStatus FileTransferId | ShowProfile | UpdateProfile ContactName Text - | UpdateProfileImage (Maybe ProfileImage) + | UpdateProfileImage (Maybe ImageData) | QuitChat | ShowVersion deriving (Show) @@ -153,6 +155,7 @@ data ChatResponse | CRChatRunning | CRApiChats {chats :: [AChat]} | CRApiChat {chat :: AChat} + | CRApiParsedMarkdown {formattedText :: Maybe MarkdownList} | CRUserSMPServers {smpServers :: [SMPServer]} | CRNewChatItem {chatItem :: AChatItem} | CRChatItemStatusUpdated {chatItem :: AChatItem} diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 04df7a9a5..dfa4497b9 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -147,14 +147,16 @@ cmToQuotedMsg = \case XMsgNew (MCQuote quotedMsg _) -> Just quotedMsg _ -> Nothing -data MsgContentTag = MCText_ | MCUnknown_ Text +data MsgContentTag = MCText_ | MCLink_ | MCUnknown_ Text instance StrEncoding MsgContentTag where strEncode = \case MCText_ -> "text" + MCLink_ -> "link" MCUnknown_ t -> encodeUtf8 t strDecode = \case "text" -> Right MCText_ + "link" -> Right MCLink_ t -> Right . MCUnknown_ $ safeDecodeUtf8 t strP = strDecode <$?> A.takeTill (== ' ') @@ -177,19 +179,32 @@ mcContent = \case MCQuote _ c -> c MCForward c -> c +data LinkPreview = LinkPreview {uri :: Text, title :: Text, description :: Text, image :: ImageData} + deriving (Eq, Show, Generic) + +instance FromJSON LinkPreview where + parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True} + +instance ToJSON LinkPreview where + toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True} + toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} + data MsgContent = MCText Text + | MCLink {text :: Text, preview :: LinkPreview} | MCUnknown {tag :: Text, text :: Text, json :: J.Object} deriving (Eq, Show) msgContentText :: MsgContent -> Text msgContentText = \case MCText t -> t + MCLink {text} -> text MCUnknown {text} -> text msgContentTag :: MsgContent -> MsgContentTag msgContentTag = \case MCText _ -> MCText_ + MCLink {} -> MCLink_ MCUnknown {tag} -> MCUnknown_ tag parseMsgContainer :: J.Object -> JT.Parser MsgContainer @@ -204,6 +219,10 @@ instance FromJSON MsgContent where parseJSON (J.Object v) = v .: "type" >>= \case MCText_ -> MCText <$> v .: "text" + MCLink_ -> do + text <- v .: "text" + preview <- v .: "preview" + pure MCLink {text, preview} MCUnknown_ tag -> do text <- fromMaybe unknownMsgType <$> v .:? "text" pure MCUnknown {tag, text, json = v} @@ -223,9 +242,11 @@ instance ToJSON MsgContent where toJSON = \case MCUnknown {json} -> J.Object json MCText t -> J.object ["type" .= MCText_, "text" .= t] + MCLink {text, preview} -> J.object ["type" .= MCLink_, "text" .= text, "preview" .= preview] toEncoding = \case MCUnknown {json} -> JE.value $ J.Object json MCText t -> J.pairs $ "type" .= MCText_ <> "text" .= t + MCLink {text, preview} -> J.pairs $ "type" .= MCLink_ <> "text" .= text <> "preview" .= preview instance ToField MsgContent where toField = toField . safeDecodeUtf8 . LB.toStrict . J.encode diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index ed38209ed..df9fb5b09 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -269,7 +269,7 @@ getUsers st = JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id |] -toUser :: (UserId, Int64, Bool, ContactName, Text, Maybe ProfileImage) -> User +toUser :: (UserId, Int64, Bool, ContactName, Text, Maybe ImageData) -> User toUser (userId, userContactId, activeUser, displayName, fullName, image) = let profile = Profile {displayName, fullName, image} in User {userId, userContactId, localDisplayName = displayName, profile, activeUser} @@ -482,7 +482,7 @@ updateContact_ db userId contactId displayName newName updatedAt = do (newName, updatedAt, userId, contactId) DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (displayName, userId) -type ContactRow = (Int64, ContactName, Maybe Int64, ContactName, Text, Maybe ProfileImage, UTCTime) +type ContactRow = (Int64, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, UTCTime) toContact :: ContactRow :. ConnectionRow -> Contact toContact ((contactId, localDisplayName, viaGroup, displayName, fullName, image, createdAt) :. connRow) = @@ -758,7 +758,7 @@ getContactRequest_ db userId contactRequestId = |] (userId, contactRequestId) -type ContactRequestRow = (Int64, ContactName, AgentInvId, Int64, AgentConnId, Int64, ContactName, Text, Maybe ProfileImage, UTCTime, Maybe XContactId) +type ContactRequestRow = (Int64, ContactName, AgentInvId, Int64, AgentConnId, Int64, ContactName, Text, Maybe ImageData, UTCTime, Maybe XContactId) toContactRequest :: ContactRequestRow -> UserContactRequest toContactRequest (contactRequestId, localDisplayName, agentInvitationId, userContactLinkId, agentContactConnId, profileId, displayName, fullName, image, createdAt, xContactId) = do @@ -1092,7 +1092,7 @@ getConnectionEntity st User {userId, userContactId} agentConnId = WHERE c.user_id = ? AND c.contact_id = ? |] (userId, contactId) - toContact' :: Int64 -> Connection -> [(ContactName, Text, Text, Maybe ProfileImage, Maybe Int64, UTCTime)] -> Either StoreError Contact + toContact' :: Int64 -> Connection -> [(ContactName, Text, Text, Maybe ImageData, Maybe Int64, UTCTime)] -> Either StoreError Contact toContact' contactId activeConn [(localDisplayName, displayName, fullName, image, viaGroup, createdAt)] = let profile = Profile {displayName, fullName, image} in Right $ Contact {contactId, localDisplayName, profile, activeConn, viaGroup, createdAt} @@ -1286,7 +1286,7 @@ getGroupInfoByName st user gName = gId <- ExceptT $ getGroupIdByName_ db user gName ExceptT $ getGroupInfo_ db user gId -type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe ProfileImage, UTCTime) :. GroupMemberRow +type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe ImageData, UTCTime) :. GroupMemberRow toGroupInfo :: Int64 -> GroupInfoRow -> GroupInfo toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, image, createdAt) :. userMemberRow) = @@ -1344,9 +1344,9 @@ getGroupInvitation st user localDisplayName = findFromContact (IBContact contactId) = find ((== Just contactId) . memberContactId) findFromContact _ = const Nothing -type GroupMemberRow = (Int64, Int64, MemberId, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Maybe Int64, ContactName, Maybe Int64, ContactName, Text, Maybe ProfileImage) +type GroupMemberRow = (Int64, Int64, MemberId, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Maybe Int64, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData) -type MaybeGroupMemberRow = (Maybe Int64, Maybe Int64, Maybe MemberId, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Int64, Maybe ContactName, Maybe Int64, Maybe ContactName, Maybe Text, Maybe ProfileImage) +type MaybeGroupMemberRow = (Maybe Int64, Maybe Int64, Maybe MemberId, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Int64, Maybe ContactName, Maybe Int64, Maybe ContactName, Maybe Text, Maybe ImageData) toGroupMember :: Int64 -> GroupMemberRow -> GroupMember toGroupMember userContactId (groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, invitedById, localDisplayName, memberContactId, displayName, fullName, image) = @@ -1724,7 +1724,7 @@ getViaGroupContact st User {userId} GroupMember {groupMemberId} = |] (userId, groupMemberId) where - toContact' :: [(Int64, ContactName, Text, Text, Maybe ProfileImage, Maybe Int64, UTCTime) :. ConnectionRow] -> Maybe Contact + toContact' :: [(Int64, ContactName, Text, Text, Maybe ImageData, Maybe Int64, UTCTime) :. ConnectionRow] -> Maybe Contact toContact' [(contactId, localDisplayName, displayName, fullName, image, viaGroup, createdAt) :. connRow] = let profile = Profile {displayName, fullName, image} activeConn = toConnection connRow diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 54ad6267f..a25a674e6 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -171,7 +171,7 @@ groupName' GroupInfo {localDisplayName = g} = g data Profile = Profile { displayName :: ContactName, fullName :: Text, - image :: Maybe ProfileImage + image :: Maybe ImageData } deriving (Eq, Show, Generic, FromJSON) @@ -182,7 +182,7 @@ instance ToJSON Profile where data GroupProfile = GroupProfile { displayName :: GroupName, fullName :: Text, - image :: Maybe ProfileImage + image :: Maybe ImageData } deriving (Eq, Show, Generic, FromJSON) @@ -190,19 +190,19 @@ instance ToJSON GroupProfile where toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True} toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} -newtype ProfileImage = ProfileImage Text +newtype ImageData = ImageData Text deriving (Eq, Show) -instance FromJSON ProfileImage where - parseJSON = fmap ProfileImage . J.parseJSON +instance FromJSON ImageData where + parseJSON = fmap ImageData . J.parseJSON -instance ToJSON ProfileImage where - toJSON (ProfileImage t) = J.toJSON t - toEncoding (ProfileImage t) = J.toEncoding t +instance ToJSON ImageData where + toJSON (ImageData t) = J.toJSON t + toEncoding (ImageData t) = J.toEncoding t -instance ToField ProfileImage where toField (ProfileImage t) = toField t +instance ToField ImageData where toField (ImageData t) = toField t -instance FromField ProfileImage where fromField = fmap ProfileImage . fromField +instance FromField ImageData where fromField = fmap ImageData . fromField data GroupInvitation = GroupInvitation { fromMember :: MemberIdRole, diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index f6cd89f82..d6f230b4e 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -46,6 +46,7 @@ responseToView testView = \case CRChatRunning -> [] CRApiChats chats -> if testView then testViewChats chats else [plain . bshow $ J.encode chats] CRApiChat chat -> if testView then testViewChat chat else [plain . bshow $ J.encode chat] + CRApiParsedMarkdown ft -> [plain . bshow $ J.encode ft] CRUserSMPServers smpServers -> viewSMPServers smpServers testView CRNewChatItem (AChatItem _ _ chat item) -> viewChatItem chat item CRChatItemStatusUpdated _ -> [] diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index ad0e238e0..7a3492af2 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -13,7 +13,7 @@ import qualified Data.ByteString as B import Data.Char (isDigit) import qualified Data.Text as T import Simplex.Chat.Controller (ChatController (..)) -import Simplex.Chat.Types (Profile (..), ProfileImage (..), User (..)) +import Simplex.Chat.Types (ImageData (..), Profile (..), User (..)) import Simplex.Chat.Util (unlessM) import System.Directory (doesFileExist) import Test.Hspec @@ -22,7 +22,7 @@ aliceProfile :: Profile aliceProfile = Profile {displayName = "alice", fullName = "Alice", image = Nothing} bobProfile :: Profile -bobProfile = Profile {displayName = "bob", fullName = "Bob", image = Just (ProfileImage "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAKHGlDQ1BJQ0MgUHJvZmlsZQAASImFVgdUVNcWve9Nb7QZeu9NehtAem/Sq6gMQ28OQxWxgAQjEFFEREARNFQFg1KjiIhiIQgoYA9IEFBisCAq6OQNJNH4//r/zDpz9ttzz7n73ffWmg0A6QCDxYqD+QCIT0hmezlYywQEBsngngEYCAIy0AC6DGYSy8rDwxUg8Xf9d7wbAxC33tHgzvrP3/9nCISFJzEBgIIRTGey2MkILkawT1oyi4tnEUxjI6IQvMLFkauYqxjQQtewwuoaHy8bBNMBwJMZDHYkAERbhJdJZUYic4hhCNZOCItOQDB3vjkzioFwxLsIXhcRl5IOAImrRzs+fivCk7QRrIL0shAcwNUW+tX8yH/tFfrPXgxG5D84Pi6F+dc9ck+HHJ7g641UMSQlQATQBHEgBaQDGcACbLAVYaIRJhx5Dv+9j77aZ4OsZIFtSEc0iARRIBnpt/9qlvfqpGSQBhjImnCEcUU+NtxnujZy4fbqVEiU/wuXdQyA9S0cDqfzC+e2F4DzyLkSB79wyi0A8KoBcL2GmcJOXePQ3C8MIAJeQAOiQArIAxXuWwMMgSmwBHbAGbgDHxAINgMmojceUZUGMkEWyAX54AA4DMpAJTgJ6sAZ0ALawQVwGVwDt8AQGAUPwQSYBi/AAngHliEIwkEUiAqJQtKQIqQO6UJ0yByyg1whLygQCoEioQQoBcqE9kD5UBFUBlVB9dBPUCd0GboBDUP3oUloDnoNfYRRMBmmwZKwEqwF02Er2AX2gTfBkXAinAHnwPvhUrgaPg23wZfhW/AoPAG/gBdRAEVCCaFkURooOsoG5Y4KQkWg2KidqDxUCaoa1YTqQvWj7qAmUPOoD2gsmoqWQWugTdGOaF80E52I3okuQJeh69Bt6D70HfQkegH9GUPBSGDUMSYYJ0wAJhKThsnFlGBqMK2Yq5hRzDTmHRaLFcIqY42wjthAbAx2O7YAewzbjO3BDmOnsIs4HE4Up44zw7njGLhkXC7uKO407hJuBDeNe48n4aXxunh7fBA+AZ+NL8E34LvxI/gZ/DKBj6BIMCG4E8II2wiFhFOELsJtwjRhmchPVCaaEX2IMcQsYimxiXiV+Ij4hkQiyZGMSZ6kaNJuUinpLOk6aZL0gSxAViPbkIPJKeT95FpyD/k++Q2FQlGiWFKCKMmU/ZR6yhXKE8p7HiqPJo8TTxjPLp5ynjaeEZ6XvAReRV4r3s28GbwlvOd4b/PO8xH4lPhs+Bh8O/nK+Tr5xvkW+an8Ovzu/PH8BfwN/Df4ZwVwAkoCdgJhAjkCJwWuCExRUVR5qg2VSd1DPUW9Sp2mYWnKNCdaDC2fdoY2SFsQFBDUF/QTTBcsF7woOCGEElISchKKEyoUahEaE/ooLClsJRwuvE+4SXhEeElEXMRSJFwkT6RZZFTko6iMqJ1orOhB0XbRx2JoMTUxT7E0seNiV8XmxWnipuJM8TzxFvEHErCEmoSXxHaJkxIDEouSUpIOkizJo5JXJOelhKQspWKkiqW6peakqdLm0tHSxdKXpJ/LCMpYycTJlMr0ySzISsg6yqbIVskOyi7LKcv5ymXLNcs9lifK0+Uj5Ivle+UXFKQV3BQyFRoVHigSFOmKUYpHFPsVl5SUlfyV9iq1K80qiyg7KWcoNyo/UqGoWKgkqlSr3FXFqtJVY1WPqQ6pwWoGalFq5Wq31WF1Q/Vo9WPqw+sw64zXJayrXjeuQdaw0kjVaNSY1BTSdNXM1mzXfKmloBWkdVCrX+uztoF2nPYp7Yc6AjrOOtk6XTqvddV0mbrlunf1KHr2erv0OvRe6avrh+sf179nQDVwM9hr0GvwydDIkG3YZDhnpGAUYlRhNE6n0T3oBfTrxhhja+NdxheMP5gYmiSbtJj8YaphGmvaYDq7Xnl9+PpT66fM5MwYZlVmE+Yy5iHmJ8wnLGQtGBbVFk8t5S3DLGssZ6xUrWKsTlu9tNa2Zlu3Wi/ZmNjssOmxRdk62ObZDtoJ2Pnaldk9sZezj7RvtF9wMHDY7tDjiHF0cTzoOO4k6cR0qndacDZy3uHc50J28XYpc3nqqubKdu1yg92c3Q65PdqguCFhQ7s7cHdyP+T+2EPZI9HjZ0+sp4dnueczLx2vTK9+b6r3Fu8G73c+1j6FPg99VXxTfHv9eP2C/er9lvxt/Yv8JwK0AnYE3AoUC4wO7AjCBfkF1QQtbrTbeHjjdLBBcG7w2CblTembbmwW2xy3+eIW3i2MLedCMCH+IQ0hKwx3RjVjMdQptCJ0gWnDPMJ8EWYZVhw2F24WXhQ+E2EWURQxG2kWeShyLsoiqiRqPtomuiz6VYxjTGXMUqx7bG0sJ84/rjkeHx8S35kgkBCb0LdVamv61mGWOiuXNZFokng4cYHtwq5JgpI2JXUk05A/0oEUlZTvUiZTzVPLU9+n+aWdS+dPT0gf2Ka2bd+2mQz7jB+3o7czt/dmymZmZU7usNpRtRPaGbqzd5f8rpxd07sddtdlEbNis37J1s4uyn67x39PV45kzu6cqe8cvmvM5cll547vNd1b+T36++jvB/fp7Tu673NeWN7NfO38kvyVAmbBzR90fij9gbM/Yv9goWHh8QPYAwkHxg5aHKwr4i/KKJo65HaorVimOK/47eEth2+U6JdUHiEeSTkyUepa2nFU4eiBoytlUWWj5dblzRUSFfsqlo6FHRs5bnm8qVKyMr/y44noE/eqHKraqpWqS05iT6aefHbK71T/j/Qf62vEavJrPtUm1E7UedX11RvV1zdINBQ2wo0pjXOng08PnbE909Gk0VTVLNScfxacTTn7/KeQn8ZaXFp6z9HPNZ1XPF/RSm3Na4PatrUttEe1T3QEdgx3Onf2dpl2tf6s+XPtBdkL5RcFLxZ2E7tzujmXMi4t9rB65i9HXp7q3dL78ErAlbt9nn2DV12uXr9mf+1Kv1X/petm1y/cMLnReZN+s/2W4a22AYOB1l8MfmkdNBxsu210u2PIeKhreP1w94jFyOU7tneu3XW6e2t0w+jwmO/YvfHg8Yl7Yfdm78fdf/Ug9cHyw92PMI/yHvM9Lnki8aT6V9VfmycMJy5O2k4OPPV++nCKOfXit6TfVqZznlGelcxIz9TP6s5emLOfG3q+8fn0C9aL5fnc3/l/r3ip8vL8H5Z/DCwELEy/Yr/ivC54I/qm9q3+295Fj8Un7+LfLS/lvRd9X/eB/qH/o//HmeW0FdxK6SfVT12fXT4/4sRzOCwGm7FqBVBIwhERALyuBYASCAB1CPEPG9f8119+BvrK2fyNwVndL5jhvubRVsMQgCakeCFp04OsQ1LJEgAe5NodqT6WANbT+yf/iqQIPd21PXgaAcDJcjivtwJAQHLFgcNZ9uBwPlUgYhHf1z37f7V9g9e8ITewiP88wfWIYET6HPg21nzjV2fybQVcxfrg2/onng/F50lD/ccAAAA4ZVhJZk1NACoAAAAIAAGHaQAEAAAAAQAAABoAAAAAAAKgAgAEAAAAAQAAABigAwAEAAAAAQAAABgAAAAAwf1XlwAAAaNJREFUSA3FlT1LA0EQQBN/gYUYRTksJZVgEbCR/D+7QMr8ABtttBBCsLGzsLG2sxaxED/ie4d77u0dyaE5HHjczn7MzO7M7nU6/yXz+bwLhzCCjTQO+rZhDH3opuNLdRYN4RHe4RIKJ7R34Ro+4AEGSw2mE1iUwT18gpI74WvkGlccu4XNdH0jnYU7cAUacidn37qR23cOxc4aGU0nYUAn7iSWEHkz46w0ocdQu1X6B/AMQZ5o7KfBqNOfwRH8JB7FajGhnmcpKvQe3MEbvILiDm5gPXaCHnZr4vvFGMoEKudKn8YvQIOOe+YzCPop7dwJ3zRfJ7GDuso4YJGRa0yZgg4tUaNXdGrbuZWKKxzYYEJc2xp9AUUjGt8KC2jvgYadF8+10vJyDnNLXwbdiWUZi0fUK01Eoc+AZhCLZVzK4Vq6sDUdz+0dEcbbTTIOJmAyTVhx/WmvrExbv2jtPhWLKodjCtefZiEeZeVZWWSndgwj6fVf3XON8Qwq15++uoqrfYVrow6dGBpCq79ME291jaB0/Q2CPncyht/99MNO/vr9AqW/CGi8sJqbAAAAAElFTkSuQmCC")} +bobProfile = Profile {displayName = "bob", fullName = "Bob", image = Just (ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAKHGlDQ1BJQ0MgUHJvZmlsZQAASImFVgdUVNcWve9Nb7QZeu9NehtAem/Sq6gMQ28OQxWxgAQjEFFEREARNFQFg1KjiIhiIQgoYA9IEFBisCAq6OQNJNH4//r/zDpz9ttzz7n73ffWmg0A6QCDxYqD+QCIT0hmezlYywQEBsngngEYCAIy0AC6DGYSy8rDwxUg8Xf9d7wbAxC33tHgzvrP3/9nCISFJzEBgIIRTGey2MkILkawT1oyi4tnEUxjI6IQvMLFkauYqxjQQtewwuoaHy8bBNMBwJMZDHYkAERbhJdJZUYic4hhCNZOCItOQDB3vjkzioFwxLsIXhcRl5IOAImrRzs+fivCk7QRrIL0shAcwNUW+tX8yH/tFfrPXgxG5D84Pi6F+dc9ck+HHJ7g641UMSQlQATQBHEgBaQDGcACbLAVYaIRJhx5Dv+9j77aZ4OsZIFtSEc0iARRIBnpt/9qlvfqpGSQBhjImnCEcUU+NtxnujZy4fbqVEiU/wuXdQyA9S0cDqfzC+e2F4DzyLkSB79wyi0A8KoBcL2GmcJOXePQ3C8MIAJeQAOiQArIAxXuWwMMgSmwBHbAGbgDHxAINgMmojceUZUGMkEWyAX54AA4DMpAJTgJ6sAZ0ALawQVwGVwDt8AQGAUPwQSYBi/AAngHliEIwkEUiAqJQtKQIqQO6UJ0yByyg1whLygQCoEioQQoBcqE9kD5UBFUBlVB9dBPUCd0GboBDUP3oUloDnoNfYRRMBmmwZKwEqwF02Er2AX2gTfBkXAinAHnwPvhUrgaPg23wZfhW/AoPAG/gBdRAEVCCaFkURooOsoG5Y4KQkWg2KidqDxUCaoa1YTqQvWj7qAmUPOoD2gsmoqWQWugTdGOaF80E52I3okuQJeh69Bt6D70HfQkegH9GUPBSGDUMSYYJ0wAJhKThsnFlGBqMK2Yq5hRzDTmHRaLFcIqY42wjthAbAx2O7YAewzbjO3BDmOnsIs4HE4Up44zw7njGLhkXC7uKO407hJuBDeNe48n4aXxunh7fBA+AZ+NL8E34LvxI/gZ/DKBj6BIMCG4E8II2wiFhFOELsJtwjRhmchPVCaaEX2IMcQsYimxiXiV+Ij4hkQiyZGMSZ6kaNJuUinpLOk6aZL0gSxAViPbkIPJKeT95FpyD/k++Q2FQlGiWFKCKMmU/ZR6yhXKE8p7HiqPJo8TTxjPLp5ynjaeEZ6XvAReRV4r3s28GbwlvOd4b/PO8xH4lPhs+Bh8O/nK+Tr5xvkW+an8Ovzu/PH8BfwN/Df4ZwVwAkoCdgJhAjkCJwWuCExRUVR5qg2VSd1DPUW9Sp2mYWnKNCdaDC2fdoY2SFsQFBDUF/QTTBcsF7woOCGEElISchKKEyoUahEaE/ooLClsJRwuvE+4SXhEeElEXMRSJFwkT6RZZFTko6iMqJ1orOhB0XbRx2JoMTUxT7E0seNiV8XmxWnipuJM8TzxFvEHErCEmoSXxHaJkxIDEouSUpIOkizJo5JXJOelhKQspWKkiqW6peakqdLm0tHSxdKXpJ/LCMpYycTJlMr0ySzISsg6yqbIVskOyi7LKcv5ymXLNcs9lifK0+Uj5Ivle+UXFKQV3BQyFRoVHigSFOmKUYpHFPsVl5SUlfyV9iq1K80qiyg7KWcoNyo/UqGoWKgkqlSr3FXFqtJVY1WPqQ6pwWoGalFq5Wq31WF1Q/Vo9WPqw+sw64zXJayrXjeuQdaw0kjVaNSY1BTSdNXM1mzXfKmloBWkdVCrX+uztoF2nPYp7Yc6AjrOOtk6XTqvddV0mbrlunf1KHr2erv0OvRe6avrh+sf179nQDVwM9hr0GvwydDIkG3YZDhnpGAUYlRhNE6n0T3oBfTrxhhja+NdxheMP5gYmiSbtJj8YaphGmvaYDq7Xnl9+PpT66fM5MwYZlVmE+Yy5iHmJ8wnLGQtGBbVFk8t5S3DLGssZ6xUrWKsTlu9tNa2Zlu3Wi/ZmNjssOmxRdk62ObZDtoJ2Pnaldk9sZezj7RvtF9wMHDY7tDjiHF0cTzoOO4k6cR0qndacDZy3uHc50J28XYpc3nqqubKdu1yg92c3Q65PdqguCFhQ7s7cHdyP+T+2EPZI9HjZ0+sp4dnueczLx2vTK9+b6r3Fu8G73c+1j6FPg99VXxTfHv9eP2C/er9lvxt/Yv8JwK0AnYE3AoUC4wO7AjCBfkF1QQtbrTbeHjjdLBBcG7w2CblTembbmwW2xy3+eIW3i2MLedCMCH+IQ0hKwx3RjVjMdQptCJ0gWnDPMJ8EWYZVhw2F24WXhQ+E2EWURQxG2kWeShyLsoiqiRqPtomuiz6VYxjTGXMUqx7bG0sJ84/rjkeHx8S35kgkBCb0LdVamv61mGWOiuXNZFokng4cYHtwq5JgpI2JXUk05A/0oEUlZTvUiZTzVPLU9+n+aWdS+dPT0gf2Ka2bd+2mQz7jB+3o7czt/dmymZmZU7usNpRtRPaGbqzd5f8rpxd07sddtdlEbNis37J1s4uyn67x39PV45kzu6cqe8cvmvM5cll547vNd1b+T36++jvB/fp7Tu673NeWN7NfO38kvyVAmbBzR90fij9gbM/Yv9goWHh8QPYAwkHxg5aHKwr4i/KKJo65HaorVimOK/47eEth2+U6JdUHiEeSTkyUepa2nFU4eiBoytlUWWj5dblzRUSFfsqlo6FHRs5bnm8qVKyMr/y44noE/eqHKraqpWqS05iT6aefHbK71T/j/Qf62vEavJrPtUm1E7UedX11RvV1zdINBQ2wo0pjXOng08PnbE909Gk0VTVLNScfxacTTn7/KeQn8ZaXFp6z9HPNZ1XPF/RSm3Na4PatrUttEe1T3QEdgx3Onf2dpl2tf6s+XPtBdkL5RcFLxZ2E7tzujmXMi4t9rB65i9HXp7q3dL78ErAlbt9nn2DV12uXr9mf+1Kv1X/petm1y/cMLnReZN+s/2W4a22AYOB1l8MfmkdNBxsu210u2PIeKhreP1w94jFyOU7tneu3XW6e2t0w+jwmO/YvfHg8Yl7Yfdm78fdf/Ug9cHyw92PMI/yHvM9Lnki8aT6V9VfmycMJy5O2k4OPPV++nCKOfXit6TfVqZznlGelcxIz9TP6s5emLOfG3q+8fn0C9aL5fnc3/l/r3ip8vL8H5Z/DCwELEy/Yr/ivC54I/qm9q3+295Fj8Un7+LfLS/lvRd9X/eB/qH/o//HmeW0FdxK6SfVT12fXT4/4sRzOCwGm7FqBVBIwhERALyuBYASCAB1CPEPG9f8119+BvrK2fyNwVndL5jhvubRVsMQgCakeCFp04OsQ1LJEgAe5NodqT6WANbT+yf/iqQIPd21PXgaAcDJcjivtwJAQHLFgcNZ9uBwPlUgYhHf1z37f7V9g9e8ITewiP88wfWIYET6HPg21nzjV2fybQVcxfrg2/onng/F50lD/ccAAAA4ZVhJZk1NACoAAAAIAAGHaQAEAAAAAQAAABoAAAAAAAKgAgAEAAAAAQAAABigAwAEAAAAAQAAABgAAAAAwf1XlwAAAaNJREFUSA3FlT1LA0EQQBN/gYUYRTksJZVgEbCR/D+7QMr8ABtttBBCsLGzsLG2sxaxED/ie4d77u0dyaE5HHjczn7MzO7M7nU6/yXz+bwLhzCCjTQO+rZhDH3opuNLdRYN4RHe4RIKJ7R34Ro+4AEGSw2mE1iUwT18gpI74WvkGlccu4XNdH0jnYU7cAUacidn37qR23cOxc4aGU0nYUAn7iSWEHkz46w0ocdQu1X6B/AMQZ5o7KfBqNOfwRH8JB7FajGhnmcpKvQe3MEbvILiDm5gPXaCHnZr4vvFGMoEKudKn8YvQIOOe+YzCPop7dwJ3zRfJ7GDuso4YJGRa0yZgg4tUaNXdGrbuZWKKxzYYEJc2xp9AUUjGt8KC2jvgYadF8+10vJyDnNLXwbdiWUZi0fUK01Eoc+AZhCLZVzK4Vq6sDUdz+0dEcbbTTIOJmAyTVhx/WmvrExbv2jtPhWLKodjCtefZiEeZeVZWWSndgwj6fVf3XON8Qwq15++uoqrfYVrow6dGBpCq79ME291jaB0/Q2CPncyht/99MNO/vr9AqW/CGi8sJqbAAAAAElFTkSuQmCC")} cathProfile :: Profile cathProfile = Profile {displayName = "cath", fullName = "Catherine", image = Nothing} diff --git a/tests/ProtocolTests.hs b/tests/ProtocolTests.hs index 2ac9801cb..344c7e0bb 100644 --- a/tests/ProtocolTests.hs +++ b/tests/ProtocolTests.hs @@ -82,7 +82,7 @@ s #==# msg = do s ==# msg testProfile :: Profile -testProfile = Profile {displayName = "alice", fullName = "Alice", image = Just (ProfileImage "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=")} +testProfile = Profile {displayName = "alice", fullName = "Alice", image = Just (ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=")} testGroupProfile :: GroupProfile testGroupProfile = GroupProfile {displayName = "team", fullName = "Team", image = Nothing} @@ -90,6 +90,9 @@ testGroupProfile = GroupProfile {displayName = "team", fullName = "Team", image decodeChatMessageTest :: Spec decodeChatMessageTest = describe "Chat message encoding/decoding" $ do it "x.msg.new" $ "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" #==# XMsgNew (MCSimple $ MCText "hello") + it "x.msg.new" $ + "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"https://simplex.chat\",\"type\":\"link\",\"preview\":{\"description\":\"SimpleX Chat\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA\",\"title\":\"SimpleX Chat\",\"uri\":\"https://simplex.chat\"}}}}" + #==# XMsgNew (MCSimple $ MCLink "https://simplex.chat" $ LinkPreview {uri = "https://simplex.chat", title = "SimpleX Chat", description = "SimpleX Chat", image = ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA"}) it "x.msg.new" $ "{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" ##==## (ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew . MCSimple $ MCText "hello")) it "x.msg.new" $ "{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}}}}"