mattermost-api 50200.4.0 → 50200.5.0
raw patch · 19 files changed
+96/−37 lines, 19 filesdep +modern-uri
Dependencies added: modern-uri
Files
- CHANGELOG.md +13/−0
- README.md +13/−11
- examples/Config.hs +1/−0
- examples/GetChannels.hs +2/−1
- examples/GetPosts.hs +2/−2
- examples/GetTeams.hs +2/−2
- examples/GetWebsocketConnection.hs +3/−3
- examples/LocalConfig.hs +1/−0
- examples/MakePost.hs +2/−2
- examples/ShowRawEvents.hs +3/−3
- mattermost-api.cabal +2/−1
- src/Network/Mattermost/Connection.hs +3/−2
- src/Network/Mattermost/Endpoints.hs +7/−0
- src/Network/Mattermost/Types.hs +6/−5
- src/Network/Mattermost/Types/Config.hs +18/−0
- src/Network/Mattermost/Types/Internal.hs +2/−0
- src/Network/Mattermost/Util.hs +11/−1
- src/Network/Mattermost/WebSocket.hs +2/−1
- test/Tests/Util.hs +3/−3
CHANGELOG.md view
@@ -1,3 +1,16 @@++50200.5.0+=========++API changes:+ * Added support for making connections to Mattermost servers that use+ non-root URL paths for their API endpoints. This change adds a new+ field, `cdUrlPath`, to the `ConnectionData` type. It also added a URL+ path argument of type `Text` to `mkConnectionData`. (Thanks Isaiah+ Mindich)+ * Added `Network.Mattermost.Endpoints.mmGetLimitedClientConfiguration`+ (thanks Eric Mertens)+ 50200.4.0 =========
README.md view
@@ -1,26 +1,29 @@ [](https://hackage.haskell.org/package/mattermost-api) [](https://travis-ci.org/matterhorn-chat/mattermost-api) # mattermost-api-Client side API for communicating with a Mattermost server, in Haskell. +Client-side API for communicating with a Mattermost server, written in+Haskell.+ # Testing -We use the MaterMost docker image for detecting changes in the API. See+We use the MatterMost docker image for detecting changes in the API. See `.travis.yml` or the [Mattermost docs](https://docs.mattermost.com/install/docker-local-machine.html#one-line-docker-install) for the details. -If you are testing your changes locally during development, you will want to run-the script `./test/local_test_mm.sh`.+If you are testing your changes locally during development, you will+want to run the script `./test/local_test_mm.sh`. -**Note: The `local_test_mm.sh` script will stop and remove a docker container-named `mattermost-preview`.**+**Note: The `local_test_mm.sh` script will stop and remove a docker+container named `mattermost-preview`.** -**Note: The tests can only be run once against a given Mattermost instance. This-is because the scripts currently assume they can create an initial admin user.**+**Note: The tests can only be run once against a given Mattermost+instance. This is because the scripts currently assume they can create+an initial admin user.** -**Note: The scripts assume the instance is reachable on `localhost:8065` over plain-HTTP.**+**Note: The scripts assume the instance is reachable on `localhost:8065`+over plain HTTP.** For use in production we use TLS, but for testing purposes we avoid the certificate setup.@@ -33,4 +36,3 @@ The short version is that in `ABBCC.X.Y`, the `ABBCC` corresponds to Mattermost server version `A.BB.CC` and the `X.Y` portion of the version string corresponds to the version of `mattermost-api` package releases.-
examples/Config.hs view
@@ -10,4 +10,5 @@ , configTeam :: UserText , configPort :: Int , configPassword :: Text+ , configPath :: Text }
examples/GetChannels.hs view
@@ -22,7 +22,8 @@ main = do config <- getConfig -- see LocalConfig import cd <- initConnectionData (configHostname config)- (fromIntegral (configPort config)) defaultConnectionPoolConfig+ (fromIntegral (configPort config)) (configPath config)+ (ConnectHTTPS True) defaultConnectionPoolConfig let login = Login { username = configUsername config , password = configPassword config
examples/GetPosts.hs view
@@ -98,8 +98,8 @@ opts <- foldl (>>=) (return defaultOptions) actions config <- getConfig -- see LocalConfig import- cd' <- initConnectionData (configHostname config) (fromIntegral (configPort config))- defaultConnectionPoolConfig+ cd' <- initConnectionData (configHostname config) (fromIntegral (configPort config)) (configPath config)+ (ConnectHTTPS True) defaultConnectionPoolConfig let login = Login { username = configUsername config , password = configPassword config }
examples/GetTeams.hs view
@@ -18,8 +18,8 @@ main :: IO () main = do config <- getConfig -- see LocalConfig import- cd <- initConnectionData (configHostname config) (fromIntegral (configPort config))- defaultConnectionPoolConfig+ cd <- initConnectionData (configHostname config) (fromIntegral (configPort config)) (configPath config)+ (ConnectHTTPS True) defaultConnectionPoolConfig let login = Login { username = configUsername config , password = configPassword config
examples/GetWebsocketConnection.hs view
@@ -53,8 +53,8 @@ opts <- foldl (>>=) (return defaultOptions) actions config <- getConfig -- see LocalConfig import- cd <- initConnectionData (configHostname config) (fromIntegral (configPort config))- defaultConnectionPoolConfig+ cd <- initConnectionData (configHostname config) (fromIntegral (configPort config)) (configPath config)+ (ConnectHTTPS True) defaultConnectionPoolConfig let login = Login { username = configUsername config , password = configPassword config@@ -67,7 +67,7 @@ mmWithWebSocket session printEvent checkForExit -printEvent :: Either String WebsocketEvent -> IO ()+printEvent :: Either String (Either WebsocketActionResponse WebsocketEvent) -> IO () printEvent we = pPrint we checkForExit :: MMWebSocket -> IO ()
examples/LocalConfig.hs view
@@ -16,4 +16,5 @@ , configTeam = UserText "TEAMNAME" , configPort = 443 -- currently we only support HTTPS , configPassword = T.pack pass+ , configPath = T.empty }
examples/MakePost.hs view
@@ -74,8 +74,8 @@ opts <- foldl (>>=) (return defaultOptions) actions config <- getConfig -- see LocalConfig import- cd <- initConnectionData (configHostname config) (fromIntegral (configPort config))- defaultConnectionPoolConfig+ cd <- initConnectionData (configHostname config) (fromIntegral (configPort config)) (configPath config)+ (ConnectHTTPS True) defaultConnectionPoolConfig let login = Login { username = configUsername config , password = configPassword config
examples/ShowRawEvents.hs view
@@ -63,8 +63,8 @@ opts <- foldl (>>=) (return defaultOptions) actions config <- getConfig -- see LocalConfig import- cd <- initConnectionData (configHostname config) (fromIntegral (configPort config))- defaultConnectionPoolConfig+ cd <- initConnectionData (configHostname config) (fromIntegral (configPort config)) (configPath config)+ (ConnectHTTPS True) defaultConnectionPoolConfig let login = Login { username = configUsername config , password = configPassword config@@ -78,7 +78,7 @@ mmWithWebSocket session printEvent checkForExit -printEvent :: Either String WebsocketEvent -> IO ()+printEvent :: Either String (Either WebsocketActionResponse WebsocketEvent) -> IO () printEvent e = pPrint e checkForExit :: MMWebSocket -> IO ()
mattermost-api.cabal view
@@ -1,5 +1,5 @@ name: mattermost-api-version: 50200.4.0+version: 50200.5.0 synopsis: Client API for Mattermost chat system description: Client API for Mattermost chat system. Mattermost is a@@ -63,6 +63,7 @@ , HTTP , http-media , network-uri+ , modern-uri , text , time , unordered-containers
src/Network/Mattermost/Connection.hs view
@@ -102,7 +102,8 @@ -> B.ByteString -> IO HTTP.Response_String submitRequest cd mToken method uri payload = do- path <- mmPath ("/api/v4" ++ uri)+ path <- buildPath cd (T.pack uri)+ parsedPath <- mmPath $ T.unpack path let contentLength = B.length payload authHeader = case mToken of@@ -110,7 +111,7 @@ Just token -> [HTTP.mkHeader HTTP.HdrAuthorization ("Bearer " ++ getTokenString token)] request = HTTP.Request- { HTTP.rqURI = path+ { HTTP.rqURI = parsedPath , HTTP.rqMethod = method , HTTP.rqHeaders = authHeader <>
src/Network/Mattermost/Endpoints.hs view
@@ -1003,6 +1003,13 @@ mmGetClientConfiguration format = inGet (printf "/config/client?%s" (mkQueryString [ sequence ("format", fmap T.unpack format) ])) noBody jsonResponse +-- | Limited version of 'mmGetClientConfiguration' that doesn't need a session ID.+mmGetLimitedClientConfiguration :: ConnectionData -> IO LimitedClientConfig+mmGetLimitedClientConfiguration cd =+ doUnauthRequest cd HTTP.GET url noBody >>= jsonResponse+ where+ url = printf "/config/client?%s" (mkQueryString [sequence ("format", Just "old")])+ -- -- | Reload the configuration file to pick up on any changes made to it. -- -- -- -- /Permissions/: Must have @manage_system@ permission.
src/Network/Mattermost/Types.hs view
@@ -68,10 +68,11 @@ maybeFail p = (Just <$> p) <|> (return Nothing) -- | Creates a structure representing a connection to the server.-mkConnectionData :: Hostname -> Port -> Pool.Pool MMConn -> ConnectionType -> ConnectionContext -> ConnectionData-mkConnectionData host port pool connTy ctx = ConnectionData+mkConnectionData :: Hostname -> Port -> T.Text -> Pool.Pool MMConn -> ConnectionType -> ConnectionContext -> ConnectionData+mkConnectionData host port path pool connTy ctx = ConnectionData { cdHostname = host , cdPort = port+ , cdUrlPath = path , cdConnectionCtx = ctx , cdAutoClose = No , cdConnectionPool = pool@@ -85,11 +86,11 @@ Pool.createPool (mkConnection ctx host port connTy >>= newMMConn) closeMMConn (cpStripesCount cpc) (cpIdleConnTimeout cpc) (cpMaxConnCount cpc) -initConnectionData :: Hostname -> Port -> ConnectionType -> ConnectionPoolConfig -> IO ConnectionData-initConnectionData host port connTy cpc = do+initConnectionData :: Hostname -> Port -> T.Text -> ConnectionType -> ConnectionPoolConfig -> IO ConnectionData+initConnectionData host port path connTy cpc = do ctx <- initConnectionContext pool <- createPool host port ctx cpc connTy- return (mkConnectionData host port pool connTy ctx)+ return (mkConnectionData host port path pool connTy ctx) destroyConnectionData :: ConnectionData -> IO () destroyConnectionData = Pool.destroyAllResources . cdConnectionPool
src/Network/Mattermost/Types/Config.hs view
@@ -282,6 +282,24 @@ , clientConfigDiagnosticsEnabled :: T.Text } deriving (Read, Show, Eq) +data LimitedClientConfig = LimitedClientConfig+ { limitedClientConfigVersion :: T.Text+ , limitedClientConfigBuildNumber :: T.Text+ , limitedClientConfigBuildDate :: T.Text+ , limitedClientConfigBuildHash :: T.Text+ , limitedClientConfigBuildHashEnterprise :: T.Text+ , limitedClientConfigBuildEnterpriseReady :: T.Text+ } deriving (Read, Show, Eq)++instance A.FromJSON LimitedClientConfig where+ parseJSON = A.withObject "LimitedClientConfig" $ \o -> do+ limitedClientConfigVersion <- o A..: "Version"+ limitedClientConfigBuildNumber <- o A..: "BuildNumber"+ limitedClientConfigBuildDate <- o A..: "BuildDate"+ limitedClientConfigBuildHash <- o A..: "BuildHash"+ limitedClientConfigBuildHashEnterprise <- o A..: "BuildHashEnterprise"+ limitedClientConfigBuildEnterpriseReady <- o A..: "BuildEnterpriseReady"+ return LimitedClientConfig { .. } instance A.FromJSON ClientConfig where parseJSON = A.withObject "ClientConfig" $ \o -> do
src/Network/Mattermost/Types/Internal.hs view
@@ -18,6 +18,7 @@ import qualified Network.HTTP.Stream as HTTP import qualified Data.ByteString.Char8 as B import Network.Mattermost.Types.Base+import qualified Data.Text as T data Token = Token String deriving (Read, Show, Eq, Ord)@@ -83,6 +84,7 @@ = ConnectionData { cdHostname :: Hostname , cdPort :: Port+ , cdUrlPath :: T.Text , cdAutoClose :: AutoClose , cdConnectionPool :: Pool MMConn , cdConnectionCtx :: C.ConnectionContext
src/Network/Mattermost/Util.hs view
@@ -10,12 +10,15 @@ , withConnection , mkConnection , connectionGetExact+, buildPath ) where import Control.Exception (finally, onException) import Data.Char ( toUpper ) import qualified Data.ByteString.Char8 as B import qualified Data.Text as T+import qualified Text.URI as URI+import Data.Monoid ((<>)) import Control.Exception ( Exception , throwIO )@@ -90,7 +93,7 @@ ConnectHTTP -> Nothing ConnectHTTPS requireTrustedCert -> -- The first argument to TLSSettingsSimple is whether to- -- *disable* cert validation. If requireTrustedCert is True,+ -- /disable/ cert validation. If requireTrustedCert is True, -- we want that argument to be False to force validation. Just (TLSSettingsSimple (not requireTrustedCert) False False) , connectionUseSocks = do@@ -115,3 +118,10 @@ | otherwise = do next <- connectionGet con (n - y) loop (B.append bs next) (y + (B.length next))++-- | Build a full URI path from the path of an API endpoint+buildPath :: ConnectionData -> T.Text -> IO T.Text+buildPath cd endpoint = do+ let rawPath = "/" <> (T.dropWhile (=='/') $ cdUrlPath cd <> "/api/v4/" <> endpoint)+ uri <- URI.mkURI rawPath+ return $ URI.render uri
src/Network/Mattermost/WebSocket.hs view
@@ -162,9 +162,10 @@ ) recv val body (MMWS c health) `catch` propagate [mId, pId]+ path <- buildPath cd "/websocket" WS.runClientWithStream stream (T.unpack $ cdHostname cd)- "/api/v4/websocket"+ (T.unpack path) WS.defaultConnectionOptions { WS.connectionOnPong = onPong } [ ("Authorization", "Bearer " <> B.pack tk) ] action
test/Tests/Util.hs view
@@ -133,7 +133,7 @@ doneMVar <- gets tsDone printFunc <- gets tsPrinter void $ liftIO $ forkIO $ mmWithWebSocket session- (either printFunc (STM.atomically . STM.writeTChan chan))+ (either printFunc (either (\_ -> pure()) (STM.atomically . STM.writeTChan chan))) (const $ takeMVar doneMVar) modify $ \ts -> ts { tsSession = Just session } @@ -330,8 +330,8 @@ connectFromConfig :: TestConfig -> IO ConnectionData connectFromConfig cfg =- initConnectionDataInsecure (configHostname cfg) (fromIntegral (configPort cfg))- defaultConnectionPoolConfig+ initConnectionData (configHostname cfg) (fromIntegral (configPort cfg)) T.empty ConnectHTTP+ defaultConnectionPoolConfig getConnection :: TestM ConnectionData getConnection = gets tsConnectionData