matrix-client 0.1.7.0 → 0.1.8.0
raw patch · 6 files changed
+58/−7 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Network.Matrix.Client: Annotation :: Text -> Annotation
+ Network.Matrix.Client: EventReaction :: EventID -> Annotation -> Event
+ Network.Matrix.Client: [unAnnotation] :: Annotation -> Text
+ Network.Matrix.Client: newtype Annotation
Files
- CHANGELOG.md +4/−0
- matrix-client.cabal +1/−1
- src/Network/Matrix/Client.hs +1/−0
- src/Network/Matrix/Events.hs +38/−6
- test/Spec.hs +7/−0
- test/data/reaction.json +7/−0
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Changelog +## 0.1.8.0++- Add support for reaction [#48](https://github.com/softwarefactory-project/matrix-client-haskell/pull/48)+ ## 0.1.7.0 - Improve login response by making the home server field optional [#45](https://github.com/softwarefactory-project/matrix-client-haskell/pull/45)
matrix-client.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: matrix-client-version: 0.1.7.0+version: 0.1.8.0 synopsis: A matrix client library description: Matrix client is a library to interface with https://matrix.org.
src/Network/Matrix/Client.hs view
@@ -1228,6 +1228,7 @@ EventRoomMessage (RoomMessageText oldMT) -> updateText oldMT EventRoomReply _ (RoomMessageText oldMT) -> updateText oldMT EventRoomEdit _ (RoomMessageText oldMT) -> updateText oldMT+ EventReaction _ _ -> error "Can't reply to reaction" EventUnknown x -> error $ "Can't reply to " <> show x in EventRoomReply eventID (RoomMessageText newMessage)
src/Network/Matrix/Events.hs view
@@ -7,6 +7,7 @@ RoomMessage (..), Event (..), EventID (..),+ Annotation (..), eventType, ) where@@ -62,6 +63,9 @@ format = omitNull "format" $ mtFormat msg formattedBody = omitNull "formatted_body" $ mtFormattedBody msg +reactionAttr :: [Pair]+reactionAttr = ["msg_type" .= ("m.reaction" :: Text)]+ instance ToJSON MessageText where toJSON = object . messageTextAttr @@ -87,11 +91,14 @@ deriving (Show, Eq) data Event- = EventRoomMessage RoomMessage+ = -- | [`m.room.message`](https://spec.matrix.org/v1.17/client-server-api/#mroommessage)+ EventRoomMessage RoomMessage | -- | A reply defined by the parent event id and the reply message EventRoomReply EventID RoomMessage | -- | An edit defined by the original message and the new message EventRoomEdit (EventID, RoomMessage) RoomMessage+ | -- [`m.reaction`](https://spec.matrix.org/v1.17/client-server-api/#mreaction)+ EventReaction EventID Annotation | EventUnknown Object deriving (Eq, Show) @@ -116,6 +123,16 @@ , "m.new_content" .= object (roomMessageAttr newMsg) ] in object $ editAttr <> roomMessageAttr msg+ EventReaction (EventID eventID) (Annotation annotationText) ->+ let attr =+ [ "m.relates_to"+ .= object+ [ "rel_type" .= ("m.annotation" :: Text)+ , "event_id" .= eventID+ , "key" .= annotationText+ ]+ ]+ in object $ attr <> reactionAttr EventUnknown v -> Object v instance FromJSON Event where@@ -123,21 +140,33 @@ parseRelated <|> parseMessage <|> pure (EventUnknown content) where parseMessage = EventRoomMessage <$> parseJSON (Object content)+ -- https://spec.matrix.org/v1.17/client-server-api/#forming-relationships-between-events parseRelated = do relateM <- content .: "m.relates_to" case relateM of- Object relate -> parseReply relate <|> parseReplace relate+ Object relate ->+ parseReply relate+ <|> parseByRelType relate _ -> mzero+ -- rich replies is a special kind of a relationship not using rel_type+ -- https://spec.matrix.org/v1.17/client-server-api/#rich-replies parseReply relate = EventRoomReply <$> relate .: "m.in_reply_to" <*> parseJSON (Object content)- parseReplace relate = do+ -- relationships using rel_type+ parseByRelType relate = do rel_type <- relate .: "rel_type"- if rel_type == ("m.replace" :: Text)- then do+ case (rel_type :: Text) of+ -- https://spec.matrix.org/v1.17/client-server-api/#event-replacements+ "m.replace" -> do ev <- EventID <$> relate .: "event_id" msg <- parseJSON (Object content) EventRoomEdit (ev, msg) <$> content .: "m.new_content"- else mzero+ -- https://spec.matrix.org/v1.17/client-server-api/#mannotation-relationship-type+ "m.annotation" -> do+ ev <- EventID <$> relate .: "event_id"+ annotation <- Annotation <$> relate .: "key"+ pure $ EventReaction ev annotation+ _ -> mzero parseJSON _ = mzero eventType :: Event -> Text@@ -145,7 +174,10 @@ EventRoomMessage _ -> "m.room.message" EventRoomReply _ _ -> "m.room.message" EventRoomEdit _ _ -> "m.room.message"+ EventReaction _ _ -> "m.reaction" -- https://spec.matrix.org/latest/client-server-api/#mreaction EventUnknown _ -> error $ "Event is not implemented: " <> show event++newtype Annotation = Annotation {unAnnotation :: Text} deriving (Show, Eq, Ord) newtype EventID = EventID {unEventID :: Text} deriving (Show, Eq, Ord)
test/Spec.hs view
@@ -96,6 +96,13 @@ mtBody srcMsg `shouldBe` " * > :typo" mtBody message `shouldBe` "> :hello" _ -> error $ show resp+ it "decode reaction" $ do+ resp <- decodeResp <$> BS.readFile "test/data/reaction.json"+ case resp of+ Right (Right (EventReaction eventID (Annotation annText))) -> do+ eventID `shouldBe` EventID "$eventID"+ annText `shouldBe` "\128077" -- :+1:+ _ -> error $ show resp it "encode room message" $ encodePretty (RoomMessageText (MessageText "Hello" TextType Nothing Nothing)) `shouldBe` "{\"body\":\"Hello\",\"msgtype\":\"m.text\"}"
+ test/data/reaction.json view
@@ -0,0 +1,7 @@+{+ "m.relates_to": {+ "event_id": "$eventID",+ "key": "👍",+ "rel_type": "m.annotation"+ }+}