mattermost-api 50200.5.0 → 50200.6.0
raw patch · 7 files changed
+132/−40 lines, 7 files
Files
- CHANGELOG.md +18/−0
- examples/MakePost.hs +11/−9
- mattermost-api.cabal +1/−1
- src/Network/Mattermost/Connection.hs +43/−1
- src/Network/Mattermost/Exceptions.hs +18/−0
- src/Network/Mattermost/Types.hs +30/−12
- src/Network/Mattermost/WebSocket/Types.hs +11/−17
CHANGELOG.md view
@@ -1,4 +1,22 @@ +50200.6.0+=========++API changes:+ * Version 4 API functions now all have the potential to raise a new+ exception type, `RateLimitExceptions`, when HTTP 429 (rate limiting)+ responses are received. The new exception type provides rate limit+ metadata received from the server so the caller can determine whether+ to attempt a request again, and how long to wait before attempting+ it.+ * The `ChannelNotifyProps` type got a new+ `channelNotifyPropsIgnoreChannelMentions` field.+ * The `WEData` type got a `wepChannelMember` field.++Other changes:+ * `channel_member_updated` websocket events are now parsed.+ * Some haddock syntax errors were fixed (thanks Eric Mertens)+ 50200.5.0 =========
examples/MakePost.hs view
@@ -57,7 +57,7 @@ (ReqArg (\arg opt -> return opt { optMessage = T.pack arg }) "MESSAGE")- "message to send"+ "message to send (reads stdin if not specified)" , Option "h" ["help"] (NoArg (\_ -> do@@ -102,15 +102,17 @@ when (optVerbose opts) $ do pPrint chan when (channelName chan == optChannel opts) $ do- when (not (T.null (optMessage opts))) $ do- let pendingPost = RawPost+ theMsg <- if T.null (optMessage opts)+ then T.pack <$> getContents+ else return $ optMessage opts+ let pendingPost = RawPost { rawPostChannelId = getId chan- , rawPostMessage = optMessage opts+ , rawPostMessage = theMsg , rawPostFileIds = mempty , rawPostRootId = Nothing }- -- pendingPost <- mkPendingPost (optMessage opts)- -- (getId mmUser)- -- (getId chan)- post <- mmCreatePost pendingPost session- when (optVerbose opts) (pPrint post)+ -- pendingPost <- mkPendingPost (optMessage opts)+ -- (getId mmUser)+ -- (getId chan)+ post <- mmCreatePost pendingPost session+ when (optVerbose opts) (pPrint post)
mattermost-api.cabal view
@@ -1,5 +1,5 @@ name: mattermost-api-version: 50200.5.0+version: 50200.6.0 synopsis: Client API for Mattermost chat system description: Client API for Mattermost chat system. Mattermost is a
src/Network/Mattermost/Connection.hs view
@@ -5,7 +5,7 @@ import Control.Arrow (left) import Control.Exception (throwIO, IOException, try, throwIO) import Control.Monad (when)-import Data.Maybe (isJust)+import Data.Maybe (isJust, listToMaybe) import Data.Monoid ((<>)) import Data.Pool (destroyAllResources) import qualified Data.Aeson as A@@ -20,6 +20,7 @@ import qualified Network.HTTP.Media as HTTPM import qualified Network.URI as URI import System.IO.Error (isEOFError)+import Text.Read ( readMaybe ) import Network.Mattermost.Exceptions import Network.Mattermost.Types@@ -95,6 +96,18 @@ -> IO HTTP.Response_String doUnauthRequest cd = submitRequest cd Nothing +-- | Submit an HTTP request.+--+-- If the request fails due to a 429 (rate-limited) response, this+-- raises 'RateLimitException' with the fields populated from the+-- response headers where possible.+--+-- If the response status is 2XX, the response is returned.+--+-- If the response status is anything else, its body is assumed to be+-- a JSON encoding of a Mattermost server error. If it can be decoded+-- as such, a 'MattermostError' exception is raised. Otherwise an+-- 'HTTPResponseException' is raised. submitRequest :: ConnectionData -> Maybe Token -> HTTP.RequestMethod@@ -151,6 +164,14 @@ rsp <- hoistE (left ConnectionException rawResponse) case HTTP.rspCode rsp of+ (4, 2, 9) -> do+ -- Extract rate limit information if possible+ let headers = HTTP.getHeaders rsp+ mLimit = readMaybe =<< findHeader rateLimitLimitHeader headers+ mRemaining = readMaybe =<< findHeader rateLimitRemainingHeader headers+ mReset = readMaybe =<< findHeader rateLimitResetHeader headers++ throwIO $ RateLimitException mLimit mRemaining mReset (2, _, _) -> return rsp code -> do case A.eitherDecode (BL.pack (HTTP.rspBody rsp)) of@@ -158,6 +179,27 @@ throwIO (err :: MattermostError) Left _ -> throwIO (HTTPResponseException ("Server returned unexpected " ++ show code ++ " response"))++-- NOTE: At least as of HTTP-4000.3.14, custom header names are matched+-- case-sensitively when looking them up in responses. This is a bug+-- (reported at https://github.com/haskell/HTTP/issues/128) and in+-- the mean time we use our own header-matching implementation.+findHeader :: HTTP.HeaderName -> [HTTP.Header] -> Maybe String+findHeader n hs = HTTP.hdrValue <$> listToMaybe (filter (matchHeader n) hs)++matchHeader :: HTTP.HeaderName -> HTTP.Header -> Bool+matchHeader (HTTP.HdrCustom a) (HTTP.Header (HTTP.HdrCustom b) _) =+ (toLower <$> a) == (toLower <$> b)+matchHeader a (HTTP.Header b _) = a == b++rateLimitLimitHeader :: HTTP.HeaderName+rateLimitLimitHeader = HTTP.HdrCustom "X-RateLimit-Limit"++rateLimitRemainingHeader :: HTTP.HeaderName+rateLimitRemainingHeader = HTTP.HdrCustom "X-RateLimit-Remaining"++rateLimitResetHeader :: HTTP.HeaderName+rateLimitResetHeader = HTTP.HdrCustom "X-RateLimit-Reset" isConnectionError :: IOException -> Bool isConnectionError e =
src/Network/Mattermost/Exceptions.hs view
@@ -12,6 +12,7 @@ , MattermostError(..) , ConnectionException(..) , MattermostServerError(..)+, RateLimitException(..) ) where import qualified Data.Aeson as A@@ -84,6 +85,23 @@ deriving (Show, Typeable) instance Exception MattermostServerError++-- | An exception raised when a request could not be completed due to a+-- request rate limit violation.+data RateLimitException =+ RateLimitException { rateLimitExceptionLimit :: Maybe Int+ -- ^ The total number of requests allowed in the+ -- current rate limit window.+ , rateLimitExceptionRemaining :: Maybe Int+ -- ^ The number of requests remaining in the+ -- current rate limit window.+ , rateLimitExceptionReset :: Maybe Int+ -- ^ The number of seconds until the rate limit+ -- window resets.+ }+ deriving (Show, Typeable)++instance Exception RateLimitException --
src/Network/Mattermost/Types.hs view
@@ -315,10 +315,11 @@ } deriving (Eq, Show, Read, Ord) data ChannelNotifyProps = ChannelNotifyProps- { channelNotifyPropsEmail :: WithDefault Bool- , channelNotifyPropsDesktop :: WithDefault NotifyOption- , channelNotifyPropsPush :: WithDefault NotifyOption- , channelNotifyPropsMarkUnread :: WithDefault NotifyOption+ { channelNotifyPropsEmail :: WithDefault Bool+ , channelNotifyPropsDesktop :: WithDefault NotifyOption+ , channelNotifyPropsPush :: WithDefault NotifyOption+ , channelNotifyPropsMarkUnread :: WithDefault NotifyOption+ , channelNotifyPropsIgnoreChannelMentions :: WithDefault Bool } deriving (Eq, Show, Read, Ord) emptyUserNotifyProps :: UserNotifyProps@@ -334,10 +335,11 @@ emptyChannelNotifyProps :: ChannelNotifyProps emptyChannelNotifyProps = ChannelNotifyProps- { channelNotifyPropsEmail = Default- , channelNotifyPropsPush = Default- , channelNotifyPropsDesktop = Default- , channelNotifyPropsMarkUnread = Default+ { channelNotifyPropsEmail = Default+ , channelNotifyPropsPush = Default+ , channelNotifyPropsDesktop = Default+ , channelNotifyPropsMarkUnread = Default+ , channelNotifyPropsIgnoreChannelMentions = Default } newtype BoolString = BoolString { fromBoolString :: Bool }@@ -353,6 +355,19 @@ toJSON (BoolString True) = A.String "true" toJSON (BoolString False) = A.String "false" +newtype OnOffString = OnOffString{ fromOnOffString :: Bool }++instance A.FromJSON OnOffString where+ parseJSON = A.withText "on/off setting" $ \v ->+ case v of+ "on" -> return (OnOffString True)+ "off" -> return (OnOffString False)+ _ -> fail "Expected \"on\" or \"off\""++instance A.ToJSON OnOffString where+ toJSON (OnOffString True) = A.String "on"+ toJSON (OnOffString False) = A.String "off"+ instance A.FromJSON UserNotifyProps where parseJSON = A.withObject "UserNotifyProps" $ \v -> do userNotifyPropsMentionKeys <- (fmap UserText) <$> T.split (==',') <$>@@ -383,14 +398,17 @@ channelNotifyPropsPush <- v .:? "push" .!= IsValue NotifyOptionMention channelNotifyPropsDesktop <- v .:? "desktop" .!= IsValue NotifyOptionAll channelNotifyPropsMarkUnread <- v .:? "mark_unread" .!= IsValue NotifyOptionAll+ channelNotifyPropsIgnoreChannelMentions <- fmap fromOnOffString <$>+ (v .:? "ignore_channel_mentions" .!= Default) return ChannelNotifyProps { .. } instance A.ToJSON ChannelNotifyProps where toJSON ChannelNotifyProps { .. } = A.object- [ "email" .= fmap BoolString channelNotifyPropsEmail- , "push" .= channelNotifyPropsPush- , "desktop" .= channelNotifyPropsDesktop- , "mark_unread" .= channelNotifyPropsMarkUnread+ [ "email" .= fmap BoolString channelNotifyPropsEmail+ , "push" .= channelNotifyPropsPush+ , "desktop" .= channelNotifyPropsDesktop+ , "mark_unread" .= channelNotifyPropsMarkUnread+ , "ignore_channel_mentions" .= channelNotifyPropsIgnoreChannelMentions ] --
src/Network/Mattermost/WebSocket/Types.hs view
@@ -70,6 +70,7 @@ | WMReactionRemoved | WMChannelViewed | WMChannelUpdated+ | WMChannelMemberUpdated | WMEmojiAdded | WMUserRoleUpdated | WMPluginStatusesChanged@@ -106,6 +107,7 @@ "preferences_deleted" -> return WMPreferenceDeleted "channel_viewed" -> return WMChannelViewed "channel_updated" -> return WMChannelUpdated+ "channel_member_updated" -> return WMChannelMemberUpdated "emoji_added" -> return WMEmojiAdded "user_role_updated" -> return WMUserRoleUpdated "plugin_statuses_changed" -> return WMPluginStatusesChanged@@ -141,6 +143,7 @@ toJSON WMAuthenticationChallenge = "authentication_challenge" toJSON WMChannelViewed = "channel_viewed" toJSON WMChannelUpdated = "channel_updated"+ toJSON WMChannelMemberUpdated = "channel_member_updated" toJSON WMEmojiAdded = "emoji_added" toJSON WMUserRoleUpdated = "user_role_updated" toJSON WMPluginStatusesChanged = "plugin_statuses_changed"@@ -205,6 +208,7 @@ , wepReaction :: Maybe Reaction , wepMentions :: Maybe (Set UserId) , wepPreferences :: Maybe (Seq Preference)+ , wepChannelMember :: Maybe ChannelMember } deriving (Read, Show, Eq) instance FromJSON WEData where@@ -215,23 +219,12 @@ wepUserId <- o .:? "user_id" wepUser <- o .:? "user" wepChannelDisplayName <- o .:? "channel_name"- wepPostRaw <- o .:? "post"- wepPost <- case wepPostRaw of- Just str -> fromValueString str- Nothing -> return Nothing- wepStatus <- o .:? "status"- wepReactionRaw <- o .:? "reaction"- wepReaction <- case wepReactionRaw of- Just str -> fromValueString str- Nothing -> return Nothing- wepMentionsRaw <- o .:? "mentions"- wepMentions <- case wepMentionsRaw of- Just str -> fromValueString str- Nothing -> return Nothing- wepPreferencesRaw <- o .:? "preferences"- wepPreferences <- case wepPreferencesRaw of- Just str -> fromValueString str- Nothing -> return Nothing+ wepPost <- mapM fromValueString =<< o .:? "post"+ wepStatus <- o .:? "status"+ wepReaction <- mapM fromValueString =<< o .:? "reaction"+ wepMentions <- mapM fromValueString =<< o .:? "mentions"+ wepPreferences <- mapM fromValueString =<< o .:? "preferences"+ wepChannelMember <- mapM fromValueString =<< o .:? "channelMember" return WEData { .. } instance ToJSON WEData where@@ -245,6 +238,7 @@ , "reaction" .= wepReaction , "mentions" .= toValueString wepMentions , "preferences" .= toValueString wepPreferences+ , "channelMember" .= toValueString wepChannelMember ] --