packages feed

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 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"+  }+}