mattermost-api 50200.10.0 → 50200.11.0

raw patch · 6 files changed

+112/−72 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +19/−0
• mattermost-api.cabal +1/−1
• src/Network/Mattermost.hs +35/−35
• src/Network/Mattermost/Types.hs +51/−30
• src/Network/Mattermost/Types/Base.hs +3/−3
• src/Network/Mattermost/WebSocket.hs +3/−3

@@ -1,4 +1,23 @@ +50200.11.0+==========++API changes: (Thanks Ajay Eeralla)+ * Added a new constructor `PreferenceCategoryFavoriteChannel` to the+   `PreferenceCategory` type and updated its JSON parser to recognize+   this category.+ * Added a `FavoriteChannelPreference` type and+   `preferenceToFavoriteChannelPreference` smart constructor.++Other changes:+ * Logging now uses `show`, not `toJSON`, for values to be logged.+   This changes the logging functionality to use simple Show instances+   instead of first converting internal data types back to AESON+   structures. That wasn't really providing any additional value, and+   the extra conversion was producing at least one inconsistency due+   to an unfinished ToJSON implementation. (Thanks to Karl Smeltzer+   (@karljs))+ 50200.10.0 ========== 

@@ -1,5 +1,5 @@ name:                mattermost-api-version:             50200.10.0+version:             50200.11.0 synopsis:            Client API for Mattermost chat system  description:         Client API for Mattermost chat system.  Mattermost is a

@@ -219,7 +219,7 @@   let rawPath = "/api/v3/users/login"   path <- mmPath rawPath   runLogger cd "mmLogin" $-    HttpRequest GET rawPath (Just (toJSON $ login { password = "<elided>" }))+    HttpRequest GET rawPath (Just (show $ login { password = "<elided>" }))   rsp  <- mmUnauthenticatedHTTPPost cd path login   if (rspCode rsp /= (2,0,0))     then do@@ -229,7 +229,7 @@       token <- mmGetHeader   rsp (HdrCustom "Token")       (raw, value) <- mmGetJSONBody "User" rsp       runLogger cd "mmLogin" $-        HttpResponse 200 rawPath (Just raw)+        HttpResponse 200 rawPath (Just $ show raw)       return (Right (Session cd (Token token), value))  showRespCode :: (Int, Int, Int) -> String@@ -257,11 +257,11 @@   let path = "/api/v3/teams/create"   uri <- mmPath path   runLoggerS sess "mmCreateTeam" $-    HttpRequest POST path (Just (toJSON payload))+    HttpRequest POST path (Just $ show payload)   rsp <- mmPOST sess uri payload   (val, r) <- mmGetJSONBody "Team" rsp   runLoggerS sess "mmCreateTeam" $-    HttpResponse 200 path (Just val)+    HttpResponse 200 path (Just $ show val)   return r  -- | Requires an authenticated user. Returns the full list of channels@@ -346,7 +346,7 @@       payload = HM.fromList $ [("channel_id" :: T.Text, chanid)] ++ prev   uri <- mmPath path   runLoggerS sess "mmViewChannel" $-    HttpRequest POST path (Just (toJSON payload))+    HttpRequest POST path (Just $ show payload)   _ <- mmPOST sess uri payload   runLoggerS sess "mmViewChannel" $     HttpResponse 200 path Nothing@@ -368,7 +368,7 @@   rsp <- mmPOST sess uri (""::T.Text)   (val, (_::Channel)) <- mmGetJSONBody "Channel" rsp   runLoggerS sess "mmJoinChannel" $-    HttpResponse 200 path (Just val)+    HttpResponse 200 path (Just $ show val)   return ()  -- |@@ -384,11 +384,11 @@       payload = HM.fromList [("id" :: T.Text, chanid)]   uri <- mmPath path   runLoggerS sess "mmLeaveChannel" $-    HttpRequest POST path (Just (toJSON payload))+    HttpRequest POST path (Just $ show payload)   rsp <- mmPOST sess uri payload   (val, (_::HM.HashMap T.Text ChannelId)) <- mmGetJSONBody "Channel name/ID map" rsp   runLoggerS sess "mmCreateDirect" $-    HttpResponse 200 path (Just val)+    HttpResponse 200 path (Just $ show val)   return ()  -- |@@ -437,7 +437,7 @@   rsp <- mmRequest sess uri   (raw, json) <- mmGetJSONBody "Posts" rsp   runLoggerS sess "mmGetPost" $-    HttpResponse 200 path (Just raw)+    HttpResponse 200 path (Just $ show raw)   return json  -- |@@ -488,11 +488,11 @@   uri <- mmPath path   let req = SearchPosts terms isOrSearch   runLoggerS sess "mmSearchPosts" $-    HttpRequest POST path (Just (toJSON req))+    HttpRequest POST path (Just $ show req)   rsp <- mmPOST sess uri req   (raw, value) <- mmGetJSONBody "SearchPostsResult" rsp   runLoggerS sess "mmSearchPosts" $-    HttpResponse 200 path (Just raw)+    HttpResponse 200 path (Just $ show raw)   return value  -- |@@ -591,11 +591,11 @@       payload = HM.fromList [("user_id" :: T.Text, userid)]   uri <- mmPath path   runLoggerS sess "mmCreateDirect" $-    HttpRequest POST path (Just (toJSON payload))+    HttpRequest POST path (Just $ show payload)   rsp <- mmPOST sess uri payload   (val, r) <- mmGetJSONBody "Channel" rsp   runLoggerS sess "mmCreateDirect" $-    HttpResponse 200 path (Just val)+    HttpResponse 200 path (Just $ show val)   return r  -- { name, display_name, purpose, header }@@ -606,11 +606,11 @@   let path = printf "/api/v3/teams/%s/channels/create" (idString teamid)   uri <- mmPath path   runLoggerS sess "mmCreateChannel" $-    HttpRequest POST path (Just (toJSON payload))+    HttpRequest POST path (Just $ show payload)   rsp <- mmPOST sess uri payload   (val, r) <- mmGetJSONBody "Channel" rsp   runLoggerS sess "mmCreateChannel" $-    HttpResponse 200 path (Just val)+    HttpResponse 200 path (Just $ show val)   return r  -- |@@ -661,11 +661,11 @@                       (idString chanid)   uri <- mmPath path   runLoggerS sess "mmUpdatePost" $-    HttpRequest POST path (Just (toJSON post))+    HttpRequest POST path (Just (show post))   rsp <- mmPOST sess uri post   (val, r) <- mmGetJSONBody "Post" rsp   runLoggerS sess "mmUpdatePost" $-    HttpResponse 200 path (Just (val))+    HttpResponse 200 path (Just $ show val)   return r  -- |@@ -681,11 +681,11 @@                       (idString chanid)   uri <- mmPath path   runLoggerS sess "mmPost" $-    HttpRequest POST path (Just (toJSON post))+    HttpRequest POST path (Just $ show post)   rsp <- mmPOST sess uri post   (val, r) <- mmGetJSONBody "Post" rsp   runLoggerS sess "mmPost" $-    HttpResponse 200 path (Just (val))+    HttpResponse 200 path (Just $ show val)   return r  -- | Get the system configuration. Requires administrative permission.@@ -713,7 +713,7 @@   let path = "/api/v3/admin/save_config"   uri <- mmPath path   runLoggerS sess "mmSaveConfig" $-    HttpRequest POST path (Just config)+    HttpRequest POST path (Just $ show config)   _ <- mmPOST sess uri config   runLoggerS sess "mmSaveConfig" $     HttpResponse 200 path Nothing@@ -733,11 +733,11 @@       req = object ["user_id" .= uId]   uri <- mmPath path   runLoggerS sess "mmChannelAddUser" $-    HttpRequest POST path (Just req)+    HttpRequest POST path (Just $ show req)   rsp <- mmPOST sess uri req   (val, r) <- mmGetJSONBody "ChannelData" rsp   runLoggerS sess "mmChannelAddUser" $-    HttpResponse 200 path (Just val)+    HttpResponse 200 path (Just $ show val)   return r  -- |@@ -752,7 +752,7 @@       req  = object ["user_id" .= uId]   uri <- mmPath path   runLoggerS sess "mmTeamAddUser" $-    HttpRequest POST path (Just req)+    HttpRequest POST path (Just $ show req)   _ <- mmPOST sess uri req   runLoggerS sess "mmTeamAddUSer" $     HttpResponse 200 path Nothing@@ -769,11 +769,11 @@                       (idString teamid)   uri <- mmPath path   runLoggerS sess "mmExecute" $-    HttpRequest POST path (Just (toJSON command))+    HttpRequest POST path (Just $ show command)   rsp <- mmPOST sess uri command   (val, r) <- mmGetJSONBody "Value" rsp   runLoggerS sess "mmExecute" $-    HttpResponse 200 path (Just (val))+    HttpResponse 200 path (Just $ show val)   return r  -- |@@ -785,11 +785,11 @@   let path = "/api/v3/users/create"   uri <- mmPath path   runLogger cd "mmUsersCreate" $-    HttpRequest POST path (Just (toJSON usersCreate))+    HttpRequest POST path (Just $ show usersCreate)   rsp <- mmUnauthenticatedHTTPPost cd uri usersCreate   (val, r) <- mmGetJSONBody "User" rsp   runLogger cd "mmUsersCreate" $-    HttpResponse 200 path (Just (val))+    HttpResponse 200 path (Just $ show val)   return r  -- |@@ -801,11 +801,11 @@   let path = "/api/v3/users/create"   uri <- mmPath path   runLoggerS sess "mmUsersCreateWithToken" $-    HttpRequest POST path (Just (toJSON usersCreate))+    HttpRequest POST path (Just $ show usersCreate)   rsp <- mmPOST sess uri usersCreate   (val, r) <- mmGetJSONBody "User" rsp   runLoggerS sess "mmUsersCreateWithToken" $-    HttpResponse 200 path (Just (val))+    HttpResponse 200 path (Just $ show val)   return r  -- |@@ -869,7 +869,7 @@           }   let rawPath = "/api/v3/preferences/save"   runLoggerS sess "mmFlagPost" $-    HttpRequest POST rawPath (Just (toJSON [flaggedPost]))+    HttpRequest POST rawPath (Just (show [flaggedPost]))   uri <- mmPath rawPath   _ <- mmPOST sess uri (Seq.singleton flaggedPost)   return ()@@ -892,7 +892,7 @@           }   let rawPath = "/api/v3/preferences/delete"   runLoggerS sess "mmUnflagPost" $-    HttpRequest POST rawPath (Just (toJSON [flaggedPost]))+    HttpRequest POST rawPath (Just (show [flaggedPost]))   uri <- mmPath rawPath   _ <- mmPOST sess uri (Seq.singleton flaggedPost)   return ()@@ -928,11 +928,11 @@       fnname = "mmCreateGroupChannel"   uri <- mmPath path   runLoggerS sess fnname $-    HttpRequest POST path (Just (toJSON uIds))+    HttpRequest POST path (Just $ show uIds)   rsp <- mmPOST sess uri uIds   (raw, json) <- mmGetJSONBody fnname rsp   runLogger cd fnname $-    HttpResponse 200 path (Just raw)+    HttpResponse 200 path (Just $ show raw)   return json  mmDeleteRequest :: Session -> URI -> IO ()@@ -991,7 +991,7 @@   rsp  <- mmRequest sess uri   (raw,json) <- mmGetJSONBody fnname rsp   runLogger cd fnname $-    HttpResponse 200 path (Just raw)+    HttpResponse 200 path (Just $ show raw)   action json  mmPOST :: ToJSON t => Session -> URI -> t -> IO Response_String@@ -1011,7 +1011,7 @@   uri <- mmPath path   let req = SetChannelHeader chanid header   runLoggerS sess "mmSetChannelHeader" $-    HttpRequest POST path (Just (toJSON req))+    HttpRequest POST path (Just (show req))   rsp <- mmPOST sess uri req   (_, r) <- mmGetJSONBody "Channel" rsp   return r

@@ -44,7 +44,7 @@                                     ) import           Network.Mattermost.Types.Base import           Network.Mattermost.Types.Internal-import           Network.Mattermost.Util (mkConnection, ConnectionType(..))+import           Network.Mattermost.Util ( mkConnection )  newtype UserText = UserText Text                  deriving (Eq, Show, Ord, Read)@@ -121,7 +121,7 @@   = Login   { username :: Text   , password :: Text-  }+  } deriving (Show)  instance A.ToJSON Login where   toJSON l = A.object ["login_id" A..= username l@@ -132,7 +132,7 @@ data SetChannelHeader = SetChannelHeader   { setChannelHeaderChanId :: ChannelId   , setChannelHeaderString :: Text-  }+  } deriving (Show)  instance A.ToJSON SetChannelHeader where   toJSON (SetChannelHeader cId p) =@@ -143,7 +143,7 @@ data SearchPosts = SearchPosts  { searchPostsTerms      :: Text  , searchPostsIsOrSearch :: Bool- }+ } deriving (Show)  instance A.ToJSON SearchPosts where  toJSON (SearchPosts t os) =@@ -617,6 +617,7 @@     userLocale             <- o .: "locale"     return User { .. } + -- The PostPropAttachment and PostPropAttachmentField types are -- actually defined by Slack, and simply used by Mattermost; the -- description of these fields can be found in this document:@@ -1133,6 +1134,7 @@ data PreferenceCategory   = PreferenceCategoryDirectChannelShow   | PreferenceCategoryGroupChannelShow+  | PreferenceCategoryFavoriteChannel   | PreferenceCategoryTutorialStep   | PreferenceCategoryAdvancedSettings   | PreferenceCategoryFlaggedPost@@ -1147,33 +1149,35 @@  instance A.FromJSON PreferenceCategory where   parseJSON = A.withText "PreferenceCategory" $ \t -> return $ case t of-    "direct_channel_show" -> PreferenceCategoryDirectChannelShow-    "group_channel_show"  -> PreferenceCategoryGroupChannelShow-    "tutorial_step"       -> PreferenceCategoryTutorialStep-    "advanced_settings"   -> PreferenceCategoryAdvancedSettings-    "flagged_post"        -> PreferenceCategoryFlaggedPost-    "display_settings"    -> PreferenceCategoryDisplaySettings-    "theme"               -> PreferenceCategoryTheme-    "oauth_app"           -> PreferenceCategoryAuthorizedOAuthApp-    "notifications"       -> PreferenceCategoryNotifications-    "last"                -> PreferenceCategoryLast-    "teams_order"         -> PreferenceCategoryTeamsOrder-    _                     -> PreferenceCategoryOther t+    "direct_channel_show"   -> PreferenceCategoryDirectChannelShow+    "group_channel_show"    -> PreferenceCategoryGroupChannelShow+    "favorite_channel"      -> PreferenceCategoryFavoriteChannel+    "tutorial_step"         -> PreferenceCategoryTutorialStep+    "advanced_settings"     -> PreferenceCategoryAdvancedSettings+    "flagged_post"          -> PreferenceCategoryFlaggedPost+    "display_settings"      -> PreferenceCategoryDisplaySettings+    "theme"                 -> PreferenceCategoryTheme+    "oauth_app"             -> PreferenceCategoryAuthorizedOAuthApp+    "notifications"         -> PreferenceCategoryNotifications+    "last"                  -> PreferenceCategoryLast+    "teams_order"           -> PreferenceCategoryTeamsOrder+    _                       -> PreferenceCategoryOther t  instance A.ToJSON PreferenceCategory where   toJSON cat = A.String $ case cat of-    PreferenceCategoryDirectChannelShow  -> "direct_channel_show"-    PreferenceCategoryGroupChannelShow   -> "group_channel_show"-    PreferenceCategoryTutorialStep       -> "tutorial_step"-    PreferenceCategoryAdvancedSettings   -> "advanced_settings"-    PreferenceCategoryFlaggedPost        -> "flagged_post"-    PreferenceCategoryDisplaySettings    -> "display_settings"-    PreferenceCategoryTheme              -> "theme"-    PreferenceCategoryAuthorizedOAuthApp -> "oauth_app"-    PreferenceCategoryNotifications      -> "notifications"-    PreferenceCategoryLast               -> "last"-    PreferenceCategoryTeamsOrder         -> "teams_order"-    PreferenceCategoryOther t            -> t+    PreferenceCategoryDirectChannelShow   -> "direct_channel_show"+    PreferenceCategoryGroupChannelShow    -> "group_channel_show"+    PreferenceCategoryFavoriteChannel     -> "favorite_channel"+    PreferenceCategoryTutorialStep        -> "tutorial_step"+    PreferenceCategoryAdvancedSettings    -> "advanced_settings"+    PreferenceCategoryFlaggedPost         -> "flagged_post"+    PreferenceCategoryDisplaySettings     -> "display_settings"+    PreferenceCategoryTheme               -> "theme"+    PreferenceCategoryAuthorizedOAuthApp  -> "oauth_app"+    PreferenceCategoryNotifications       -> "notifications"+    PreferenceCategoryLast                -> "last"+    PreferenceCategoryTeamsOrder          -> "teams_order"+    PreferenceCategoryOther t             -> t  data PreferenceName   = PreferenceName { fromRawPreferenceName :: Text }@@ -1219,12 +1223,30 @@     , "value"    .= preferenceValue     ] +data FavoriteChannelPreference =+    FavoriteChannelPreference { favoriteChannelId :: ChannelId+                              , favoriteChannelShow :: Bool+                              } deriving (Read, Show, Eq)++-- | Attempt to expose a 'Preference' as a 'FavoriteChannelPreference'+preferenceToFavoriteChannelPreference :: Preference -> Maybe FavoriteChannelPreference+preferenceToFavoriteChannelPreference+  Preference+    { preferenceCategory = PreferenceCategoryFavoriteChannel+    , preferenceName     = PreferenceName name+    , preferenceValue    = PreferenceValue value+    } = Just FavoriteChannelPreference+          { favoriteChannelId = CI (Id name)+          , favoriteChannelShow = value == "true"+          }+preferenceToFavoriteChannelPreference _ = Nothing+ data GroupChannelPreference =     GroupChannelPreference { groupChannelId :: ChannelId                            , groupChannelShow :: Bool                            } deriving (Read, Show, Eq) --- | Attempt to expose a 'Preference' as a 'FlaggedPost'+-- | Attempt to expose a 'Preference' as a 'GroupChannelPreference' preferenceToGroupChannelPreference :: Preference -> Maybe GroupChannelPreference preferenceToGroupChannelPreference   Preference@@ -1418,7 +1440,6 @@  instance A.ToJSON User where toJSON = error "to user" instance A.ToJSON Team where toJSON = error "to team"-  -- -- 

@@ -25,10 +25,10 @@  -- | A 'LogEventType' describes the particular event that happened data LogEventType-  = HttpRequest RequestMethod String (Maybe A.Value)-  | HttpResponse Int String (Maybe A.Value)+  = HttpRequest RequestMethod String (Maybe String)+  | HttpResponse Int String (Maybe String)   | WebSocketRequest A.Value-  | WebSocketResponse (Either String A.Value)+  | WebSocketResponse (Either String String)   -- ^ Left means we got an exception trying to parse the response;   -- Right means we succeeded and here it is.   | WebSocketPing

@@ -126,7 +126,7 @@            val <- case result of                 Left e -> do-                    doLog $ WebSocketResponse $ Right $ toJSON $+                    doLog $ WebSocketResponse $ Right $                          "Got exception on receiveDataMessage: " <> show e                     throwIO e                 Right dataMsg -> do@@ -157,8 +157,8 @@            doLog (WebSocketResponse $ case val of                 Left s -> Left s-                Right (Left v) -> Right $ toJSON v-                Right (Right v) -> Right $ toJSON v+                Right (Left v) -> Right $ show v+                Right (Right v) -> Right $ show v                 )           recv val         body (MMWS c health) `catch` propagate [mId, pId]