diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,18 @@ + +50200.1.0 +========= + + * Added `mmUploadFile` and exposed its `UploadResponse` result type. + * Fixed the `FileInfo` JSON decoder to permit `post_id` to be omitted. + * Added `RestrictDirectMessageSetting` data type for + `clientConfigRestrictDirectMessage` field of `ClientConfig`. + * Added `mmAutocompleteUsers`. + * Added `mmAutocompleteChannels`. + * Added `DirectChannelShowStatus` preference type and constructor. + +Bug fixes: + * `mkQueryString` now properly URI-encodes keys and values. + 50200.0.1 ========= diff --git a/mattermost-api.cabal b/mattermost-api.cabal --- a/mattermost-api.cabal +++ b/mattermost-api.cabal @@ -1,5 +1,5 @@ name: mattermost-api -version: 50200.0.1 +version: 50200.1.0 synopsis: Client API for Mattermost chat system description: Client API for Mattermost chat system license: BSD3 diff --git a/src/Network/Mattermost/Connection.hs b/src/Network/Mattermost/Connection.hs --- a/src/Network/Mattermost/Connection.hs +++ b/src/Network/Mattermost/Connection.hs @@ -172,7 +172,9 @@ mkQueryString :: [Maybe (String, String)] -> String mkQueryString ls = - List.intercalate "&" [ k ++ "=" ++ v | Just (k, v) <- ls ] + List.intercalate "&" [ URI.escapeURIString URI.isUnescapedInURIComponent k ++ "=" ++ + URI.escapeURIString URI.isUnescapedInURIComponent v + | Just (k, v) <- ls ] jsonBody :: A.ToJSON i => i -> B.ByteString jsonBody = BL.toStrict . A.encode diff --git a/src/Network/Mattermost/Endpoints.hs b/src/Network/Mattermost/Endpoints.hs --- a/src/Network/Mattermost/Endpoints.hs +++ b/src/Network/Mattermost/Endpoints.hs @@ -1,5 +1,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} module Network.Mattermost.Endpoints where @@ -460,12 +461,16 @@ mmGetFile fileId = inGet (printf "/files/%s" fileId) noBody bytestringResponse --- -- | Uploads a file that can later be attached to a post. --- -- --- -- /Permissions/: Must have @upload_file@ permission. --- mmUploadFile :: Session -> IO XX15 --- mmUploadFile = --- inPost "/files" noBody jsonResponse +-- | Uploads a file that can later be attached to a post. +-- +-- /Permissions/: Must have @upload_file@ permission. +mmUploadFile :: ChannelId -> String -> B.ByteString -> Session -> IO UploadResponse +mmUploadFile cId filename bytes = + let qs = mkQueryString + [ Just ("channel_id", T.unpack $ idString cId) + , Just ("filename", filename) + ] + in inPost (printf "/files?%s" qs) bytes jsonResponse -- | Gets a file's info. -- @@ -1708,18 +1713,33 @@ -- mmPatchUser userId body = -- inPut (printf "/users/%s/patch" userId) (jsonBody body) jsonResponse --- -- | Get a list of users for the purpose of autocompleting based on the --- -- provided search term. Specify a combination of @team_id@ and --- -- @channel_id@ to filter results further. --- -- --- -- /Permissions/: Requires an active session and @view_team@ and --- -- @read_channel@ on any teams or channels used to filter the results --- -- further. --- mmAutocompleteUsers :: TeamId -> ChannelId -> Text -> Session -> IO UserAutocomplete --- mmAutocompleteUsers teamId channelId name = --- inGet (printf "/users/autocomplete?%s" (mkQueryString [ Just ("team_id", T.unpack (idString teamId)) , Just ("channel_id", T.unpack (idString channelId)) , Just ("name", T.unpack name) ])) noBody jsonResponse - +-- | Get a list of users for the purpose of autocompleting based on the +-- provided search term. Specify a combination of @team_id@ and +-- @channel_id@ to filter results further. +-- +-- /Permissions/: Requires an active session and @view_team@ and +-- @read_channel@ on any teams or channels used to filter the results +-- further. +mmAutocompleteUsers :: Maybe TeamId + -> Maybe ChannelId + -> Text -> Session -> IO UserAutocomplete +mmAutocompleteUsers mTeamId mChannelId name = + let queryString = mkQueryString args + args = [ (("in_team",) . T.unpack . idString) <$> mTeamId + , (("in_channel",) . T.unpack . idString) <$> mChannelId + , Just ("name", T.unpack name) + ] + in inGet (printf "/users/autocomplete?%s" queryString) noBody jsonResponse +-- | Get a list of channels for the purpose of autocompleting based on +-- the provided search term. +mmAutocompleteChannels :: TeamId -> Text -> Session -> IO (Seq Channel) +mmAutocompleteChannels teamId name = + let queryString = mkQueryString args + args = [ Just ("name", T.unpack name) + ] + in inGet (printf "/teams/%s/channels/autocomplete?%s" teamId queryString) + noBody jsonResponse -- * Webhooks @@ -3073,23 +3093,24 @@ -- -- --- data UserAutocomplete = UserAutocomplete --- { userAutocompleteUsers :: (Seq User) --- , userAutocompleteOutOfChannel :: (Seq User) --- -- ^ A special case list of users returned when autocompleting in a specific channel. Omitted when empty or not relevant --- } deriving (Read, Show, Eq) +data UserAutocomplete = UserAutocomplete + { userAutocompleteUsers :: Seq User + , userAutocompleteOutOfChannel :: Maybe (Seq User) + -- ^ A special case list of users returned when autocompleting in a + -- specific channel. Omitted when empty or not relevant + } deriving (Read, Show, Eq) --- instance A.FromJSON UserAutocomplete where --- parseJSON = A.withObject "userAutocomplete" $ \v -> do --- userAutocompleteUsers <- v A..: "users" --- userAutocompleteOutOfChannel <- v A..: "out_of_channel" --- return UserAutocomplete { .. } +instance A.FromJSON UserAutocomplete where + parseJSON = A.withObject "userAutocomplete" $ \v -> do + userAutocompleteUsers <- v A..: "users" + userAutocompleteOutOfChannel <- v A..:? "out_of_channel" + return UserAutocomplete { .. } --- instance A.ToJSON UserAutocomplete where --- toJSON UserAutocomplete { .. } = A.object --- [ "users" A..= userAutocompleteUsers --- , "out_of_channel" A..= userAutocompleteOutOfChannel --- ] +instance A.ToJSON UserAutocomplete where + toJSON UserAutocomplete { .. } = A.object + [ "users" A..= userAutocompleteUsers + , "out_of_channel" A..= userAutocompleteOutOfChannel + ] -- -- @@ -3247,23 +3268,23 @@ -- -- --- data XX15 = XX15 --- { xx15ClientIds :: (Seq Text) --- , xx15FileInfos :: (Seq FileInfo) --- -- ^ A list of file metadata that has been stored in the database --- } deriving (Read, Show, Eq) +data UploadResponse = UploadResponse + { uploadResponseClientIds :: (Seq Text) + , uploadResponseFileInfos :: (Seq FileInfo) + -- ^ A list of file metadata that has been stored in the database + } deriving (Read, Show, Eq) --- instance A.FromJSON XX15 where --- parseJSON = A.withObject "xx15" $ \v -> do --- xx15ClientIds <- v A..: "client_ids" --- xx15FileInfos <- v A..: "file_infos" --- return XX15 { .. } +instance A.FromJSON UploadResponse where + parseJSON = A.withObject "UploadResponse" $ \v -> do + uploadResponseClientIds <- v A..: "client_ids" + uploadResponseFileInfos <- v A..: "file_infos" + return UploadResponse { .. } --- instance A.ToJSON XX15 where --- toJSON XX15 { .. } = A.object --- [ "client_ids" A..= xx15ClientIds --- , "file_infos" A..= xx15FileInfos --- ] +instance A.ToJSON UploadResponse where + toJSON UploadResponse { .. } = A.object + [ "client_ids" A..= uploadResponseClientIds + , "file_infos" A..= uploadResponseFileInfos + ] -- -- diff --git a/src/Network/Mattermost/Types.hs b/src/Network/Mattermost/Types.hs --- a/src/Network/Mattermost/Types.hs +++ b/src/Network/Mattermost/Types.hs @@ -911,7 +911,7 @@ parseJSON = A.withObject "file_info" $ \o -> do fileInfoId <- o .: "id" fileInfoUserId <- o .: "user_id" - fileInfoPostId <- o .: "post_id" + fileInfoPostId <- o .:? "post_id" fileInfoCreateAt <- timeFromServer <$> o .: "create_at" fileInfoUpdateAt <- timeFromServer <$> o .: "update_at" fileInfoDeleteAt <- timeFromServer <$> o .: "delete_at" @@ -1207,6 +1207,23 @@ , flaggedPostId :: PostId , flaggedPostStatus :: Bool } deriving (Read, Show, Eq) + +data DirectChannelShowStatus = + DirectChannelShowStatus { directChannelShowUserId :: UserId + , directChannelShowValue :: Bool + } + +preferenceToDirectChannelShowStatus :: Preference -> Maybe DirectChannelShowStatus +preferenceToDirectChannelShowStatus + Preference + { preferenceCategory = PreferenceCategoryDirectChannelShow + , preferenceName = PreferenceName name + , preferenceValue = PreferenceValue value + } = Just DirectChannelShowStatus + { directChannelShowUserId = UI (Id name) + , directChannelShowValue = value == "true" + } +preferenceToDirectChannelShowStatus _ = Nothing -- | Attempt to expose a 'Preference' as a 'FlaggedPost' preferenceToFlaggedPost :: Preference -> Maybe FlaggedPost diff --git a/src/Network/Mattermost/Types/Config.hs b/src/Network/Mattermost/Types/Config.hs --- a/src/Network/Mattermost/Types/Config.hs +++ b/src/Network/Mattermost/Types/Config.hs @@ -188,6 +188,24 @@ toJSON TMFullname = "full_name" toJSON (TMUnknown t) = A.toJSON t +data RestrictDirectMessageSetting = + RestrictAny + | RestrictTeam + | RestrictUnknown T.Text + deriving (Show, Eq, Read) + +instance A.FromJSON RestrictDirectMessageSetting where + parseJSON = A.withText "RestrictDirectMessageSetting" $ \t -> + case t of + "any" -> return RestrictAny + "team" -> return RestrictTeam + _ -> return $ RestrictUnknown t + +instance A.ToJSON RestrictDirectMessageSetting where + toJSON RestrictAny = A.toJSON ("any" :: T.Text) + toJSON RestrictTeam = A.toJSON ("team" :: T.Text) + toJSON (RestrictUnknown t) = A.toJSON t + data ClientConfig = ClientConfig { clientConfigVersion :: T.Text , clientConfigBuildNumber :: T.Text @@ -199,7 +217,7 @@ , clientConfigSiteURL :: T.Text , clientConfigSiteName :: T.Text , clientConfigEnableOpenServer :: T.Text - , clientConfigRestrictDirectMessage :: T.Text + , clientConfigRestrictDirectMessage :: RestrictDirectMessageSetting , clientConfigTeammateNameDisplay :: TeammateNameDisplayMode , clientConfigEnableOAuthServiceProvider :: T.Text