diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,30 @@ +40600.0.0 +========= + +API changes: + * This release provides implementations of many of Mattermost's version + 4 API endpoints in the new Network.Mattermost.Endpoints module. The + old version 3 API is still provided by Network.Mattermost but will + be deprecated in a future release, and removed after that. Note + that this release chiefly exposes version 4 endpoints used by the + Matterhorn application; endpoints not used there have not been tested + and so are left commented out in this release and may be enabled in + future releases as needed. + * This release also provides first-class Haskell types corresponding to + the server-side configuration; see Network.Mattermost.Types.Config. + * The Post data type got a new postEditAt field corresponding to the + (at the time) undocumented `edit_at` field of posts. + * Websockets got action support; see + Network.Mattermost.WebSocket.mmSendWSAction and the new + WebsocketAction type (thanks to Abhinav Sarkar for this change) + * All UTCTimes received from the Mattermost server are wrapped in a + `ServerTime` newtype to ensure that users cannot accidentally compare + such timestamps to local UTCTimes, since the server time is not + necessarily comparable. + * Added Network.Mattermost.Endpoints.mmGetClientConfig to get the + client configuration from the server (Thanks to Kelly McLaughlin for + this change) + 40400.0.0 ========= diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -[![Build +[![Hackage](https://img.shields.io/hackage/v/mattermost-api.svg)](https://hackage.haskell.org/package/mattermost-api) [![Build Status](https://travis-ci.org/matterhorn-chat/mattermost-api.svg?branch=master)](https://travis-ci.org/matterhorn-chat/mattermost-api) # mattermost-api Client side API for communicating with a Mattermost server, in Haskell. diff --git a/examples/GetChannels.hs b/examples/GetChannels.hs --- a/examples/GetChannels.hs +++ b/examples/GetChannels.hs @@ -9,7 +9,9 @@ import Data.Foldable import Control.Monad ( when, join ) -import Network.Mattermost +import Network.Mattermost.Endpoints +import Network.Mattermost.Types +import Network.Mattermost.Util import Config import LocalConfig -- You will need to define a function: @@ -31,11 +33,10 @@ putStrLn "Authenticated as:" pPrint mmUser - i <- mmGetInitialLoad session - forM_ (initialLoadTeams i) $ \t -> do + teams <- mmGetUsersTeams UserMe session + forM_ teams $ \t -> do when (teamName t == configTeam config) $ do - chans <- mmGetChannels session (teamId t) + chans <- mmGetChannelsForUser UserMe (getId t) session forM_ chans $ \chan -> do - channel <- mmGetChannel session (teamId t) (channelId chan) - pPrint channel + pPrint chan putStrLn "" diff --git a/examples/GetPosts.hs b/examples/GetPosts.hs --- a/examples/GetPosts.hs +++ b/examples/GetPosts.hs @@ -19,7 +19,8 @@ import System.Console.GetOpt import System.Environment ( getArgs, getProgName ) -import Network.Mattermost +import Network.Mattermost.Endpoints +import Network.Mattermost.Types import Network.Mattermost.Logging import Network.Mattermost.Util @@ -113,20 +114,23 @@ putStrLn "Authenticated as:" pPrint mmUser - i <- mmGetInitialLoad session + teams <- mmGetUsersTeams UserMe session when (optVerbose opts) $ do - pPrint i - forM_ (initialLoadTeams i) $ \t -> do + pPrint teams + forM_ teams $ \t -> do when (teamName t == configTeam config) $ do - userMap <- mmGetProfiles session (getId t) 0 10000 + users <- mmGetUsers (defaultUserQuery { userQueryInTeam = Just (getId t), userQueryPerPage = Just 1000 }) session + let userMap = HM.fromList [ (getId u, u) | u <- toList users ] when (optVerbose opts) $ do pPrint userMap - chans <- mmGetChannels session (getId t) + chans <- mmGetChannelsForUser UserMe (getId t) session forM_ chans $ \chan -> do when (optVerbose opts) $ do pPrint chan when (channelName chan == optChannel opts) $ do - posts <- mmGetPosts session (getId t) (getId chan) (optOffset opts) (optLimit opts) + posts <- mmGetPostsForChannel (getId chan) defaultPostQuery { postQueryPage = Just (optOffset opts) + , postQueryPerPage = Just (optLimit opts) + } session forM_ (reverse (toList (postsOrder posts))) $ \postId -> do -- this is just a toy program, so we don't care about -- this pattern match failure diff --git a/examples/GetTeams.hs b/examples/GetTeams.hs --- a/examples/GetTeams.hs +++ b/examples/GetTeams.hs @@ -6,7 +6,9 @@ import Network.Connection import System.Process ( readProcess ) -import Network.Mattermost +import Network.Mattermost.Endpoints +import Network.Mattermost.Types +import Network.Mattermost.Util import Config import LocalConfig -- You will need to define a function: @@ -27,5 +29,5 @@ (session, mmUser) <- join (hoistE <$> mmLogin cd login) putStrLn "Authenticated as: " pPrint mmUser - i <- mmGetInitialLoad session - pPrint $ initialLoadTeams i + teams <- mmGetUsersTeams UserMe session + pPrint $ teams diff --git a/examples/LocalConfig.hs b/examples/LocalConfig.hs --- a/examples/LocalConfig.hs +++ b/examples/LocalConfig.hs @@ -9,9 +9,9 @@ let cmd = words "pass ldap" pass <- takeWhile (/='\n') <$> readProcess (head cmd) (tail cmd) "" return $ Config - { configUsername = T.pack "gdritter" - , configHostname = T.pack "matterhorn-dev.galois.com" - , configTeam = T.pack "galwegians" + { configUsername = T.pack "USERNAME" + , configHostname = T.pack "mattermost.example.com" + , configTeam = T.pack "TEAMNAME" , configPort = 443 -- currently we only support HTTPS , configPassword = T.pack pass } diff --git a/examples/MakePost.hs b/examples/MakePost.hs --- a/examples/MakePost.hs +++ b/examples/MakePost.hs @@ -18,7 +18,8 @@ import System.Console.GetOpt import System.Environment ( getArgs, getProgName ) -import Network.Mattermost +import Network.Mattermost.Endpoints +import Network.Mattermost.Types import Network.Mattermost.Util import Config @@ -86,22 +87,31 @@ putStrLn "Authenticated as:" pPrint mmUser - i <- mmGetInitialLoad session + teams <- mmGetUsersTeams UserMe session when (optVerbose opts) $ do - pPrint i - forM_ (initialLoadTeams i) $ \t -> do + pPrint teams + forM_ teams $ \t -> do when (teamName t == configTeam config) $ do - userMap <- mmGetProfiles session (getId t) 0 10000 + users <- mmGetUsers (defaultUserQuery { userQueryInTeam = Just (getId t) + , userQueryPerPage = Just 1000 + }) session + let userMap = HM.fromList [ (getId u, u) | u <- toList users ] when (optVerbose opts) $ do pPrint userMap - chans <- mmGetChannels session (getId t) + chans <- mmGetChannelsForUser UserMe (getId t) session forM_ chans $ \chan -> do when (optVerbose opts) $ do pPrint chan when (channelName chan == optChannel opts) $ do when (not (T.null (optMessage opts))) $ do - pendingPost <- mkPendingPost (optMessage opts) - (getId mmUser) - (getId chan) - post <- mmPost session (getId t) pendingPost + let pendingPost = RawPost + { rawPostChannelId = getId chan + , rawPostMessage = optMessage opts + , rawPostFileIds = mempty + , rawPostRootId = Nothing + } + -- pendingPost <- mkPendingPost (optMessage opts) + -- (getId mmUser) + -- (getId chan) + post <- mmCreatePost pendingPost session when (optVerbose opts) (pPrint post) 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: 40400.0.0 +version: 40600.0.0 synopsis: Client API for Mattermost chat system description: Client API for Mattermost chat system license: BSD3 @@ -32,8 +32,11 @@ Network.Mattermost.Version Network.Mattermost.Types Network.Mattermost.Types.Base + Network.Mattermost.Types.Config Network.Mattermost.Types.Internal + Network.Mattermost.Endpoints other-modules: Network.Mattermost.TH + Network.Mattermost.Connection Paths_mattermost_api -- other-extensions: build-depends: base >=4.4 && <5 diff --git a/src/Network/Mattermost.hs b/src/Network/Mattermost.hs --- a/src/Network/Mattermost.hs +++ b/src/Network/Mattermost.hs @@ -1,7 +1,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} module Network.Mattermost ( -- * Types -- ** Mattermost-Related Types (deprecated: use Network.Mattermost.Types instead) @@ -105,6 +104,7 @@ , mmUpdatePost , mmExecute , mmGetConfig +, mmGetClientConfig , mmSetPreferences , mmSavePreferences , mmDeletePreferences @@ -125,11 +125,6 @@ import Text.Printf ( printf ) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as BL -import Data.Time.Clock ( UTCTime ) -import Network.Connection ( Connection - , connectionGetLine - , connectionPut - , connectionClose ) import Network.HTTP.Headers ( HeaderName(..) , mkHeader , lookupHeader ) @@ -138,7 +133,6 @@ , defaultUserAgent , Response_String , Response(..) ) -import Network.Stream as NS ( Stream(..) ) import Network.URI ( URI, parseRelativeReference ) import Network.HTTP.Stream ( simpleHTTP_ ) import Data.HashMap.Strict ( HashMap ) @@ -157,25 +151,14 @@ import qualified Data.Text as T import Control.Arrow ( left ) +import Network.Mattermost.Connection() import Network.Mattermost.Exceptions import Network.Mattermost.Util import Network.Mattermost.Types.Base import Network.Mattermost.Types.Internal import Network.Mattermost.Types -maxLineLength :: Int -maxLineLength = 2^(16::Int) --- | This instance allows us to use 'simpleHTTP' from 'Network.HTTP.Stream' with --- connections from the 'connection' package. -instance Stream Connection where - readLine con = Right . B.unpack . dropTrailingChar <$> connectionGetLine maxLineLength con - readBlock con n = Right . B.unpack <$> connectionGetExact con n - writeBlock con block = Right <$> connectionPut con (B.pack block) - close con = connectionClose con - closeOnEnd _ _ = return () - - -- MM utility functions -- | Parse a path, failing if we cannot. @@ -437,14 +420,14 @@ mmGetPostsSince :: Session -> TeamId -> ChannelId - -> UTCTime + -> ServerTime -> IO Posts mmGetPostsSince sess teamid chanid since = mmDoRequest sess "mmGetPostsSince" $ printf "/api/v3/teams/%s/channels/%s/posts/since/%d" (idString teamid) (idString chanid) - (utcTimeToMilliseconds since :: Int) + (timeToServer since) -- | -- route: @\/api\/v3\/teams\/{team_id}\/channels\/{channel_id}\/posts\/{post_id}\/get@ @@ -720,6 +703,16 @@ -> IO Value mmGetConfig sess = mmDoRequest sess "mmGetConfig" "/api/v3/admin/config" + +-- | Get a subset of the server configuration needed by the client. Does not +-- require administrative permission. The format query parameter is currently +-- required with the value of "old". +-- +-- route: @\/api\/v4\/config\/client@ +mmGetClientConfig :: Session + -> IO Value +mmGetClientConfig sess = + mmDoRequest sess "mmGetClientConfig" "/api/v4/config/client?format=old" mmSaveConfig :: Session -> Value diff --git a/src/Network/Mattermost/Connection.hs b/src/Network/Mattermost/Connection.hs new file mode 100644 --- /dev/null +++ b/src/Network/Mattermost/Connection.hs @@ -0,0 +1,174 @@ +module Network.Mattermost.Connection where + + +import Control.Arrow (left) +import Control.Exception (throwIO) +import qualified Data.Aeson as A +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy.Char8 as BL +import qualified Data.List as List +import qualified Data.Text as T +import qualified Network.HTTP.Base as HTTP +import qualified Network.HTTP.Headers as HTTP +import qualified Network.HTTP.Stream as HTTP +import qualified Network.URI as URI + +import Network.Mattermost.Exceptions +import Network.Mattermost.Types +import Network.Mattermost.Types.Internal +import Network.Mattermost.Util + +-- | Parse a path, failing if we cannot. +mmPath :: String -> IO URI.URI +mmPath str = + noteE (URI.parseRelativeReference str) + (URIParseException ("mmPath: " ++ str)) + + +-- | Parse the JSON body out of a request, failing if it isn't an +-- 'application/json' response, or if the parsing failed +jsonResponse :: A.FromJSON t => HTTP.Response_String -> IO t +jsonResponse rsp = do + contentType <- mmGetHeader rsp HTTP.HdrContentType + assertE (contentType ~= "application/json") + (ContentTypeException + ("Expected content type 'application/json'" ++ + " found " ++ contentType)) + + hoistE $ left (\s -> JSONDecodeException s (HTTP.rspBody rsp)) + (A.eitherDecode (BL.pack (HTTP.rspBody rsp))) + +-- | Parse the JSON body out of a request, failing if it isn't an +-- 'application/json' response, or if the parsing failed +bytestringResponse :: HTTP.Response_String -> IO B.ByteString +bytestringResponse rsp = + return (B.pack (HTTP.rspBody rsp)) + + +noResponse :: HTTP.Response_String -> IO () +noResponse _ = return () + + +-- | Grab a header from the response, failing if it isn't present +mmGetHeader :: HTTP.Response_String -> HTTP.HeaderName -> IO String +mmGetHeader rsp hdr = + noteE (HTTP.lookupHeader hdr (HTTP.rspHeaders rsp)) + (HeaderNotFoundException ("mmGetHeader: " ++ show hdr)) + +-- | Parse the JSON body out of a request, failing if it isn't an +-- 'application/json' response, or if the parsing failed +mmGetJSONBody :: A.FromJSON t => String -> HTTP.Response_String -> IO (t) +mmGetJSONBody label rsp = do + contentType <- mmGetHeader rsp HTTP.HdrContentType + assertE (contentType ~= "application/json") + (ContentTypeException + ("mmGetJSONBody: " ++ label ++ ": " ++ + "Expected content type 'application/json'" ++ + " found " ++ contentType)) + + let value = left (\s -> JSONDecodeException ("mmGetJSONBody: " ++ label ++ ": " ++ s) + (HTTP.rspBody rsp)) + (A.eitherDecode (BL.pack (HTTP.rspBody rsp))) + hoistE $ do + y <- value + return (y) + +doRequest :: HTTP.RequestMethod -> String -> B.ByteString -> Session -> IO HTTP.Response_String +doRequest method uri payload (Session cd token) = do + path <- mmPath ("/api/v4" ++ uri) + rawResponse <- withConnection cd $ \con -> do + let contentLength = B.length payload + request = HTTP.Request + { HTTP.rqURI = path + , HTTP.rqMethod = method + , HTTP.rqHeaders = + [ HTTP.mkHeader HTTP.HdrAuthorization ("Bearer " ++ getTokenString token) + , HTTP.mkHeader HTTP.HdrHost (T.unpack $ cdHostname cd) + , HTTP.mkHeader HTTP.HdrUserAgent HTTP.defaultUserAgent + , HTTP.mkHeader HTTP.HdrContentType "application/json" + , HTTP.mkHeader HTTP.HdrContentLength (show contentLength) + ] ++ autoCloseToHeader (cdAutoClose cd) + , HTTP.rqBody = B.unpack payload + } + HTTP.simpleHTTP_ con request + rsp <- hoistE (left ConnectionException rawResponse) + case HTTP.rspCode rsp of + (2, _, _) -> return rsp + code -> do + case A.eitherDecode (BL.pack (HTTP.rspBody rsp)) of + Right err -> + throwIO (err :: MattermostError) + Left _ -> + throwIO (HTTPResponseException ("Server returned unexpected " ++ show code ++ " response")) + + +mkQueryString :: [Maybe (String, String)] -> String +mkQueryString ls = + List.intercalate "&" [ k ++ "=" ++ v | Just (k, v) <- ls ] + +jsonBody :: A.ToJSON i => i -> B.ByteString +jsonBody = BL.toStrict . A.encode + +noBody :: B.ByteString +noBody = B.empty + + +inPost + :: String + -> B.ByteString + -> (HTTP.Response_String -> IO o) + -> Session + -> IO o +inPost uri payload k session = + doRequest HTTP.POST uri payload session >>= k + +inPut + :: String + -> B.ByteString + -> (HTTP.Response_String -> IO o) + -> Session + -> IO o +inPut uri payload k session = + doRequest HTTP.PUT uri payload session >>= k + +inGet + :: String + -> B.ByteString + -> (HTTP.Response_String -> IO o) + -> Session + -> IO o +inGet uri payload k session = + doRequest HTTP.GET uri payload session >>= k + +inDelete + :: String + -> B.ByteString + -> (HTTP.Response_String -> IO o) + -> Session + -> IO o +inDelete uri payload k session = + doRequest HTTP.DELETE uri payload session >>= k + + + +doUnauthRequest :: HTTP.RequestMethod -> String -> B.ByteString -> ConnectionData -> IO HTTP.Response_String +doUnauthRequest method uri payload cd = do + path <- mmPath ("/api/v4" ++ uri) + rawResponse <- withConnection cd $ \con -> do + let contentLength = B.length payload + request = HTTP.Request + { HTTP.rqURI = path + , HTTP.rqMethod = method + , HTTP.rqHeaders = + [ HTTP.mkHeader HTTP.HdrHost (T.unpack $ cdHostname cd) + , HTTP.mkHeader HTTP.HdrUserAgent HTTP.defaultUserAgent + , HTTP.mkHeader HTTP.HdrContentType "application/json" + , HTTP.mkHeader HTTP.HdrContentLength (show contentLength) + ] ++ autoCloseToHeader (cdAutoClose cd) + , HTTP.rqBody = B.unpack payload + } + HTTP.simpleHTTP_ con request + rsp <- hoistE (left ConnectionException rawResponse) + case HTTP.rspCode rsp of + (2, _, _) -> return rsp + code -> throwIO (HTTPResponseException ("Server returned unexpected " ++ show code ++ " response")) diff --git a/src/Network/Mattermost/Endpoints.hs b/src/Network/Mattermost/Endpoints.hs new file mode 100644 --- /dev/null +++ b/src/Network/Mattermost/Endpoints.hs @@ -0,0 +1,4014 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} + +module Network.Mattermost.Endpoints where + +import qualified Data.Aeson as A +import qualified Data.ByteString.Char8 as B +import qualified Data.HashMap.Strict as HM +import Data.Sequence (Seq) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time.Clock ( UTCTime ) +import qualified Network.HTTP.Base as HTTP +import qualified Network.HTTP.Headers as HTTP +import Text.Printf (printf) + +import Network.Mattermost.Connection +import Network.Mattermost.Exceptions +import Network.Mattermost.Types +import Network.Mattermost.Types.Config +import Network.Mattermost.Types.Internal + + +mmLogin :: ConnectionData -> Login -> IO (Either LoginFailureException (Session, User)) +mmLogin cd login = do + rsp <- doUnauthRequest HTTP.POST "/users/login" (jsonBody login) cd + case HTTP.rspCode rsp of + (2, _, _) -> do + token <- mmGetHeader rsp (HTTP.HdrCustom "Token") + value <- mmGetJSONBody "User" rsp + return (Right (Session cd (Token token), value)) + _ -> + let eMsg = "Server returned unexpected " ++ show (HTTP.rspCode rsp) ++ " response" + in return (Left (LoginFailureException eMsg)) + +mmInitialUser :: ConnectionData -> UsersCreate -> IO User +mmInitialUser cd users = do + rsp <- doUnauthRequest HTTP.POST "/users" (jsonBody users) cd + case HTTP.rspCode rsp of + (2, _, _) -> mmGetJSONBody "User" rsp + _ -> error ("Server returned unexpected " ++ show (HTTP.rspCode rsp) ++ " response") + +-- * Endpoints + +-- * Brand + +-- -- | Uploads a brand image. +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmUploadBrandImage :: Session -> IO () +-- mmUploadBrandImage = +-- inPost "/brand/image" noBody jsonResponse + +-- -- | Get the previously uploaded brand image. Returns 404 if no brand image +-- -- has been uploaded. +-- -- +-- -- /Permissions/: No permission required. +-- mmGetBrandImage :: Session -> IO Text +-- mmGetBrandImage = +-- inGet "/brand/image" noBody jsonResponse + + + +-- * Channels + +-- | Get all channel members on a team for a user. +-- +-- /Permissions/: Logged in as the user and @view_team@ permission for +-- the team. Having @manage_system@ permission voids the previous +-- requirements. +mmGetChannelMembersForUser :: UserParam -> TeamId -> Session -> IO (Seq ChannelMember) +mmGetChannelMembersForUser userId teamId = + inGet (printf "/users/%s/teams/%s/channels/members" userId teamId) noBody jsonResponse + +-- | Get all the channels on a team for a user. +-- +-- /Permissions/: Logged in as the user, or have @edit_other_users@ +-- permission, and @view_team@ permission for the team. +mmGetChannelsForUser :: UserParam -> TeamId -> Session -> IO (Seq Channel) +mmGetChannelsForUser userId teamId = + inGet (printf "/users/%s/teams/%s/channels" userId teamId) noBody jsonResponse + +-- -- | Get a list of channel members based on the provided user ids. +-- -- +-- -- /Permissions/: Must have the @read_channel@ permission. +-- mmGetChannelMembersByIds :: ChannelId -> (Seq Text) -> Session -> IO (Seq ChannelMember) +-- mmGetChannelMembersByIds channelId body = +-- inPost (printf "/channels/%s/members/ids" channelId) (jsonBody body) jsonResponse + +-- | Perform all the actions involved in viewing a channel. This includes +-- marking channels as read, clearing push notifications, and updating +-- the active channel. +-- +-- /Permissions/: Must be logged in as user or have @edit_other_users@ +-- permission. +mmViewChannel :: UserParam -> ChannelId -> Maybe ChannelId -> Session -> IO () +mmViewChannel userId chanId prevChanIdMb = + inPost (printf "/channels/members/%s/view" userId) (jsonBody body) noResponse + where body = HM.fromList $ + ("channel_id" :: T.Text, chanId) + : case prevChanIdMb of + Just prevChanId -> [ ("prev_channel_id", prevChanId) ] + Nothing -> [] + +-- | Create a new group message channel to group of users. If the logged in +-- user's id is not included in the list, it will be appended to the end. +-- +-- /Permissions/: Must have @create_group_channel@ permission. +mmCreateGroupMessageChannel :: Seq UserId -> Session -> IO Channel +mmCreateGroupMessageChannel body = + inPost "/channels/group" (jsonBody body) jsonResponse + +-- | Get the total unread messages and mentions for a channel for a user. +-- +-- /Permissions/: Must be logged in as user and have the @read_channel@ +-- permission, or have @edit_other_usrs@ permission. +mmGetUnreadMessages :: UserParam -> ChannelId -> Session -> IO ChannelUnread +mmGetUnreadMessages userId channelId = + inGet (printf "/users/%s/channels/%s/unread" userId channelId) noBody jsonResponse + +-- -- | Gets a channel from the provided team name and channel name strings. +-- -- +-- -- /Permissions/: @read_channel@ permission for the channel. +-- mmGetChannelByNameAndTeamName :: Text -> Text -> Session -> IO Channel +-- mmGetChannelByNameAndTeamName teamName channelName = +-- inGet (printf "/teams/name/%s/channels/name/%s" teamName channelName) noBody jsonResponse + +-- | Get a list of public channels on a team by id. +-- +-- /Permissions/: @view_team@ for the team the channels are on. +mmGetListOfChannelsByIds :: TeamId -> Seq ChannelId -> Session -> IO (Seq Channel) +mmGetListOfChannelsByIds teamId body = + inPost (printf "/teams/%s/channels/ids" teamId) (jsonBody body) jsonResponse + +-- | Partially update a channel by providing only the fields you want to +-- update. Omitted fields will not be updated. The fields that can be +-- updated are defined in the request body, all other provided fields +-- will be ignored. +-- +-- /Permissions/: If updating a public channel, +-- @manage_public_channel_members@ permission is required. If updating a +-- private channel, @manage_private_channel_members@ permission is +-- required. +mmPatchChannel :: ChannelId -> ChannelPatch -> Session -> IO Channel +mmPatchChannel channelId body = + inPut (printf "/channels/%s/patch" channelId) (jsonBody body) jsonResponse + +-- | Create a new direct message channel between two users. +-- +-- /Permissions/: Must be one of the two users and have +-- @create_direct_channel@ permission. Having the @manage_system@ +-- permission voids the previous requirements. +mmCreateDirectMessageChannel :: (UserId, UserId) -> Session -> IO Channel +mmCreateDirectMessageChannel body = + inPost "/channels/direct" (jsonBody body) jsonResponse + +-- -- | Get a list of pinned posts for channel. +-- mmGetChannelsPinnedPosts :: ChannelId -> Session -> IO PostList +-- mmGetChannelsPinnedPosts channelId = +-- inGet (printf "/channels/%s/pinned" channelId) noBody jsonResponse + +-- | Get statistics for a channel. +-- +-- /Permissions/: Must have the @read_channel@ permission. +mmGetChannelStatistics :: ChannelId -> Session -> IO ChannelStats +mmGetChannelStatistics channelId = + inGet (printf "/channels/%s/stats" channelId) noBody jsonResponse + +-- -- | Update a user's notification properties for a channel. Only the +-- -- provided fields are updated. +-- -- +-- -- /Permissions/: Must be logged in as the user or have +-- -- @edit_other_users@ permission. +-- mmUpdateChannelNotifications :: ChannelId -> UserId -> XX17 -> Session -> IO () +-- mmUpdateChannelNotifications channelId userId body = +-- inPut (printf "/channels/%s/members/%s/notify_props" channelId userId) (jsonBody body) jsonResponse + +-- | Add a user to the channel. +mmAddUser :: ChannelId -> MinChannelMember -> Session -> IO ChannelMember +mmAddUser channelId body = + inPost (printf "/channels/%s/members" channelId) (jsonBody body) jsonResponse + +-- -- | Get a page of members for a channel. +-- -- +-- -- /Permissions/: @read_channel@ permission for the channel. +-- mmGetChannelMembers :: ChannelId -> Maybe Integer -> Maybe Integer -> Session -> IO (Seq ChannelMember) +-- mmGetChannelMembers channelId page perPage = +-- inGet (printf "/channels/%s/members?%s" channelId (mkQueryString [ sequence ("page", fmap show page) , sequence ("per_page", fmap show perPage) ])) noBody jsonResponse + +-- | Create a new channel. +-- +-- /Permissions/: If creating a public channel, @create_public_channel@ +-- permission is required. If creating a private channel, +-- @create_private_channel@ permission is required. +mmCreateChannel :: MinChannel -> Session -> IO Channel +mmCreateChannel body = + inPost "/channels" (jsonBody body) jsonResponse + +-- | Gets channel from the provided team id and channel name strings. +-- +-- /Permissions/: @read_channel@ permission for the channel. +mmGetChannelByName :: TeamId -> Text -> Session -> IO Channel +mmGetChannelByName teamId channelName = + inGet (printf "/teams/%s/channels/name/%s" teamId channelName) noBody jsonResponse + +-- -- | Update a user's roles for a channel. +-- -- +-- -- /Permissions/: Must have @manage_channel_roles@ permission for the +-- -- channel. +-- mmUpdateChannelRoles :: ChannelId -> UserId -> Text -> Session -> IO () +-- mmUpdateChannelRoles channelId userId roles = +-- inPut (printf "/channels/%s/members/%s/roles" channelId userId) (jsonBody (A.object [ "roles" A..= roles ])) jsonResponse + +-- -- | Update a channel. The fields that can be updated are listed as +-- -- paramters. Omitted fields will be treated as blanks. +-- -- +-- -- /Permissions/: If updating a public channel, +-- -- @manage_public_channel_members@ permission is required. If updating a +-- -- private channel, @manage_private_channel_members@ permission is +-- -- required. +-- mmUpdateChannel :: ChannelId -> XX28 -> Session -> IO Channel +-- mmUpdateChannel channelId body = +-- inPut (printf "/channels/%s" channelId) (jsonBody body) jsonResponse + +-- | Get channel from the provided channel id string. +-- +-- /Permissions/: @read_channel@ permission for the channel. +mmGetChannel :: ChannelId -> Session -> IO Channel +mmGetChannel channelId = + inGet (printf "/channels/%s" channelId) noBody jsonResponse + +-- | Delete a channel based from provided channel id string. +-- +-- /Permissions/: @delete_public_channel@ permission if the channel is +-- public, +-- +-- @delete_private_channel@ permission if the channel is private, +-- +-- or have @manage_system@ permission. +mmDeleteChannel :: ChannelId -> Session -> IO () +mmDeleteChannel channelId = + inDelete (printf "/channels/%s" channelId) noBody noResponse + +-- -- | Restore channel from the provided channel id string. +-- -- +-- -- +-- -- /Minimum server version/: 3.10 +-- -- +-- -- +-- -- /Permissions/: @manage_team@ permission for the team of channel. +-- mmRestoreChannel :: ChannelId -> Session -> IO Channel +-- mmRestoreChannel channelId = +-- inPost (printf "/channels/%s/restore" channelId) noBody jsonResponse + +-- | Get a channel member. +-- +-- /Permissions/: @read_channel@ permission for the channel. +mmGetChannelMember :: ChannelId -> UserParam -> Session -> IO ChannelMember +mmGetChannelMember channelId userId = + inGet (printf "/channels/%s/members/%s" channelId userId) noBody jsonResponse + +-- | Delete a channel member, effectively removing them from a channel. +-- +-- /Permissions/: @manage_public_channel_members@ permission if the +-- channel is public. +-- +-- @manage_private_channel_members@ permission if the channel is private. +mmRemoveUserFromChannel :: ChannelId -> UserParam -> Session -> IO () +mmRemoveUserFromChannel channelId userId = + inDelete (printf "/channels/%s/members/%s" channelId userId) noBody noResponse + + + +-- * Cluster + +-- -- | Get a set of information for each node in the cluster, useful for +-- -- checking the status and health of each node. +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmGetClusterStatus :: Session -> IO (Seq ClusterInfo) +-- mmGetClusterStatus = +-- inGet "/cluster/status" noBody jsonResponse + + + +-- * Commands + +-- -- | Generate a new token for the command based on command id string. +-- -- +-- -- /Permissions/: Must have @manage_slash_commands@ permission for the +-- -- team the command is in. +-- mmGenerateNewToken :: CommandId -> Session -> IO Text +-- mmGenerateNewToken commandId = +-- inPut (printf "/commands/%s/regen_token" commandId) noBody jsonResponse + +-- | Execute a command on a team. +-- +-- /Permissions/: Must have @use_slash_commands@ permission for the team +-- the command is in. +mmExecuteCommand :: MinCommand -> Session -> IO CommandResponse +mmExecuteCommand body = + inPost "/commands/execute" (jsonBody body) jsonResponse + +-- -- | Update a single command based on command id string and Command struct. +-- -- +-- -- /Permissions/: Must have @manage_slash_commands@ permission for the +-- -- team the command is in. +-- mmUpdateCommand :: CommandId -> Command -> Session -> IO Command +-- mmUpdateCommand commandId body = +-- inPut (printf "/commands/%s" commandId) (jsonBody body) jsonResponse + +-- -- | Delete a command based on command id string. +-- -- +-- -- /Permissions/: Must have @manage_slash_commands@ permission for the +-- -- team the command is in. +-- mmDeleteCommand :: CommandId -> Session -> IO () +-- mmDeleteCommand commandId = +-- inDelete (printf "/commands/%s" commandId) noBody jsonResponse + +-- -- | List autocomplete commands in the team. +-- -- +-- -- /Permissions/: @view_team@ for the team. +-- mmListAutocompleteCommands :: TeamId -> Session -> IO (Seq Command) +-- mmListAutocompleteCommands teamId = +-- inGet (printf "/teams/%s/commands/autocomplete" teamId) noBody jsonResponse + +-- -- | Create a command for a team. +-- -- +-- -- /Permissions/: @manage_slash_commands@ for the team the command is in. +-- mmCreateCommand :: XX32 -> Session -> IO Command +-- mmCreateCommand body = +-- inPost "/commands" (jsonBody body) jsonResponse + +-- -- | List commands for a team. +-- -- +-- -- /Permissions/: @manage_slash_commands@ if need list custom commands. +-- mmListCommandsForTeam :: TeamId -> Maybe Text -> Session -> IO (Seq Command) +-- mmListCommandsForTeam teamId customOnly = +-- inGet (printf "/commands?%s" (mkQueryString [ Just ("team_id", T.unpack (idString teamId)) , sequence ("custom_only", fmap T.unpack customOnly) ])) noBody jsonResponse + + + +-- * Compliance + +-- -- | Get a compliance reports previously created. +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmGetReport :: ReportId -> Session -> IO Compliance +-- mmGetReport reportId = +-- inGet (printf "/compliance/reports/%s" reportId) noBody jsonResponse + +-- -- | Create and save a compliance report. +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmCreateReport :: Session -> IO Compliance +-- mmCreateReport = +-- inPost "/compliance/reports" noBody jsonResponse + +-- -- | Get a list of compliance reports previously created by page, selected +-- -- with @page@ and @per_page@ query parameters. +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmGetReports :: Maybe Integer -> Maybe Integer -> Session -> IO (Seq Compliance) +-- mmGetReports page perPage = +-- inGet (printf "/compliance/reports?%s" (mkQueryString [ sequence ("page", fmap show page) , sequence ("per_page", fmap show perPage) ])) noBody jsonResponse + +-- -- | Download the full contents of a report as a file. +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmDownloadReport :: ReportId -> Session -> IO () +-- mmDownloadReport reportId = +-- inGet (printf "/compliance/reports/%s/download" reportId) noBody jsonResponse + + + +-- * Elasticsearch + +-- -- | Deletes all Elasticsearch indexes and their contents. After calling +-- -- this endpoint, it is +-- -- +-- -- necessary to schedule a new Elasticsearch indexing job to repopulate +-- -- the indexes. +-- -- +-- -- /Minimum server version/: 4.1 +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmPurgeAllElasticsearchIndexes :: Session -> IO () +-- mmPurgeAllElasticsearchIndexes = +-- inPost "/elasticsearch/purge_indexes" noBody jsonResponse + +-- -- | Test the current Elasticsearch configuration to see if the +-- -- Elasticsearch server can be contacted successfully. +-- -- +-- -- Optionally provide a configuration in the request body to test. If no +-- -- valid configuration is present in the +-- -- +-- -- request body the current server configuration will be tested. +-- -- +-- -- +-- -- /Minimum server version/: 4.1 +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmTestElasticsearchConfiguration :: Session -> IO () +-- mmTestElasticsearchConfiguration = +-- inPost "/elasticsearch/test" noBody jsonResponse + + + +-- * Emoji + +-- -- | Create a custom emoji for the team. +-- -- +-- -- /Permissions/: Must be authenticated. +-- mmCreateCustomEmoji :: Session -> IO Emoji +-- mmCreateCustomEmoji = +-- inPost "/emoji" noBody jsonResponse + +-- -- | Get a page of metadata for custom emoji on the system. +-- -- +-- -- /Permissions/: Must be authenticated. +-- mmGetListOfCustomEmoji :: Maybe Integer -> Maybe Integer -> Session -> IO Emoji +-- mmGetListOfCustomEmoji page perPage = +-- inGet (printf "/emoji?%s" (mkQueryString [ sequence ("page", fmap show page) , sequence ("per_page", fmap show perPage) ])) noBody jsonResponse + +-- -- | Get some metadata for a custom emoji. +-- -- +-- -- /Permissions/: Must be authenticated. +-- mmGetCustomEmoji :: EmojiId -> Session -> IO Emoji +-- mmGetCustomEmoji emojiId = +-- inGet (printf "/emoji/%s" emojiId) noBody jsonResponse + +-- -- | Delete a custom emoji. +-- -- +-- -- /Permissions/: Must have the @manage_team@ or @manage_system@ +-- -- permissions or be the user who created the emoji. +-- mmDeleteCustomEmoji :: EmojiId -> Session -> IO Emoji +-- mmDeleteCustomEmoji emojiId = +-- inDelete (printf "/emoji/%s" emojiId) noBody jsonResponse + +-- -- | Get the image for a custom emoji. +-- -- +-- -- /Permissions/: Must be authenticated. +-- mmGetCustomEmojiImage :: EmojiId -> Session -> IO () +-- mmGetCustomEmojiImage emojiId = +-- inGet (printf "/emoji/%s/image" emojiId) noBody jsonResponse + + + +-- * Files + +-- -- | Gets a public link for a file that can be accessed without logging +-- mmGetPublicFileLink :: FileId -> Session -> IO Text +-- mmGetPublicFileLink fileId = +-- inGet (printf "/files/%s/link" fileId) noBody jsonResponse + +-- | Gets a file that has been uploaded previously. +-- +-- /Permissions/: Must have @read_channel@ permission or be uploader of +-- the file. +mmGetFile :: FileId -> Session -> IO B.ByteString +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 + +-- | Gets a file's info. +-- +-- /Permissions/: Must have @read_channel@ permission or be uploader of +-- the file. +mmGetMetadataForFile :: FileId -> Session -> IO FileInfo +mmGetMetadataForFile fileId = + inGet (printf "/files/%s/info" fileId) noBody jsonResponse + +-- -- | Gets a file's thumbnail. +-- -- +-- -- /Permissions/: Must have @read_channel@ permission or be uploader of +-- -- the file. +-- mmGetFilesThumbnail :: FileId -> Session -> IO () +-- mmGetFilesThumbnail fileId = +-- inGet (printf "/files/%s/thumbnail" fileId) noBody jsonResponse + +-- -- | Gets a file's preview. +-- -- +-- -- /Permissions/: Must have @read_channel@ permission or be uploader of +-- -- the file. +-- mmGetFilesPreview :: FileId -> Session -> IO () +-- mmGetFilesPreview fileId = +-- inGet (printf "/files/%s/preview" fileId) noBody jsonResponse + + + +-- * Jobs + +-- -- | Create a new job. +-- -- +-- -- /Minimum server version: 4.1/ +-- -- +-- -- /Permissions/: Must have @manage_jobs@ permission. +-- mmCreateNewJob :: XX20 -> Session -> IO Job +-- mmCreateNewJob body = +-- inPost "/jobs" (jsonBody body) jsonResponse + +-- -- | Get a page of jobs. Use the query parameters to modify the behaviour +-- -- of this endpoint. +-- -- +-- -- /Minimum server version: 4.1/ +-- -- +-- -- /Permissions/: Must have @manage_jobs@ permission. +-- mmGetJobs :: Maybe Integer -> Maybe Integer -> Session -> IO (Seq Job) +-- mmGetJobs page perPage = +-- inGet (printf "/jobs?%s" (mkQueryString [ sequence ("page", fmap show page) , sequence ("per_page", fmap show perPage) ])) noBody jsonResponse + +-- -- | Cancel a job. +-- -- +-- -- /Minimum server version: 4.1/ +-- -- +-- -- /Permissions/: Must have @manage_jobs@ permission. +-- mmCancelJob :: JobId -> Session -> IO () +-- mmCancelJob jobId = +-- inPost (printf "/jobs/%s/cancel" jobId) noBody jsonResponse + +-- -- | Gets a single job. +-- -- +-- -- /Minimum server version: 4.1/ +-- -- +-- -- /Permissions/: Must have @manage_jobs@ permission. +-- mmGetJob :: JobId -> Session -> IO Job +-- mmGetJob jobId = +-- inGet (printf "/jobs/%s" jobId) noBody jsonResponse + +-- -- | Get a page of jobs of the given type. Use the query parameters to +-- -- modify the behaviour of this endpoint. +-- -- +-- -- /Minimum server version: 4.1/ +-- -- +-- -- /Permissions/: Must have @manage_jobs@ permission. +-- mmGetJobsOfGivenType :: Text -> Maybe Integer -> Maybe Integer -> Session -> IO (Seq Job) +-- mmGetJobsOfGivenType type_ page perPage = +-- inGet (printf "/jobs/type/%s?%s" type_ (mkQueryString [ sequence ("page", fmap show page) , sequence ("per_page", fmap show perPage) ])) noBody jsonResponse + + + +-- * LDAP + +-- -- | Test the current AD\/LDAP configuration to see if the AD\/LDAP server +-- -- can be contacted successfully. +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmTestLdapConfiguration :: Session -> IO () +-- mmTestLdapConfiguration = +-- inPost "/ldap/test" noBody jsonResponse + +-- -- | Synchronize any user attribute changes in the configured AD\/LDAP +-- -- server with Mattermost. +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmSyncWithLdap :: Session -> IO () +-- mmSyncWithLdap = +-- inPost "/ldap/sync" noBody jsonResponse + + + +-- * OAuth + +-- -- | Register an OAuth 2.0 client application with Mattermost as the +-- -- service provider. +-- -- +-- -- /Permissions/: Must have @manage_oauth@ permission. +-- mmRegisterOauthApp :: XX13 -> Session -> IO OAuthApp +-- mmRegisterOauthApp body = +-- inPost "/oauth/apps" (jsonBody body) jsonResponse + +-- -- | Get a page of OAuth 2.0 client applications registered with +-- -- Mattermost. +-- -- +-- -- /Permissions/: With @manage_oauth@ permission, the apps registered by +-- -- the logged in user are returned. With @manage_system_wide_oauth@ +-- -- permission, all apps regardless of creator are returned. +-- mmGetOauthApps :: Maybe Integer -> Maybe Integer -> Session -> IO (Seq OAuthApp) +-- mmGetOauthApps page perPage = +-- inGet (printf "/oauth/apps?%s" (mkQueryString [ sequence ("page", fmap show page) , sequence ("per_page", fmap show perPage) ])) noBody jsonResponse + +-- -- | Get an OAuth 2.0 client application registered with Mattermost. +-- -- +-- -- /Permissions/: If app creator, must have @mange_oauth@ permission +-- -- otherwise @manage_system_wide_oauth@ permission is required. +-- mmGetAnOauthApp :: AppId -> Session -> IO OAuthApp +-- mmGetAnOauthApp appId = +-- inGet (printf "/oauth/apps/%s" appId) noBody jsonResponse + +-- -- | Delete and unregister an OAuth 2.0 client application +-- -- +-- -- /Permissions/: If app creator, must have @mange_oauth@ permission +-- -- otherwise @manage_system_wide_oauth@ permission is required. +-- mmDeleteAnOauthApp :: AppId -> Session -> IO () +-- mmDeleteAnOauthApp appId = +-- inDelete (printf "/oauth/apps/%s" appId) noBody jsonResponse + +-- -- | Get public information about an OAuth 2.0 client application +-- -- registered with Mattermost. The application's client secret will be +-- -- blanked out. +-- -- +-- -- /Permissions/: Must be authenticated. +-- mmGetInfoOnAnOauthApp :: AppId -> Session -> IO OAuthApp +-- mmGetInfoOnAnOauthApp appId = +-- inGet (printf "/oauth/apps/%s/info" appId) noBody jsonResponse + +-- -- | Get a page of OAuth 2.0 client applications authorized to access a +-- -- user's account. +-- -- +-- -- /Permissions/: Must be authenticated as the user or have +-- -- @edit_other_users@ permission. +-- mmGetAuthorizedOauthApps :: UserId -> Maybe Integer -> Maybe Integer -> Session -> IO (Seq OAuthApp) +-- mmGetAuthorizedOauthApps userId page perPage = +-- inGet (printf "/users/%s/oauth/apps/authorized?%s" userId (mkQueryString [ sequence ("page", fmap show page) , sequence ("per_page", fmap show perPage) ])) noBody jsonResponse + +-- -- | Regenerate the client secret for an OAuth 2.0 client application +-- -- registered with Mattermost. +-- -- +-- -- /Permissions/: If app creator, must have @mange_oauth@ permission +-- -- otherwise @manage_system_wide_oauth@ permission is required. +-- mmRegenerateOauthAppSecret :: AppId -> Session -> IO OAuthApp +-- mmRegenerateOauthAppSecret appId = +-- inPost (printf "/oauth/apps/%s/regen_secret" appId) noBody jsonResponse + + + +-- * Posts + +-- | Create a new post in a channel. To create the post as a comment on +-- another post, provide @root_id@. +-- +-- /Permissions/: Must have @create_post@ permission for the channel the +-- post is being created in. +mmCreatePost :: RawPost -> Session -> IO Post +mmCreatePost body = + inPost "/posts" (jsonBody body) jsonResponse + +-- | Search posts in the team and from the provided terms string. +-- +-- /Permissions/: Must be authenticated and have the @view_team@ +-- permission. +mmSearchForTeamPosts :: TeamId -> SearchPosts -> Session -> IO Posts +mmSearchForTeamPosts teamId body = + inPost (printf "/teams/%s/posts/search" teamId) (jsonBody body) jsonResponse + +-- -- | Pin a post to a channel it is in based from the provided post id +-- -- string. +-- -- +-- -- /Permissions/: Must be authenticated and have the @read_channel@ +-- -- permission to the channel the post is in. +-- mmPinPostToChannel :: PostId -> Session -> IO () +-- mmPinPostToChannel postId = +-- inPost (printf "/posts/%s/pin" postId) noBody jsonResponse + +-- | Get a post and the rest of the posts in the same thread. +-- +-- /Permissions/: Must have @read_channel@ permission for the channel the +-- post is in or if the channel is public, have the +-- @read_public_channels@ permission for the team. +mmGetThread :: PostId -> Session -> IO Posts +mmGetThread postId = + inGet (printf "/posts/%s/thread" postId) noBody jsonResponse + +-- | Update a post. Only the fields listed below are updatable, omitted +-- fields will be treated as blank. +-- +-- /Permissions/: Must have @edit_post@ permission for the channel the +-- post is in. +mmUpdatePost :: PostId -> PostUpdate -> Session -> IO Post +mmUpdatePost postId body = + inPut (printf "/posts/%s" postId) (jsonBody body) jsonResponse + +-- | Get a single post. +-- +-- /Permissions/: Must have @read_channel@ permission for the channel the +-- post is in or if the channel is public, have the +-- @read_public_channels@ permission for the team. +mmGetPost :: PostId -> Session -> IO Post +mmGetPost postId = + inGet (printf "/posts/%s" postId) noBody jsonResponse + +-- | Soft deletes a post, by marking the post as deleted in the database. +-- Soft deleted posts will not be returned in post queries. +-- +-- /Permissions/: Must be logged in as the user or have +-- @delete_others_posts@ permission. +mmDeletePost :: PostId -> Session -> IO () +mmDeletePost postId = + inDelete (printf "/posts/%s" postId) noBody noResponse + +data FlaggedPostsQuery = FlaggedPostsQuery + { flaggedPostsQueryPage :: Maybe Int + , flaggedPostsQueryPerPage :: Maybe Int + , flaggedPostsQueryTeamId :: Maybe TeamId + , flaggedPostsQueryChannelId :: Maybe ChannelId + } + +defaultFlaggedPostsQuery :: FlaggedPostsQuery +defaultFlaggedPostsQuery = FlaggedPostsQuery + { flaggedPostsQueryPage = Nothing + , flaggedPostsQueryPerPage = Nothing + , flaggedPostsQueryTeamId = Nothing + , flaggedPostsQueryChannelId = Nothing + } + + +-- | Get a page of flagged posts of a user provided user id string. Selects +-- from a channel, team or all flagged posts by a user. +-- +-- /Permissions/: Must be user or have @manage_system@ permission. +mmGetListOfFlaggedPosts :: UserParam -> FlaggedPostsQuery -> Session -> IO Posts +mmGetListOfFlaggedPosts userId FlaggedPostsQuery { .. } = + inGet (printf "/users/%s/posts/flagged?%s" userId query) noBody jsonResponse + where query = mkQueryString + [ sequence ("team_id", fmap (T.unpack . idString) flaggedPostsQueryTeamId) + , sequence ("channel_id", fmap (T.unpack . idString) flaggedPostsQueryChannelId) + , sequence ("page", fmap show flaggedPostsQueryPage) + , sequence ("per_page", fmap show flaggedPostsQueryPerPage) + ] + +-- -- | Unpin a post to a channel it is in based from the provided post id +-- -- string. +-- -- +-- -- /Permissions/: Must be authenticated and have the @read_channel@ +-- -- permission to the channel the post is in. +-- mmUnpinPostToChannel :: PostId -> Session -> IO () +-- mmUnpinPostToChannel postId = +-- inPost (printf "/posts/%s/unpin" postId) noBody jsonResponse + +-- -- | Partially update a post by providing only the fields you want to +-- -- update. Omitted fields will not be updated. The fields that can be +-- -- updated are defined in the request body, all other provided fields +-- -- will be ignored. +-- -- +-- -- /Permissions/: Must have the @edit_post@ permission. +-- mmPatchPost :: PostId -> XX27 -> Session -> IO Post +-- mmPatchPost postId body = +-- inPut (printf "/posts/%s/patch" postId) (jsonBody body) jsonResponse + +data PostQuery = PostQuery + { postQueryPage :: Maybe Int + , postQueryPerPage :: Maybe Int + , postQuerySince :: Maybe UTCTime + , postQueryBefore :: Maybe PostId + , postQueryAfter :: Maybe PostId + } + +defaultPostQuery :: PostQuery +defaultPostQuery = PostQuery + { postQueryPage = Nothing + , postQueryPerPage = Nothing + , postQuerySince = Nothing + , postQueryBefore = Nothing + , postQueryAfter = Nothing + } + +postQueryToQueryString :: PostQuery -> String +postQueryToQueryString PostQuery { .. } = + mkQueryString + [ sequence ("page", fmap show postQueryPage) + , sequence ("per_page", fmap show postQueryPerPage) + , sequence ("since", fmap show postQuerySince) + , sequence ("before", fmap (T.unpack . idString) postQueryBefore) + , sequence ("after", fmap (T.unpack . idString) postQueryAfter) + ] + +-- | Get a page of posts in a channel. Use the query parameters to modify +-- the behaviour of this endpoint. The parameters @since@, @before@ and +-- @after@ must not be used together. +-- +-- /Permissions/: Must have @read_channel@ permission for the channel. +mmGetPostsForChannel :: ChannelId -> PostQuery -> Session -> IO Posts +mmGetPostsForChannel channelId postQuery = + inGet (printf "/channels/%s/posts?%s" channelId (postQueryToQueryString postQuery)) noBody jsonResponse + +-- -- | Gets a list of file information objects for the files attached to a +-- -- post. +-- -- +-- -- /Permissions/: Must have @read_channel@ permission for the channel the +-- -- post is in. +-- mmGetFileInfoForPost :: PostId -> Session -> IO (Seq FileInfo) +-- mmGetFileInfoForPost postId = +-- inGet (printf "/posts/%s/files/info" postId) noBody jsonResponse + + + +-- * Preferences + +-- | Gets a single preference for the current user with the given category +-- and name. +-- +-- /Permissions/: Must be logged in as the user being updated or have the +-- @edit_other_users@ permission. +mmGetSpecificUserPreference :: UserParam -> Text -> Text -> Session -> IO Preference +mmGetSpecificUserPreference userId category preferenceName = + inGet (printf "/users/%s/preferences/%s/name/%s" userId category preferenceName) noBody jsonResponse + +-- | Save a list of the user's preferences. +-- +-- /Permissions/: Must be logged in as the user being updated or have the +-- @edit_other_users@ permission. +mmSaveUsersPreferences :: UserParam -> (Seq Preference) -> Session -> IO () +mmSaveUsersPreferences userId body = + inPut (printf "/users/%s/preferences" userId) (jsonBody body) noResponse + +-- | Get a list of the user's preferences. +-- +-- /Permissions/: Must be logged in as the user being updated or have the +-- @edit_other_users@ permission. +mmGetUsersPreferences :: UserParam -> Session -> IO (Seq Preference) +mmGetUsersPreferences userId = + inGet (printf "/users/%s/preferences" userId) noBody jsonResponse + +-- | Delete a list of the user's preferences. +-- +-- /Permissions/: Must be logged in as the user being updated or have the +-- @edit_other_users@ permission. +mmDeleteUsersPreferences :: UserParam -> (Seq Preference) -> Session -> IO () +mmDeleteUsersPreferences userId body = + inPost (printf "/users/%s/preferences/delete" userId) (jsonBody body) noResponse + +-- | Lists the current user's stored preferences in the given category. +-- +-- /Permissions/: Must be logged in as the user being updated or have the +-- @edit_other_users@ permission. +mmListUsersPreferencesByCategory :: UserParam -> Text -> Session -> IO (Seq Preference) +mmListUsersPreferencesByCategory userId category = + inGet (printf "/users/%s/preferences/%s" userId category) noBody jsonResponse + + +-- * Reactions + +mmGetReactionsForPost :: PostId -> Session -> IO (Seq Reaction) +mmGetReactionsForPost postId = + inGet (printf "/posts/%s/reactions" postId) noBody jsonResponse + +-- mmPostReaction :: Session -> IO () +-- mmPostReaction = +-- inPost (printf "/reactions") (jsonBody ()) noResponse + + + +-- * SAML + +-- -- | Upload the private key to be used for encryption with your SAML +-- -- configuration. This will also set the filename for the PrivateKeyFile +-- -- setting in your @config.json@. +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmUploadPrivateKey :: Session -> IO () +-- mmUploadPrivateKey = +-- inPost "/saml/certificate/private" noBody noResponse + +-- -- | Delete the current private key being used with your SAML +-- -- configuration. This will also disable encryption for SAML on your +-- -- system as this key is required for that. +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmRemovePrivateKey :: Session -> IO () +-- mmRemovePrivateKey = +-- inDelete "/saml/certificate/private" noBody jsonResponse + +-- -- | Upload the public certificate to be used for encryption with your SAML +-- -- configuration. This will also set the filename for the +-- -- PublicCertificateFile setting in your @config.json@. +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmUploadPublicCertificate :: Session -> IO () +-- mmUploadPublicCertificate = +-- inPost "/saml/certificate/public" noBody jsonResponse + +-- -- | Delete the current public certificate being used with your SAML +-- -- configuration. This will also disable encryption for SAML on your +-- -- system as this certificate is required for that. +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmRemovePublicCertificate :: Session -> IO () +-- mmRemovePublicCertificate = +-- inDelete "/saml/certificate/public" noBody jsonResponse + +-- -- | Upload the IDP certificate to be used with your SAML configuration. +-- -- This will also set the filename for the IdpCertificateFile setting in +-- -- your @config.json@. +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmUploadIdpCertificate :: Session -> IO () +-- mmUploadIdpCertificate = +-- inPost "/saml/certificate/idp" noBody jsonResponse + +-- -- | Delete the current IDP certificate being used with your SAML +-- -- configuration. This will also disable SAML on your system as this +-- -- certificate is required for SAML. +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmRemoveIdpCertificate :: Session -> IO () +-- mmRemoveIdpCertificate = +-- inDelete "/saml/certificate/idp" noBody jsonResponse + +-- -- | Get the status of the uploaded certificates and keys in use by your +-- -- SAML configuration. +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmGetCertificateStatus :: Session -> IO SamlCertificateStatus +-- mmGetCertificateStatus = +-- inGet "/saml/certificate/status" noBody jsonResponse + +-- -- | Get SAML metadata from the server. SAML must be configured properly. +-- -- +-- -- /Permissions/: No permission required. +-- mmGetMetadata :: Session -> IO Text +-- mmGetMetadata = +-- inGet "/saml/metadata" noBody jsonResponse + + +-- * Statuses + +mmGetUserStatusByIds :: Seq UserId -> Session -> IO (Seq Status) +mmGetUserStatusByIds body = + inPost "/users/status/ids" (jsonBody body) jsonResponse + + +-- * System + +-- -- | Get a page of audits for all users on the system, selected with @page@ +-- -- and @per_page@ query parameters. +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmGetAudits :: Maybe Integer -> Maybe Integer -> Session -> IO (Seq Audit) +-- mmGetAudits page perPage = +-- inGet (printf "/audits?%s" (mkQueryString [ sequence ("page", fmap show page) , sequence ("per_page", fmap show perPage) ])) noBody jsonResponse + +-- -- | Get a subset of the server license needed by the client. +-- -- +-- -- /Permissions/: No permission required but having the @manage_system@ +-- -- permission returns more information. +-- mmGetClientLicense :: Text -> Session -> IO () +-- mmGetClientLicense format = +-- inGet (printf "/license/client?%s" (mkQueryString [ Just ("format", T.unpack format) ])) noBody jsonResponse + +-- -- | Upload a license to enable enterprise features. +-- -- +-- -- /Minimum server version/: 4.0 +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmUploadLicenseFile :: Session -> IO () +-- mmUploadLicenseFile = +-- inPost "/license" noBody jsonResponse + +-- -- | Remove the license file from the server. This will disable all +-- -- enterprise features. +-- -- +-- -- /Minimum server version/: 4.0 +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmRemoveLicenseFile :: Session -> IO () +-- mmRemoveLicenseFile = +-- inDelete "/license" noBody jsonResponse + +-- -- | Get a valid WebRTC token, STUN and TURN server URLs along with TURN +-- -- credentials to use with the Mattermost WebRTC service. See +-- -- https:\/\/docs.mattermost.com\/administration\/config-settings.html +-- -- #webrtc-beta for WebRTC configutation settings. The token returned is +-- -- for the current user's session. +-- -- +-- -- /Permissions/: Must be authenticated. +-- mmGetWebrtcToken :: Session -> IO XX8 +-- mmGetWebrtcToken = +-- inGet "/webrtc/token" noBody jsonResponse + +-- | Get a subset of the server configuration needed by the client. +-- +-- /Permissions/: No permission required. +mmGetClientConfiguration :: Maybe Text -> Session -> IO ClientConfig +mmGetClientConfiguration format = + inGet (printf "/config/client?%s" (mkQueryString [ sequence ("format", fmap T.unpack format) ])) noBody jsonResponse + +-- -- | Reload the configuration file to pick up on any changes made to it. +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmReloadConfiguration :: Session -> IO () +-- mmReloadConfiguration = +-- inPost "/config/reload" noBody jsonResponse + +-- -- | Purge all the in-memory caches for the Mattermost server. This can +-- -- have a temporary negative effect on performance while the caches are +-- -- re-populated. +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmInvalidateAllCaches :: Session -> IO () +-- mmInvalidateAllCaches = +-- inPost "/caches/invalidate" noBody jsonResponse + +-- -- | Recycle database connections by closing and reconnecting all +-- -- connections to master and read replica databases. +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmRecycleDatabaseConnections :: Session -> IO () +-- mmRecycleDatabaseConnections = +-- inPost "/database/recycle" noBody jsonResponse + +-- -- | Add log messages to the server logs. +-- -- +-- -- /Permissions/: Must have @manage_system@ permission or if +-- -- @ServiceSettings.EnableDeveloper@ in the +-- -- +-- -- config file is set to @true@ then any user can use this endpoint. +-- mmAddLogMessage :: XX26 -> Session -> IO UnknownType +-- mmAddLogMessage body = +-- inPost "/logs" (jsonBody body) jsonResponse + +-- -- | Get a page of server logs, selected with @page@ and @per_page@ query +-- -- parameters. +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmGetLogs :: Maybe Integer -> Maybe Integer -> Session -> IO (Seq Text) +-- mmGetLogs page perPage = +-- inGet (printf "/logs?%s" (mkQueryString [ sequence ("page", fmap show page) , sequence ("per_page", fmap show perPage) ])) noBody jsonResponse + +-- -- | Send a test email to make sure you have your email settings configured +-- -- correctly. Optionally provide a configuration in the request body to +-- -- test. If no valid configuration is present in the request body the +-- -- current server configuration will be tested. +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmSendTestEmail :: Session -> IO () +-- mmSendTestEmail = +-- inPost "/email/test" noBody jsonResponse + +-- -- | Check if the server is up and healthy based on the configuration +-- -- setting @GoRoutineHealthThreshold@. If @GoRoutineHealthThreshold@ and +-- -- the number of goroutines on the server exceeds that threshold the +-- -- server is considered unhealthy. If @GoRoutineHealthThreshold@ is not +-- -- set or the number of goroutines is below the threshold the server is +-- -- considered healthy. +-- -- +-- -- /Minimum server version/: 3.10 +-- -- +-- -- /Permissions/: Must be logged in. +-- mmCheckSystemHealth :: Session -> IO UnknownType +-- mmCheckSystemHealth = +-- inGet "/system/ping" noBody jsonResponse + +-- -- | Get some analytics data about the system. This endpoint uses the old +-- -- format, the @\/analytics@ route is reserved for the new format when it +-- -- gets implemented. +-- -- +-- -- +-- -- The returned JSON changes based on the @name@ query parameter but is +-- -- always key\/value pairs. +-- -- +-- -- +-- -- /Minimum server version/: 4.0 +-- -- +-- -- +-- -- /Permissions/: Must have @manage_system@ permission. +-- mmGetAnalytics :: Maybe Text -> TeamId -> Session -> IO () +-- mmGetAnalytics name teamId = +-- inGet (printf "/analytics/old?%s" (mkQueryString [ sequence ("name", fmap T.unpack name) , Just ("team_id", T.unpack (idString teamId)) ])) noBody jsonResponse + +-- | Submit a new configuration for the server to use. +-- +-- /Permissions/: Must have @manage_system@ permission. +mmUpdateConfiguration :: ServerConfig -> Session -> IO ServerConfig +mmUpdateConfiguration body = + inPut "/config" (jsonBody body) jsonResponse + +-- | Retrieve the current server configuration +-- +-- /Permissions/: Must have @manage_system@ permission. +mmGetConfiguration :: Session -> IO ServerConfig +mmGetConfiguration = + inGet "/config" noBody jsonResponse + + + +-- * Teams + +-- | Get a team member on the system. +-- +-- /Permissions/: Must be authenticated and have the @view_team@ +-- permission. +mmGetTeamMember :: TeamId -> UserParam -> Session -> IO TeamMember +mmGetTeamMember teamId userId = + inGet (printf "/teams/%s/members/%s" teamId userId) noBody jsonResponse + +-- | Delete the team member object for a user, effectively removing them +-- from a team. +-- +-- /Permissions/: Must be logged in as the user or have the +-- @remove_user_from_team@ permission. +mmRemoveUserFromTeam :: TeamId -> UserParam -> Session -> IO () +mmRemoveUserFromTeam teamId userId = + inDelete (printf "/teams/%s/members/%s" teamId userId) noBody jsonResponse + +-- -- | Get a page of deleted channels on a team based on query string +-- -- parameters - team_id, page and per_page. +-- -- +-- -- +-- -- /Minimum server version/: 3.10 +-- -- +-- -- +-- -- /Permissions/: Must be authenticated and have the @manage_team@ +-- -- permission. +-- mmGetDeletedChannels :: TeamId -> Maybe Integer -> Maybe Integer -> Session -> IO (Seq Channel) +-- mmGetDeletedChannels teamId page perPage = +-- inGet (printf "/teams/%s/channels/deleted?%s" teamId (mkQueryString [ sequence ("page", fmap show page) , sequence ("per_page", fmap show perPage) ])) noBody jsonResponse + +-- -- | Update a team member roles. Valid team roles are "team_user", +-- -- "team_admin" or both of them. Overwrites any previously assigned team +-- -- roles. +-- -- +-- -- /Permissions/: Must be authenticated and have the @manage_team_roles@ +-- -- permission. +-- mmUpdateTeamMemberRoles :: TeamId -> UserId -> Text -> Session -> IO () +-- mmUpdateTeamMemberRoles teamId userId roles = +-- inPut (printf "/teams/%s/members/%s/roles" teamId userId) (jsonBody (A.object [ "roles" A..= roles ])) jsonResponse + +-- | Get a page of public channels on a team based on query string +-- parameters - page and per_page. +-- +-- /Permissions/: Must be authenticated and have the @list_team_channels@ +-- permission. +mmGetPublicChannels :: TeamId -> Maybe Int -> Maybe Int -> Session -> IO (Seq Channel) +mmGetPublicChannels teamId page perPage = + inGet (printf "/teams/%s/channels?%s" teamId (mkQueryString [ sequence ("page", fmap show page) + , sequence ("per_page", fmap show perPage) + ])) noBody jsonResponse + +-- -- | Check if the team exists based on a team name. +-- mmCheckIfTeamExists :: Text -> Session -> IO TeamExists +-- mmCheckIfTeamExists name = +-- inGet (printf "/teams/name/%s/exists" name) noBody jsonResponse + +-- | Create a new team on the system. +-- +-- /Permissions/: Must be authenticated and have the @create_team@ +-- permission. +mmCreateTeam :: TeamsCreate -> Session -> IO Team +mmCreateTeam body = + inPost "/teams" (jsonBody body) jsonResponse + +-- | For regular users only returns open teams. Users with the +-- "manage_system" permission will return teams regardless of type. The +-- result is based on query string parameters - page and per_page. +-- +-- /Permissions/: Must be authenticated. "manage_system" permission is +-- required to show all teams. +mmGetTeams :: Maybe Integer -> Maybe Integer -> Session -> IO (Seq Team) +mmGetTeams page perPage = + inGet (printf "/teams?%s" + (mkQueryString [ sequence ("page", fmap show page) + , sequence ("per_page", fmap show perPage) + ])) noBody jsonResponse + +-- | Search teams based on search term provided in the request body. +-- +-- /Permissions/: Logged in user only shows open teams +-- +-- Logged in user with "manage_system" permission shows all teams +mmSearchTeams :: Text -> Session -> IO (Seq Team) +mmSearchTeams term = + inPost "/teams/search" (jsonBody (A.object [ "term" A..= term ])) jsonResponse + +-- -- | Invite users to the existing team usign the user's email. +-- -- +-- -- /Permissions/: Must have @invite_to_team@ permission for the team. +-- mmInviteUsersToTeamByEmail :: TeamId -> (Seq Text) -> Session -> IO () +-- mmInviteUsersToTeamByEmail teamId body = +-- inPost (printf "/teams/%s/invite/email" teamId) (jsonBody body) jsonResponse + +-- | Search public channels on a team based on the search term provided in +-- the request body. +-- +-- /Permissions/: Must have the @list_team_channels@ permission. +mmSearchChannels :: TeamId -> Text -> Session -> IO (Seq Channel) +mmSearchChannels teamId term = + inPost (printf "/teams/%s/channels/search" teamId) (jsonBody (A.object [ "term" A..= term ])) jsonResponse + +-- -- | Get the count for unread messages and mentions in the teams the user +-- -- is a member of. +-- -- +-- -- /Permissions/: Must be logged in. +-- mmGetTeamUnreadsForUser :: UserId -> Text -> Session -> IO (Seq TeamUnread) +-- mmGetTeamUnreadsForUser userId excludeTeam = +-- inGet (printf "/users/%s/teams/unread?%s" userId (mkQueryString [ Just ("exclude_team", T.unpack excludeTeam) ])) noBody jsonResponse + +-- | Get a list of teams that a user is on. +-- +-- /Permissions/: Must be authenticated as the user or have the +-- @manage_system@ permission. +mmGetUsersTeams :: UserParam -> Session -> IO (Seq Team) +mmGetUsersTeams userId = + inGet (printf "/users/%s/teams" userId) noBody jsonResponse + +-- -- | Using either an invite id or hash\/data pair from an email invite +-- -- link, add a user to a team. +-- -- +-- -- /Permissions/: Must be authenticated. +-- mmAddUserToTeamFromInvite :: Text -> Text -> InviteId -> Session -> IO TeamMember +-- mmAddUserToTeamFromInvite hash data_ inviteId = +-- inPost (printf "/teams/members/invite?%s" (mkQueryString [ Just ("hash", T.unpack hash) , Just ("data", T.unpack data_) , Just ("invite_id", T.unpack (idString inviteId)) ])) noBody jsonResponse + +-- -- | Get a team stats on the system. +-- -- +-- -- /Permissions/: Must be authenticated and have the @view_team@ +-- -- permission. +-- mmGetTeamStats :: TeamId -> Session -> IO TeamStats +-- mmGetTeamStats teamId = +-- inGet (printf "/teams/%s/stats" teamId) noBody jsonResponse + +-- | Get a list of team members based on a provided array of user ids. +-- +-- /Permissions/: Must have @view_team@ permission for the team. +mmGetTeamMembersByIds :: TeamId -> Seq UserId -> Session -> IO (Seq TeamMember) +mmGetTeamMembersByIds teamId body = + inPost (printf "/teams/%s/members/ids" teamId) (jsonBody body) jsonResponse + +-- -- | Partially update a team by providing only the fields you want to +-- -- update. Omitted fields will not be updated. The fields that can be +-- -- updated are defined in the request body, all other provided fields +-- -- will be ignored. +-- -- +-- -- /Permissions/: Must have the @manage_team@ permission. +-- mmPatchTeam :: TeamId -> XX23 -> Session -> IO Team +-- mmPatchTeam teamId body = +-- inPut (printf "/teams/%s/patch" teamId) (jsonBody body) jsonResponse + +-- | Get a list of team members for a user. Useful for getting the ids of +-- teams the user is on and the roles they have in those teams. +-- +-- /Permissions/: Must be logged in as the user or have the +-- @edit_other_users@ permission. +mmGetTeamMembersForUser :: UserParam -> Session -> IO (Seq TeamMember) +mmGetTeamMembersForUser userId = + inGet (printf "/users/%s/teams/members" userId) noBody jsonResponse + +-- | Add user to the team by user_id. +-- +-- /Permissions/: Must be authenticated and team be open to add self. For +-- adding another user, authenticated user must have the +-- @add_user_to_team@ permission. +mmAddUserToTeam :: TeamId -> TeamMember -> Session -> IO TeamMember +mmAddUserToTeam teamId body = + inPost (printf "/teams/%s/members" teamId) (jsonBody body) jsonResponse + +-- -- | Get a page team members list based on query string parameters - team +-- -- id, page and per page. +-- -- +-- -- /Permissions/: Must be authenticated and have the @view_team@ +-- -- permission. +-- mmGetTeamMembers :: TeamId -> Maybe Integer -> Maybe Integer -> Session -> IO (Seq TeamMember) +-- mmGetTeamMembers teamId page perPage = +-- inGet (printf "/teams/%s/members?%s" teamId (mkQueryString [ sequence ("page", fmap show page) , sequence ("per_page", fmap show perPage) ])) noBody jsonResponse + +-- -- | Import a team into a existing team. Import users, channels, posts, +-- -- hooks. +-- -- +-- -- /Permissions/: Must have @permission_import_team@ permission. +-- mmImportTeamFromOtherApplication :: TeamId -> Session -> IO Text +-- mmImportTeamFromOtherApplication teamId = +-- inPost (printf "/teams/%s/import" teamId) noBody jsonResponse + +-- -- | Add a number of users to the team by user_id. +-- -- +-- -- /Permissions/: Must be authenticated. Authenticated user must have the +-- -- @add_user_to_team@ permission. +-- mmAddMultipleUsersToTeam :: TeamId -> (Seq TeamMember) -> Session -> IO (Seq TeamMember) +-- mmAddMultipleUsersToTeam teamId body = +-- inPost (printf "/teams/%s/members/batch" teamId) (jsonBody body) jsonResponse + +-- -- | Get the unread mention and message counts for a team for the specified +-- -- user. +-- -- +-- -- /Permissions/: Must be the user or have @edit_other_users@ permission +-- -- and have @view_team@ permission for the team. +-- mmGetUnreadsForTeam :: UserId -> TeamId -> Session -> IO TeamUnread +-- mmGetUnreadsForTeam userId teamId = +-- inGet (printf "/users/%s/teams/%s/unread" userId teamId) noBody jsonResponse + +-- -- | Get the @name@, @display_name@, @description@ and @id@ for a team from +-- -- the invite id. +-- -- +-- -- +-- -- /Minimum server version/: 4.0 +-- -- +-- -- +-- -- /Permissions/: No authentication required. +-- mmGetInviteInfoForTeam :: InviteId -> Session -> IO XX34 +-- mmGetInviteInfoForTeam inviteId = +-- inGet (printf "/teams/invite/%s" inviteId) noBody jsonResponse + +-- | Get a team based on provided name string +-- +-- /Permissions/: Must be authenticated, team type is open and have the +-- @view_team@ permission. +mmGetTeamByName :: Text -> Session -> IO Team +mmGetTeamByName name = + inGet (printf "/teams/name/%s" name) noBody jsonResponse + +-- -- | Update a team by providing the team object. The fields that can be +-- -- updated are defined in the request body, all other provided fields +-- -- will be ignored. +-- -- +-- -- /Permissions/: Must have the @manage_team@ permission. +-- mmUpdateTeam :: TeamId -> XX36 -> Session -> IO Team +-- mmUpdateTeam teamId body = +-- inPut (printf "/teams/%s" teamId) (jsonBody body) jsonResponse + +-- | Get a team on the system. +-- +-- /Permissions/: Must be authenticated and have the @view_team@ +-- permission. +mmGetTeam :: TeamId -> Session -> IO Team +mmGetTeam teamId = + inGet (printf "/teams/%s" teamId) noBody jsonResponse + +-- -- | Delete a team softly and put in archived only. +-- -- +-- -- /Permissions/: Must have the @manage_team@ permission. +-- mmDeleteTeam :: TeamId -> Bool -> Session -> IO () +-- mmDeleteTeam teamId permanent = +-- inDelete (printf "/teams/%s?%s" teamId (mkQueryString [ Just ("permanent", if permanent then "true" else "false") ])) noBody jsonResponse + + + +-- * Users + +-- | Get a list of users based on search criteria provided in the request +-- body. Searches are typically done against username, full name, +-- nickname and email unless otherwise configured by the server. +-- +-- /Permissions/: Requires an active session and @read_channel@ and\/or +-- @view_team@ permissions for any channels or teams specified in the +-- request body. +mmSearchUsers :: UserSearch -> Session -> IO (Seq User) +mmSearchUsers body = + inPost "/users/search" (jsonBody body) jsonResponse + +-- | Get a list of users based on a provided list of usernames. +-- +-- /Permissions/: Requires an active session but no other permissions. +mmGetUsersByUsernames :: (Seq Text) -> Session -> IO (Seq User) +mmGetUsersByUsernames body = + inPost "/users/usernames" (jsonBody body) jsonResponse + +-- -- | Revokes a user session from the provided user id and session id +-- -- strings. +-- -- +-- -- /Permissions/: Must be logged in as the user being updated or have the +-- -- @edit_other_users@ permission. +-- mmRevokeUserSession :: UserId -> Text -> Session -> IO () +-- mmRevokeUserSession userId sessionId = +-- inPost (printf "/users/%s/sessions/revoke" userId) (jsonBody (A.object [ "session_id" A..= sessionId ])) jsonResponse + +-- | Update a user's system-level roles. Valid user roles are +-- "system_user", "system_admin" or both of them. Overwrites any +-- previously assigned system-level roles. +-- +-- /Permissions/: Must have the @manage_roles@ permission. +mmUpdateUsersRoles :: UserId -> Text -> Session -> IO () +mmUpdateUsersRoles userId roles = + inPut (printf "/users/%s/roles" userId) (jsonBody (A.object [ "roles" A..= roles ])) noResponse + +-- -- | Send an email with a verification link to a user that has an email +-- -- matching the one in the request body. This endpoint will return +-- -- success even if the email does not match any users on the system. +-- -- +-- -- /Permissions/: No permissions required. +-- mmSendVerificationEmail :: Text -> Session -> IO () +-- mmSendVerificationEmail email = +-- inPost "/users/email/verify/send" (jsonBody (A.object [ "email" A..= email ])) jsonResponse + +-- -- | Get a list of sessions by providing the user GUID. Sensitive +-- -- information will be sanitized out. +-- -- +-- -- /Permissions/: Must be logged in as the user being updated or have the +-- -- @edit_other_users@ permission. +-- -- mmGetUsersSessions :: UserId -> Session -> IO (Seq Session) +-- -- mmGetUsersSessions userId = +-- -- inGet (printf "/users/%s/sessions" userId) noBody jsonResponse + +-- -- | Check if a user has multi-factor authentication active on their +-- -- account by providing a login id. Used to check whether an MFA code +-- -- needs to be provided when logging in. +-- -- +-- -- /Permissions/: No permission required. +-- mmCheckMfa :: Text -> Session -> IO Bool +-- mmCheckMfa loginId = +-- inPost "/users/mfa" (jsonBody (A.object [ "login_id" A..= loginId ])) jsonResponse + +-- -- | Generate a user access token that can be used to authenticate with the +-- -- Mattermost REST API. +-- -- +-- -- +-- -- /Minimum server version/: 4.1 +-- -- +-- -- +-- -- /Permissions/: Must have @create_user_access_token@ permission. For +-- -- non-self requests, must also have the @edit_other_users@ permission. +-- mmCreateUserAccessToken :: UserId -> Text -> Session -> IO UserAccessToken +-- mmCreateUserAccessToken userId description = +-- inPost (printf "/users/%s/tokens" userId) (jsonBody (A.object [ "description" A..= description ])) jsonResponse + +-- -- | Get a list of user access tokens for a user. Does not include the +-- -- actual authentication tokens. Use query paremeters for paging. +-- -- +-- -- +-- -- /Minimum server version/: 4.1 +-- -- +-- -- +-- -- /Permissions/: Must have @read_user_access_token@ permission. For non- +-- -- self requests, must also have the @edit_other_users@ permission. +-- mmGetUserAccessTokens :: UserId -> Maybe Integer -> Maybe Integer -> Session -> IO (Seq UserAccessTokenSanitized) +-- mmGetUserAccessTokens userId page perPage = +-- inGet (printf "/users/%s/tokens?%s" userId (mkQueryString [ sequence ("page", fmap show page) , sequence ("per_page", fmap show perPage) ])) noBody jsonResponse + +-- -- | Revoke a user access token and delete any sessions using the token. +-- -- +-- -- +-- -- /Minimum server version/: 4.1 +-- -- +-- -- +-- -- /Permissions/: Must have @revoke_user_access_token@ permission. For +-- -- non-self requests, must also have the @edit_other_users@ permission. +-- mmRevokeUserAccessToken :: Text -> Session -> IO () +-- mmRevokeUserAccessToken token = +-- inPost "/users/tokens/revoke" (jsonBody (A.object [ "token" A..= token ])) jsonResponse + +-- -- | Get a user access token. Does not include the actual authentication +-- -- token. +-- -- +-- -- +-- -- /Minimum server version/: 4.1 +-- -- +-- -- +-- -- /Permissions/: Must have @read_user_access_token@ permission. For non- +-- -- self requests, must also have the @edit_other_users@ permission. +-- mmGetUserAccessToken :: TokenId -> Session -> IO UserAccessTokenSanitized +-- mmGetUserAccessToken tokenId = +-- inGet (printf "/users/tokens/%s" tokenId) noBody jsonResponse + +-- -- | Update user active or inactive status +-- -- +-- -- /Permissions/: User can deactivate itself. +-- -- +-- -- User with @manage_system@ permission can activate or deactivate a +-- -- user. +-- mmUpdateUserActiveStatus :: UserId -> Bool -> Session -> IO () +-- mmUpdateUserActiveStatus userId active = +-- inPut (printf "/users/%s/active" userId) (jsonBody (A.object [ "active" A..= active ])) jsonResponse + +-- -- | Get a user object by providing a username. Sensitive information will +-- -- be sanitized out. +-- -- +-- -- /Permissions/: Requires an active session but no other permissions. +-- mmGetUserByUsername :: Text -> Session -> IO User +-- mmGetUserByUsername username = +-- inGet (printf "/users/username/%s" username) noBody jsonResponse + +-- -- | Get a list of users based on a provided list of user ids. +-- -- +-- -- /Permissions/: Requires an active session but no other permissions. +-- mmGetUsersByIds :: (Seq Text) -> Session -> IO (Seq User) +-- mmGetUsersByIds body = +-- inPost "/users/ids" (jsonBody body) jsonResponse + +-- -- | Attach a mobile device id to the currently logged in session. This +-- -- will enable push notiofications for a user, if configured by the +-- -- server. +-- -- +-- -- /Permissions/: Must be authenticated. +-- mmAttachMobileDevice :: Text -> Session -> IO () +-- mmAttachMobileDevice deviceId = +-- inPut "/users/sessions/device" (jsonBody (A.object [ "device_id" A..= deviceId ])) jsonResponse + +-- -- | Send an email containing a link for resetting the user's password. The +-- -- link will contain a one-use, timed recovery code tied to the user's +-- -- account. Only works for non-SSO users. +-- -- +-- -- /Permissions/: No permissions required. +-- mmSendPasswordResetEmail :: Text -> Session -> IO () +-- mmSendPasswordResetEmail email = +-- inPost "/users/password/reset/send" (jsonBody (A.object [ "email" A..= email ])) jsonResponse + +-- -- | Get a user object by providing a user email. Sensitive information +-- -- will be sanitized out. +-- -- +-- -- /Permissions/: Requires an active session but no other permissions. +-- mmGetUserByEmail :: Text -> Session -> IO User +-- mmGetUserByEmail email = +-- inGet (printf "/users/email/%s" email) noBody jsonResponse + +-- -- | Switch a user's login method from using email to OAuth2\/SAML\/LDAP or +-- -- back to email. When switching to OAuth2\/SAML, account switching is +-- -- not complete until the user follows the returned link and completes +-- -- any steps on the OAuth2\/SAML service provider. +-- -- +-- -- +-- -- To switch from email to OAuth2\/SAML, specify @current_service@, +-- -- @new_service@, @email@ and @password@. +-- -- +-- -- +-- -- To switch from OAuth2\/SAML to email, specify @current_service@, +-- -- @new_service@, @email@ and @new_password@. +-- -- +-- -- +-- -- To switch from email to LDAP\/AD, specify @current_service@, +-- -- @new_service@, @email@, @password@, @ldap_ip@ and @new_password@ (this +-- -- is the user's LDAP password). +-- -- +-- -- +-- -- To switch from LDAP\/AD to email, specify @current_service@, +-- -- @new_service@, @ldap_ip@, @password@ (this is the user's LDAP +-- -- password), @email@ and @new_password@. +-- -- +-- -- +-- -- Additionally, specify @mfa_code@ when trying to switch an account on +-- -- LDAP\/AD or email that has MFA activated. +-- -- +-- -- +-- -- /Permissions/: No current authentication required except when +-- -- switching from OAuth2\/SAML to email. +-- mmSwitchLoginMethod :: XX19 -> Session -> IO Text +-- mmSwitchLoginMethod body = +-- inPost "/users/login/switch" (jsonBody body) jsonResponse + +-- -- | Set a user's profile image based on user_id string parameter. +-- -- +-- -- /Permissions/: Must be logged in as the user being updated or have the +-- -- @edit_other_users@ permission. +-- mmSetUsersProfileImage :: UserId -> Session -> IO () +-- mmSetUsersProfileImage userId = +-- inPost (printf "/users/%s/image" userId) noBody jsonResponse + +-- -- | Get a user's profile image based on user_id string parameter. +-- -- +-- -- /Permissions/: Must be logged in. +-- mmGetUsersProfileImage :: UserId -> Session -> IO () +-- mmGetUsersProfileImage userId = +-- inGet (printf "/users/%s/image" userId) noBody jsonResponse + +-- -- | Activates multi-factor authentication for the user if @activate@ is +-- -- true and a valid @code@ is provided. If activate is false, then @code@ +-- -- is not required and multi-factor authentication is disabled for the +-- -- user. +-- -- +-- -- /Permissions/: Must be logged in as the user being updated or have the +-- -- @edit_other_users@ permission. +-- mmUpdateUsersMfa :: UserId -> XX22 -> Session -> IO () +-- mmUpdateUsersMfa userId body = +-- inPut (printf "/users/%s/mfa" userId) (jsonBody body) jsonResponse + +-- -- | Verify the email used by a user to sign-up their account with. +-- -- +-- -- /Permissions/: No permissions required. +-- mmVerifyUserEmail :: Text -> Session -> IO () +-- mmVerifyUserEmail token = +-- inPost "/users/email/verify" (jsonBody (A.object [ "token" A..= token ])) jsonResponse + +-- -- | Update the password for a user using a one-use, timed recovery code +-- -- tied to the user's account. Only works for non-SSO users. +-- -- +-- -- /Permissions/: No permissions required. +-- mmResetPassword :: XX24 -> Session -> IO () +-- mmResetPassword body = +-- inPost "/users/password/reset" (jsonBody body) jsonResponse + +-- -- | Get a list of audit by providing the user GUID. +-- -- +-- -- /Permissions/: Must be logged in as the user or have the +-- -- @edit_other_users@ permission. +-- mmGetUsersAudits :: UserId -> Session -> IO (Seq Audit) +-- mmGetUsersAudits userId = +-- inGet (printf "/users/%s/audits" userId) noBody jsonResponse + +-- -- | Update a user's password. New password must meet password policy set +-- -- by server configuration. +-- -- +-- -- /Permissions/: Must be logged in as the user the password is being +-- -- changed for or have @manage_system@ permission. +-- mmUpdateUsersPassword :: UserId -> XX29 -> Session -> IO () +-- mmUpdateUsersPassword userId body = +-- inPut (printf "/users/%s/password" userId) (jsonBody body) jsonResponse + +-- -- | Update a user by providing the user object. The fields that can be +-- -- updated are defined in the request body, all other provided fields +-- -- will be ignored. +-- -- +-- -- /Permissions/: Must be logged in as the user being updated or have the +-- -- @edit_other_users@ permission. +-- mmUpdateUser :: UserId -> XX30 -> Session -> IO User +-- mmUpdateUser userId body = +-- inPut (printf "/users/%s" userId) (jsonBody body) jsonResponse + +-- | Get a user a object. Sensitive information will be sanitized out. +-- +-- /Permissions/: Requires an active session but no other permissions. +mmGetUser :: UserParam -> Session -> IO User +mmGetUser userId = + inGet (printf "/users/%s" userId) noBody jsonResponse + +-- | Deactivates the user by archiving its user object. +-- +-- /Permissions/: Must be logged in as the user being deactivated or have +-- the @edit_other_users@ permission. +mmDeactivateUserAccount :: UserParam -> Session -> IO () +mmDeactivateUserAccount userId = + inDelete (printf "/users/%s" userId) noBody jsonResponse + +-- | Create a new user on the system. +-- +-- /Permissions/: No permission required but user creation can be +-- controlled by server configuration. +mmCreateUser :: UsersCreate -> Session -> IO User +mmCreateUser body = + inPost "/users" (jsonBody body) jsonResponse + -- UsersCreate was XX31 + +data UserQuery = UserQuery + { userQueryPage :: Maybe Int + , userQueryPerPage :: Maybe Int + , userQueryInTeam :: Maybe TeamId + , userQueryNotInTeam :: Maybe TeamId + , userQueryInChannel :: Maybe ChannelId + , userQueryNotInChannel :: Maybe ChannelId + , userQueryWithoutTeam :: Maybe Bool + , userQuerySort :: Maybe UserQuerySort + } + +defaultUserQuery :: UserQuery +defaultUserQuery = UserQuery + { userQueryPage = Nothing + , userQueryPerPage = Nothing + , userQueryInTeam = Nothing + , userQueryNotInTeam = Nothing + , userQueryInChannel = Nothing + , userQueryNotInChannel = Nothing + , userQueryWithoutTeam = Nothing + , userQuerySort = Nothing + } + +data UserQuerySort + = UserQuerySortByLastActivity + | UserQuerySortByCreation + +userQueryToQueryString :: UserQuery -> String +userQueryToQueryString UserQuery { .. } = + mkQueryString [ sequence ("page", fmap show userQueryPage) + , sequence ("per_page", fmap show userQueryPerPage) + , sequence ("in_team", fmap (T.unpack . idString) userQueryInTeam) + , sequence ("not_in_team", fmap (T.unpack . idString) userQueryNotInTeam) + , sequence ("in_channel", fmap (T.unpack . idString) userQueryInChannel) + , sequence ("not_in_channel", fmap (T.unpack . idString) userQueryNotInChannel) + , sequence ( "without_team" + , case userQueryWithoutTeam of + Nothing -> Nothing + Just True -> Just "true" + Just False -> Just "false" + ) + , sequence ( "sort" + , case userQuerySort of + Nothing -> Nothing + Just UserQuerySortByLastActivity -> Just "last_activity_at" + Just UserQuerySortByCreation -> Just "create_at" + ) + ] + +-- | Get a page of a list of users. Based on query string parameters, +-- select users from a team, channel, or select users not in a specific +-- channel. +-- +-- +-- Since server version 4.0, some basic sorting is available using the +-- @sort@ query parameter. Sorting is currently only supported when +-- selecting users on a team. +-- +-- /Permissions/: Requires an active session and (if specified) +-- membership to the channel or team being selected from. +mmGetUsers + :: UserQuery + -> Session + -> IO (Seq User) +mmGetUsers userQuery = + inGet (printf "/users?%s" (userQueryToQueryString userQuery)) noBody jsonResponse + +-- -- | Generates an multi-factor authentication secret for a user and returns +-- -- it as a string and as base64 encoded QR code image. +-- -- +-- -- /Permissions/: Must be logged in as the user or have the +-- -- @edit_other_users@ permission. +-- mmGenerateMfaSecret :: UserId -> Session -> IO XX37 +-- mmGenerateMfaSecret userId = +-- inPost (printf "/users/%s/mfa/generate" userId) noBody jsonResponse + +-- -- | Partially update a user by providing only the fields you want to +-- -- update. Omitted fields will not be updated. The fields that can be +-- -- updated are defined in the request body, all other provided fields +-- -- will be ignored. +-- -- +-- -- /Permissions/: Must be logged in as the user being updated or have the +-- -- @edit_other_users@ permission. +-- mmPatchUser :: UserId -> XX38 -> Session -> IO User +-- 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 + + + +-- * Webhooks + +-- -- | Update an outgoing webhook given the hook id. +-- -- +-- -- /Permissions/: @manage_webhooks@ for system or @manage_webhooks@ for +-- -- the specific team or @manage_webhooks@ for the channel. +-- mmUpdateAnOutgoingWebhook :: HookId -> XX12 -> Session -> IO OutgoingWebhook +-- mmUpdateAnOutgoingWebhook hookId body = +-- inPut (printf "/hooks/outgoing/%s" hookId) (jsonBody body) jsonResponse + +-- -- | Get an outgoing webhook given the hook id. +-- -- +-- -- /Permissions/: @manage_webhooks@ for system or @manage_webhooks@ for +-- -- the specific team or @manage_webhooks@ for the channel. +-- mmGetAnOutgoingWebhook :: HookId -> Session -> IO OutgoingWebhook +-- mmGetAnOutgoingWebhook hookId = +-- inGet (printf "/hooks/outgoing/%s" hookId) noBody jsonResponse + +-- -- | Delete an outgoing webhook given the hook id. +-- -- +-- -- /Permissions/: @manage_webhooks@ for system or @manage_webhooks@ for +-- -- the specific team or @manage_webhooks@ for the channel. +-- mmDeleteAnOutgoingWebhook :: HookId -> Session -> IO () +-- mmDeleteAnOutgoingWebhook hookId = +-- inDelete (printf "/hooks/outgoing/%s" hookId) noBody jsonResponse + +-- -- | Regenerate the token for the outgoing webhook. +-- -- +-- -- /Permissions/: @manage_webhooks@ for system or @manage_webhooks@ for +-- -- the specific team or @manage_webhooks@ for the channel. +-- mmRegenerateTokenForOutgoingWebhook :: HookId -> Session -> IO () +-- mmRegenerateTokenForOutgoingWebhook hookId = +-- inPost (printf "/hooks/outgoing/%s/regen_token" hookId) noBody jsonResponse + +-- -- | Create an incoming webhook for a channel. +-- -- +-- -- /Permissions/: @manage_webhooks@ for the channel the webhook is in. +-- mmCreateAnIncomingWebhook :: XX25 -> Session -> IO IncomingWebhook +-- mmCreateAnIncomingWebhook body = +-- inPost "/hooks/incoming" (jsonBody body) jsonResponse + +-- -- | Get a page of a list of incoming webhooks. Optionally filter for a +-- -- specific team using query parameters. +-- -- +-- -- /Permissions/: @manage_webhooks@ for the system or @manage_webhooks@ +-- -- for the specific team. +-- mmListIncomingWebhooks :: Maybe Integer -> Maybe Integer -> TeamId -> Session -> IO (Seq IncomingWebhook) +-- mmListIncomingWebhooks page perPage teamId = +-- inGet (printf "/hooks/incoming?%s" (mkQueryString [ sequence ("page", fmap show page) , sequence ("per_page", fmap show perPage) , Just ("team_id", T.unpack (idString teamId)) ])) noBody jsonResponse + +-- -- | Create an outgoing webhook for a team. +-- -- +-- -- /Permissions/: @manage_webhooks@ for the team the webhook is in. +-- mmCreateAnOutgoingWebhook :: XX33 -> Session -> IO OutgoingWebhook +-- mmCreateAnOutgoingWebhook body = +-- inPost "/hooks/outgoing" (jsonBody body) jsonResponse + +-- -- | Get a page of a list of outgoing webhooks. Optionally filter for a +-- -- specific team or channel using query parameters. +-- -- +-- -- /Permissions/: @manage_webhooks@ for the system or @manage_webhooks@ +-- -- for the specific team\/channel. +-- mmListOutgoingWebhooks :: Maybe Integer -> Maybe Integer -> TeamId -> ChannelId -> Session -> IO (Seq OutgoingWebhook) +-- mmListOutgoingWebhooks page perPage teamId channelId = +-- inGet (printf "/hooks/outgoing?%s" (mkQueryString [ sequence ("page", fmap show page) , sequence ("per_page", fmap show perPage) , Just ("team_id", T.unpack (idString teamId)) , Just ("channel_id", T.unpack (idString channelId)) ])) noBody jsonResponse + +-- -- | Update an incoming webhook given the hook id. +-- -- +-- -- /Permissions/: @manage_webhooks@ for system or @manage_webhooks@ for +-- -- the specific team or @manage_webhooks@ for the channel. +-- mmUpdateAnIncomingWebhook :: HookId -> XX35 -> Session -> IO IncomingWebhook +-- mmUpdateAnIncomingWebhook hookId body = +-- inPut (printf "/hooks/incoming/%s" hookId) (jsonBody body) jsonResponse + +-- -- | Get an incoming webhook given the hook id. +-- -- +-- -- /Permissions/: @manage_webhooks@ for system or @manage_webhooks@ for +-- -- the specific team or @manage_webhooks@ for the channel. +-- mmGetAnIncomingWebhook :: HookId -> Session -> IO IncomingWebhook +-- mmGetAnIncomingWebhook hookId = +-- inGet (printf "/hooks/incoming/%s" hookId) noBody jsonResponse + +-- data AppError = AppError +-- { appErrorStatusCode :: Integer +-- , appErrorMessage :: Text +-- , appErrorId :: Text +-- , appErrorRequestId :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON AppError where +-- parseJSON = A.withObject "appError" $ \v -> do +-- appErrorStatusCode <- v A..: "status_code" +-- appErrorMessage <- v A..: "message" +-- appErrorId <- v A..: "id" +-- appErrorRequestId <- v A..: "request_id" +-- return AppError { .. } + +-- instance A.ToJSON AppError where +-- toJSON AppError { .. } = A.object +-- [ "status_code" A..= appErrorStatusCode +-- , "message" A..= appErrorMessage +-- , "id" A..= appErrorId +-- , "request_id" A..= appErrorRequestId +-- ] + +-- ** User Statuses + +mmGetUserStatus :: UserParam -> Session -> IO T.Text +mmGetUserStatus userId = + inGet (printf "/users/%s/status" userId) noBody jsonResponse + +getUserStatusesByIds :: Seq UserId -> Session -> IO (HM.HashMap UserId T.Text) +getUserStatusesByIds body = + inPost (printf "/users/%s/status/ids") (jsonBody body) jsonResponse + +-- updateUserStatus :: UserParam -> Session -> IO () +-- updateUserStatus = +-- inPut + +-- -- + +-- data Article = Article +-- { articlePublishedTime :: Text +-- , articleTags :: (Seq Text) +-- , articleSection :: Text +-- , articleAuthors :: (Seq XX4) +-- , articleExpirationTime :: Text +-- , articleModifiedTime :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON Article where +-- parseJSON = A.withObject "article" $ \v -> do +-- articlePublishedTime <- v A..: "published_time" +-- articleTags <- v A..: "tags" +-- articleSection <- v A..: "section" +-- articleAuthors <- v A..: "authors" +-- articleExpirationTime <- v A..: "expiration_time" +-- articleModifiedTime <- v A..: "modified_time" +-- return Article { .. } + +-- instance A.ToJSON Article where +-- toJSON Article { .. } = A.object +-- [ "published_time" A..= articlePublishedTime +-- , "tags" A..= articleTags +-- , "section" A..= articleSection +-- , "authors" A..= articleAuthors +-- , "expiration_time" A..= articleExpirationTime +-- , "modified_time" A..= articleModifiedTime +-- ] + +-- -- + +-- data Audit = Audit +-- { auditUserId :: Text +-- , auditAction :: Text +-- , auditExtraInfo :: Text +-- , auditIpAddress :: Text +-- , auditCreateAt :: UnknownType +-- , auditSessionId :: Text +-- , auditId :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON Audit where +-- parseJSON = A.withObject "audit" $ \v -> do +-- auditUserId <- v A..: "user_id" +-- auditAction <- v A..: "action" +-- auditExtraInfo <- v A..: "extra_info" +-- auditIpAddress <- v A..: "ip_address" +-- auditCreateAt <- v A..: "create_at" +-- auditSessionId <- v A..: "session_id" +-- auditId <- v A..: "id" +-- return Audit { .. } + +-- instance A.ToJSON Audit where +-- toJSON Audit { .. } = A.object +-- [ "user_id" A..= auditUserId +-- , "action" A..= auditAction +-- , "extra_info" A..= auditExtraInfo +-- , "ip_address" A..= auditIpAddress +-- , "create_at" A..= auditCreateAt +-- , "session_id" A..= auditSessionId +-- , "id" A..= auditId +-- ] + +-- -- + +-- data Book = Book +-- { bookReleaseDate :: Text +-- , bookTags :: (Seq Text) +-- , bookIsbn :: Text +-- , bookAuthors :: (Seq XX2) +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON Book where +-- parseJSON = A.withObject "book" $ \v -> do +-- bookReleaseDate <- v A..: "release_date" +-- bookTags <- v A..: "tags" +-- bookIsbn <- v A..: "isbn" +-- bookAuthors <- v A..: "authors" +-- return Book { .. } + +-- instance A.ToJSON Book where +-- toJSON Book { .. } = A.object +-- [ "release_date" A..= bookReleaseDate +-- , "tags" A..= bookTags +-- , "isbn" A..= bookIsbn +-- , "authors" A..= bookAuthors +-- ] + +-- -- + +-- -- + +-- data ClusterInfo = ClusterInfo +-- { clusterInfoLastPing :: Integer +-- , clusterInfoVersion :: Text +-- -- ^ The server version the node is on +-- , clusterInfoInternodeUrl :: Text +-- -- ^ The URL used to communicate with those node from other nodes +-- , clusterInfoConfigHash :: Text +-- -- ^ The hash of the configuartion file the node is using +-- , clusterInfoHostname :: Text +-- -- ^ The hostname for this node +-- , clusterInfoIsAlive :: UnknownType +-- -- ^ Whether or not the node is alive and well +-- , clusterInfoId :: Text +-- -- ^ The unique ID for the node +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON ClusterInfo where +-- parseJSON = A.withObject "clusterInfo" $ \v -> do +-- clusterInfoLastPing <- v A..: "last_ping" +-- clusterInfoVersion <- v A..: "version" +-- clusterInfoInternodeUrl <- v A..: "internode_url" +-- clusterInfoConfigHash <- v A..: "config_hash" +-- clusterInfoHostname <- v A..: "hostname" +-- clusterInfoIsAlive <- v A..: "is_alive" +-- clusterInfoId <- v A..: "id" +-- return ClusterInfo { .. } + +-- instance A.ToJSON ClusterInfo where +-- toJSON ClusterInfo { .. } = A.object +-- [ "last_ping" A..= clusterInfoLastPing +-- , "version" A..= clusterInfoVersion +-- , "internode_url" A..= clusterInfoInternodeUrl +-- , "config_hash" A..= clusterInfoConfigHash +-- , "hostname" A..= clusterInfoHostname +-- , "is_alive" A..= clusterInfoIsAlive +-- , "id" A..= clusterInfoId +-- ] + +-- -- + +-- data ClusterSettings = ClusterSettings +-- { clusterSettingsInternodeurls :: (Seq Text) +-- , clusterSettingsEnable :: UnknownType +-- , clusterSettingsInternodelistenaddress :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON ClusterSettings where +-- parseJSON = A.withObject "clusterSettings" $ \v -> do +-- clusterSettingsInternodeurls <- v A..: "InterNodeUrls" +-- clusterSettingsEnable <- v A..: "Enable" +-- clusterSettingsInternodelistenaddress <- v A..: "InterNodeListenAddress" +-- return ClusterSettings { .. } + +-- instance A.ToJSON ClusterSettings where +-- toJSON ClusterSettings { .. } = A.object +-- [ "InterNodeUrls" A..= clusterSettingsInternodeurls +-- , "Enable" A..= clusterSettingsEnable +-- , "InterNodeListenAddress" A..= clusterSettingsInternodelistenaddress +-- ] + +-- -- + +-- data Compliance = Compliance +-- { complianceStatus :: Text +-- , complianceCount :: UnknownType +-- , complianceUserId :: Text +-- , complianceId :: Text +-- , complianceCreateAt :: UnknownType +-- , complianceEndAt :: UnknownType +-- , complianceKeywords :: Text +-- , complianceStartAt :: UnknownType +-- , complianceType :: Text +-- , complianceEmails :: Text +-- , complianceDesc :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON Compliance where +-- parseJSON = A.withObject "compliance" $ \v -> do +-- complianceStatus <- v A..: "status" +-- complianceCount <- v A..: "count" +-- complianceUserId <- v A..: "user_id" +-- complianceId <- v A..: "id" +-- complianceCreateAt <- v A..: "create_at" +-- complianceEndAt <- v A..: "end_at" +-- complianceKeywords <- v A..: "keywords" +-- complianceStartAt <- v A..: "start_at" +-- complianceType <- v A..: "type" +-- complianceEmails <- v A..: "emails" +-- complianceDesc <- v A..: "desc" +-- return Compliance { .. } + +-- instance A.ToJSON Compliance where +-- toJSON Compliance { .. } = A.object +-- [ "status" A..= complianceStatus +-- , "count" A..= complianceCount +-- , "user_id" A..= complianceUserId +-- , "id" A..= complianceId +-- , "create_at" A..= complianceCreateAt +-- , "end_at" A..= complianceEndAt +-- , "keywords" A..= complianceKeywords +-- , "start_at" A..= complianceStartAt +-- , "type" A..= complianceType +-- , "emails" A..= complianceEmails +-- , "desc" A..= complianceDesc +-- ] + +-- -- + +-- -- + +-- -- + +-- data Emoji = Emoji +-- { emojiCreatorId :: Text +-- , emojiName :: Text +-- -- ^ The name of the emoji +-- , emojiDeleteAt :: UnknownType +-- -- ^ The time at which the emoji was deleted. +-- , emojiUpdateAt :: UnknownType +-- -- ^ The time at which the emoji was updated. +-- , emojiCreateAt :: UnknownType +-- -- ^ The time at which the emoji was made +-- , emojiId :: Text +-- -- ^ The ID of the emoji +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON Emoji where +-- parseJSON = A.withObject "emoji" $ \v -> do +-- emojiCreatorId <- v A..: "creator_id" +-- emojiName <- v A..: "name" +-- emojiDeleteAt <- v A..: "delete_at" +-- emojiUpdateAt <- v A..: "update_at" +-- emojiCreateAt <- v A..: "create_at" +-- emojiId <- v A..: "id" +-- return Emoji { .. } + +-- instance A.ToJSON Emoji where +-- toJSON Emoji { .. } = A.object +-- [ "creator_id" A..= emojiCreatorId +-- , "name" A..= emojiName +-- , "delete_at" A..= emojiDeleteAt +-- , "update_at" A..= emojiUpdateAt +-- , "create_at" A..= emojiCreateAt +-- , "id" A..= emojiId +-- ] + +-- -- + +-- data FileSettings = FileSettings +-- { fileSettingsInitialfont :: Text +-- , fileSettingsThumbnailwidth :: UnknownType +-- , fileSettingsAmazons3accesskeyid :: Text +-- , fileSettingsAmazons3region :: Text +-- , fileSettingsPreviewwidth :: UnknownType +-- , fileSettingsAmazons3endpoint :: Text +-- , fileSettingsDirectory :: Text +-- , fileSettingsThumbnailheight :: UnknownType +-- , fileSettingsAmazons3bucket :: Text +-- , fileSettingsAmazons3secretaccesskey :: Text +-- , fileSettingsAmazons3ssl :: UnknownType +-- , fileSettingsPreviewheight :: UnknownType +-- , fileSettingsEnablepubliclink :: UnknownType +-- , fileSettingsMaxfilesize :: UnknownType +-- , fileSettingsProfilewidth :: UnknownType +-- , fileSettingsProfileheight :: UnknownType +-- , fileSettingsPubliclinksalt :: Text +-- , fileSettingsDrivername :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON FileSettings where +-- parseJSON = A.withObject "fileSettings" $ \v -> do +-- fileSettingsInitialfont <- v A..: "InitialFont" +-- fileSettingsThumbnailwidth <- v A..: "ThumbnailWidth" +-- fileSettingsAmazons3accesskeyid <- v A..: "AmazonS3AccessKeyId" +-- fileSettingsAmazons3region <- v A..: "AmazonS3Region" +-- fileSettingsPreviewwidth <- v A..: "PreviewWidth" +-- fileSettingsAmazons3endpoint <- v A..: "AmazonS3Endpoint" +-- fileSettingsDirectory <- v A..: "Directory" +-- fileSettingsThumbnailheight <- v A..: "ThumbnailHeight" +-- fileSettingsAmazons3bucket <- v A..: "AmazonS3Bucket" +-- fileSettingsAmazons3secretaccesskey <- v A..: "AmazonS3SecretAccessKey" +-- fileSettingsAmazons3ssl <- v A..: "AmazonS3SSL" +-- fileSettingsPreviewheight <- v A..: "PreviewHeight" +-- fileSettingsEnablepubliclink <- v A..: "EnablePublicLink" +-- fileSettingsMaxfilesize <- v A..: "MaxFileSize" +-- fileSettingsProfilewidth <- v A..: "ProfileWidth" +-- fileSettingsProfileheight <- v A..: "ProfileHeight" +-- fileSettingsPubliclinksalt <- v A..: "PublicLinkSalt" +-- fileSettingsDrivername <- v A..: "DriverName" +-- return FileSettings { .. } + +-- instance A.ToJSON FileSettings where +-- toJSON FileSettings { .. } = A.object +-- [ "InitialFont" A..= fileSettingsInitialfont +-- , "ThumbnailWidth" A..= fileSettingsThumbnailwidth +-- , "AmazonS3AccessKeyId" A..= fileSettingsAmazons3accesskeyid +-- , "AmazonS3Region" A..= fileSettingsAmazons3region +-- , "PreviewWidth" A..= fileSettingsPreviewwidth +-- , "AmazonS3Endpoint" A..= fileSettingsAmazons3endpoint +-- , "Directory" A..= fileSettingsDirectory +-- , "ThumbnailHeight" A..= fileSettingsThumbnailheight +-- , "AmazonS3Bucket" A..= fileSettingsAmazons3bucket +-- , "AmazonS3SecretAccessKey" A..= fileSettingsAmazons3secretaccesskey +-- , "AmazonS3SSL" A..= fileSettingsAmazons3ssl +-- , "PreviewHeight" A..= fileSettingsPreviewheight +-- , "EnablePublicLink" A..= fileSettingsEnablepubliclink +-- , "MaxFileSize" A..= fileSettingsMaxfilesize +-- , "ProfileWidth" A..= fileSettingsProfilewidth +-- , "ProfileHeight" A..= fileSettingsProfileheight +-- , "PublicLinkSalt" A..= fileSettingsPubliclinksalt +-- , "DriverName" A..= fileSettingsDrivername +-- ] + +-- -- + +-- data GitLabSettings = GitLabSettings +-- { gitLabSettingsSecret :: Text +-- , gitLabSettingsEnable :: UnknownType +-- , gitLabSettingsScope :: Text +-- , gitLabSettingsUserapiendpoint :: Text +-- , gitLabSettingsTokenendpoint :: Text +-- , gitLabSettingsAuthendpoint :: Text +-- , gitLabSettingsId :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON GitLabSettings where +-- parseJSON = A.withObject "gitLabSettings" $ \v -> do +-- gitLabSettingsSecret <- v A..: "Secret" +-- gitLabSettingsEnable <- v A..: "Enable" +-- gitLabSettingsScope <- v A..: "Scope" +-- gitLabSettingsUserapiendpoint <- v A..: "UserApiEndpoint" +-- gitLabSettingsTokenendpoint <- v A..: "TokenEndpoint" +-- gitLabSettingsAuthendpoint <- v A..: "AuthEndpoint" +-- gitLabSettingsId <- v A..: "Id" +-- return GitLabSettings { .. } + +-- instance A.ToJSON GitLabSettings where +-- toJSON GitLabSettings { .. } = A.object +-- [ "Secret" A..= gitLabSettingsSecret +-- , "Enable" A..= gitLabSettingsEnable +-- , "Scope" A..= gitLabSettingsScope +-- , "UserApiEndpoint" A..= gitLabSettingsUserapiendpoint +-- , "TokenEndpoint" A..= gitLabSettingsTokenendpoint +-- , "AuthEndpoint" A..= gitLabSettingsAuthendpoint +-- , "Id" A..= gitLabSettingsId +-- ] + +-- -- + +-- data GoogleSettings = GoogleSettings +-- { googleSettingsSecret :: Text +-- , googleSettingsEnable :: UnknownType +-- , googleSettingsScope :: Text +-- , googleSettingsUserapiendpoint :: Text +-- , googleSettingsTokenendpoint :: Text +-- , googleSettingsAuthendpoint :: Text +-- , googleSettingsId :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON GoogleSettings where +-- parseJSON = A.withObject "googleSettings" $ \v -> do +-- googleSettingsSecret <- v A..: "Secret" +-- googleSettingsEnable <- v A..: "Enable" +-- googleSettingsScope <- v A..: "Scope" +-- googleSettingsUserapiendpoint <- v A..: "UserApiEndpoint" +-- googleSettingsTokenendpoint <- v A..: "TokenEndpoint" +-- googleSettingsAuthendpoint <- v A..: "AuthEndpoint" +-- googleSettingsId <- v A..: "Id" +-- return GoogleSettings { .. } + +-- instance A.ToJSON GoogleSettings where +-- toJSON GoogleSettings { .. } = A.object +-- [ "Secret" A..= googleSettingsSecret +-- , "Enable" A..= googleSettingsEnable +-- , "Scope" A..= googleSettingsScope +-- , "UserApiEndpoint" A..= googleSettingsUserapiendpoint +-- , "TokenEndpoint" A..= googleSettingsTokenendpoint +-- , "AuthEndpoint" A..= googleSettingsAuthendpoint +-- , "Id" A..= googleSettingsId +-- ] + +-- -- + +-- data IncomingWebhook = IncomingWebhook +-- { incomingWebhookChannelId :: Text +-- , incomingWebhookDisplayName :: Text +-- -- ^ The display name for this incoming webhook +-- , incomingWebhookDescription :: Text +-- -- ^ The description for this incoming webhook +-- , incomingWebhookDeleteAt :: UnknownType +-- , incomingWebhookUpdateAt :: UnknownType +-- , incomingWebhookCreateAt :: UnknownType +-- , incomingWebhookId :: Text +-- -- ^ The unique identifier for this incoming webhook +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON IncomingWebhook where +-- parseJSON = A.withObject "incomingWebhook" $ \v -> do +-- incomingWebhookChannelId <- v A..: "channel_id" +-- incomingWebhookDisplayName <- v A..: "display_name" +-- incomingWebhookDescription <- v A..: "description" +-- incomingWebhookDeleteAt <- v A..: "delete_at" +-- incomingWebhookUpdateAt <- v A..: "update_at" +-- incomingWebhookCreateAt <- v A..: "create_at" +-- incomingWebhookId <- v A..: "id" +-- return IncomingWebhook { .. } + +-- instance A.ToJSON IncomingWebhook where +-- toJSON IncomingWebhook { .. } = A.object +-- [ "channel_id" A..= incomingWebhookChannelId +-- , "display_name" A..= incomingWebhookDisplayName +-- , "description" A..= incomingWebhookDescription +-- , "delete_at" A..= incomingWebhookDeleteAt +-- , "update_at" A..= incomingWebhookUpdateAt +-- , "create_at" A..= incomingWebhookCreateAt +-- , "id" A..= incomingWebhookId +-- ] + +-- -- + +-- data Job = Job +-- { jobStatus :: Text +-- , jobStartAt :: UnknownType +-- -- ^ The time at which the job was started +-- , jobType :: Text +-- -- ^ The type of job +-- , jobCreateAt :: UnknownType +-- -- ^ The time at which the job was created +-- , jobId :: Text +-- -- ^ The unique id of the job +-- , jobProgress :: UnknownType +-- -- ^ The progress (as a percentage) of the job +-- , jobData :: UnknownType +-- -- ^ A freeform data field containing additional information about the job +-- , jobLastActivityAt :: UnknownType +-- -- ^ The last time at which the job had activity +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON Job where +-- parseJSON = A.withObject "job" $ \v -> do +-- jobStatus <- v A..: "status" +-- jobStartAt <- v A..: "start_at" +-- jobType <- v A..: "type" +-- jobCreateAt <- v A..: "create_at" +-- jobId <- v A..: "id" +-- jobProgress <- v A..: "progress" +-- jobData <- v A..: "data" +-- jobLastActivityAt <- v A..: "last_activity_at" +-- return Job { .. } + +-- instance A.ToJSON Job where +-- toJSON Job { .. } = A.object +-- [ "status" A..= jobStatus +-- , "start_at" A..= jobStartAt +-- , "type" A..= jobType +-- , "create_at" A..= jobCreateAt +-- , "id" A..= jobId +-- , "progress" A..= jobProgress +-- , "data" A..= jobData +-- , "last_activity_at" A..= jobLastActivityAt +-- ] + +-- -- + +-- data LdapSettings = LdapSettings +-- { ldapSettingsLastnameattribute :: Text +-- , ldapSettingsIdattribute :: Text +-- , ldapSettingsSyncintervalminutes :: UnknownType +-- , ldapSettingsLoginfieldname :: Text +-- , ldapSettingsLdapserver :: Text +-- , ldapSettingsLdapport :: UnknownType +-- , ldapSettingsUsernameattribute :: Text +-- , ldapSettingsMaxpagesize :: UnknownType +-- , ldapSettingsEnable :: UnknownType +-- , ldapSettingsUserfilter :: Text +-- , ldapSettingsBindpassword :: Text +-- , ldapSettingsSkipcertificateverification :: UnknownType +-- , ldapSettingsQuerytimeout :: UnknownType +-- , ldapSettingsBasedn :: Text +-- , ldapSettingsPositionattribute :: Text +-- , ldapSettingsEmailattribute :: Text +-- , ldapSettingsConnectionsecurity :: Text +-- , ldapSettingsBindusername :: Text +-- , ldapSettingsFirstnameattribute :: Text +-- , ldapSettingsNicknameattribute :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON LdapSettings where +-- parseJSON = A.withObject "ldapSettings" $ \v -> do +-- ldapSettingsLastnameattribute <- v A..: "LastNameAttribute" +-- ldapSettingsIdattribute <- v A..: "IdAttribute" +-- ldapSettingsSyncintervalminutes <- v A..: "SyncIntervalMinutes" +-- ldapSettingsLoginfieldname <- v A..: "LoginFieldName" +-- ldapSettingsLdapserver <- v A..: "LdapServer" +-- ldapSettingsLdapport <- v A..: "LdapPort" +-- ldapSettingsUsernameattribute <- v A..: "UsernameAttribute" +-- ldapSettingsMaxpagesize <- v A..: "MaxPageSize" +-- ldapSettingsEnable <- v A..: "Enable" +-- ldapSettingsUserfilter <- v A..: "UserFilter" +-- ldapSettingsBindpassword <- v A..: "BindPassword" +-- ldapSettingsSkipcertificateverification <- v A..: "SkipCertificateVerification" +-- ldapSettingsQuerytimeout <- v A..: "QueryTimeout" +-- ldapSettingsBasedn <- v A..: "BaseDN" +-- ldapSettingsPositionattribute <- v A..: "PositionAttribute" +-- ldapSettingsEmailattribute <- v A..: "EmailAttribute" +-- ldapSettingsConnectionsecurity <- v A..: "ConnectionSecurity" +-- ldapSettingsBindusername <- v A..: "BindUsername" +-- ldapSettingsFirstnameattribute <- v A..: "FirstNameAttribute" +-- ldapSettingsNicknameattribute <- v A..: "NicknameAttribute" +-- return LdapSettings { .. } + +-- instance A.ToJSON LdapSettings where +-- toJSON LdapSettings { .. } = A.object +-- [ "LastNameAttribute" A..= ldapSettingsLastnameattribute +-- , "IdAttribute" A..= ldapSettingsIdattribute +-- , "SyncIntervalMinutes" A..= ldapSettingsSyncintervalminutes +-- , "LoginFieldName" A..= ldapSettingsLoginfieldname +-- , "LdapServer" A..= ldapSettingsLdapserver +-- , "LdapPort" A..= ldapSettingsLdapport +-- , "UsernameAttribute" A..= ldapSettingsUsernameattribute +-- , "MaxPageSize" A..= ldapSettingsMaxpagesize +-- , "Enable" A..= ldapSettingsEnable +-- , "UserFilter" A..= ldapSettingsUserfilter +-- , "BindPassword" A..= ldapSettingsBindpassword +-- , "SkipCertificateVerification" A..= ldapSettingsSkipcertificateverification +-- , "QueryTimeout" A..= ldapSettingsQuerytimeout +-- , "BaseDN" A..= ldapSettingsBasedn +-- , "PositionAttribute" A..= ldapSettingsPositionattribute +-- , "EmailAttribute" A..= ldapSettingsEmailattribute +-- , "ConnectionSecurity" A..= ldapSettingsConnectionsecurity +-- , "BindUsername" A..= ldapSettingsBindusername +-- , "FirstNameAttribute" A..= ldapSettingsFirstnameattribute +-- , "NicknameAttribute" A..= ldapSettingsNicknameattribute +-- ] + +-- -- + +-- data LocalizationSettings = LocalizationSettings +-- { localizationSettingsDefaultclientlocale :: Text +-- , localizationSettingsAvailablelocales :: Text +-- , localizationSettingsDefaultserverlocale :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON LocalizationSettings where +-- parseJSON = A.withObject "localizationSettings" $ \v -> do +-- localizationSettingsDefaultclientlocale <- v A..: "DefaultClientLocale" +-- localizationSettingsAvailablelocales <- v A..: "AvailableLocales" +-- localizationSettingsDefaultserverlocale <- v A..: "DefaultServerLocale" +-- return LocalizationSettings { .. } + +-- instance A.ToJSON LocalizationSettings where +-- toJSON LocalizationSettings { .. } = A.object +-- [ "DefaultClientLocale" A..= localizationSettingsDefaultclientlocale +-- , "AvailableLocales" A..= localizationSettingsAvailablelocales +-- , "DefaultServerLocale" A..= localizationSettingsDefaultserverlocale +-- ] + +-- -- + +-- -- + +-- -- + +-- data OAuthApp = OAuthApp +-- { oAuthAppDescription :: Text +-- , oAuthAppIconUrl :: Text +-- -- ^ A URL to an icon to display with the application +-- , oAuthAppUpdateAt :: UnknownType +-- -- ^ The last time of update for the application +-- , oAuthAppCreateAt :: UnknownType +-- -- ^ The time of registration for the application +-- , oAuthAppIsTrusted :: UnknownType +-- -- ^ Set this to `true` to skip asking users for permission +-- , oAuthAppClientSecret :: Text +-- -- ^ The client secret of the application +-- , oAuthAppCallbackUrls :: (Seq Text) +-- -- ^ A list of callback URLs for the appliation +-- , oAuthAppHomepage :: Text +-- -- ^ A link to the website of the application +-- , oAuthAppId :: Text +-- -- ^ The client id of the application +-- , oAuthAppName :: Text +-- -- ^ The name of the client application +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON OAuthApp where +-- parseJSON = A.withObject "oAuthApp" $ \v -> do +-- oAuthAppDescription <- v A..: "description" +-- oAuthAppIconUrl <- v A..: "icon_url" +-- oAuthAppUpdateAt <- v A..: "update_at" +-- oAuthAppCreateAt <- v A..: "create_at" +-- oAuthAppIsTrusted <- v A..: "is_trusted" +-- oAuthAppClientSecret <- v A..: "client_secret" +-- oAuthAppCallbackUrls <- v A..: "callback_urls" +-- oAuthAppHomepage <- v A..: "homepage" +-- oAuthAppId <- v A..: "id" +-- oAuthAppName <- v A..: "name" +-- return OAuthApp { .. } + +-- instance A.ToJSON OAuthApp where +-- toJSON OAuthApp { .. } = A.object +-- [ "description" A..= oAuthAppDescription +-- , "icon_url" A..= oAuthAppIconUrl +-- , "update_at" A..= oAuthAppUpdateAt +-- , "create_at" A..= oAuthAppCreateAt +-- , "is_trusted" A..= oAuthAppIsTrusted +-- , "client_secret" A..= oAuthAppClientSecret +-- , "callback_urls" A..= oAuthAppCallbackUrls +-- , "homepage" A..= oAuthAppHomepage +-- , "id" A..= oAuthAppId +-- , "name" A..= oAuthAppName +-- ] + +-- -- + +-- data Office365Settings = Office365Settings +-- { office365SettingsSecret :: Text +-- , office365SettingsEnable :: UnknownType +-- , office365SettingsScope :: Text +-- , office365SettingsUserapiendpoint :: Text +-- , office365SettingsTokenendpoint :: Text +-- , office365SettingsAuthendpoint :: Text +-- , office365SettingsId :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON Office365Settings where +-- parseJSON = A.withObject "office365Settings" $ \v -> do +-- office365SettingsSecret <- v A..: "Secret" +-- office365SettingsEnable <- v A..: "Enable" +-- office365SettingsScope <- v A..: "Scope" +-- office365SettingsUserapiendpoint <- v A..: "UserApiEndpoint" +-- office365SettingsTokenendpoint <- v A..: "TokenEndpoint" +-- office365SettingsAuthendpoint <- v A..: "AuthEndpoint" +-- office365SettingsId <- v A..: "Id" +-- return Office365Settings { .. } + +-- instance A.ToJSON Office365Settings where +-- toJSON Office365Settings { .. } = A.object +-- [ "Secret" A..= office365SettingsSecret +-- , "Enable" A..= office365SettingsEnable +-- , "Scope" A..= office365SettingsScope +-- , "UserApiEndpoint" A..= office365SettingsUserapiendpoint +-- , "TokenEndpoint" A..= office365SettingsTokenendpoint +-- , "AuthEndpoint" A..= office365SettingsAuthendpoint +-- , "Id" A..= office365SettingsId +-- ] + +-- -- + +-- data OpenGraph = OpenGraph +-- { openGraphProfile :: UnknownObject +-- , openGraphSiteName :: Text +-- , openGraphDescription :: Text +-- , openGraphVideos :: (Seq XX1) +-- , openGraphTitle :: Text +-- , openGraphUrl :: Text +-- , openGraphLocalesAlternate :: (Seq Text) +-- , openGraphLocale :: Text +-- , openGraphBook :: Book +-- -- ^ Book object used in OpenGraph metadata of a webpage, if type is book +-- , openGraphImages :: (Seq XX3) +-- , openGraphArticle :: Article +-- -- ^ Article object used in OpenGraph metadata of a webpage, if type is article +-- , openGraphAudios :: (Seq XX5) +-- , openGraphType :: Text +-- , openGraphDeterminer :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON OpenGraph where +-- parseJSON = A.withObject "openGraph" $ \v -> do +-- openGraphProfile <- v A..: "profile" +-- openGraphSiteName <- v A..: "site_name" +-- openGraphDescription <- v A..: "description" +-- openGraphVideos <- v A..: "videos" +-- openGraphTitle <- v A..: "title" +-- openGraphUrl <- v A..: "url" +-- openGraphLocalesAlternate <- v A..: "locales_alternate" +-- openGraphLocale <- v A..: "locale" +-- openGraphBook <- v A..: "book" +-- openGraphImages <- v A..: "images" +-- openGraphArticle <- v A..: "article" +-- openGraphAudios <- v A..: "audios" +-- openGraphType <- v A..: "type" +-- openGraphDeterminer <- v A..: "determiner" +-- return OpenGraph { .. } + +-- instance A.ToJSON OpenGraph where +-- toJSON OpenGraph { .. } = A.object +-- [ "profile" A..= openGraphProfile +-- , "site_name" A..= openGraphSiteName +-- , "description" A..= openGraphDescription +-- , "videos" A..= openGraphVideos +-- , "title" A..= openGraphTitle +-- , "url" A..= openGraphUrl +-- , "locales_alternate" A..= openGraphLocalesAlternate +-- , "locale" A..= openGraphLocale +-- , "book" A..= openGraphBook +-- , "images" A..= openGraphImages +-- , "article" A..= openGraphArticle +-- , "audios" A..= openGraphAudios +-- , "type" A..= openGraphType +-- , "determiner" A..= openGraphDeterminer +-- ] + +-- -- + +-- data OutgoingWebhook = OutgoingWebhook +-- { outgoingWebhookTriggerWhen :: Integer +-- , outgoingWebhookDisplayName :: Text +-- -- ^ The display name for this outgoing webhook +-- , outgoingWebhookDescription :: Text +-- -- ^ The description for this outgoing webhook +-- , outgoingWebhookDeleteAt :: UnknownType +-- , outgoingWebhookUpdateAt :: UnknownType +-- , outgoingWebhookCreateAt :: UnknownType +-- , outgoingWebhookChannelId :: Text +-- -- ^ The ID of a public channel that the webhook watchs +-- , outgoingWebhookCreatorId :: Text +-- -- ^ The Id of the user who created the webhook +-- , outgoingWebhookContentType :: Text +-- -- ^ The format to POST the data in, either `application/json` or `application/x-www-form-urlencoded` +-- , outgoingWebhookTriggerWords :: (Seq Text) +-- -- ^ List of words for the webhook to trigger on +-- , outgoingWebhookTeamId :: Text +-- -- ^ The ID of the team that the webhook watchs +-- , outgoingWebhookCallbackUrls :: (Seq Text) +-- -- ^ The URLs to POST the payloads to when the webhook is triggered +-- , outgoingWebhookId :: Text +-- -- ^ The unique identifier for this outgoing webhook +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON OutgoingWebhook where +-- parseJSON = A.withObject "outgoingWebhook" $ \v -> do +-- outgoingWebhookTriggerWhen <- v A..: "trigger_when" +-- outgoingWebhookDisplayName <- v A..: "display_name" +-- outgoingWebhookDescription <- v A..: "description" +-- outgoingWebhookDeleteAt <- v A..: "delete_at" +-- outgoingWebhookUpdateAt <- v A..: "update_at" +-- outgoingWebhookCreateAt <- v A..: "create_at" +-- outgoingWebhookChannelId <- v A..: "channel_id" +-- outgoingWebhookCreatorId <- v A..: "creator_id" +-- outgoingWebhookContentType <- v A..: "content_type" +-- outgoingWebhookTriggerWords <- v A..: "trigger_words" +-- outgoingWebhookTeamId <- v A..: "team_id" +-- outgoingWebhookCallbackUrls <- v A..: "callback_urls" +-- outgoingWebhookId <- v A..: "id" +-- return OutgoingWebhook { .. } + +-- instance A.ToJSON OutgoingWebhook where +-- toJSON OutgoingWebhook { .. } = A.object +-- [ "trigger_when" A..= outgoingWebhookTriggerWhen +-- , "display_name" A..= outgoingWebhookDisplayName +-- , "description" A..= outgoingWebhookDescription +-- , "delete_at" A..= outgoingWebhookDeleteAt +-- , "update_at" A..= outgoingWebhookUpdateAt +-- , "create_at" A..= outgoingWebhookCreateAt +-- , "channel_id" A..= outgoingWebhookChannelId +-- , "creator_id" A..= outgoingWebhookCreatorId +-- , "content_type" A..= outgoingWebhookContentType +-- , "trigger_words" A..= outgoingWebhookTriggerWords +-- , "team_id" A..= outgoingWebhookTeamId +-- , "callback_urls" A..= outgoingWebhookCallbackUrls +-- , "id" A..= outgoingWebhookId +-- ] + +-- -- + +-- -- + +-- data SamlCertificateStatus = SamlCertificateStatus +-- { samlCertificateStatusIdpCertificateFile :: Bool +-- , samlCertificateStatusPrivateKeyFile :: UnknownType +-- -- ^ Status is good when `true` +-- , samlCertificateStatusPublicCertificateFile :: UnknownType +-- -- ^ Status is good when `true` +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON SamlCertificateStatus where +-- parseJSON = A.withObject "samlCertificateStatus" $ \v -> do +-- samlCertificateStatusIdpCertificateFile <- v A..: "idp_certificate_file" +-- samlCertificateStatusPrivateKeyFile <- v A..: "private_key_file" +-- samlCertificateStatusPublicCertificateFile <- v A..: "public_certificate_file" +-- return SamlCertificateStatus { .. } + +-- instance A.ToJSON SamlCertificateStatus where +-- toJSON SamlCertificateStatus { .. } = A.object +-- [ "idp_certificate_file" A..= samlCertificateStatusIdpCertificateFile +-- , "private_key_file" A..= samlCertificateStatusPrivateKeyFile +-- , "public_certificate_file" A..= samlCertificateStatusPublicCertificateFile +-- ] + +-- -- + +-- data SamlSettings = SamlSettings +-- { samlSettingsLoginbuttontext :: Text +-- , samlSettingsLastnameattribute :: Text +-- , samlSettingsEncrypt :: UnknownType +-- , samlSettingsIdpurl :: Text +-- , samlSettingsVerify :: UnknownType +-- , samlSettingsAssertionconsumerserviceurl :: Text +-- , samlSettingsUsernameattribute :: Text +-- , samlSettingsLocaleattribute :: Text +-- , samlSettingsFirstnameattribute :: Text +-- , samlSettingsEnable :: UnknownType +-- , samlSettingsNicknameattribute :: Text +-- , samlSettingsPositionattribute :: Text +-- , samlSettingsIdpdescriptorurl :: Text +-- , samlSettingsPrivatekeyfile :: Text +-- , samlSettingsIdpcertificatefile :: Text +-- , samlSettingsEmailattribute :: Text +-- , samlSettingsPubliccertificatefile :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON SamlSettings where +-- parseJSON = A.withObject "samlSettings" $ \v -> do +-- samlSettingsLoginbuttontext <- v A..: "LoginButtonText" +-- samlSettingsLastnameattribute <- v A..: "LastNameAttribute" +-- samlSettingsEncrypt <- v A..: "Encrypt" +-- samlSettingsIdpurl <- v A..: "IdpUrl" +-- samlSettingsVerify <- v A..: "Verify" +-- samlSettingsAssertionconsumerserviceurl <- v A..: "AssertionConsumerServiceURL" +-- samlSettingsUsernameattribute <- v A..: "UsernameAttribute" +-- samlSettingsLocaleattribute <- v A..: "LocaleAttribute" +-- samlSettingsFirstnameattribute <- v A..: "FirstNameAttribute" +-- samlSettingsEnable <- v A..: "Enable" +-- samlSettingsNicknameattribute <- v A..: "NicknameAttribute" +-- samlSettingsPositionattribute <- v A..: "PositionAttribute" +-- samlSettingsIdpdescriptorurl <- v A..: "IdpDescriptorUrl" +-- samlSettingsPrivatekeyfile <- v A..: "PrivateKeyFile" +-- samlSettingsIdpcertificatefile <- v A..: "IdpCertificateFile" +-- samlSettingsEmailattribute <- v A..: "EmailAttribute" +-- samlSettingsPubliccertificatefile <- v A..: "PublicCertificateFile" +-- return SamlSettings { .. } + +-- instance A.ToJSON SamlSettings where +-- toJSON SamlSettings { .. } = A.object +-- [ "LoginButtonText" A..= samlSettingsLoginbuttontext +-- , "LastNameAttribute" A..= samlSettingsLastnameattribute +-- , "Encrypt" A..= samlSettingsEncrypt +-- , "IdpUrl" A..= samlSettingsIdpurl +-- , "Verify" A..= samlSettingsVerify +-- , "AssertionConsumerServiceURL" A..= samlSettingsAssertionconsumerserviceurl +-- , "UsernameAttribute" A..= samlSettingsUsernameattribute +-- , "LocaleAttribute" A..= samlSettingsLocaleattribute +-- , "FirstNameAttribute" A..= samlSettingsFirstnameattribute +-- , "Enable" A..= samlSettingsEnable +-- , "NicknameAttribute" A..= samlSettingsNicknameattribute +-- , "PositionAttribute" A..= samlSettingsPositionattribute +-- , "IdpDescriptorUrl" A..= samlSettingsIdpdescriptorurl +-- , "PrivateKeyFile" A..= samlSettingsPrivatekeyfile +-- , "IdpCertificateFile" A..= samlSettingsIdpcertificatefile +-- , "EmailAttribute" A..= samlSettingsEmailattribute +-- , "PublicCertificateFile" A..= samlSettingsPubliccertificatefile +-- ] + +-- -- + +-- data ServiceSettings = ServiceSettings +-- { serviceSettingsEnableposticonoverride :: Bool +-- , serviceSettingsSegmentdeveloperkey :: Text +-- , serviceSettingsEnablepostusernameoverride :: UnknownType +-- , serviceSettingsForward80to443 :: UnknownType +-- , serviceSettingsEnableincomingwebhooks :: UnknownType +-- , serviceSettingsSessionlengthmobileindays :: UnknownType +-- , serviceSettingsUseletsencrypt :: UnknownType +-- , serviceSettingsRestrictcustomemojicreation :: Text +-- , serviceSettingsReadtimeout :: UnknownType +-- , serviceSettingsEnableoutgoingwebhooks :: UnknownType +-- , serviceSettingsTlscertfile :: Text +-- , serviceSettingsEnableonlyadminintegrations :: UnknownType +-- , serviceSettingsEnableinsecureoutgoingconnections :: UnknownType +-- , serviceSettingsEnableoauthserviceprovider :: UnknownType +-- , serviceSettingsEnablecustomemoji :: UnknownType +-- , serviceSettingsEnabletesting :: UnknownType +-- , serviceSettingsSessioncacheinminutes :: UnknownType +-- , serviceSettingsSessionlengthwebindays :: UnknownType +-- , serviceSettingsWebservermode :: Text +-- , serviceSettingsEnablesecurityfixalert :: UnknownType +-- , serviceSettingsEnablemultifactorauthentication :: UnknownType +-- , serviceSettingsEnabledeveloper :: UnknownType +-- , serviceSettingsSiteurl :: Text +-- , serviceSettingsTlskeyfile :: Text +-- , serviceSettingsListenaddress :: Text +-- , serviceSettingsGoogledeveloperkey :: Text +-- , serviceSettingsEnforcemultifactorauthentication :: UnknownType +-- , serviceSettingsLetsencryptcertificatecachefile :: Text +-- , serviceSettingsWebsocketport :: UnknownType +-- , serviceSettingsWebsocketsecureport :: UnknownType +-- , serviceSettingsAllowcorsfrom :: Text +-- , serviceSettingsSessionlengthssoindays :: UnknownType +-- , serviceSettingsEnablecommands :: UnknownType +-- , serviceSettingsConnectionsecurity :: Text +-- , serviceSettingsWritetimeout :: UnknownType +-- , serviceSettingsMaximumloginattempts :: UnknownType +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON ServiceSettings where +-- parseJSON = A.withObject "serviceSettings" $ \v -> do +-- serviceSettingsEnableposticonoverride <- v A..: "EnablePostIconOverride" +-- serviceSettingsSegmentdeveloperkey <- v A..: "SegmentDeveloperKey" +-- serviceSettingsEnablepostusernameoverride <- v A..: "EnablePostUsernameOverride" +-- serviceSettingsForward80to443 <- v A..: "Forward80To443" +-- serviceSettingsEnableincomingwebhooks <- v A..: "EnableIncomingWebhooks" +-- serviceSettingsSessionlengthmobileindays <- v A..: "SessionLengthMobileInDays" +-- serviceSettingsUseletsencrypt <- v A..: "UseLetsEncrypt" +-- serviceSettingsRestrictcustomemojicreation <- v A..: "RestrictCustomEmojiCreation" +-- serviceSettingsReadtimeout <- v A..: "ReadTimeout" +-- serviceSettingsEnableoutgoingwebhooks <- v A..: "EnableOutgoingWebhooks" +-- serviceSettingsTlscertfile <- v A..: "TLSCertFile" +-- serviceSettingsEnableonlyadminintegrations <- v A..: "EnableOnlyAdminIntegrations" +-- serviceSettingsEnableinsecureoutgoingconnections <- v A..: "EnableInsecureOutgoingConnections" +-- serviceSettingsEnableoauthserviceprovider <- v A..: "EnableOAuthServiceProvider" +-- serviceSettingsEnablecustomemoji <- v A..: "EnableCustomEmoji" +-- serviceSettingsEnabletesting <- v A..: "EnableTesting" +-- serviceSettingsSessioncacheinminutes <- v A..: "SessionCacheInMinutes" +-- serviceSettingsSessionlengthwebindays <- v A..: "SessionLengthWebInDays" +-- serviceSettingsWebservermode <- v A..: "WebserverMode" +-- serviceSettingsEnablesecurityfixalert <- v A..: "EnableSecurityFixAlert" +-- serviceSettingsEnablemultifactorauthentication <- v A..: "EnableMultifactorAuthentication" +-- serviceSettingsEnabledeveloper <- v A..: "EnableDeveloper" +-- serviceSettingsSiteurl <- v A..: "SiteURL" +-- serviceSettingsTlskeyfile <- v A..: "TLSKeyFile" +-- serviceSettingsListenaddress <- v A..: "ListenAddress" +-- serviceSettingsGoogledeveloperkey <- v A..: "GoogleDeveloperKey" +-- serviceSettingsEnforcemultifactorauthentication <- v A..: "EnforceMultifactorAuthentication" +-- serviceSettingsLetsencryptcertificatecachefile <- v A..: "LetsEncryptCertificateCacheFile" +-- serviceSettingsWebsocketport <- v A..: "WebsocketPort" +-- serviceSettingsWebsocketsecureport <- v A..: "WebsocketSecurePort" +-- serviceSettingsAllowcorsfrom <- v A..: "AllowCorsFrom" +-- serviceSettingsSessionlengthssoindays <- v A..: "SessionLengthSSOInDays" +-- serviceSettingsEnablecommands <- v A..: "EnableCommands" +-- serviceSettingsConnectionsecurity <- v A..: "ConnectionSecurity" +-- serviceSettingsWritetimeout <- v A..: "WriteTimeout" +-- serviceSettingsMaximumloginattempts <- v A..: "MaximumLoginAttempts" +-- return ServiceSettings { .. } + +-- instance A.ToJSON ServiceSettings where +-- toJSON ServiceSettings { .. } = A.object +-- [ "EnablePostIconOverride" A..= serviceSettingsEnableposticonoverride +-- , "SegmentDeveloperKey" A..= serviceSettingsSegmentdeveloperkey +-- , "EnablePostUsernameOverride" A..= serviceSettingsEnablepostusernameoverride +-- , "Forward80To443" A..= serviceSettingsForward80to443 +-- , "EnableIncomingWebhooks" A..= serviceSettingsEnableincomingwebhooks +-- , "SessionLengthMobileInDays" A..= serviceSettingsSessionlengthmobileindays +-- , "UseLetsEncrypt" A..= serviceSettingsUseletsencrypt +-- , "RestrictCustomEmojiCreation" A..= serviceSettingsRestrictcustomemojicreation +-- , "ReadTimeout" A..= serviceSettingsReadtimeout +-- , "EnableOutgoingWebhooks" A..= serviceSettingsEnableoutgoingwebhooks +-- , "TLSCertFile" A..= serviceSettingsTlscertfile +-- , "EnableOnlyAdminIntegrations" A..= serviceSettingsEnableonlyadminintegrations +-- , "EnableInsecureOutgoingConnections" A..= serviceSettingsEnableinsecureoutgoingconnections +-- , "EnableOAuthServiceProvider" A..= serviceSettingsEnableoauthserviceprovider +-- , "EnableCustomEmoji" A..= serviceSettingsEnablecustomemoji +-- , "EnableTesting" A..= serviceSettingsEnabletesting +-- , "SessionCacheInMinutes" A..= serviceSettingsSessioncacheinminutes +-- , "SessionLengthWebInDays" A..= serviceSettingsSessionlengthwebindays +-- , "WebserverMode" A..= serviceSettingsWebservermode +-- , "EnableSecurityFixAlert" A..= serviceSettingsEnablesecurityfixalert +-- , "EnableMultifactorAuthentication" A..= serviceSettingsEnablemultifactorauthentication +-- , "EnableDeveloper" A..= serviceSettingsEnabledeveloper +-- , "SiteURL" A..= serviceSettingsSiteurl +-- , "TLSKeyFile" A..= serviceSettingsTlskeyfile +-- , "ListenAddress" A..= serviceSettingsListenaddress +-- , "GoogleDeveloperKey" A..= serviceSettingsGoogledeveloperkey +-- , "EnforceMultifactorAuthentication" A..= serviceSettingsEnforcemultifactorauthentication +-- , "LetsEncryptCertificateCacheFile" A..= serviceSettingsLetsencryptcertificatecachefile +-- , "WebsocketPort" A..= serviceSettingsWebsocketport +-- , "WebsocketSecurePort" A..= serviceSettingsWebsocketsecureport +-- , "AllowCorsFrom" A..= serviceSettingsAllowcorsfrom +-- , "SessionLengthSSOInDays" A..= serviceSettingsSessionlengthssoindays +-- , "EnableCommands" A..= serviceSettingsEnablecommands +-- , "ConnectionSecurity" A..= serviceSettingsConnectionsecurity +-- , "WriteTimeout" A..= serviceSettingsWritetimeout +-- , "MaximumLoginAttempts" A..= serviceSettingsMaximumloginattempts +-- ] + +-- -- + +-- data SlackAttachment = SlackAttachment +-- { slackAttachmentTitlelink :: Text +-- , slackAttachmentFooter :: Text +-- , slackAttachmentFields :: (Seq SlackAttachmentField) +-- , slackAttachmentImageurl :: Text +-- , slackAttachmentAuthorname :: Text +-- , slackAttachmentThumburl :: Text +-- , slackAttachmentTitle :: Text +-- , slackAttachmentFallback :: Text +-- , slackAttachmentColor :: Text +-- , slackAttachmentText :: Text +-- , slackAttachmentAuthorlink :: Text +-- , slackAttachmentAuthoricon :: Text +-- , slackAttachmentTimestamp :: Text +-- -- ^ The timestamp of the slack attahment, either type of string or integer +-- , slackAttachmentPretext :: Text +-- , slackAttachmentId :: Text +-- , slackAttachmentFootericon :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON SlackAttachment where +-- parseJSON = A.withObject "slackAttachment" $ \v -> do +-- slackAttachmentTitlelink <- v A..: "TitleLink" +-- slackAttachmentFooter <- v A..: "Footer" +-- slackAttachmentFields <- v A..: "Fields" +-- slackAttachmentImageurl <- v A..: "ImageURL" +-- slackAttachmentAuthorname <- v A..: "AuthorName" +-- slackAttachmentThumburl <- v A..: "ThumbURL" +-- slackAttachmentTitle <- v A..: "Title" +-- slackAttachmentFallback <- v A..: "Fallback" +-- slackAttachmentColor <- v A..: "Color" +-- slackAttachmentText <- v A..: "Text" +-- slackAttachmentAuthorlink <- v A..: "AuthorLink" +-- slackAttachmentAuthoricon <- v A..: "AuthorIcon" +-- slackAttachmentTimestamp <- v A..: "Timestamp" +-- slackAttachmentPretext <- v A..: "Pretext" +-- slackAttachmentId <- v A..: "Id" +-- slackAttachmentFootericon <- v A..: "FooterIcon" +-- return SlackAttachment { .. } + +-- instance A.ToJSON SlackAttachment where +-- toJSON SlackAttachment { .. } = A.object +-- [ "TitleLink" A..= slackAttachmentTitlelink +-- , "Footer" A..= slackAttachmentFooter +-- , "Fields" A..= slackAttachmentFields +-- , "ImageURL" A..= slackAttachmentImageurl +-- , "AuthorName" A..= slackAttachmentAuthorname +-- , "ThumbURL" A..= slackAttachmentThumburl +-- , "Title" A..= slackAttachmentTitle +-- , "Fallback" A..= slackAttachmentFallback +-- , "Color" A..= slackAttachmentColor +-- , "Text" A..= slackAttachmentText +-- , "AuthorLink" A..= slackAttachmentAuthorlink +-- , "AuthorIcon" A..= slackAttachmentAuthoricon +-- , "Timestamp" A..= slackAttachmentTimestamp +-- , "Pretext" A..= slackAttachmentPretext +-- , "Id" A..= slackAttachmentId +-- , "FooterIcon" A..= slackAttachmentFootericon +-- ] + +-- -- + +-- data SlackAttachmentField = SlackAttachmentField +-- { slackAttachmentFieldShort :: Bool +-- , slackAttachmentFieldValue :: Text +-- -- ^ The value of the attachment, set as string but capable with golang interface +-- , slackAttachmentFieldTitle :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON SlackAttachmentField where +-- parseJSON = A.withObject "slackAttachmentField" $ \v -> do +-- slackAttachmentFieldShort <- v A..: "Short" +-- slackAttachmentFieldValue <- v A..: "Value" +-- slackAttachmentFieldTitle <- v A..: "Title" +-- return SlackAttachmentField { .. } + +-- instance A.ToJSON SlackAttachmentField where +-- toJSON SlackAttachmentField { .. } = A.object +-- [ "Short" A..= slackAttachmentFieldShort +-- , "Value" A..= slackAttachmentFieldValue +-- , "Title" A..= slackAttachmentFieldTitle +-- ] + +-- -- + +-- data Status = Status +-- { statusStatus :: Text +-- , statusActiveChannel :: Text +-- , statusManual :: UnknownType +-- , statusLastActivityAt :: UnknownType +-- , statusUserId :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON Status where +-- parseJSON = A.withObject "status" $ \v -> do +-- statusStatus <- v A..: "status" +-- statusActiveChannel <- v A..: "active_channel" +-- statusManual <- v A..: "manual" +-- statusLastActivityAt <- v A..: "last_activity_at" +-- statusUserId <- v A..: "user_id" +-- return Status { .. } + +-- instance A.ToJSON Status where +-- toJSON Status { .. } = A.object +-- [ "status" A..= statusStatus +-- , "active_channel" A..= statusActiveChannel +-- , "manual" A..= statusManual +-- , "last_activity_at" A..= statusLastActivityAt +-- , "user_id" A..= statusUserId +-- ] + +-- -- + +-- newtype StatusOK = StatusOK +-- { statusOKStatus :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON StatusOK where +-- parseJSON = A.withObject "statusOK" $ \v -> do +-- statusOKStatus <- v A..: "status" +-- return StatusOK { .. } + +-- instance A.ToJSON StatusOK where +-- toJSON StatusOK { .. } = A.object +-- [ "status" A..= statusOKStatus +-- ] + +-- -- + +-- -- + +-- newtype TeamExists = TeamExists +-- { teamExistsExists :: Bool +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON TeamExists where +-- parseJSON = A.withObject "teamExists" $ \v -> do +-- teamExistsExists <- v A..: "exists" +-- return TeamExists { .. } + +-- instance A.ToJSON TeamExists where +-- toJSON TeamExists { .. } = A.object +-- [ "exists" A..= teamExistsExists +-- ] + +-- -- + +-- newtype TeamMap = TeamMap +-- { teamMapTeamId :: Team +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON TeamMap where +-- parseJSON = A.withObject "teamMap" $ \v -> do +-- teamMapTeamId <- v A..: "team_id" +-- return TeamMap { .. } + +-- instance A.ToJSON TeamMap where +-- toJSON TeamMap { .. } = A.object +-- [ "team_id" A..= teamMapTeamId +-- ] + +-- -- + +-- -- + +-- data TeamStats = TeamStats +-- { teamStatsTeamId :: Text +-- , teamStatsActiveMemberCount :: UnknownType +-- , teamStatsTotalMemberCount :: UnknownType +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON TeamStats where +-- parseJSON = A.withObject "teamStats" $ \v -> do +-- teamStatsTeamId <- v A..: "team_id" +-- teamStatsActiveMemberCount <- v A..: "active_member_count" +-- teamStatsTotalMemberCount <- v A..: "total_member_count" +-- return TeamStats { .. } + +-- instance A.ToJSON TeamStats where +-- toJSON TeamStats { .. } = A.object +-- [ "team_id" A..= teamStatsTeamId +-- , "active_member_count" A..= teamStatsActiveMemberCount +-- , "total_member_count" A..= teamStatsTotalMemberCount +-- ] + +-- -- + +-- data TeamUnread = TeamUnread +-- { teamUnreadTeamId :: Text +-- , teamUnreadMsgCount :: UnknownType +-- , teamUnreadMentionCount :: UnknownType +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON TeamUnread where +-- parseJSON = A.withObject "teamUnread" $ \v -> do +-- teamUnreadTeamId <- v A..: "team_id" +-- teamUnreadMsgCount <- v A..: "msg_count" +-- teamUnreadMentionCount <- v A..: "mention_count" +-- return TeamUnread { .. } + +-- instance A.ToJSON TeamUnread where +-- toJSON TeamUnread { .. } = A.object +-- [ "team_id" A..= teamUnreadTeamId +-- , "msg_count" A..= teamUnreadMsgCount +-- , "mention_count" A..= teamUnreadMentionCount +-- ] + +-- -- + +-- data UserAccessToken = UserAccessToken +-- { userAccessTokenToken :: Text +-- , userAccessTokenUserId :: Text +-- -- ^ The user the token authenticates for +-- , userAccessTokenId :: Text +-- -- ^ Unique identifier for the token +-- , userAccessTokenDescription :: Text +-- -- ^ A description of the token usage +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON UserAccessToken where +-- parseJSON = A.withObject "userAccessToken" $ \v -> do +-- userAccessTokenToken <- v A..: "token" +-- userAccessTokenUserId <- v A..: "user_id" +-- userAccessTokenId <- v A..: "id" +-- userAccessTokenDescription <- v A..: "description" +-- return UserAccessToken { .. } + +-- instance A.ToJSON UserAccessToken where +-- toJSON UserAccessToken { .. } = A.object +-- [ "token" A..= userAccessTokenToken +-- , "user_id" A..= userAccessTokenUserId +-- , "id" A..= userAccessTokenId +-- , "description" A..= userAccessTokenDescription +-- ] + +-- -- + +-- data UserAccessTokenSanitized = UserAccessTokenSanitized +-- { userAccessTokenSanitizedUserId :: Text +-- , userAccessTokenSanitizedId :: Text +-- -- ^ Unique identifier for the token +-- , userAccessTokenSanitizedDescription :: Text +-- -- ^ A description of the token usage +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON UserAccessTokenSanitized where +-- parseJSON = A.withObject "userAccessTokenSanitized" $ \v -> do +-- userAccessTokenSanitizedUserId <- v A..: "user_id" +-- userAccessTokenSanitizedId <- v A..: "id" +-- userAccessTokenSanitizedDescription <- v A..: "description" +-- return UserAccessTokenSanitized { .. } + +-- instance A.ToJSON UserAccessTokenSanitized where +-- toJSON UserAccessTokenSanitized { .. } = A.object +-- [ "user_id" A..= userAccessTokenSanitizedUserId +-- , "id" A..= userAccessTokenSanitizedId +-- , "description" A..= userAccessTokenSanitizedDescription +-- ] + +-- -- + +-- 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) + +-- 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 +-- ] + +-- -- + +-- data UserAutocompleteInChannel = UserAutocompleteInChannel +-- { userAutocompleteInChannelInChannel :: (Seq User) +-- , userAutocompleteInChannelOutOfChannel :: (Seq User) +-- -- ^ A list of user objects not in the channel +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON UserAutocompleteInChannel where +-- parseJSON = A.withObject "userAutocompleteInChannel" $ \v -> do +-- userAutocompleteInChannelInChannel <- v A..: "in_channel" +-- userAutocompleteInChannelOutOfChannel <- v A..: "out_of_channel" +-- return UserAutocompleteInChannel { .. } + +-- instance A.ToJSON UserAutocompleteInChannel where +-- toJSON UserAutocompleteInChannel { .. } = A.object +-- [ "in_channel" A..= userAutocompleteInChannelInChannel +-- , "out_of_channel" A..= userAutocompleteInChannelOutOfChannel +-- ] + +-- -- + +-- newtype UserAutocompleteInTeam = UserAutocompleteInTeam +-- { userAutocompleteInTeamInTeam :: (Seq User) +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON UserAutocompleteInTeam where +-- parseJSON = A.withObject "userAutocompleteInTeam" $ \v -> do +-- userAutocompleteInTeamInTeam <- v A..: "in_team" +-- return UserAutocompleteInTeam { .. } + +-- instance A.ToJSON UserAutocompleteInTeam where +-- toJSON UserAutocompleteInTeam { .. } = A.object +-- [ "in_team" A..= userAutocompleteInTeamInTeam +-- ] + +-- -- + +-- -- + +-- data XX1 = XX1 +-- { xx1Url :: Text +-- , xx1Width :: UnknownType +-- , xx1SecureUrl :: Text +-- , xx1Type :: Text +-- , xx1Height :: UnknownType +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX1 where +-- parseJSON = A.withObject "xx1" $ \v -> do +-- xx1Url <- v A..: "url" +-- xx1Width <- v A..: "width" +-- xx1SecureUrl <- v A..: "secure_url" +-- xx1Type <- v A..: "type" +-- xx1Height <- v A..: "height" +-- return XX1 { .. } + +-- instance A.ToJSON XX1 where +-- toJSON XX1 { .. } = A.object +-- [ "url" A..= xx1Url +-- , "width" A..= xx1Width +-- , "secure_url" A..= xx1SecureUrl +-- , "type" A..= xx1Type +-- , "height" A..= xx1Height +-- ] + +-- -- + +-- data XX10 = XX10 +-- { xx10IsOrSearch :: Bool +-- , xx10Terms :: Text +-- -- ^ The search terms as inputed by the user. +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX10 where +-- parseJSON = A.withObject "xx10" $ \v -> do +-- xx10IsOrSearch <- v A..: "is_or_search" +-- xx10Terms <- v A..: "terms" +-- return XX10 { .. } + +-- instance A.ToJSON XX10 where +-- toJSON XX10 { .. } = A.object +-- [ "is_or_search" A..= xx10IsOrSearch +-- , "terms" A..= xx10Terms +-- ] + +-- -- + +-- -- + +-- data XX12 = XX12 +-- { xx12HookId :: Text +-- , xx12ChannelId :: Text +-- -- ^ The ID of a public channel or private group that receives the webhook payloads. +-- , xx12DisplayName :: Text +-- -- ^ The display name for this incoming webhook +-- , xx12Description :: Text +-- -- ^ The description for this incoming webhook +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX12 where +-- parseJSON = A.withObject "xx12" $ \v -> do +-- xx12HookId <- v A..: "hook_id" +-- xx12ChannelId <- v A..: "channel_id" +-- xx12DisplayName <- v A..: "display_name" +-- xx12Description <- v A..: "description" +-- return XX12 { .. } + +-- instance A.ToJSON XX12 where +-- toJSON XX12 { .. } = A.object +-- [ "hook_id" A..= xx12HookId +-- , "channel_id" A..= xx12ChannelId +-- , "display_name" A..= xx12DisplayName +-- , "description" A..= xx12Description +-- ] + +-- -- + +-- data XX13 = XX13 +-- { xx13Name :: Text +-- , xx13IconUrl :: Text +-- -- ^ A URL to an icon to display with the application +-- , xx13CallbackUrls :: (Seq Text) +-- -- ^ A list of callback URLs for the appliation +-- , xx13Homepage :: Text +-- -- ^ A link to the website of the application +-- , xx13IsTrusted :: UnknownType +-- -- ^ Set this to `true` to skip asking users for permission +-- , xx13Description :: Text +-- -- ^ A short description of the application +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX13 where +-- parseJSON = A.withObject "xx13" $ \v -> do +-- xx13Name <- v A..: "name" +-- xx13IconUrl <- v A..: "icon_url" +-- xx13CallbackUrls <- v A..: "callback_urls" +-- xx13Homepage <- v A..: "homepage" +-- xx13IsTrusted <- v A..: "is_trusted" +-- xx13Description <- v A..: "description" +-- return XX13 { .. } + +-- instance A.ToJSON XX13 where +-- toJSON XX13 { .. } = A.object +-- [ "name" A..= xx13Name +-- , "icon_url" A..= xx13IconUrl +-- , "callback_urls" A..= xx13CallbackUrls +-- , "homepage" A..= xx13Homepage +-- , "is_trusted" A..= xx13IsTrusted +-- , "description" A..= xx13Description +-- ] + +-- -- + +-- -- + +-- 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) + +-- 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.ToJSON XX15 where +-- toJSON XX15 { .. } = A.object +-- [ "client_ids" A..= xx15ClientIds +-- , "file_infos" A..= xx15FileInfos +-- ] + +-- -- + +-- -- + +-- data XX17 = XX17 +-- { xx17MarkUnread :: Text +-- , xx17Desktop :: Text +-- -- ^ Controls when to send desktop notifications. The possible options are `default`, `all`, `mention`, `none` +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX17 where +-- parseJSON = A.withObject "xx17" $ \v -> do +-- xx17MarkUnread <- v A..: "mark_unread" +-- xx17Desktop <- v A..: "desktop" +-- return XX17 { .. } + +-- instance A.ToJSON XX17 where +-- toJSON XX17 { .. } = A.object +-- [ "mark_unread" A..= xx17MarkUnread +-- , "desktop" A..= xx17Desktop +-- ] + +-- -- + +-- -- + +-- data XX19 = XX19 +-- { xx19LdapId :: Text +-- , xx19CurrentService :: Text +-- -- ^ The service the user currently uses to login +-- , xx19NewService :: Text +-- -- ^ The service the user will use to login +-- , xx19Password :: Text +-- -- ^ The password used with the current service +-- , xx19Email :: Text +-- -- ^ The email of the user +-- , xx19MfaCode :: Text +-- -- ^ The MFA code of the current service +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX19 where +-- parseJSON = A.withObject "xx19" $ \v -> do +-- xx19LdapId <- v A..: "ldap_id" +-- xx19CurrentService <- v A..: "current_service" +-- xx19NewService <- v A..: "new_service" +-- xx19Password <- v A..: "password" +-- xx19Email <- v A..: "email" +-- xx19MfaCode <- v A..: "mfa_code" +-- return XX19 { .. } + +-- instance A.ToJSON XX19 where +-- toJSON XX19 { .. } = A.object +-- [ "ldap_id" A..= xx19LdapId +-- , "current_service" A..= xx19CurrentService +-- , "new_service" A..= xx19NewService +-- , "password" A..= xx19Password +-- , "email" A..= xx19Email +-- , "mfa_code" A..= xx19MfaCode +-- ] + +-- -- + +-- data XX2 = XX2 +-- { xx2Username :: Text +-- , xx2Gender :: Text +-- , xx2FirstName :: Text +-- , xx2LastName :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX2 where +-- parseJSON = A.withObject "xx2" $ \v -> do +-- xx2Username <- v A..: "username" +-- xx2Gender <- v A..: "gender" +-- xx2FirstName <- v A..: "first_name" +-- xx2LastName <- v A..: "last_name" +-- return XX2 { .. } + +-- instance A.ToJSON XX2 where +-- toJSON XX2 { .. } = A.object +-- [ "username" A..= xx2Username +-- , "gender" A..= xx2Gender +-- , "first_name" A..= xx2FirstName +-- , "last_name" A..= xx2LastName +-- ] + +-- -- + +-- data XX20 = XX20 +-- { xx20Type :: Text +-- , xx20Data :: UnknownType +-- -- ^ An object containing any additional data required for this job type +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX20 where +-- parseJSON = A.withObject "xx20" $ \v -> do +-- xx20Type <- v A..: "type" +-- xx20Data <- v A..: "data" +-- return XX20 { .. } + +-- instance A.ToJSON XX20 where +-- toJSON XX20 { .. } = A.object +-- [ "type" A..= xx20Type +-- , "data" A..= xx20Data +-- ] + +-- + +-- -- + +-- data XX22 = XX22 +-- { xx22Code :: Text +-- , xx22Activate :: UnknownType +-- -- ^ Use `true` to activate, `false` to deactivate +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX22 where +-- parseJSON = A.withObject "xx22" $ \v -> do +-- xx22Code <- v A..: "code" +-- xx22Activate <- v A..: "activate" +-- return XX22 { .. } + +-- instance A.ToJSON XX22 where +-- toJSON XX22 { .. } = A.object +-- [ "code" A..= xx22Code +-- , "activate" A..= xx22Activate +-- ] + +-- -- + +-- data XX23 = XX23 +-- { xx23DisplayName :: Text +-- , xx23CompanyName :: Text +-- , xx23InviteId :: Text +-- , xx23Description :: Text +-- , xx23AllowOpenInvite :: UnknownType +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX23 where +-- parseJSON = A.withObject "xx23" $ \v -> do +-- xx23DisplayName <- v A..: "display_name" +-- xx23CompanyName <- v A..: "company_name" +-- xx23InviteId <- v A..: "invite_id" +-- xx23Description <- v A..: "description" +-- xx23AllowOpenInvite <- v A..: "allow_open_invite" +-- return XX23 { .. } + +-- instance A.ToJSON XX23 where +-- toJSON XX23 { .. } = A.object +-- [ "display_name" A..= xx23DisplayName +-- , "company_name" A..= xx23CompanyName +-- , "invite_id" A..= xx23InviteId +-- , "description" A..= xx23Description +-- , "allow_open_invite" A..= xx23AllowOpenInvite +-- ] + +-- -- + +-- data XX24 = XX24 +-- { xx24NewPassword :: Text +-- , xx24Code :: Text +-- -- ^ The recovery code +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX24 where +-- parseJSON = A.withObject "xx24" $ \v -> do +-- xx24NewPassword <- v A..: "new_password" +-- xx24Code <- v A..: "code" +-- return XX24 { .. } + +-- instance A.ToJSON XX24 where +-- toJSON XX24 { .. } = A.object +-- [ "new_password" A..= xx24NewPassword +-- , "code" A..= xx24Code +-- ] + +-- -- + +-- data XX25 = XX25 +-- { xx25ChannelId :: Text +-- , xx25DisplayName :: Text +-- -- ^ The display name for this incoming webhook +-- , xx25Description :: Text +-- -- ^ The description for this incoming webhook +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX25 where +-- parseJSON = A.withObject "xx25" $ \v -> do +-- xx25ChannelId <- v A..: "channel_id" +-- xx25DisplayName <- v A..: "display_name" +-- xx25Description <- v A..: "description" +-- return XX25 { .. } + +-- instance A.ToJSON XX25 where +-- toJSON XX25 { .. } = A.object +-- [ "channel_id" A..= xx25ChannelId +-- , "display_name" A..= xx25DisplayName +-- , "description" A..= xx25Description +-- ] + +-- -- + +-- data XX26 = XX26 +-- { xx26Message :: Text +-- , xx26Level :: Text +-- -- ^ The error level, e.g. ERROR or INFO +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX26 where +-- parseJSON = A.withObject "xx26" $ \v -> do +-- xx26Message <- v A..: "message" +-- xx26Level <- v A..: "level" +-- return XX26 { .. } + +-- instance A.ToJSON XX26 where +-- toJSON XX26 { .. } = A.object +-- [ "message" A..= xx26Message +-- , "level" A..= xx26Level +-- ] + +-- -- + +-- data XX27 = XX27 +-- { xx27IsPinned :: Bool +-- , xx27Message :: Text +-- -- ^ The message text of the post +-- , xx27HasReactions :: UnknownType +-- -- ^ Set to `true` if the post has reactions to it +-- , xx27FileIds :: (Seq UnknownType) +-- -- ^ The list of files attached to this post +-- , xx27Props :: Text +-- -- ^ A general JSON property bag to attach to the post +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX27 where +-- parseJSON = A.withObject "xx27" $ \v -> do +-- xx27IsPinned <- v A..: "is_pinned" +-- xx27Message <- v A..: "message" +-- xx27HasReactions <- v A..: "has_reactions" +-- xx27FileIds <- v A..: "file_ids" +-- xx27Props <- v A..: "props" +-- return XX27 { .. } + +-- instance A.ToJSON XX27 where +-- toJSON XX27 { .. } = A.object +-- [ "is_pinned" A..= xx27IsPinned +-- , "message" A..= xx27Message +-- , "has_reactions" A..= xx27HasReactions +-- , "file_ids" A..= xx27FileIds +-- , "props" A..= xx27Props +-- ] + +-- -- + +-- data XX28 = XX28 +-- { xx28Header :: Text +-- , xx28DisplayName :: Text +-- -- ^ The non-unique UI name for the channel +-- , xx28Name :: Text +-- -- ^ The unique handle for the channel, will be present in the channel URL +-- , xx28Type :: Text +-- -- ^ 'O' for a public channel, 'P' for a private channel +-- , xx28Id :: Text +-- -- ^ The channel's id, not updatable +-- , xx28Purpose :: Text +-- -- ^ A short description of the purpose of the channel +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX28 where +-- parseJSON = A.withObject "xx28" $ \v -> do +-- xx28Header <- v A..: "header" +-- xx28DisplayName <- v A..: "display_name" +-- xx28Name <- v A..: "name" +-- xx28Type <- v A..: "type" +-- xx28Id <- v A..: "id" +-- xx28Purpose <- v A..: "purpose" +-- return XX28 { .. } + +-- instance A.ToJSON XX28 where +-- toJSON XX28 { .. } = A.object +-- [ "header" A..= xx28Header +-- , "display_name" A..= xx28DisplayName +-- , "name" A..= xx28Name +-- , "type" A..= xx28Type +-- , "id" A..= xx28Id +-- , "purpose" A..= xx28Purpose +-- ] + +-- -- + +-- data XX29 = XX29 +-- { xx29CurrentPassword :: Text +-- , xx29NewPassword :: Text +-- -- ^ The new password for the user +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX29 where +-- parseJSON = A.withObject "xx29" $ \v -> do +-- xx29CurrentPassword <- v A..: "current_password" +-- xx29NewPassword <- v A..: "new_password" +-- return XX29 { .. } + +-- instance A.ToJSON XX29 where +-- toJSON XX29 { .. } = A.object +-- [ "current_password" A..= xx29CurrentPassword +-- , "new_password" A..= xx29NewPassword +-- ] + +-- -- + +-- data XX3 = XX3 +-- { xx3Url :: Text +-- , xx3Width :: UnknownType +-- , xx3SecureUrl :: Text +-- , xx3Type :: Text +-- , xx3Height :: UnknownType +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX3 where +-- parseJSON = A.withObject "xx3" $ \v -> do +-- xx3Url <- v A..: "url" +-- xx3Width <- v A..: "width" +-- xx3SecureUrl <- v A..: "secure_url" +-- xx3Type <- v A..: "type" +-- xx3Height <- v A..: "height" +-- return XX3 { .. } + +-- instance A.ToJSON XX3 where +-- toJSON XX3 { .. } = A.object +-- [ "url" A..= xx3Url +-- , "width" A..= xx3Width +-- , "secure_url" A..= xx3SecureUrl +-- , "type" A..= xx3Type +-- , "height" A..= xx3Height +-- ] + +-- -- + +-- data XX30 = XX30 +-- { xx30Username :: Text +-- , xx30FirstName :: Text +-- , xx30LastName :: Text +-- , xx30NotifyProps :: UnknownType +-- , xx30Locale :: Text +-- , xx30Id :: Text +-- , xx30Props :: UnknownType +-- , xx30Position :: Text +-- , xx30Nickname :: Text +-- , xx30Email :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX30 where +-- parseJSON = A.withObject "xx30" $ \v -> do +-- xx30Username <- v A..: "username" +-- xx30FirstName <- v A..: "first_name" +-- xx30LastName <- v A..: "last_name" +-- xx30NotifyProps <- v A..: "notify_props" +-- xx30Locale <- v A..: "locale" +-- xx30Id <- v A..: "id" +-- xx30Props <- v A..: "props" +-- xx30Position <- v A..: "position" +-- xx30Nickname <- v A..: "nickname" +-- xx30Email <- v A..: "email" +-- return XX30 { .. } + +-- instance A.ToJSON XX30 where +-- toJSON XX30 { .. } = A.object +-- [ "username" A..= xx30Username +-- , "first_name" A..= xx30FirstName +-- , "last_name" A..= xx30LastName +-- , "notify_props" A..= xx30NotifyProps +-- , "locale" A..= xx30Locale +-- , "id" A..= xx30Id +-- , "props" A..= xx30Props +-- , "position" A..= xx30Position +-- , "nickname" A..= xx30Nickname +-- , "email" A..= xx30Email +-- ] + +-- -- + +-- data XX31 = XX31 +-- { xx31Username :: Text +-- , xx31FirstName :: Text +-- , xx31LastName :: Text +-- , xx31Locale :: Text +-- , xx31Props :: UnknownType +-- , xx31Password :: Text +-- , xx31Nickname :: Text +-- , xx31Email :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX31 where +-- parseJSON = A.withObject "xx31" $ \v -> do +-- xx31Username <- v A..: "username" +-- xx31FirstName <- v A..: "first_name" +-- xx31LastName <- v A..: "last_name" +-- xx31Locale <- v A..: "locale" +-- xx31Props <- v A..: "props" +-- xx31Password <- v A..: "password" +-- xx31Nickname <- v A..: "nickname" +-- xx31Email <- v A..: "email" +-- return XX31 { .. } + +-- instance A.ToJSON XX31 where +-- toJSON XX31 { .. } = A.object +-- [ "username" A..= xx31Username +-- , "first_name" A..= xx31FirstName +-- , "last_name" A..= xx31LastName +-- , "locale" A..= xx31Locale +-- , "props" A..= xx31Props +-- , "password" A..= xx31Password +-- , "nickname" A..= xx31Nickname +-- , "email" A..= xx31Email +-- ] + +-- -- + +-- data XX32 = XX32 +-- { xx32Url :: Text +-- , xx32TeamId :: Text +-- -- ^ Team ID to where the command should be created +-- , xx32Trigger :: Text +-- -- ^ Activation word to trigger the command +-- , xx32Method :: Text +-- -- ^ `'P'` for post request, `'G'` for get request +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX32 where +-- parseJSON = A.withObject "xx32" $ \v -> do +-- xx32Url <- v A..: "url" +-- xx32TeamId <- v A..: "team_id" +-- xx32Trigger <- v A..: "trigger" +-- xx32Method <- v A..: "method" +-- return XX32 { .. } + +-- instance A.ToJSON XX32 where +-- toJSON XX32 { .. } = A.object +-- [ "url" A..= xx32Url +-- , "team_id" A..= xx32TeamId +-- , "trigger" A..= xx32Trigger +-- , "method" A..= xx32Method +-- ] + +-- -- + +-- data XX33 = XX33 +-- { xx33TriggerWhen :: Integer +-- , xx33DisplayName :: Text +-- -- ^ The display name for this outgoing webhook +-- , xx33Description :: Text +-- -- ^ The description for this outgoing webhook +-- , xx33ChannelId :: Text +-- -- ^ The ID of a public channel that the webhook watchs +-- , xx33TeamId :: Text +-- -- ^ The ID of the team that the webhook watchs +-- , xx33ContentType :: Text +-- -- ^ The format to POST the data in, either `application/json` or `application/x-www-form-urlencoded` +-- , xx33TriggerWords :: (Seq Text) +-- -- ^ List of words for the webhook to trigger on +-- , xx33CallbackUrls :: (Seq Text) +-- -- ^ The URLs to POST the payloads to when the webhook is triggered +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX33 where +-- parseJSON = A.withObject "xx33" $ \v -> do +-- xx33TriggerWhen <- v A..: "trigger_when" +-- xx33DisplayName <- v A..: "display_name" +-- xx33Description <- v A..: "description" +-- xx33ChannelId <- v A..: "channel_id" +-- xx33TeamId <- v A..: "team_id" +-- xx33ContentType <- v A..: "content_type" +-- xx33TriggerWords <- v A..: "trigger_words" +-- xx33CallbackUrls <- v A..: "callback_urls" +-- return XX33 { .. } + +-- instance A.ToJSON XX33 where +-- toJSON XX33 { .. } = A.object +-- [ "trigger_when" A..= xx33TriggerWhen +-- , "display_name" A..= xx33DisplayName +-- , "description" A..= xx33Description +-- , "channel_id" A..= xx33ChannelId +-- , "team_id" A..= xx33TeamId +-- , "content_type" A..= xx33ContentType +-- , "trigger_words" A..= xx33TriggerWords +-- , "callback_urls" A..= xx33CallbackUrls +-- ] + +-- -- + +-- data XX34 = XX34 +-- { xx34DisplayName :: Text +-- , xx34Description :: Text +-- , xx34Name :: Text +-- , xx34Id :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX34 where +-- parseJSON = A.withObject "xx34" $ \v -> do +-- xx34DisplayName <- v A..: "display_name" +-- xx34Description <- v A..: "description" +-- xx34Name <- v A..: "name" +-- xx34Id <- v A..: "id" +-- return XX34 { .. } + +-- instance A.ToJSON XX34 where +-- toJSON XX34 { .. } = A.object +-- [ "display_name" A..= xx34DisplayName +-- , "description" A..= xx34Description +-- , "name" A..= xx34Name +-- , "id" A..= xx34Id +-- ] + +-- -- + +-- data XX35 = XX35 +-- { xx35HookId :: Text +-- , xx35ChannelId :: Text +-- -- ^ The ID of a public channel or private group that receives the webhook payloads. +-- , xx35DisplayName :: Text +-- -- ^ The display name for this incoming webhook +-- , xx35Description :: Text +-- -- ^ The description for this incoming webhook +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX35 where +-- parseJSON = A.withObject "xx35" $ \v -> do +-- xx35HookId <- v A..: "hook_id" +-- xx35ChannelId <- v A..: "channel_id" +-- xx35DisplayName <- v A..: "display_name" +-- xx35Description <- v A..: "description" +-- return XX35 { .. } + +-- instance A.ToJSON XX35 where +-- toJSON XX35 { .. } = A.object +-- [ "hook_id" A..= xx35HookId +-- , "channel_id" A..= xx35ChannelId +-- , "display_name" A..= xx35DisplayName +-- , "description" A..= xx35Description +-- ] + +-- -- + +-- data XX36 = XX36 +-- { xx36DisplayName :: Text +-- , xx36AllowedDomains :: Text +-- , xx36CompanyName :: Text +-- , xx36AllowOpenInvite :: Text +-- , xx36InviteId :: Text +-- , xx36Description :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX36 where +-- parseJSON = A.withObject "xx36" $ \v -> do +-- xx36DisplayName <- v A..: "display_name" +-- xx36AllowedDomains <- v A..: "allowed_domains" +-- xx36CompanyName <- v A..: "company_name" +-- xx36AllowOpenInvite <- v A..: "allow_open_invite" +-- xx36InviteId <- v A..: "invite_id" +-- xx36Description <- v A..: "description" +-- return XX36 { .. } + +-- instance A.ToJSON XX36 where +-- toJSON XX36 { .. } = A.object +-- [ "display_name" A..= xx36DisplayName +-- , "allowed_domains" A..= xx36AllowedDomains +-- , "company_name" A..= xx36CompanyName +-- , "allow_open_invite" A..= xx36AllowOpenInvite +-- , "invite_id" A..= xx36InviteId +-- , "description" A..= xx36Description +-- ] + +-- -- + +-- data XX37 = XX37 +-- { xx37Secret :: Text +-- , xx37QrCode :: Text +-- -- ^ A base64 encoded QR code image +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX37 where +-- parseJSON = A.withObject "xx37" $ \v -> do +-- xx37Secret <- v A..: "secret" +-- xx37QrCode <- v A..: "qr_code" +-- return XX37 { .. } + +-- instance A.ToJSON XX37 where +-- toJSON XX37 { .. } = A.object +-- [ "secret" A..= xx37Secret +-- , "qr_code" A..= xx37QrCode +-- ] + +-- -- + +-- data XX38 = XX38 +-- { xx38Username :: Text +-- , xx38FirstName :: Text +-- , xx38LastName :: Text +-- , xx38NotifyProps :: UnknownType +-- , xx38Locale :: Text +-- , xx38Props :: UnknownType +-- , xx38Position :: Text +-- , xx38Nickname :: Text +-- , xx38Email :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX38 where +-- parseJSON = A.withObject "xx38" $ \v -> do +-- xx38Username <- v A..: "username" +-- xx38FirstName <- v A..: "first_name" +-- xx38LastName <- v A..: "last_name" +-- xx38NotifyProps <- v A..: "notify_props" +-- xx38Locale <- v A..: "locale" +-- xx38Props <- v A..: "props" +-- xx38Position <- v A..: "position" +-- xx38Nickname <- v A..: "nickname" +-- xx38Email <- v A..: "email" +-- return XX38 { .. } + +-- instance A.ToJSON XX38 where +-- toJSON XX38 { .. } = A.object +-- [ "username" A..= xx38Username +-- , "first_name" A..= xx38FirstName +-- , "last_name" A..= xx38LastName +-- , "notify_props" A..= xx38NotifyProps +-- , "locale" A..= xx38Locale +-- , "props" A..= xx38Props +-- , "position" A..= xx38Position +-- , "nickname" A..= xx38Nickname +-- , "email" A..= xx38Email +-- ] + +-- -- + +-- data XX4 = XX4 +-- { xx4Username :: Text +-- , xx4Gender :: Text +-- , xx4FirstName :: Text +-- , xx4LastName :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX4 where +-- parseJSON = A.withObject "xx4" $ \v -> do +-- xx4Username <- v A..: "username" +-- xx4Gender <- v A..: "gender" +-- xx4FirstName <- v A..: "first_name" +-- xx4LastName <- v A..: "last_name" +-- return XX4 { .. } + +-- instance A.ToJSON XX4 where +-- toJSON XX4 { .. } = A.object +-- [ "username" A..= xx4Username +-- , "gender" A..= xx4Gender +-- , "first_name" A..= xx4FirstName +-- , "last_name" A..= xx4LastName +-- ] + +-- -- + +-- data XX5 = XX5 +-- { xx5Url :: Text +-- , xx5SecureUrl :: Text +-- , xx5Type :: Text +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX5 where +-- parseJSON = A.withObject "xx5" $ \v -> do +-- xx5Url <- v A..: "url" +-- xx5SecureUrl <- v A..: "secure_url" +-- xx5Type <- v A..: "type" +-- return XX5 { .. } + +-- instance A.ToJSON XX5 where +-- toJSON XX5 { .. } = A.object +-- [ "url" A..= xx5Url +-- , "secure_url" A..= xx5SecureUrl +-- , "type" A..= xx5Type +-- ] + +-- -- + +-- -- + +-- data XX8 = XX8 +-- { xx8Token :: Text +-- , xx8TurnUsername :: Text +-- -- ^ The username to use with the TURN server +-- , xx8TurnUri :: Text +-- -- ^ The URI to the TURN server +-- , xx8StunUri :: Text +-- -- ^ The URI to the STUN server +-- , xx8GatewayUrl :: Text +-- -- ^ The URL to the gateway server +-- , xx8TurnPassword :: Text +-- -- ^ The password to use with the TURN server +-- } deriving (Read, Show, Eq) + +-- instance A.FromJSON XX8 where +-- parseJSON = A.withObject "xx8" $ \v -> do +-- xx8Token <- v A..: "token" +-- xx8TurnUsername <- v A..: "turn_username" +-- xx8TurnUri <- v A..: "turn_uri" +-- xx8StunUri <- v A..: "stun_uri" +-- xx8GatewayUrl <- v A..: "gateway_url" +-- xx8TurnPassword <- v A..: "turn_password" +-- return XX8 { .. } + +-- instance A.ToJSON XX8 where +-- toJSON XX8 { .. } = A.object +-- [ "token" A..= xx8Token +-- , "turn_username" A..= xx8TurnUsername +-- , "turn_uri" A..= xx8TurnUri +-- , "stun_uri" A..= xx8StunUri +-- , "gateway_url" A..= xx8GatewayUrl +-- , "turn_password" A..= xx8TurnPassword +-- ] + + +-- * Helpers + +-- | Add a post to a user's flagged post list. This is a convenience +-- wrapper for the 'mmSaveUsersPreferences' function. +-- +-- /Permissions/: Must be logged in as the user being updated or have the +-- @edit_other_users@ permission. +mmFlagPost :: UserId -> PostId -> Session -> IO () +mmFlagPost uId pId = + let body = FlaggedPost + { flaggedPostUserId = uId + , flaggedPostId = pId + , flaggedPostStatus = True + } + in inPut (printf "/users/%s/preferences" uId) (jsonBody [body]) noResponse + +-- | Remove a post from a user's flagged post list. This is a convenience +-- wrapper for the 'mmSaveUsersPreferences' function. +-- +-- /Permissions/: Must be logged in as the user being updated or have the +-- @edit_other_users@ permission. +mmUnflagPost :: UserId -> PostId -> Session -> IO () +mmUnflagPost uId pId = + let body = FlaggedPost + { flaggedPostUserId = uId + , flaggedPostId = pId + , flaggedPostStatus = False + } + in inPut (printf "/users/%s/preferences" uId) (jsonBody [body]) noResponse diff --git a/src/Network/Mattermost/Exceptions.hs b/src/Network/Mattermost/Exceptions.hs --- a/src/Network/Mattermost/Exceptions.hs +++ b/src/Network/Mattermost/Exceptions.hs @@ -1,4 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} module Network.Mattermost.Exceptions ( -- Exception Types LoginFailureException(..) @@ -7,10 +9,12 @@ , JSONDecodeException(..) , HeaderNotFoundException(..) , HTTPResponseException(..) +, MattermostError(..) , ConnectionException(..) , MattermostServerError(..) ) where +import qualified Data.Aeson as A import qualified Data.Text as T import Data.Typeable ( Typeable ) import Control.Exception ( Exception(..) ) @@ -56,6 +60,25 @@ instance Exception HeaderNotFoundException -- + +data MattermostError = MattermostError + { mattermostErrorId :: T.Text + , mattermostErrorMessage :: T.Text + , mattermostErrorRequestId :: T.Text + , mattermostErrorStatusCode :: Int + , mattermostErrorIsOAuth :: Bool + } deriving (Show, Typeable) + +instance Exception MattermostError + +instance A.FromJSON MattermostError where + parseJSON = A.withObject "MattermostError" $ \o -> do + mattermostErrorId <- o A..: "id" + mattermostErrorMessage <- o A..: "message" + mattermostErrorRequestId <- o A..: "request_id" + mattermostErrorStatusCode <- o A..: "status_code" + mattermostErrorIsOAuth <- o A..:? "is_oauth" A..!= False + return MattermostError { .. } data MattermostServerError = MattermostServerError T.Text deriving (Show, Typeable) 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 @@ -5,10 +5,14 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} -module Network.Mattermost.Types where +module Network.Mattermost.Types + ( module Network.Mattermost.Types + , module Network.Mattermost.Types.Base + ) + where import Control.Applicative -import Text.Printf ( printf ) +import Text.Printf ( PrintfArg(..), printf ) import Data.Hashable ( Hashable ) import qualified Data.Aeson as A import Data.Aeson ( (.:), (.=), (.:?), (.!=) ) @@ -26,7 +30,7 @@ import qualified Data.Sequence as S import Data.Text (Text) import qualified Data.Text as T -import Data.Time.Clock ( UTCTime, getCurrentTime ) +import Data.Time.Clock ( getCurrentTime ) import Data.Time.Clock.POSIX ( posixSecondsToUTCTime , utcTimeToPOSIXSeconds ) import Network.Connection (ConnectionContext, initConnectionContext) @@ -189,12 +193,15 @@ toId = unTI fromId = TI +instance PrintfArg TeamId where + formatArg = formatArg . idString + data Team = Team { teamId :: TeamId - , teamCreateAt :: UTCTime - , teamUpdateAt :: UTCTime - , teamDeleteAt :: UTCTime + , teamCreateAt :: ServerTime + , teamUpdateAt :: ServerTime + , teamDeleteAt :: ServerTime , teamDisplayName :: Text , teamName :: Text , teamEmail :: Text @@ -212,9 +219,9 @@ instance A.FromJSON Team where parseJSON = A.withObject "Team" $ \v -> do teamId <- v .: "id" - teamCreateAt <- millisecondsToUTCTime <$> v .: "create_at" - teamUpdateAt <- millisecondsToUTCTime <$> v .: "update_at" - teamDeleteAt <- millisecondsToUTCTime <$> v .: "delete_at" + teamCreateAt <- timeFromServer <$> v .: "create_at" + teamUpdateAt <- timeFromServer <$> v .: "update_at" + teamDeleteAt <- timeFromServer <$> v .: "delete_at" teamDisplayName <- v .: "display_name" teamName <- v .: "name" teamEmail <- v .: "email" @@ -238,6 +245,12 @@ teamMemberRoles <- v .: "roles" return TeamMember { .. } +instance A.ToJSON TeamMember where + toJSON TeamMember { .. } = A.object + [ "user_id" .= teamMemberUserId + , "team_id" .= teamMemberTeamId + , "roles" .= teamMemberRoles + ] -- data WithDefault a @@ -245,6 +258,10 @@ | Default deriving (Read, Show, Eq, Ord) +instance A.ToJSON t => A.ToJSON (WithDefault t) where + toJSON Default = A.String "default" + toJSON (IsValue x) = A.toJSON x + instance A.FromJSON t => A.FromJSON (WithDefault t) where parseJSON (A.String "default") = return Default parseJSON t = IsValue <$> A.parseJSON t @@ -259,6 +276,11 @@ | NotifyOptionNone deriving (Read, Show, Eq, Ord) +instance A.ToJSON NotifyOption where + toJSON NotifyOptionAll = A.String "all" + toJSON NotifyOptionMention = A.String "mention" + toJSON NotifyOptionNone = A.String "none" + instance A.FromJSON NotifyOption where parseJSON (A.String "all") = return NotifyOptionAll parseJSON (A.String "mention") = return NotifyOptionMention @@ -310,6 +332,10 @@ "false" -> return (BoolString False) _ -> fail "Expected \"true\" or \"false\"" +instance A.ToJSON BoolString where + toJSON (BoolString True) = A.String "true" + toJSON (BoolString False) = A.String "false" + instance A.FromJSON UserNotifyProps where parseJSON = A.withObject "UserNotifyProps" $ \v -> do userNotifyPropsMentionKeys <- T.split (==',') <$> @@ -322,6 +348,17 @@ userNotifyPropsFirstName <- fromBoolString <$> (v .:? "first_name" .!= BoolString False) return UserNotifyProps { .. } +instance A.ToJSON UserNotifyProps where + toJSON UserNotifyProps { .. } = A.object + [ "mention_keys" .= T.intercalate "," userNotifyPropsMentionKeys + , "push" .= userNotifyPropsPush + , "desktop" .= userNotifyPropsDesktop + , "email" .= BoolString userNotifyPropsEmail + , "desktop_sound" .= BoolString userNotifyPropsDesktopSound + , "channel" .= BoolString userNotifyPropsChannel + , "first_name" .= BoolString userNotifyPropsFirstName + ] + instance A.FromJSON ChannelNotifyProps where parseJSON = A.withObject "ChannelNotifyProps" $ \v -> do channelNotifyPropsEmail <- fmap fromBoolString <$> @@ -331,6 +368,14 @@ channelNotifyPropsMarkUnread <- v .:? "mark_unread" .!= IsValue NotifyOptionAll return ChannelNotifyProps { .. } +instance A.ToJSON ChannelNotifyProps where + toJSON ChannelNotifyProps { .. } = A.object + [ "email" .= fmap BoolString channelNotifyPropsEmail + , "push" .= channelNotifyPropsPush + , "desktop" .= channelNotifyPropsDesktop + , "mark_unread" .= channelNotifyPropsMarkUnread + ] + -- newtype ChannelId = CI { unCI :: Id } @@ -340,21 +385,24 @@ toId = unCI fromId = CI +instance PrintfArg ChannelId where + formatArg = formatArg . idString + data Channel = Channel { channelId :: ChannelId - , channelCreateAt :: UTCTime - , channelUpdateAt :: UTCTime - , channelDeleteAt :: UTCTime + , channelCreateAt :: ServerTime + , channelUpdateAt :: ServerTime + , channelDeleteAt :: ServerTime , channelTeamId :: Maybe TeamId , channelType :: Type , channelDisplayName :: Text , channelName :: Text , channelHeader :: Text , channelPurpose :: Text - , channelLastPostAt :: UTCTime + , channelLastPostAt :: ServerTime , channelTotalMsgCount :: Int - , channelExtraUpdateAt :: UTCTime + , channelExtraUpdateAt :: ServerTime , channelCreatorId :: Maybe UserId } deriving (Read, Show, Eq, Ord) @@ -364,18 +412,18 @@ instance A.FromJSON Channel where parseJSON = A.withObject "Channel" $ \v -> do channelId <- v .: "id" - channelCreateAt <- millisecondsToUTCTime <$> v .: "create_at" - channelUpdateAt <- millisecondsToUTCTime <$> v .: "update_at" - channelDeleteAt <- millisecondsToUTCTime <$> v .: "delete_at" + channelCreateAt <- timeFromServer <$> v .: "create_at" + channelUpdateAt <- timeFromServer <$> v .: "update_at" + channelDeleteAt <- timeFromServer <$> v .: "delete_at" channelTeamId <- maybeFail (v .: "team_id") channelType <- v .: "type" channelDisplayName <- v .: "display_name" channelName <- v .: "name" channelHeader <- v .: "header" channelPurpose <- v .: "purpose" - channelLastPostAt <- millisecondsToUTCTime <$> v .: "last_post_at" + channelLastPostAt <- timeFromServer <$> v .: "last_post_at" channelTotalMsgCount <- v .: "total_msg_count" - channelExtraUpdateAt <- millisecondsToUTCTime <$> v .: "extra_update_at" + channelExtraUpdateAt <- timeFromServer <$> v .: "extra_update_at" channelCreatorId <- maybeFail (v .: "creator_id") return Channel { .. } @@ -398,11 +446,11 @@ { channelDataChannelId :: ChannelId , channelDataUserId :: UserId , channelDataRoles :: Text - , channelDataLastViewedAt :: UTCTime + , channelDataLastViewedAt :: ServerTime , channelDataMsgCount :: Int , channelDataMentionCount :: Int , channelDataNotifyProps :: ChannelNotifyProps - , channelDataLastUpdateAt :: UTCTime + , channelDataLastUpdateAt :: ServerTime } deriving (Read, Show, Eq) instance A.FromJSON ChannelData where @@ -410,11 +458,11 @@ channelDataChannelId <- o .: "channel_id" channelDataUserId <- o .: "user_id" channelDataRoles <- o .: "roles" - channelDataLastViewedAt <- millisecondsToUTCTime <$> o .: "last_viewed_at" + channelDataLastViewedAt <- timeFromServer <$> o .: "last_viewed_at" channelDataMsgCount <- o .: "msg_count" channelDataMentionCount <- o .: "mention_count" channelDataNotifyProps <- o .: "notify_props" - channelDataLastUpdateAt <- millisecondsToUTCTime <$> o .: "last_update_at" + channelDataLastUpdateAt <- timeFromServer <$> o .: "last_update_at" return ChannelData { .. } data ChannelWithData = ChannelWithData Channel ChannelData @@ -434,6 +482,7 @@ , minChannelPurpose :: Maybe Text , minChannelHeader :: Maybe Text , minChannelType :: Type + , minChannelTeamId :: TeamId } deriving (Read, Eq, Show) instance A.ToJSON MinChannel where @@ -441,6 +490,7 @@ [ "name" .= minChannelName , "display_name" .= minChannelDisplayName , "type" .= minChannelType + , "team_id" .= minChannelTeamId ] ++ [ "purpose" .= p | Just p <- [minChannelPurpose] ] ++ [ "header" .= h | Just h <- [minChannelHeader] ] @@ -453,6 +503,21 @@ toId = unUI fromId = UI +instance PrintfArg UserId where + formatArg = formatArg . idString + +data UserParam + = UserById UserId + | UserMe + deriving (Read, Show, Eq, Ord) + +instance PrintfArg UserParam where + formatArg = formatArg . userParamString + +userParamString :: UserParam -> Text +userParamString (UserById uid) = idString uid +userParamString UserMe = "me" + -- -- Note: there's lots of other stuff in an initial_load response but @@ -477,9 +542,9 @@ data User = User { userId :: UserId - , userCreateAt :: UTCTime - , userUpdateAt :: UTCTime - , userDeleteAt :: UTCTime + , userCreateAt :: ServerTime + , userUpdateAt :: ServerTime + , userDeleteAt :: ServerTime , userUsername :: Text , userAuthData :: Text , userAuthService :: Text @@ -490,17 +555,17 @@ , userLastName :: Text , userRoles :: Text , userNotifyProps :: UserNotifyProps - , userLastPasswordUpdate :: Maybe UTCTime - , userLastPictureUpdate :: Maybe UTCTime + , userLastPasswordUpdate :: Maybe ServerTime + , userLastPictureUpdate :: Maybe ServerTime , userLocale :: Text } deriving (Read, Show, Eq) instance A.FromJSON User where parseJSON = A.withObject "User" $ \o -> do userId <- o .: "id" - userCreateAt <- millisecondsToUTCTime <$> o .: "create_at" - userUpdateAt <- millisecondsToUTCTime <$> o .: "update_at" - userDeleteAt <- millisecondsToUTCTime <$> o .: "delete_at" + userCreateAt <- timeFromServer <$> o .: "create_at" + userUpdateAt <- timeFromServer <$> o .: "update_at" + userDeleteAt <- timeFromServer <$> o .: "delete_at" userUsername <- o .: "username" userAuthData <- o .: "auth_data" userAuthService <- o .: "auth_service" @@ -511,9 +576,9 @@ userLastName <- o .: "last_name" userRoles <- o .: "roles" userNotifyProps <- o .:? "notify_props" .!= emptyUserNotifyProps - userLastPasswordUpdate <- (millisecondsToUTCTime <$>) <$> + userLastPasswordUpdate <- (timeFromServer <$>) <$> (o .:? "last_password_update") - userLastPictureUpdate <- (millisecondsToUTCTime <$>) <$> (o .:? "last_picture_update") + userLastPictureUpdate <- (timeFromServer <$>) <$> (o .:? "last_picture_update") userLocale <- o .: "locale" return User { .. } @@ -613,6 +678,9 @@ toId = unPI fromId = PI +instance PrintfArg PostId where + formatArg = formatArg . idString + newtype FileId = FI { unFI :: Id } deriving (Read, Show, Eq, Ord, Hashable, ToJSON, ToJSONKey, FromJSONKey, FromJSON) @@ -620,6 +688,9 @@ toId = unFI fromId = FI +instance PrintfArg FileId where + formatArg = formatArg . idString + urlForFile :: FileId -> Text urlForFile fId = "/api/v3/files/" <> idString fId <> "/get" @@ -673,11 +744,12 @@ , postId :: PostId , postType :: PostType , postMessage :: Text - , postDeleteAt :: Maybe UTCTime + , postDeleteAt :: Maybe ServerTime , postHashtags :: Text - , postUpdateAt :: UTCTime + , postUpdateAt :: ServerTime + , postEditAt :: ServerTime , postUserId :: Maybe UserId - , postCreateAt :: UTCTime + , postCreateAt :: ServerTime , postParentId :: Maybe PostId , postChannelId :: ChannelId , postHasReactions :: Bool @@ -696,11 +768,12 @@ postId <- v .: "id" postType <- v .: "type" postMessage <- v .: "message" - postDeleteAt <- (millisecondsToUTCTime <$>) <$> v .:? "delete_at" + postDeleteAt <- (timeFromServer <$>) <$> v .:? "delete_at" postHashtags <- v .: "hashtags" - postUpdateAt <- millisecondsToUTCTime <$> v .: "update_at" + postUpdateAt <- timeFromServer <$> v .: "update_at" + postEditAt <- timeFromServer <$> v .: "edit_at" postUserId <- maybeFail (v .: "user_id") - postCreateAt <- millisecondsToUTCTime <$> v .: "create_at" + postCreateAt <- timeFromServer <$> v .: "create_at" postParentId <- maybeFail (v .: "parent_id") postChannelId <- v .: "channel_id" postHasReactions <- (v .: "has_reactions") <|> (return False) @@ -716,11 +789,11 @@ , "id" .= postId , "type" .= postType , "message" .= postMessage - , "delete_at" .= (utcTimeToMilliseconds <$> postDeleteAt) + , "delete_at" .= (timeToServer <$> postDeleteAt) , "hashtags" .= postHashtags - , "update_at" .= utcTimeToMilliseconds postUpdateAt + , "update_at" .= timeToServer postUpdateAt , "user_id" .= postUserId - , "create_at" .= utcTimeToMilliseconds postCreateAt + , "create_at" .= timeToServer postCreateAt , "parent_id" .= postParentId , "channel_id" .= postChannelId , "has_reactions" .= postHasReactions @@ -729,7 +802,7 @@ data PendingPost = PendingPost { pendingPostChannelId :: ChannelId - , pendingPostCreateAt :: Maybe UTCTime + , pendingPostCreateAt :: Maybe ServerTime , pendingPostFilenames :: Seq FilePath , pendingPostMessage :: Text , pendingPostId :: PendingPostId @@ -741,7 +814,7 @@ instance A.ToJSON PendingPost where toJSON post = A.object [ "channel_id" .= pendingPostChannelId post - , "create_at" .= maybe 0 utcTimeToMilliseconds (pendingPostCreateAt post) + , "create_at" .= maybe 0 timeToServer (pendingPostCreateAt post) , "filenames" .= pendingPostFilenames post , "message" .= pendingPostMessage post , "pending_post_id" .= pendingPostId post @@ -762,8 +835,10 @@ mkPendingPost :: Text -> UserId -> ChannelId -> IO PendingPost mkPendingPost msg userid channelid = do + -- locally generating a ServerTime: ok because it's just used for an + -- initial string ID for this post and not an actual time value. now <- getCurrentTime - let ms = utcTimeToMilliseconds now :: Int + let ms = timeToServer (ServerTime now) :: Int pid = T.pack $ printf "%s:%d" (idString userid) ms return PendingPost { pendingPostId = PPI (Id pid) @@ -781,9 +856,9 @@ { fileInfoId :: FileId , fileInfoUserId :: UserId , fileInfoPostId :: Maybe PostId - , fileInfoCreateAt :: UTCTime - , fileInfoUpdateAt :: UTCTime - , fileInfoDeleteAt :: UTCTime + , fileInfoCreateAt :: ServerTime + , fileInfoUpdateAt :: ServerTime + , fileInfoDeleteAt :: ServerTime , fileInfoName :: Text , fileInfoExtension :: Text , fileInfoSize :: Int @@ -793,14 +868,17 @@ , fileInfoHasPreview :: Bool } deriving (Read, Show, Eq) +instance ToJSON FileInfo where + toJSON = error "file info" + instance FromJSON FileInfo where parseJSON = A.withObject "file_info" $ \o -> do fileInfoId <- o .: "id" fileInfoUserId <- o .: "user_id" fileInfoPostId <- o .: "post_id" - fileInfoCreateAt <- millisecondsToUTCTime <$> o .: "create_at" - fileInfoUpdateAt <- millisecondsToUTCTime <$> o .: "update_at" - fileInfoDeleteAt <- millisecondsToUTCTime <$> o .: "delete_at" + fileInfoCreateAt <- timeFromServer <$> o .: "create_at" + fileInfoUpdateAt <- timeFromServer <$> o .: "update_at" + fileInfoDeleteAt <- timeFromServer <$> o .: "delete_at" fileInfoName <- o .: "name" fileInfoExtension <- o .: "extension" fileInfoSize <- o .: "size" @@ -826,12 +904,16 @@ -- -millisecondsToUTCTime :: Integer -> UTCTime -millisecondsToUTCTime ms = posixSecondsToUTCTime (fromRational (ms%1000)) +-- The JSON specification of times exchanged with the server are in +-- integer milliSeconds; convert to and from the local ServerTime +-- internal value. -utcTimeToMilliseconds :: UTCTime -> Int -utcTimeToMilliseconds utc = truncate ((utcTimeToPOSIXSeconds utc)*1000) +timeFromServer :: Integer -> ServerTime +timeFromServer ms = ServerTime $ posixSecondsToUTCTime (fromRational (ms%1000)) +timeToServer :: ServerTime -> Int +timeToServer time = truncate ((utcTimeToPOSIXSeconds $ withServerTime time)*1000) + -- data MinCommand @@ -840,6 +922,7 @@ , minComCommand :: Text , minComParentId :: Maybe PostId , minComRootId :: Maybe PostId + , minComTeamId :: TeamId } deriving (Read, Show, Eq) instance A.ToJSON MinCommand where @@ -848,6 +931,7 @@ , "command" .= minComCommand , "parent_id" .= minComParentId , "root_id" .= minComRootId + , "team_id" .= minComTeamId ] -- @@ -856,9 +940,9 @@ = Command { commandId :: CommandId , commandToken :: Token - , commandCreateAt :: UTCTime - , commandUpdateAt :: UTCTime - , commandDeleteAt :: UTCTime + , commandCreateAt :: ServerTime + , commandUpdateAt :: ServerTime + , commandDeleteAt :: ServerTime , commandCreatorId :: UserId , commandTeamId :: TeamId , commandTrigger :: Text @@ -883,6 +967,9 @@ instance HasId Command CommandId where getId = commandId +instance PrintfArg CommandId where + formatArg = formatArg . idString + data CommandResponseType = CommandResponseInChannel | CommandResponseEphemeral @@ -954,7 +1041,7 @@ { reactionUserId :: UserId , reactionPostId :: PostId , reactionEmojiName :: Text - , reactionCreateAt :: UTCTime + , reactionCreateAt :: ServerTime } deriving (Read, Show, Eq) instance A.FromJSON Reaction where @@ -962,7 +1049,7 @@ reactionUserId <- v .: "user_id" reactionPostId <- v .: "post_id" reactionEmojiName <- v .: "emoji_name" - reactionCreateAt <- millisecondsToUTCTime <$> v .: "create_at" + reactionCreateAt <- timeFromServer <$> v .: "create_at" return Reaction { .. } instance A.ToJSON Reaction where @@ -970,7 +1057,7 @@ [ "user_id" .= reactionUserId , "post_id" .= reactionPostId , "emoji_name" .= reactionEmojiName - , "create_at" .= utcTimeToMilliseconds reactionCreateAt + , "create_at" .= timeToServer reactionCreateAt ] -- * Preferences @@ -1111,3 +1198,388 @@ , preferenceValue = PreferenceValue (if status then "true" else "false") , preferenceUserId = userId } + +-- + +newtype HookId = HI { unHI :: Id } + deriving (Read, Show, Eq, Ord, Hashable, ToJSON, ToJSONKey, FromJSONKey, FromJSON) + +instance IsId HookId where + toId = unHI + fromId = HI + +instance PrintfArg HookId where + formatArg = formatArg . idString + +-- + +newtype InviteId = II { unII :: Id } + deriving (Read, Show, Eq, Ord, Hashable, ToJSON, ToJSONKey, FromJSONKey, FromJSON) + +instance IsId InviteId where + toId = unII + fromId = II + +instance PrintfArg InviteId where + formatArg = formatArg . idString + +-- + +newtype TokenId = TkI { unTkI :: Id } + deriving (Read, Show, Eq, Ord, Hashable, ToJSON, ToJSONKey, FromJSONKey, FromJSON) + +instance IsId TokenId where + toId = unTkI + fromId = TkI + +instance PrintfArg TokenId where + formatArg = formatArg . idString + +-- + +newtype AppId = AI { unAI :: Id } + deriving (Read, Show, Eq, Ord, Hashable, ToJSON, ToJSONKey, FromJSONKey, FromJSON) + +instance IsId AppId where + toId = unAI + fromId = AI + +instance PrintfArg AppId where + formatArg = formatArg . idString + +-- + +newtype JobId = JI { unJI :: Id } + deriving (Read, Show, Eq, Ord, Hashable, ToJSON, ToJSONKey, FromJSONKey, FromJSON) + +instance IsId JobId where + toId = unJI + fromId = JI + +instance PrintfArg JobId where + formatArg = formatArg . idString + +-- + +newtype EmojiId = EI { unEI :: Id } + deriving (Read, Show, Eq, Ord, Hashable, ToJSON, ToJSONKey, FromJSONKey, FromJSON) + +instance IsId EmojiId where + toId = unEI + fromId = EI + +instance PrintfArg EmojiId where + formatArg = formatArg . idString + +-- + +newtype ReportId = RI { unRI :: Id } + deriving (Read, Show, Eq, Ord, Hashable, ToJSON, ToJSONKey, FromJSONKey, FromJSON) + +instance IsId ReportId where + toId = unRI + fromId = RI + +instance PrintfArg ReportId where + formatArg = formatArg . idString + +-- FIXMES + +instance A.ToJSON User where toJSON = error "to user" +instance A.ToJSON Team where toJSON = error "to team" +instance A.FromJSON Command where parseJSON = error "from command" +instance A.ToJSON Command where toJSON = error "to command" + + +-- -- + +data MinChannelMember = MinChannelMember + { minChannelMemberUserId :: UserId + , minChannelMemberChannelId :: ChannelId + } deriving (Read, Show, Eq) + +instance A.FromJSON MinChannelMember where + parseJSON = A.withObject "channelMember" $ \v -> do + minChannelMemberUserId <- v A..: "user_id" + minChannelMemberChannelId <- v A..: "channel_id" + return MinChannelMember { .. } + +instance A.ToJSON MinChannelMember where + toJSON MinChannelMember { .. } = A.object + [ "user_id" A..= minChannelMemberUserId + , "channel_id" A..= minChannelMemberChannelId + ] + +data ChannelMember = ChannelMember + { channelMemberMsgCount :: Integer + , channelMemberUserId :: UserId + , channelMemberRoles :: Text + , channelMemberMentionCount :: Int + , channelMemberLastViewedAt :: ServerTime + , channelMemberChannelId :: ChannelId + , channelMemberLastUpdateAt :: ServerTime + , channelMemberNotifyProps :: ChannelNotifyProps + } deriving (Read, Show, Eq) + +instance A.FromJSON ChannelMember where + parseJSON = A.withObject "channelMember" $ \v -> do + channelMemberMsgCount <- v A..: "msg_count" + channelMemberUserId <- v A..: "user_id" + channelMemberRoles <- v A..: "roles" + channelMemberMentionCount <- v A..: "mention_count" + channelMemberLastViewedAt <- timeFromServer <$> v A..: "last_viewed_at" + channelMemberChannelId <- v A..: "channel_id" + channelMemberLastUpdateAt <- timeFromServer <$> v A..: "last_update_at" + channelMemberNotifyProps <- v A..: "notify_props" + return ChannelMember { .. } + +instance A.ToJSON ChannelMember where + toJSON ChannelMember { .. } = A.object + [ "msg_count" A..= channelMemberMsgCount + , "user_id" A..= channelMemberUserId + , "roles" A..= channelMemberRoles + , "mention_count" A..= channelMemberMentionCount + , "last_viewed_at" A..= timeToServer channelMemberLastViewedAt + , "channel_id" A..= channelMemberChannelId + , "last_update_at" A..= timeToServer channelMemberLastUpdateAt + , "notify_props" A..= channelMemberNotifyProps + ] + + +data Status = Status + { statusUserId :: UserId + , statusStatus :: T.Text + , statusManual :: Bool + , statusLastActivityAt :: ServerTime + } + +instance A.FromJSON Status where + parseJSON = A.withObject "Status" $ \o -> do + statusUserId <- o A..: "user_id" + statusStatus <- o A..: "status" + statusManual <- o A..: "manual" + statusLastActivityAt <- timeFromServer <$> o A..: "last_activity_at" + return Status { .. } + +instance A.ToJSON Status where + toJSON Status { .. } = A.object + [ "user_id" A..= statusUserId + , "status" A..= statusStatus + , "manual" A..= statusManual + , "last_activity_at" A..= timeToServer statusLastActivityAt + ] + + +data UserSearch = UserSearch + { userSearchTerm :: Text + , userSearchAllowInactive :: Bool + -- ^ When `true`, include deactivated users in the results + , userSearchWithoutTeam :: Bool + -- ^ Set this to `true` if you would like to search for users that are not on a team. This option takes precendence over `team_id`, `in_channel_id`, and `not_in_channel_id`. + , userSearchInChannelId :: Text + -- ^ If provided, only search users in this channel + , userSearchNotInTeamId :: Text + -- ^ If provided, only search users not on this team + , userSearchNotInChannelId :: Text + -- ^ If provided, only search users not in this channel. Must specifiy `team_id` when using this option + , userSearchTeamId :: Text + -- ^ If provided, only search users on this team + } deriving (Read, Show, Eq) + +instance A.FromJSON UserSearch where + parseJSON = A.withObject "userSearch" $ \v -> do + userSearchTerm <- v A..: "term" + userSearchAllowInactive <- v A..: "allow_inactive" + userSearchWithoutTeam <- v A..: "without_team" + userSearchInChannelId <- v A..: "in_channel_id" + userSearchNotInTeamId <- v A..: "not_in_team_id" + userSearchNotInChannelId <- v A..: "not_in_channel_id" + userSearchTeamId <- v A..: "team_id" + return UserSearch { .. } + +instance A.ToJSON UserSearch where + toJSON UserSearch { .. } = A.object + [ "term" A..= userSearchTerm + , "allow_inactive" A..= userSearchAllowInactive + , "without_team" A..= userSearchWithoutTeam + , "in_channel_id" A..= userSearchInChannelId + , "not_in_team_id" A..= userSearchNotInTeamId + , "not_in_channel_id" A..= userSearchNotInChannelId + , "team_id" A..= userSearchTeamId + ] + +-- -- + +data RawPost = RawPost + { rawPostChannelId :: ChannelId + , rawPostMessage :: Text + -- ^ The message contents, can be formatted with Markdown + , rawPostFileIds :: Seq FileId + -- ^ A list of file IDs to associate with the post + , rawPostRootId :: Maybe PostId + -- ^ The post ID to comment on + } deriving (Read, Show, Eq) + +instance A.FromJSON RawPost where + parseJSON = A.withObject "rawPost" $ \v -> do + rawPostChannelId <- v A..: "channel_id" + rawPostMessage <- v A..: "message" + rawPostFileIds <- v A..: "file_ids" + rawPostRootId <- v A..:? "root_id" + return RawPost { .. } + +instance A.ToJSON RawPost where + toJSON RawPost { .. } = A.object + ( "channel_id" A..= rawPostChannelId + : "message" A..= rawPostMessage + : "file_ids" A..= rawPostFileIds + : case rawPostRootId of + Nothing -> [] + Just rId -> [("root_id" A..= rId)] + ) + +rawPost :: Text -> ChannelId -> RawPost +rawPost message channelId = RawPost + { rawPostChannelId = channelId + , rawPostMessage = message + , rawPostFileIds = mempty + , rawPostRootId = Nothing + } + + +data PostUpdate = PostUpdate + { postUpdateIsPinned :: Maybe Bool + , postUpdateMessage :: Text + -- ^ The message text of the post + , postUpdateHasReactions :: Maybe Bool + -- ^ Set to `true` if the post has reactions to it + , postUpdateFileIds :: Maybe (Seq FileId) + -- ^ The list of files attached to this post + , postUpdateProps :: Maybe Text + -- ^ A general JSON property bag to attach to the post + } deriving (Read, Show, Eq) + +instance A.FromJSON PostUpdate where + parseJSON = A.withObject "postUpdate" $ \v -> do + postUpdateIsPinned <- v A..:? "is_pinned" A..!= Nothing + postUpdateMessage <- v A..: "message" + postUpdateHasReactions <- v A..:? "has_reactions" A..!= Nothing + postUpdateFileIds <- v A..:? "file_ids" A..!= Nothing + postUpdateProps <- v A..:? "props" A..!= Nothing + return PostUpdate { .. } + +instance A.ToJSON PostUpdate where + toJSON PostUpdate { .. } = A.object $ + [ "is_pinned" A..= p | Just p <- [postUpdateIsPinned] ] ++ + [ "message" A..= postUpdateMessage ] ++ + [ "has_reactions" A..= p | Just p <- [postUpdateHasReactions] ] ++ + [ "file_ids" A..= p | Just p <- [postUpdateFileIds] ] ++ + [ "props" A..= p | Just p <- [postUpdateProps] ] + +postUpdate :: Text -> PostUpdate +postUpdate message = PostUpdate + { postUpdateIsPinned = Nothing + , postUpdateMessage = message + , postUpdateHasReactions = Nothing + , postUpdateFileIds = Nothing + , postUpdateProps = Nothing + } + + +data ChannelPatch = ChannelPatch + { channelPatchHeader :: Maybe Text + , channelPatchDisplayName :: Maybe Text + -- ^ The non-unique UI name for the channel + , channelPatchName :: Maybe Text + -- ^ The unique handle for the channel, will be present in the channel URL + , channelPatchPurpose :: Maybe Text + -- ^ A short description of the purpose of the channel + } deriving (Read, Show, Eq) + +instance A.FromJSON ChannelPatch where + parseJSON = A.withObject "channelPatch" $ \v -> do + channelPatchHeader <- v A..:? "header" + channelPatchDisplayName <- v A..:? "display_name" + channelPatchName <- v A..:? "name" + channelPatchPurpose <- v A..:? "purpose" + return ChannelPatch { .. } + +instance A.ToJSON ChannelPatch where + toJSON ChannelPatch { .. } = A.object $ + [ "header" A..= x | Just x <- [ channelPatchHeader] ] ++ + [ "display_name" A..= x | Just x <- [channelPatchDisplayName] ] ++ + [ "name" A..= x | Just x <- [channelPatchName] ] ++ + [ "purpose" A..= x | Just x <- [channelPatchPurpose] ] + +defaultChannelPatch :: ChannelPatch +defaultChannelPatch = ChannelPatch + { channelPatchHeader = Nothing + , channelPatchDisplayName = Nothing + , channelPatchName = Nothing + , channelPatchPurpose = Nothing + } + + +data InitialTeamData = InitialTeamData + { initialTeamDataDisplayName :: Text + , initialTeamDataType :: Text + -- ^ `'O'` for open, `'I'` for invite only + , initialTeamDataName :: Text + -- ^ Unique handler for a team, will be present in the team URL + } deriving (Read, Show, Eq) + +instance A.FromJSON InitialTeamData where + parseJSON = A.withObject "initialTeamData" $ \v -> do + initialTeamDataDisplayName <- v A..: "display_name" + initialTeamDataType <- v A..: "type" + initialTeamDataName <- v A..: "name" + return InitialTeamData { .. } + +instance A.ToJSON InitialTeamData where + toJSON InitialTeamData { .. } = A.object + [ "display_name" A..= initialTeamDataDisplayName + , "type" A..= initialTeamDataType + , "name" A..= initialTeamDataName + ] + +data ChannelStats = ChannelStats + { channelStatsChannelId :: Text + , channelStatsMemberCount :: Int + } deriving (Read, Show, Eq) + +instance A.FromJSON ChannelStats where + parseJSON = A.withObject "channelStats" $ \v -> do + channelStatsChannelId <- v A..: "channel_id" + channelStatsMemberCount <- v A..: "member_count" + return ChannelStats { .. } + +instance A.ToJSON ChannelStats where + toJSON ChannelStats { .. } = A.object + [ "channel_id" A..= channelStatsChannelId + , "member_count" A..= channelStatsMemberCount + ] + +-- -- + +data ChannelUnread = ChannelUnread + { channelUnreadChannelId :: Text + , channelUnreadTeamId :: Text + , channelUnreadMsgCount :: Int + , channelUnreadMentionCount :: Int + } deriving (Read, Show, Eq) + +instance A.FromJSON ChannelUnread where + parseJSON = A.withObject "channelUnread" $ \v -> do + channelUnreadChannelId <- v A..: "channel_id" + channelUnreadTeamId <- v A..: "team_id" + channelUnreadMsgCount <- v A..: "msg_count" + channelUnreadMentionCount <- v A..: "mention_count" + return ChannelUnread { .. } + +instance A.ToJSON ChannelUnread where + toJSON ChannelUnread { .. } = A.object + [ "channel_id" A..= channelUnreadChannelId + , "team_id" A..= channelUnreadTeamId + , "msg_count" A..= channelUnreadMsgCount + , "mention_count" A..= channelUnreadMentionCount + ] diff --git a/src/Network/Mattermost/Types/Base.hs b/src/Network/Mattermost/Types/Base.hs --- a/src/Network/Mattermost/Types/Base.hs +++ b/src/Network/Mattermost/Types/Base.hs @@ -7,6 +7,7 @@ import qualified Data.Aeson as A import Data.Text (Text) +import Data.Time.Clock ( UTCTime ) import Network.HTTP.Base (RequestMethod) type Hostname = Text @@ -33,3 +34,11 @@ | WebSocketPing | WebSocketPong deriving (Eq, Show) + + +-- | The time as provided by the Server. This is a wrapper designed +-- to warn against naive comparisons to local times: the server's time +-- and local times are not necessarily synchronized. + +newtype ServerTime = ServerTime { withServerTime :: UTCTime } + deriving (Eq, Ord, Read, Show) diff --git a/src/Network/Mattermost/Types/Config.hs b/src/Network/Mattermost/Types/Config.hs new file mode 100644 --- /dev/null +++ b/src/Network/Mattermost/Types/Config.hs @@ -0,0 +1,666 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} + +module Network.Mattermost.Types.Config where + +import qualified Data.Aeson as A +import Data.Text (Text) +import qualified Data.Text as T + +data ServerConfig = ServerConfig + { + -- { configSqlsettings :: UnknownObject + -- , configPrivacysettings :: PrivacySettings + configLogsettings :: LogSettings + , configCompliancesettings :: ComplianceSettings + , configEmailsettings :: EmailSettings + -- , configFilesettings :: FileSettings + -- , configGitlabsettings :: GitLabSettings + , configNativeappsettings :: NativeAppSettings + -- , configLdapsettings :: LdapSettings + -- , configServicesettings :: ServiceSettings + -- , configOffice365settings :: Office365Settings + -- , configGooglesettings :: GoogleSettings + , configPasswordsettings :: PasswordSettings + , configTeamsettings :: TeamSettings + -- , configSamlsettings :: SamlSettings + -- , configClustersettings :: ClusterSettings + -- , configRatelimitsettings :: RateLimitSettings + -- , configLocalizationsettings :: LocalizationSettings + , configSupportsettings :: SupportSettings + -- , configAnalyticssettings :: Integer + , configMetricssettings :: MetricsSettings + , configWebrtcsettings :: WebrtcSettings + } deriving (Read, Show, Eq) + +instance A.FromJSON ServerConfig where + parseJSON = A.withObject "config" $ \v -> do + -- configSqlsettings <- v A..: "SqlSettings" + -- configPrivacysettings <- v A..: "PrivacySettings" + configLogsettings <- v A..: "LogSettings" + configCompliancesettings <- v A..: "ComplianceSettings" + configEmailsettings <- v A..: "EmailSettings" + -- configFilesettings <- v A..: "FileSettings" + -- configGitlabsettings <- v A..: "GitLabSettings" + configNativeappsettings <- v A..: "NativeAppSettings" + -- configLdapsettings <- v A..: "LdapSettings" + -- configServicesettings <- v A..: "ServiceSettings" + -- configOffice365settings <- v A..: "Office365Settings" + -- configGooglesettings <- v A..: "GoogleSettings" + configPasswordsettings <- v A..: "PasswordSettings" + configTeamsettings <- v A..: "TeamSettings" + -- configSamlsettings <- v A..: "SamlSettings" + -- configClustersettings <- v A..: "ClusterSettings" + -- configRatelimitsettings <- v A..: "RateLimitSettings" + -- configLocalizationsettings <- v A..: "LocalizationSettings" + configSupportsettings <- v A..: "SupportSettings" + -- configAnalyticssettings <- v A..: "AnalyticsSettings" + configMetricssettings <- v A..: "MetricsSettings" + configWebrtcsettings <- v A..: "WebrtcSettings" + return ServerConfig { .. } + +instance A.ToJSON ServerConfig where + toJSON ServerConfig { .. } = A.object + [ "EmailSettings" A..= configEmailsettings + , "WebrtcSettings" A..= configWebrtcsettings + , "PasswordSettings" A..= configPasswordsettings + , "LogSettings" A..= configLogsettings + , "NativeAppSettings" A..= configNativeappsettings + , "MetricsSettings" A..= configMetricssettings + , "ComplianceSettings" A..= configCompliancesettings + -- , "SqlSettings" A..= configSqlsettings + -- , "PrivacySettings" A..= configPrivacysettings + -- , "EmailSettings" A..= configEmailsettings + -- , "FileSettings" A..= configFilesettings + -- , "GitLabSettings" A..= configGitlabsettings + -- , "LdapSettings" A..= configLdapsettings + -- , "ServiceSettings" A..= configServicesettings + -- , "Office365Settings" A..= configOffice365settings + -- , "GoogleSettings" A..= configGooglesettings + -- , "TeamSettings" A..= configTeamsettings + -- , "SamlSettings" A..= configSamlsettings + -- , "ClusterSettings" A..= configClustersettings + -- , "RateLimitSettings" A..= configRatelimitsettings + -- , "LocalizationSettings" A..= configLocalizationsettings + , "SupportSettings" A..= configSupportsettings + -- , "AnalyticsSettings" A..= configAnalyticssettings + , "WebrtcSettings" A..= configWebrtcsettings + ] + +-- -- + +data EmailSettings = EmailSettings + { emailSettingsSendemailnotifications :: Bool + , emailSettingsPasswordresetsalt :: Maybe T.Text + , emailSettingsEnablesignupwithemail :: Bool + , emailSettingsSmtpusername ::T.Text + , emailSettingsEmailbatchinginterval :: Int + , emailSettingsFeedbackname ::T.Text + , emailSettingsRequireemailverification :: Bool + , emailSettingsSmtpserver ::T.Text + , emailSettingsSmtppassword ::T.Text + , emailSettingsEnablesigninwithemail :: Bool + , emailSettingsPushnotificationcontents ::T.Text + , emailSettingsPushnotificationserver ::T.Text + , emailSettingsEnableemailbatching :: Bool + , emailSettingsEmailbatchingbuffersize :: Int + , emailSettingsConnectionsecurity ::T.Text + , emailSettingsSmtpport ::T.Text + , emailSettingsFeedbackemail ::T.Text + , emailSettingsSendpushnotifications :: Bool + , emailSettingsFeedbackorganization ::T.Text + , emailSettingsInvitesalt ::T.Text + , emailSettingsEnablesigninwithusername :: Bool + } deriving (Read, Show, Eq) + +instance A.FromJSON EmailSettings where + parseJSON = A.withObject "emailSettings" $ \v -> do + emailSettingsSendemailnotifications <- v A..: "SendEmailNotifications" + emailSettingsPasswordresetsalt <- v A..:? "PasswordResetSalt" + emailSettingsEnablesignupwithemail <- v A..: "EnableSignUpWithEmail" + emailSettingsSmtpusername <- v A..: "SMTPUsername" + emailSettingsEmailbatchinginterval <- v A..: "EmailBatchingInterval" + emailSettingsFeedbackname <- v A..: "FeedbackName" + emailSettingsRequireemailverification <- v A..: "RequireEmailVerification" + emailSettingsSmtpserver <- v A..: "SMTPServer" + emailSettingsSmtppassword <- v A..: "SMTPPassword" + emailSettingsEnablesigninwithemail <- v A..: "EnableSignInWithEmail" + emailSettingsPushnotificationcontents <- v A..: "PushNotificationContents" + emailSettingsPushnotificationserver <- v A..: "PushNotificationServer" + emailSettingsEnableemailbatching <- v A..: "EnableEmailBatching" + emailSettingsEmailbatchingbuffersize <- v A..: "EmailBatchingBufferSize" + emailSettingsConnectionsecurity <- v A..: "ConnectionSecurity" + emailSettingsSmtpport <- v A..: "SMTPPort" + emailSettingsFeedbackemail <- v A..: "FeedbackEmail" + emailSettingsSendpushnotifications <- v A..: "SendPushNotifications" + emailSettingsFeedbackorganization <- v A..: "FeedbackOrganization" + emailSettingsInvitesalt <- v A..: "InviteSalt" + emailSettingsEnablesigninwithusername <- v A..: "EnableSignInWithUsername" + return EmailSettings { .. } + +instance A.ToJSON EmailSettings where + toJSON EmailSettings { .. } = A.object $ + [ "SendEmailNotifications" A..= emailSettingsSendemailnotifications + , "EnableSignUpWithEmail" A..= emailSettingsEnablesignupwithemail + , "SMTPUsername" A..= emailSettingsSmtpusername + , "EmailBatchingInterval" A..= emailSettingsEmailbatchinginterval + , "FeedbackName" A..= emailSettingsFeedbackname + , "RequireEmailVerification" A..= emailSettingsRequireemailverification + , "SMTPServer" A..= emailSettingsSmtpserver + , "SMTPPassword" A..= emailSettingsSmtppassword + , "EnableSignInWithEmail" A..= emailSettingsEnablesigninwithemail + , "PushNotificationContents" A..= emailSettingsPushnotificationcontents + , "PushNotificationServer" A..= emailSettingsPushnotificationserver + , "EnableEmailBatching" A..= emailSettingsEnableemailbatching + , "EmailBatchingBufferSize" A..= emailSettingsEmailbatchingbuffersize + , "ConnectionSecurity" A..= emailSettingsConnectionsecurity + , "SMTPPort" A..= emailSettingsSmtpport + , "FeedbackEmail" A..= emailSettingsFeedbackemail + , "SendPushNotifications" A..= emailSettingsSendpushnotifications + , "FeedbackOrganization" A..= emailSettingsFeedbackorganization + , "InviteSalt" A..= emailSettingsInvitesalt + , "EnableSignInWithUsername" A..= emailSettingsEnablesigninwithusername + ] ++ + [ "PasswordResetSalt" A..= x | Just x <- [emailSettingsPasswordresetsalt] ] + +data ClientConfig = ClientConfig + { clientConfigVersion :: T.Text + , clientConfigBuildNumber :: T.Text + , clientConfigBuildDate :: T.Text + , clientConfigBuildHash :: T.Text + , clientConfigBuildHashEnterprise :: T.Text + , clientConfigBuildEnterpriseReady :: T.Text + + , clientConfigSiteURL :: T.Text + , clientConfigSiteName :: T.Text + , clientConfigEnableTeamCreation :: T.Text + , clientConfigEnableUserCreation :: T.Text + , clientConfigEnableOpenServer :: T.Text + , clientConfigRestrictDirectMessage :: T.Text + , clientConfigRestrictTeamInvite :: T.Text + , clientConfigRestrictPublicChannelCreation :: T.Text + , clientConfigRestrictPrivateChannelCreation :: T.Text + , clientConfigRestrictPublicChannelManagement :: T.Text + , clientConfigRestrictPrivateChannelManagement :: T.Text + , clientConfigRestrictPublicChannelDeletion :: T.Text + , clientConfigRestrictPrivateChannelDeletion :: T.Text + , clientConfigRestrictPrivateChannelManageMembers :: T.Text + , clientConfigTeammateNameDisplay :: T.Text + + , clientConfigEnableOAuthServiceProvider :: T.Text + , clientConfigGoogleDeveloperKey :: T.Text + , clientConfigEnableIncomingWebhooks :: T.Text + , clientConfigEnableOutgoingWebhooks :: T.Text + , clientConfigEnableCommands :: T.Text + , clientConfigEnableOnlyAdminIntegrations :: T.Text + , clientConfigEnablePostUsernameOverride :: T.Text + , clientConfigEnablePostIconOverride :: T.Text + , clientConfigEnableLinkPreviews :: T.Text + , clientConfigEnableTesting :: T.Text + , clientConfigEnableDeveloper :: T.Text + , clientConfigEnableDiagnostics :: T.Text + , clientConfigRestrictPostDelete :: T.Text + , clientConfigAllowEditPost :: T.Text + , clientConfigPostEditTimeLimit :: T.Text + + , clientConfigSendEmailNotifications :: T.Text + , clientConfigSendPushNotifications :: T.Text + , clientConfigEnableSignUpWithEmail :: T.Text + , clientConfigEnableSignInWithEmail :: T.Text + , clientConfigEnableSignInWithUsername :: T.Text + , clientConfigRequireEmailVerification :: T.Text + , clientConfigEnableEmailBatching :: T.Text + + , clientConfigEnableSignUpWithGitLab :: T.Text + + , clientConfigShowEmailAddress :: T.Text + + , clientConfigTermsOfServiceLink :: T.Text + , clientConfigPrivacyPolicyLink :: T.Text + , clientConfigAboutLink :: T.Text + , clientConfigHelpLink :: T.Text + , clientConfigReportAProblemLink :: T.Text + , clientConfigAdministratorsGuideLink :: Maybe T.Text + , clientConfigTroubleshootingForumLink :: Maybe T.Text + , clientConfigCommercialSupportLink :: Maybe T.Text + , clientConfigSupportEmail :: T.Text + + , clientConfigEnableFileAttachments :: T.Text + , clientConfigEnablePublicLink :: T.Text + + , clientConfigWebsocketPort :: T.Text + , clientConfigWebsocketSecurePort :: T.Text + + , clientConfigDefaultClientLocale :: T.Text + , clientConfigAvailableLocales :: T.Text + , clientConfigSQLDriverName :: T.Text + + , clientConfigEnableCustomEmoji :: T.Text + , clientConfigEnableEmojiPicker :: T.Text + , clientConfigRestrictCustomEmojiCreation :: T.Text + , clientConfigMaxFileSize :: T.Text + + , clientConfigAppDownloadLink :: T.Text + , clientConfigAndroidAppDownloadLink :: T.Text + , clientConfigIosAppDownloadLink :: T.Text + + , clientConfigEnableWebrtc :: T.Text + + , clientConfigMaxNotificationsPerChannel :: T.Text + , clientConfigTimeBetweenUserTypingUpdatesMilliseconds :: T.Text + , clientConfigEnableUserTypingMessages :: T.Text + , clientConfigEnableChannelViewedMessages :: T.Text + + , clientConfigDiagnosticId :: T.Text + , clientConfigDiagnosticsEnabled :: T.Text + } deriving (Read, Show, Eq) + + +instance A.FromJSON ClientConfig where + parseJSON = A.withObject "ClientConfig" $ \o -> do + clientConfigVersion <- o A..: "Version" + clientConfigBuildNumber <- o A..: "BuildNumber" + clientConfigBuildDate <- o A..: "BuildDate" + clientConfigBuildHash <- o A..: "BuildHash" + clientConfigBuildHashEnterprise <- o A..: "BuildHashEnterprise" + clientConfigBuildEnterpriseReady <- o A..: "BuildEnterpriseReady" + + clientConfigSiteURL <- o A..: "SiteURL" + clientConfigSiteName <- o A..: "SiteName" + clientConfigEnableTeamCreation <- o A..: "EnableTeamCreation" + clientConfigEnableUserCreation <- o A..: "EnableUserCreation" + clientConfigEnableOpenServer <- o A..: "EnableOpenServer" + clientConfigRestrictDirectMessage <- o A..: "RestrictDirectMessage" + clientConfigRestrictTeamInvite <- o A..: "RestrictTeamInvite" + clientConfigRestrictPublicChannelCreation <- o A..: "RestrictPublicChannelCreation" + clientConfigRestrictPrivateChannelCreation <- o A..: "RestrictPrivateChannelCreation" + clientConfigRestrictPublicChannelManagement <- o A..: "RestrictPublicChannelManagement" + clientConfigRestrictPrivateChannelManagement <- o A..: "RestrictPrivateChannelManagement" + clientConfigRestrictPublicChannelDeletion <- o A..: "RestrictPublicChannelDeletion" + clientConfigRestrictPrivateChannelDeletion <- o A..: "RestrictPrivateChannelDeletion" + clientConfigRestrictPrivateChannelManageMembers <- o A..: "RestrictPrivateChannelManageMembers" + clientConfigTeammateNameDisplay <- o A..: "TeammateNameDisplay" + + clientConfigEnableOAuthServiceProvider <- o A..: "EnableOAuthServiceProvider" + clientConfigGoogleDeveloperKey <- o A..: "GoogleDeveloperKey" + clientConfigEnableIncomingWebhooks <- o A..: "EnableIncomingWebhooks" + clientConfigEnableOutgoingWebhooks <- o A..: "EnableOutgoingWebhooks" + clientConfigEnableCommands <- o A..: "EnableCommands" + clientConfigEnableOnlyAdminIntegrations <- o A..: "EnableOnlyAdminIntegrations" + clientConfigEnablePostUsernameOverride <- o A..: "EnablePostUsernameOverride" + clientConfigEnablePostIconOverride <- o A..: "EnablePostIconOverride" + clientConfigEnableLinkPreviews <- o A..: "EnableLinkPreviews" + clientConfigEnableTesting <- o A..: "EnableTesting" + clientConfigEnableDeveloper <- o A..: "EnableDeveloper" + clientConfigEnableDiagnostics <- o A..: "EnableDiagnostics" + clientConfigRestrictPostDelete <- o A..: "RestrictPostDelete" + clientConfigAllowEditPost <- o A..: "AllowEditPost" + clientConfigPostEditTimeLimit <- o A..: "PostEditTimeLimit" + + clientConfigSendEmailNotifications <- o A..: "SendEmailNotifications" + clientConfigSendPushNotifications <- o A..: "SendPushNotifications" + clientConfigEnableSignUpWithEmail <- o A..: "EnableSignUpWithEmail" + clientConfigEnableSignInWithEmail <- o A..: "EnableSignInWithEmail" + clientConfigEnableSignInWithUsername <- o A..: "EnableSignInWithUsername" + clientConfigRequireEmailVerification <- o A..: "RequireEmailVerification" + clientConfigEnableEmailBatching <- o A..: "EnableEmailBatching" + + clientConfigEnableSignUpWithGitLab <- o A..: "EnableSignUpWithGitLab" + + clientConfigShowEmailAddress <- o A..: "ShowEmailAddress" + + clientConfigTermsOfServiceLink <- o A..: "TermsOfServiceLink" + clientConfigPrivacyPolicyLink <- o A..: "PrivacyPolicyLink" + clientConfigAboutLink <- o A..: "AboutLink" + clientConfigHelpLink <- o A..: "HelpLink" + clientConfigReportAProblemLink <- o A..: "ReportAProblemLink" + clientConfigAdministratorsGuideLink <- o A..:? "AdministratorsGuideLink" + clientConfigTroubleshootingForumLink <- o A..:? "TroubleshootingForumLink" + clientConfigCommercialSupportLink <- o A..:? "CommercialSupportLink" + clientConfigSupportEmail <- o A..: "SupportEmail" + + clientConfigEnableFileAttachments <- o A..: "EnableFileAttachments" + clientConfigEnablePublicLink <- o A..: "EnablePublicLink" + + clientConfigWebsocketPort <- o A..: "WebsocketPort" + clientConfigWebsocketSecurePort <- o A..: "WebsocketSecurePort" + + clientConfigDefaultClientLocale <- o A..: "DefaultClientLocale" + clientConfigAvailableLocales <- o A..: "AvailableLocales" + clientConfigSQLDriverName <- o A..: "SQLDriverName" + + clientConfigEnableCustomEmoji <- o A..: "EnableCustomEmoji" + clientConfigEnableEmojiPicker <- o A..: "EnableEmojiPicker" + clientConfigRestrictCustomEmojiCreation <- o A..: "RestrictCustomEmojiCreation" + clientConfigMaxFileSize <- o A..: "MaxFileSize" + + clientConfigAppDownloadLink <- o A..: "AppDownloadLink" + clientConfigAndroidAppDownloadLink <- o A..: "AndroidAppDownloadLink" + clientConfigIosAppDownloadLink <- o A..: "IosAppDownloadLink" + + clientConfigEnableWebrtc <- o A..: "EnableWebrtc" + + clientConfigMaxNotificationsPerChannel <- o A..: "MaxNotificationsPerChannel" + clientConfigTimeBetweenUserTypingUpdatesMilliseconds <- o A..: "TimeBetweenUserTypingUpdatesMilliseconds" + clientConfigEnableUserTypingMessages <- o A..: "EnableUserTypingMessages" + clientConfigEnableChannelViewedMessages <- o A..: "EnableChannelViewedMessages" + + clientConfigDiagnosticId <- o A..: "DiagnosticId" + clientConfigDiagnosticsEnabled <- o A..: "DiagnosticsEnabled" + return ClientConfig { .. } + + +data TeamSettings = TeamSettings + { teamSettingsRestrictpublicchanneldeletion :: Text + , teamSettingsRestrictcreationtodomains :: Text + , teamSettingsMaxusersperteam :: Int + , teamSettingsCustomdescriptiontext :: Text + , teamSettingsEnableopenserver :: Bool + , teamSettingsEnableusercreation :: Bool + , teamSettingsCustombrandtext :: Text + , teamSettingsRestrictprivatechanneldeletion :: Text + , teamSettingsMaxchannelsperteam :: Int + , teamSettingsRestrictteaminvite :: Text + , teamSettingsEnableteamcreation :: Bool + , teamSettingsSitename :: Text + , teamSettingsRestrictpublicchannelmanagement :: Text + , teamSettingsMaxnotificationsperchannel :: Int + , teamSettingsRestrictdirectmessage :: Text + , teamSettingsUserstatusawaytimeout :: Int + , teamSettingsEnablecustombrand :: Bool + , teamSettingsRestrictprivatechannelmanagement :: Text + , teamSettingsRestrictprivatechannelcreation :: Text + , teamSettingsRestrictpublicchannelcreation :: Text + } deriving (Read, Show, Eq) + +instance A.FromJSON TeamSettings where + parseJSON = A.withObject "teamSettings" $ \v -> do + teamSettingsRestrictpublicchanneldeletion <- v A..: "RestrictPublicChannelDeletion" + teamSettingsRestrictcreationtodomains <- v A..: "RestrictCreationToDomains" + teamSettingsMaxusersperteam <- v A..: "MaxUsersPerTeam" + teamSettingsCustomdescriptiontext <- v A..: "CustomDescriptionText" + teamSettingsEnableopenserver <- v A..: "EnableOpenServer" + teamSettingsEnableusercreation <- v A..: "EnableUserCreation" + teamSettingsCustombrandtext <- v A..: "CustomBrandText" + teamSettingsRestrictprivatechanneldeletion <- v A..: "RestrictPrivateChannelDeletion" + teamSettingsMaxchannelsperteam <- v A..: "MaxChannelsPerTeam" + teamSettingsRestrictteaminvite <- v A..: "RestrictTeamInvite" + teamSettingsEnableteamcreation <- v A..: "EnableTeamCreation" + teamSettingsSitename <- v A..: "SiteName" + teamSettingsRestrictpublicchannelmanagement <- v A..: "RestrictPublicChannelManagement" + teamSettingsMaxnotificationsperchannel <- v A..: "MaxNotificationsPerChannel" + teamSettingsRestrictdirectmessage <- v A..: "RestrictDirectMessage" + teamSettingsUserstatusawaytimeout <- v A..: "UserStatusAwayTimeout" + teamSettingsEnablecustombrand <- v A..: "EnableCustomBrand" + teamSettingsRestrictprivatechannelmanagement <- v A..: "RestrictPrivateChannelManagement" + teamSettingsRestrictprivatechannelcreation <- v A..: "RestrictPrivateChannelCreation" + teamSettingsRestrictpublicchannelcreation <- v A..: "RestrictPublicChannelCreation" + return TeamSettings { .. } + +instance A.ToJSON TeamSettings where + toJSON TeamSettings { .. } = A.object + [ "RestrictPublicChannelDeletion" A..= teamSettingsRestrictpublicchanneldeletion + , "RestrictCreationToDomains" A..= teamSettingsRestrictcreationtodomains + , "MaxUsersPerTeam" A..= teamSettingsMaxusersperteam + , "CustomDescriptionText" A..= teamSettingsCustomdescriptiontext + , "EnableOpenServer" A..= teamSettingsEnableopenserver + , "EnableUserCreation" A..= teamSettingsEnableusercreation + , "CustomBrandText" A..= teamSettingsCustombrandtext + , "RestrictPrivateChannelDeletion" A..= teamSettingsRestrictprivatechanneldeletion + , "MaxChannelsPerTeam" A..= teamSettingsMaxchannelsperteam + , "RestrictTeamInvite" A..= teamSettingsRestrictteaminvite + , "EnableTeamCreation" A..= teamSettingsEnableteamcreation + , "SiteName" A..= teamSettingsSitename + , "RestrictPublicChannelManagement" A..= teamSettingsRestrictpublicchannelmanagement + , "MaxNotificationsPerChannel" A..= teamSettingsMaxnotificationsperchannel + , "RestrictDirectMessage" A..= teamSettingsRestrictdirectmessage + , "UserStatusAwayTimeout" A..= teamSettingsUserstatusawaytimeout + , "EnableCustomBrand" A..= teamSettingsEnablecustombrand + , "RestrictPrivateChannelManagement" A..= teamSettingsRestrictprivatechannelmanagement + , "RestrictPrivateChannelCreation" A..= teamSettingsRestrictprivatechannelcreation + , "RestrictPublicChannelCreation" A..= teamSettingsRestrictpublicchannelcreation + ] + + +data WebrtcSettings = WebrtcSettings + { webrtcSettingsStunuri :: Text + , webrtcSettingsTurnsharedkey :: Text + , webrtcSettingsEnable :: Bool + , webrtcSettingsGatewayadminsecret :: Text + , webrtcSettingsTurnuri :: Text + , webrtcSettingsGatewayadminurl :: Text + , webrtcSettingsTurnusername :: Text + , webrtcSettingsGatewaywebsocketurl :: Text + } deriving (Read, Show, Eq) + +instance A.FromJSON WebrtcSettings where + parseJSON = A.withObject "webrtcSettings" $ \v -> do + webrtcSettingsStunuri <- v A..: "StunURI" + webrtcSettingsTurnsharedkey <- v A..: "TurnSharedKey" + webrtcSettingsEnable <- v A..: "Enable" + webrtcSettingsGatewayadminsecret <- v A..: "GatewayAdminSecret" + webrtcSettingsTurnuri <- v A..: "TurnURI" + webrtcSettingsGatewayadminurl <- v A..: "GatewayAdminUrl" + webrtcSettingsTurnusername <- v A..: "TurnUsername" + webrtcSettingsGatewaywebsocketurl <- v A..: "GatewayWebsocketUrl" + return WebrtcSettings { .. } + +instance A.ToJSON WebrtcSettings where + toJSON WebrtcSettings { .. } = A.object + [ "StunURI" A..= webrtcSettingsStunuri + , "TurnSharedKey" A..= webrtcSettingsTurnsharedkey + , "Enable" A..= webrtcSettingsEnable + , "GatewayAdminSecret" A..= webrtcSettingsGatewayadminsecret + , "TurnURI" A..= webrtcSettingsTurnuri + , "GatewayAdminUrl" A..= webrtcSettingsGatewayadminurl + , "TurnUsername" A..= webrtcSettingsTurnusername + , "GatewayWebsocketUrl" A..= webrtcSettingsGatewaywebsocketurl + ] + + +data PasswordSettings = PasswordSettings + { passwordSettingsUppercase :: Bool + , passwordSettingsLowercase :: Bool + , passwordSettingsNumber :: Bool + , passwordSettingsSymbol :: Bool + , passwordSettingsMinimumlength :: Int + } deriving (Read, Show, Eq) + +instance A.FromJSON PasswordSettings where + parseJSON = A.withObject "passwordSettings" $ \v -> do + passwordSettingsUppercase <- v A..: "Uppercase" + passwordSettingsLowercase <- v A..: "Lowercase" + passwordSettingsNumber <- v A..: "Number" + passwordSettingsSymbol <- v A..: "Symbol" + passwordSettingsMinimumlength <- v A..: "MinimumLength" + return PasswordSettings { .. } + +instance A.ToJSON PasswordSettings where + toJSON PasswordSettings { .. } = A.object + [ "Uppercase" A..= passwordSettingsUppercase + , "Lowercase" A..= passwordSettingsLowercase + , "Number" A..= passwordSettingsNumber + , "Symbol" A..= passwordSettingsSymbol + , "MinimumLength" A..= passwordSettingsMinimumlength + ] + +-- + +data PrivacySettings = PrivacySettings + { privacySettingsShowemailaddress :: Bool + , privacySettingsShowfullname :: Bool + } deriving (Read, Show, Eq) + +instance A.FromJSON PrivacySettings where + parseJSON = A.withObject "privacySettings" $ \v -> do + privacySettingsShowemailaddress <- v A..: "ShowEmailAddress" + privacySettingsShowfullname <- v A..: "ShowFullName" + return PrivacySettings { .. } + +instance A.ToJSON PrivacySettings where + toJSON PrivacySettings { .. } = A.object + [ "ShowEmailAddress" A..= privacySettingsShowemailaddress + , "ShowFullName" A..= privacySettingsShowfullname + ] + +-- + +data RateLimitSettings = RateLimitSettings + { rateLimitSettingsEnable :: Bool + , rateLimitSettingsVarybyremoteaddr :: Bool + , rateLimitSettingsMemorystoresize :: Int + , rateLimitSettingsMaxburst :: Int + , rateLimitSettingsVarybyheader :: Text + , rateLimitSettingsPersec :: Int + } deriving (Read, Show, Eq) + +instance A.FromJSON RateLimitSettings where + parseJSON = A.withObject "rateLimitSettings" $ \v -> do + rateLimitSettingsEnable <- v A..: "Enable" + rateLimitSettingsVarybyremoteaddr <- v A..: "VaryByRemoteAddr" + rateLimitSettingsMemorystoresize <- v A..: "MemoryStoreSize" + rateLimitSettingsMaxburst <- v A..: "MaxBurst" + rateLimitSettingsVarybyheader <- v A..: "VaryByHeader" + rateLimitSettingsPersec <- v A..: "PerSec" + return RateLimitSettings { .. } + +instance A.ToJSON RateLimitSettings where + toJSON RateLimitSettings { .. } = A.object + [ "Enable" A..= rateLimitSettingsEnable + , "VaryByRemoteAddr" A..= rateLimitSettingsVarybyremoteaddr + , "MemoryStoreSize" A..= rateLimitSettingsMemorystoresize + , "MaxBurst" A..= rateLimitSettingsMaxburst + , "VaryByHeader" A..= rateLimitSettingsVarybyheader + , "PerSec" A..= rateLimitSettingsPersec + ] + + +data LogSettings = LogSettings + { logSettingsEnablefile :: Bool + , logSettingsFilelocation :: Text + , logSettingsFilelevel :: Text + , logSettingsEnableconsole :: Bool + , logSettingsEnablewebhookdebugging :: Bool + , logSettingsConsolelevel :: Text + , logSettingsFileformat :: Text + , logSettingsEnablediagnostics :: Bool + } deriving (Read, Show, Eq) + +instance A.FromJSON LogSettings where + parseJSON = A.withObject "logSettings" $ \v -> do + logSettingsEnablefile <- v A..: "EnableFile" + logSettingsFilelocation <- v A..: "FileLocation" + logSettingsFilelevel <- v A..: "FileLevel" + logSettingsEnableconsole <- v A..: "EnableConsole" + logSettingsEnablewebhookdebugging <- v A..: "EnableWebhookDebugging" + logSettingsConsolelevel <- v A..: "ConsoleLevel" + logSettingsFileformat <- v A..: "FileFormat" + logSettingsEnablediagnostics <- v A..: "EnableDiagnostics" + return LogSettings { .. } + +instance A.ToJSON LogSettings where + toJSON LogSettings { .. } = A.object + [ "EnableFile" A..= logSettingsEnablefile + , "FileLocation" A..= logSettingsFilelocation + , "FileLevel" A..= logSettingsFilelevel + , "EnableConsole" A..= logSettingsEnableconsole + , "EnableWebhookDebugging" A..= logSettingsEnablewebhookdebugging + , "ConsoleLevel" A..= logSettingsConsolelevel + , "FileFormat" A..= logSettingsFileformat + , "EnableDiagnostics" A..= logSettingsEnablediagnostics + ] + +-- + +data MetricsSettings = MetricsSettings + { metricsSettingsBlockprofilerate :: Integer + , metricsSettingsEnable :: Bool + , metricsSettingsListenaddress :: Text + } deriving (Read, Show, Eq) + +instance A.FromJSON MetricsSettings where + parseJSON = A.withObject "metricsSettings" $ \v -> do + metricsSettingsBlockprofilerate <- v A..: "BlockProfileRate" + metricsSettingsEnable <- v A..: "Enable" + metricsSettingsListenaddress <- v A..: "ListenAddress" + return MetricsSettings { .. } + +instance A.ToJSON MetricsSettings where + toJSON MetricsSettings { .. } = A.object + [ "BlockProfileRate" A..= metricsSettingsBlockprofilerate + , "Enable" A..= metricsSettingsEnable + , "ListenAddress" A..= metricsSettingsListenaddress + ] + +-- + +data NativeAppSettings = NativeAppSettings + { nativeAppSettingsAndroidappdownloadlink :: Text + , nativeAppSettingsAppdownloadlink :: Text + , nativeAppSettingsIosappdownloadlink :: Text + } deriving (Read, Show, Eq) + +instance A.FromJSON NativeAppSettings where + parseJSON = A.withObject "nativeAppSettings" $ \v -> do + nativeAppSettingsAndroidappdownloadlink <- v A..: "AndroidAppDownloadLink" + nativeAppSettingsAppdownloadlink <- v A..: "AppDownloadLink" + nativeAppSettingsIosappdownloadlink <- v A..: "IosAppDownloadLink" + return NativeAppSettings { .. } + +instance A.ToJSON NativeAppSettings where + toJSON NativeAppSettings { .. } = A.object + [ "AndroidAppDownloadLink" A..= nativeAppSettingsAndroidappdownloadlink + , "AppDownloadLink" A..= nativeAppSettingsAppdownloadlink + , "IosAppDownloadLink" A..= nativeAppSettingsIosappdownloadlink + ] + + +data ComplianceSettings = ComplianceSettings + { complianceSettingsDirectory :: Text + , complianceSettingsEnable :: Bool + , complianceSettingsEnabledaily :: Bool + } deriving (Read, Show, Eq) + +instance A.FromJSON ComplianceSettings where + parseJSON = A.withObject "complianceSettings" $ \v -> do + complianceSettingsDirectory <- v A..: "Directory" + complianceSettingsEnable <- v A..: "Enable" + complianceSettingsEnabledaily <- v A..: "EnableDaily" + return ComplianceSettings { .. } + +instance A.ToJSON ComplianceSettings where + toJSON ComplianceSettings { .. } = A.object + [ "Directory" A..= complianceSettingsDirectory + , "Enable" A..= complianceSettingsEnable + , "EnableDaily" A..= complianceSettingsEnabledaily + ] + + +data SupportSettings = SupportSettings + { supportSettingsReportaproblemlink :: Text + , supportSettingsHelplink :: Text + , supportSettingsPrivacypolicylink :: Text + , supportSettingsTermsofservicelink :: Text + , supportSettingsAboutlink :: Text + , supportSettingsSupportemail :: Text + } deriving (Read, Show, Eq) + +instance A.FromJSON SupportSettings where + parseJSON = A.withObject "supportSettings" $ \v -> do + supportSettingsReportaproblemlink <- v A..: "ReportAProblemLink" + supportSettingsHelplink <- v A..: "HelpLink" + supportSettingsPrivacypolicylink <- v A..: "PrivacyPolicyLink" + supportSettingsTermsofservicelink <- v A..: "TermsOfServiceLink" + supportSettingsAboutlink <- v A..: "AboutLink" + supportSettingsSupportemail <- v A..: "SupportEmail" + return SupportSettings { .. } + +instance A.ToJSON SupportSettings where + toJSON SupportSettings { .. } = A.object + [ "ReportAProblemLink" A..= supportSettingsReportaproblemlink + , "HelpLink" A..= supportSettingsHelplink + , "PrivacyPolicyLink" A..= supportSettingsPrivacypolicylink + , "TermsOfServiceLink" A..= supportSettingsTermsofservicelink + , "AboutLink" A..= supportSettingsAboutlink + , "SupportEmail" A..= supportSettingsSupportemail + ] diff --git a/src/Network/Mattermost/Util.hs b/src/Network/Mattermost/Util.hs --- a/src/Network/Mattermost/Util.hs +++ b/src/Network/Mattermost/Util.hs @@ -23,8 +23,11 @@ , ConnectionParams(..) , TLSSettings(..) , connectionGet + , connectionGetLine + , connectionPut , connectionClose , connectTo ) +import qualified Network.HTTP.Stream as HTTP import Network.Mattermost.Types.Internal @@ -59,11 +62,26 @@ -- | Creates a new connection to 'Hostname' from an already initialized 'ConnectionContext'. -- Internally it uses 'bracket' to cleanup the connection. -withConnection :: ConnectionData -> (Connection -> IO a) -> IO a +withConnection :: ConnectionData -> (MMConn -> IO a) -> IO a withConnection cd action = - bracket (mkConnection cd) - connectionClose + bracket (MMConn <$> mkConnection cd) + (connectionClose . fromMMConn) action + +maxLineLength :: Int +maxLineLength = 2^(16::Int) + +newtype MMConn = MMConn { fromMMConn :: Connection } + +-- | This instance allows us to use 'simpleHTTP' from 'Network.HTTP.Stream' with +-- connections from the 'connection' package. +instance HTTP.Stream MMConn where + readLine con = Right . B.unpack . dropTrailingChar <$> connectionGetLine maxLineLength (fromMMConn con) + readBlock con n = Right . B.unpack <$> connectionGetExact (fromMMConn con) n + writeBlock con block = Right <$> connectionPut (fromMMConn con) (B.pack block) + close con = connectionClose (fromMMConn con) + closeOnEnd _ _ = return () + -- | Creates a connection from a 'ConnectionData' value, returning it. It -- is the user's responsibility to close this appropriately. diff --git a/src/Network/Mattermost/WebSocket.hs b/src/Network/Mattermost/WebSocket.hs --- a/src/Network/Mattermost/WebSocket.hs +++ b/src/Network/Mattermost/WebSocket.hs @@ -7,6 +7,7 @@ , MMWebSocketTimeoutException , mmWithWebSocket , mmCloseWebSocket +, mmSendWSAction , mmGetConnectionHealth , module Network.Mattermost.WebSocket.Types ) where @@ -142,3 +143,8 @@ propagate ts e = do sequence_ [ throwTo t e | t <- ts ] throwIO e + +mmSendWSAction :: ConnectionData -> MMWebSocket -> WebsocketAction -> IO () +mmSendWSAction cd (MMWS ws _) a = do + runLogger cd "websocket" $ WebSocketRequest $ toJSON a + WS.sendTextData ws a diff --git a/src/Network/Mattermost/WebSocket/Types.hs b/src/Network/Mattermost/WebSocket/Types.hs --- a/src/Network/Mattermost/WebSocket/Types.hs +++ b/src/Network/Mattermost/WebSocket/Types.hs @@ -7,6 +7,7 @@ , WebsocketEvent(..) , WEData(..) , WEBroadcast(..) +, WebsocketAction(..) ) where import Control.Applicative @@ -255,3 +256,29 @@ , "user_id" .= webUserId , "omit_users" .= webOmitUsers ] + +-- + +data WebsocketAction = + UserTyping { waSeq :: Int64 + , waChannelId :: ChannelId + , waParentPostId :: Maybe PostId + } + -- -- | GetStatuses { waSeq :: Int64 } + -- -- | GetStatusesByIds { waSeq :: Int64, waUserIds :: [UserId] } + deriving (Read, Show, Eq, Ord) + +instance ToJSON WebsocketAction where + toJSON (UserTyping s cId pId) = A.object + [ "seq" .= s + , "action" .= T.pack "user_typing" + , "data" .= A.object + [ "channel_id" .= unId (toId cId) + , "parent_id" .= maybe "" (unId . toId) pId + ] + ] + +instance WebSocketsData WebsocketAction where + fromDataMessage _ = error "Not implemented" + fromLazyByteString _ = error "Not implemented" + toLazyByteString = A.encode diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -10,14 +10,14 @@ import Text.Show.Pretty ( ppShow ) -import Data.Aeson import Data.Monoid ((<>)) -import qualified Data.HashMap.Strict as HM import qualified Data.Sequence as Seq +import qualified Data.Text as T (Text) import Test.Tasty import Network.Mattermost.Types +import Network.Mattermost.Types.Config import Network.Mattermost.WebSocket.Types import Network.Mattermost.Exceptions @@ -32,8 +32,8 @@ -- Users and other test configuration data -testConfig :: Config -testConfig = Config +testConfig :: TestConfig +testConfig = TestConfig { configUsername = "testAdmin" , configEmail = "testAdmin@example.com" , configHostname = "localhost" @@ -48,15 +48,20 @@ , password = "password" } -testMinChannel :: MinChannel -testMinChannel = MinChannel +testMinChannel :: TeamId -> MinChannel +testMinChannel tId = MinChannel { minChannelName = "test-channel" , minChannelDisplayName = "Test Channel" , minChannelPurpose = Just "A channel for test cases" , minChannelHeader = Just "Test Header" , minChannelType = Ordinary + , minChannelTeamId = tId } +testMinChannelName :: T.Text +testMinChannelName = "test-channel" + + testTeamsCreate :: TeamsCreate testTeamsCreate = TeamsCreate { teamsCreateDisplayName = "Test Team" @@ -91,6 +96,7 @@ , leaveChannelTest , joinChannelTest , deleteChannelTest + , clientConfigTest ] -- Test definitions @@ -120,16 +126,16 @@ print_ "Saving Config" -- Enable open team so that the admin can create -- new users. - let Object oldConfig = config - Object teamSettings = oldConfig HM.! "TeamSettings" - newConfig = Object (HM.insert "TeamSettings" - (Object (HM.insert "EnableOpenServer" - (Bool True) teamSettings)) oldConfig) + let newTeamSettings = (configTeamsettings config) { teamSettingsEnableopenserver = True } + newConfig = config { configTeamsettings = newTeamSettings } saveConfig newConfig expectWSEvent "admin joined town square" (isPost adminUser townSquare "testadmin has joined the channel.") + expectWSEvent "admin joined test team" + (isAddedToTeam adminUser testTeam) + print_ "Creating test account" testUser <- createAccount testAccount @@ -162,9 +168,8 @@ mmTestCase "Initial Load" testConfig $ do loginAccount testUserLogin - initialLoad <- getInitialLoad - -- print the team names - print_ (ppShow (fmap teamName (initialLoadTeams initialLoad))) + teams <- getTeams + print_ (ppShow (fmap teamName teams)) expectWSEvent "hello" (hasWSEventType WMHello) expectWSDone @@ -174,12 +179,16 @@ mmTestCase "Create Channel" testConfig $ do loginAccount testUserLogin - initialLoad <- getInitialLoad - let team Seq.:< _ = Seq.viewl (initialLoadTeams initialLoad) - chan <- createChannel team testMinChannel + testUser <- getMe + teams <- getTeams + let team Seq.:< _ = Seq.viewl teams + + chan <- createChannel (testMinChannel (teamId team)) print_ (ppShow chan) expectWSEvent "hello" (hasWSEventType WMHello) + expectWSEvent "test user joins test channel" + (isPost testUser chan "test-user has joined the channel.") expectWSEvent "new channel event" (isChannelCreatedEvent chan) expectWSDone @@ -187,8 +196,8 @@ getChannelsTest = mmTestCase "Get Channels" testConfig $ do loginAccount testUserLogin - initialLoad <- getInitialLoad - let team Seq.:< _ = Seq.viewl (initialLoadTeams initialLoad) + teams <- getTeams + let team Seq.:< _ = Seq.viewl teams chans <- getChannels team let chan Seq.:< _ = Seq.viewl chans @@ -202,14 +211,14 @@ mmTestCase "Leave Channel" testConfig $ do loginAccount testUserLogin Just testUser <- getUserByName (username testUserLogin) - initialLoad <- getInitialLoad + teams <- getTeams - let team Seq.:< _ = Seq.viewl (initialLoadTeams initialLoad) + let team Seq.:< _ = Seq.viewl teams chans <- getChannels team print_ (ppShow chans) - let chan = findChannel chans $ minChannelName testMinChannel - leaveChannel team chan + let chan = findChannel chans $ testMinChannelName + leaveChannel chan expectWSEvent "hello" (hasWSEventType WMHello) expectWSEvent "leave channel" (isUserLeave testUser chan) @@ -220,25 +229,26 @@ mmTestCase "Join Channel" testConfig $ do loginAccount testUserLogin Just testUser <- getUserByName (username testUserLogin) - initialLoad <- getInitialLoad + teams <- getTeams - let team Seq.:< _ = Seq.viewl (initialLoadTeams initialLoad) - chans <- getMoreChannels team + let team Seq.:< _ = Seq.viewl teams + chans <- getChannels team print_ (ppShow chans) - let chan = findChannel chans $ minChannelName testMinChannel - joinChannel team chan + let chan = findChannel chans $ testMinChannelName + joinChannel testUser chan - members <- getChannelMembers team chan + members <- getChannelMembers chan let expected :: [User] expected = [testUser] - when (members /= expected) $ - error $ "Expected channel members: " <> show expected + when (fmap userId members /= fmap userId expected) $ + error $ "Expected channel members: " <> show expected <> "\ngot: " <> show members expectWSEvent "hello" (hasWSEventType WMHello) expectWSEvent "join channel" (isUserJoin testUser chan) expectWSEvent "join post" (isPost testUser chan "test-user has joined the channel.") + expectWSEvent "view channel" isViewedChannel expectWSDone deleteChannelTest :: TestTree @@ -247,13 +257,13 @@ loginAccount testUserLogin Just testUser <- getUserByName (username testUserLogin) - initialLoad <- getInitialLoad - let team Seq.:< _ = Seq.viewl (initialLoadTeams initialLoad) + teams <- getTeams + let team Seq.:< _ = Seq.viewl teams chans <- getChannels team - let toDelete = findChannel chans (minChannelName testMinChannel) + let toDelete = findChannel chans (testMinChannelName) - deleteChannel team toDelete + deleteChannel toDelete expectWSEvent "hello" (hasWSEventType WMHello) @@ -264,3 +274,30 @@ (isChannelDeleteEvent toDelete) expectWSDone + +clientConfigTest :: TestTree +clientConfigTest = + mmTestCase "Client Config Test" testConfig $ do + loginAccount testUserLogin + + print_ "Getting Client Config" + config <- getClientConfig + + print_ (ppShow config) + + return () + + -- let Object config = configObj + + -- keyAssert "AboutLink" config + -- keyAssert "EnableSignInWithEmail" config + -- keyAssert "RestrictPrivateChannelCreation" config + -- keyAssert "SiteName" config + -- keyAssert "TermsOfServiceLink" config + -- keyAssert "WebsocketSecurePort" config + + -- where + -- keyAssert k c = unless (HM.member k c) $ + -- let m = T.unpack k <> " key not present" + -- in print_ m + -- >> error m diff --git a/test/Tests/Types.hs b/test/Tests/Types.hs --- a/test/Tests/Types.hs +++ b/test/Tests/Types.hs @@ -1,5 +1,5 @@ module Tests.Types - ( Config(..) + ( TestConfig(..) , TestM , TestState(..) ) @@ -14,20 +14,21 @@ import Network.Mattermost.Types (Session) import Network.Mattermost.WebSocket.Types -data Config - = Config { configUsername :: Text - , configHostname :: Text - , configTeam :: Text - , configPort :: Int - , configPassword :: Text - , configEmail :: Text - } +data TestConfig + = TestConfig + { configUsername :: Text + , configHostname :: Text + , configTeam :: Text + , configPort :: Int + , configPassword :: Text + , configEmail :: Text + } type TestM a = StateT TestState IO a data TestState = TestState { tsPrinter :: String -> IO () - , tsConfig :: Config + , tsConfig :: TestConfig , tsConnectionData :: ConnectionData , tsSession :: Maybe Session , tsDebug :: Bool diff --git a/test/Tests/Util.hs b/test/Tests/Util.hs --- a/test/Tests/Util.hs +++ b/test/Tests/Util.hs @@ -3,16 +3,17 @@ , print_ , getConnection , getSession - , getInitialLoad + , getTeams , createChannel , deleteChannel , joinChannel , leaveChannel - , getMoreChannels +-- , getMoreChannels , getChannels , getChannelMembers , getUserByName , getConfig + , getClientConfig , saveConfig , teamAddUser , reportJSONExceptions @@ -24,6 +25,7 @@ , createTeam , findChannel , connectFromConfig + , getMe -- * Testing Websocket Events , expectWSEvent @@ -38,18 +40,20 @@ , isNewUserEvent , isChannelCreatedEvent , isChannelDeleteEvent + , isAddedToTeam , isUserJoin , isUserLeave + , isViewedChannel , wsHas , (&&&) ) where -import qualified Data.Aeson as A import qualified Control.Exception as E import qualified Control.Concurrent.STM as STM import Control.Concurrent (forkIO) import Control.Concurrent.MVar +import qualified Data.Foldable as F import Data.Monoid ((<>)) import qualified Data.Sequence as Seq import qualified Data.Text as T @@ -57,15 +61,18 @@ import Test.Tasty.HUnit (testCaseSteps) import Control.Monad.State.Lazy import System.Timeout (timeout) -import qualified Data.HashMap.Lazy as HM -import Network.Mattermost +import Network.Mattermost (ConnectionData) +import Network.Mattermost.Endpoints +import Network.Mattermost.Types +import Network.Mattermost.Types.Config import Network.Mattermost.WebSocket import Network.Mattermost.Exceptions +import Network.Mattermost.Util import Tests.Types -mmTestCase :: String -> Config -> TestM () -> TestTree +mmTestCase :: String -> TestConfig -> TestM () -> TestTree mmTestCase testName cfg act = testCaseSteps testName $ \prnt -> do cd <- connectFromConfig cfg @@ -101,7 +108,7 @@ putStrLn badJson E.throwIO e -adminAccount :: Config -> UsersCreate +adminAccount :: TestConfig -> UsersCreate adminAccount cfg = UsersCreate { usersCreateEmail = configEmail cfg , usersCreatePassword = configPassword cfg @@ -113,7 +120,7 @@ createAdminAccount = do cd <- getConnection cfg <- gets tsConfig - u <- liftIO $ mmUsersCreate cd $ adminAccount cfg + u <- liftIO $ mmInitialUser cd $ adminAccount cfg print_ "Admin Account created" return u @@ -196,6 +203,20 @@ isNewUserEvent u = hasWSEventType WMNewUser &&& forUser u +isViewedChannel :: WebsocketEvent -> Bool +isViewedChannel = hasWSEventType WMChannelViewed + +-- | Is the websocket event indicating that a new user was added to the +-- team +isAddedToTeam :: User + -- ^ The user that was added + -> Team + -- ^ The team to which the user was added + -> WebsocketEvent + -> Bool +isAddedToTeam u _ = + hasWSEventType WMAddedToTeam &&& forUser u + isChannelCreatedEvent :: Channel -> WebsocketEvent -> Bool @@ -282,14 +303,14 @@ createAccount :: UsersCreate -> TestM User createAccount account = do session <- getSession - newUser <- liftIO $ mmUsersCreateWithSession session account + newUser <- liftIO $ mmCreateUser account session print_ $ "account created for " <> (T.unpack $ usersCreateUsername account) return newUser createTeam :: TeamsCreate -> TestM Team createTeam tc = do session <- getSession - team <- liftIO $ mmCreateTeam session tc + team <- liftIO $ mmCreateTeam tc session print_ $ "Team created: " <> (T.unpack $ teamsCreateName tc) return team @@ -307,7 +328,7 @@ in error $ "Expected to find channel by name " <> show name <> " but got " <> show namePairs -connectFromConfig :: Config -> IO ConnectionData +connectFromConfig :: TestConfig -> IO ConnectionData connectFromConfig cfg = initConnectionDataInsecure (configHostname cfg) (fromIntegral (configPort cfg)) @@ -322,73 +343,95 @@ Just s -> return s Nothing -> error "Expected authentication token but none was present" -getInitialLoad :: TestM InitialLoad -getInitialLoad = do +getTeams :: TestM (Seq.Seq Team) +getTeams = do session <- getSession - liftIO $ mmGetInitialLoad session + liftIO $ mmGetUsersTeams UserMe session +getMe :: TestM User +getMe = do + session <- getSession + liftIO $ mmGetUser UserMe session + getUserByName :: T.Text -> TestM (Maybe User) getUserByName uname = do session <- getSession - allUserMap <- liftIO $ mmGetUsers session 0 10000 + let query = defaultUserQuery + { userQueryPage = Just 0 + , userQueryPerPage = Just 10000 + } + allUserMap <- liftIO $ mmGetUsers query session -- Find the user matching the username and get its ID - let matches = HM.filter matchingUser allUserMap + let matches = Seq.filter matchingUser allUserMap matchingUser u = userUsername u == uname - case HM.size matches == 1 of - False -> return Nothing - True -> do - let uId = fst $ HM.toList matches !! 0 + case Seq.viewl matches of + user Seq.:< _ -> do + let uId = userId user -- Then load the User record - Just <$> (liftIO $ mmGetUser session uId) - -createChannel :: Team -> MinChannel -> TestM Channel -createChannel team mc = do - session <- getSession - liftIO $ mmCreateChannel session (teamId team) mc + Just <$> (liftIO $ mmGetUser (UserById uId) session) + _ -> return Nothing -deleteChannel :: Team -> Channel -> TestM () -deleteChannel team ch = do +createChannel :: MinChannel -> TestM Channel +createChannel mc = do session <- getSession - liftIO $ mmDeleteChannel session (teamId team) (channelId ch) + liftIO $ mmCreateChannel mc session -joinChannel :: Team -> Channel -> TestM () -joinChannel team chan = do +deleteChannel :: Channel -> TestM () +deleteChannel ch = do session <- getSession - liftIO $ mmJoinChannel session (teamId team) (channelId chan) + liftIO $ mmDeleteChannel (channelId ch) session -getMoreChannels :: Team -> TestM Channels -getMoreChannels team = do +joinChannel :: User -> Channel -> TestM () +joinChannel user chan = do session <- getSession - liftIO $ mmGetMoreChannels session (teamId team) 0 100 + let member = MinChannelMember + { minChannelMemberUserId = userId user + , minChannelMemberChannelId = channelId chan + } + liftIO $ void $ mmAddUser (channelId chan) member session -leaveChannel :: Team -> Channel -> TestM () -leaveChannel team chan = do +leaveChannel :: Channel -> TestM () +leaveChannel chan = do session <- getSession - liftIO $ mmLeaveChannel session (teamId team) (channelId chan) + liftIO $ mmRemoveUserFromChannel (channelId chan) UserMe session -getChannelMembers :: Team -> Channel -> TestM [User] -getChannelMembers team chan = do +getChannelMembers :: Channel -> TestM [User] +getChannelMembers chan = do session <- getSession - (snd <$>) <$> HM.toList <$> - (liftIO $ mmGetChannelMembers session (teamId team) (channelId chan) 0 10000) + let query = defaultUserQuery + { userQueryPage = Just 0 + , userQueryPerPage = Just 10000 + , userQueryInChannel = Just (channelId chan) + } + F.toList <$> (liftIO $ mmGetUsers query session) getChannels :: Team -> TestM Channels getChannels team = do session <- getSession - liftIO $ mmGetChannels session (teamId team) + liftIO $ mmGetPublicChannels (teamId team) Nothing Nothing session -getConfig :: TestM A.Value +getConfig :: TestM ServerConfig getConfig = do session <- getSession - liftIO $ mmGetConfig session + liftIO $ mmGetConfiguration session -saveConfig :: A.Value -> TestM () +getClientConfig :: TestM ClientConfig -- A.Value +getClientConfig = do + session <- getSession + liftIO $ mmGetClientConfiguration (Just (T.pack "old")) session + +saveConfig :: ServerConfig -> TestM () saveConfig newConfig = do session <- getSession - liftIO $ mmSaveConfig session newConfig + liftIO $ void $ mmUpdateConfiguration newConfig session teamAddUser :: Team -> User -> TestM () teamAddUser team user = do session <- getSession - liftIO $ mmTeamAddUser session (teamId team) (userId user) + let member = TeamMember + { teamMemberUserId = userId user + , teamMemberTeamId = teamId team + , teamMemberRoles = T.empty + } + liftIO $ void $ mmAddUserToTeam (teamId team) member session