mattermost-api 50200.1.4 → 50200.2.0
raw patch · 7 files changed
+194/−63 lines, 7 filesdep +split
Dependencies added: split
Files
- CHANGELOG.md +17/−0
- mattermost-api.cabal +3/−1
- src/Network/Mattermost/Endpoints.hs +62/−50
- src/Network/Mattermost/Proxy.hs +84/−0
- src/Network/Mattermost/Types.hs +4/−4
- src/Network/Mattermost/Util.hs +23/−7
- src/Network/Mattermost/WebSocket.hs +1/−1
CHANGELOG.md view
@@ -1,3 +1,20 @@++50200.2.0+=========++API changes:+ * Added `Network.Mattermost.Endpoints.mmDeleteReaction` to delete+ reactions.+ * Added `Network.Mattermost.Endpoints.mmPostReaction` to add reactions.+ * Added an `Emoji` data type and functions for custom emoji search and listing:+ * `Network.Mattermost.Endpoints.mmSearchCustomEmoji`+ * `Network.Mattermost.Endpoints.mmGetListOfCustomEmoji`++New features:+ * Add support for SOCKS proxies via standard environment variables+ `HTTPS_PROXY` and `ALL_PROXY`.+ * Support `NO_PROXY` to blacklist proxied hosts.+ 50200.1.4 =========
mattermost-api.cabal view
@@ -1,5 +1,5 @@ name: mattermost-api-version: 50200.1.4+version: 50200.2.0 synopsis: Client API for Mattermost chat system description: Client API for Mattermost chat system. Mattermost is a@@ -34,6 +34,7 @@ Network.Mattermost.Lenses Network.Mattermost.Logging Network.Mattermost.Util+ Network.Mattermost.Proxy Network.Mattermost.WebSocket Network.Mattermost.WebSocket.Types Network.Mattermost.Version@@ -73,6 +74,7 @@ , microlens-th -- Only here to make debugging easier , pretty-show+ , split hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall -Wcompat
src/Network/Mattermost/Endpoints.hs view
@@ -415,13 +415,26 @@ -- 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+-- | Search custom emoji using an infix match. (Does not support the+-- prefix_only option).+--+-- /Permissions/: Must be authenticated.+mmSearchCustomEmoji :: T.Text -> Session -> IO [Emoji]+mmSearchCustomEmoji searchString =+ let body = A.object [ "term" A..= searchString+ ]+ in inPost (printf "/emoji/search") (jsonBody body) 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 =+ let qs = mkQueryString [ sequence ("page", fmap show page)+ , sequence ("per_page", fmap show perPage)+ ]+ in inGet (printf "/emoji?%s" qs) noBody jsonResponse+ -- -- | Get some metadata for a custom emoji. -- -- -- -- /Permissions/: Must be authenticated.@@ -844,11 +857,17 @@ mmGetReactionsForPost postId = inGet (printf "/posts/%s/reactions" postId) noBody jsonResponse --- mmPostReaction :: Session -> IO ()--- mmPostReaction =--- inPost (printf "/reactions") (jsonBody ()) noResponse-+mmPostReaction :: PostId -> UserId -> T.Text -> Session -> IO ()+mmPostReaction postId userId reac =+ let body = A.object [ "user_id" A..= userId+ , "post_id" A..= postId+ , "emoji_name" A..= reac+ ]+ in inPost (printf "/reactions") (jsonBody body) noResponse +mmDeleteReaction :: PostId -> UserId -> T.Text -> Session -> IO ()+mmDeleteReaction postId userId reac =+ inDelete (printf "/users/%s/posts/%s/reactions/%s" userId postId reac) noBody noResponse -- * SAML @@ -1346,7 +1365,8 @@ mmSearchUsers body = inPost "/users/search" (jsonBody body) jsonResponse --- | Get a list of users based on a provided list of usernames.+-- | Get a list of users based on a provided list of usernames. The+-- input usernames must be usernames without sigils (@). -- -- /Permissions/: Requires an active session but no other permissions. mmGetUsersByUsernames :: (Seq Text) -> Session -> IO (Seq User)@@ -2060,47 +2080,39 @@ -- , "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 { .. }+data Emoji = Emoji+ { emojiCreatorId :: Text+ , emojiName :: Text+ -- ^ The name of the emoji+ , emojiDeleteAt :: Integer+ -- ^ The time at which the emoji was deleted.+ , emojiUpdateAt :: Integer+ -- ^ The time at which the emoji was updated.+ , emojiCreateAt :: Integer+ -- ^ The time at which the emoji was made+ , emojiId :: Text+ -- ^ The ID of the emoji+ } deriving (Read, Show, Eq) --- 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--- ]+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
+ src/Network/Mattermost/Proxy.hs view
@@ -0,0 +1,84 @@+module Network.Mattermost.Proxy+ ( Scheme(..)+ , ProxyType(..)+ , proxyForScheme+ , proxyHostPermitted+ )+where++import Control.Applicative ((<|>))+import Data.Char (toLower)+import Data.List (isPrefixOf)+import Data.List.Split (splitOn)+import Network.URI (parseURI, uriRegName, uriPort, uriAuthority, uriScheme)+import System.Environment (getEnvironment, lookupEnv)+import Text.Read (readMaybe)++data Scheme = HTTPS+ deriving (Eq, Show)++data ProxyType = Socks+ deriving (Eq, Show)++newtype NormalizedEnv = NormalizedEnv [(String, String)]++proxyHostPermitted :: String -> IO Bool+proxyHostPermitted hostname = do+ result <- lookupEnv "NO_PROXY"+ case result of+ Nothing -> return True+ Just blacklist -> do+ let patterns = splitOn "," blacklist+ hostnameParts = reverse $ splitOn "." hostname+ isBlacklisted = any matches patterns+ matches pat =+ let patParts = reverse $ splitOn "." pat+ go [] [] = True+ go [] _ = False+ go _ [] = False+ go (p:pParts) hParts =+ if p == "*"+ then True+ else case hParts of+ [] -> False+ (h:hTail) -> p == h && go pParts hTail+ in go patParts hostnameParts+ return $ not isBlacklisted++proxyForScheme :: Scheme -> IO (Maybe (ProxyType, String, Int))+proxyForScheme s = do+ env <- getEnvironment+ let proxy = case s of+ HTTPS -> httpsProxy+ return $ proxy $ normalizeEnv env++httpsProxy :: NormalizedEnv -> Maybe (ProxyType, String, Int)+httpsProxy env = proxyFor "HTTPS_PROXY" env <|>+ proxyFor "ALL_PROXY" env++proxyFor :: String -> NormalizedEnv -> Maybe (ProxyType, String, Int)+proxyFor name env = do+ val <- envLookup name env+ uri <- parseURI val++ let scheme = uriScheme uri+ getProxyType = isSocks+ isSocks = if "socks" `isPrefixOf` scheme+ then return Socks+ else Nothing++ ty <- getProxyType+ auth <- uriAuthority uri+ port <- readMaybe (drop 1 $ uriPort auth)+ return (ty, uriRegName auth, port)++normalizeEnv :: [(String, String)] -> NormalizedEnv+normalizeEnv env =+ let norm (k, v) = (normalizeVar k, v)+ in NormalizedEnv $ norm <$> env++normalizeVar :: String -> String+normalizeVar = (toLower <$>)++envLookup :: String -> NormalizedEnv -> Maybe String+envLookup v (NormalizedEnv env) = lookup (normalizeVar v) env
src/Network/Mattermost/Types.hs view
@@ -80,8 +80,8 @@ } -- | Plaintext HTTP instead of a TLS connection.-mkConnectionDataInsecure :: Hostname -> Port -> Pool.Pool MMConn -> ConnectionContext -> ConnectionData-mkConnectionDataInsecure host port pool ctx = ConnectionData+mkConnectionDataInsecure :: Hostname -> Port -> ConnectionContext -> Pool.Pool MMConn -> ConnectionData+mkConnectionDataInsecure host port ctx pool = ConnectionData { cdHostname = host , cdPort = port , cdConnectionCtx = ctx@@ -94,7 +94,7 @@ createPool :: Hostname -> Port -> ConnectionContext -> ConnectionPoolConfig -> Bool -> IO (Pool.Pool MMConn) createPool host port ctx cpc secure =- Pool.createPool (mkConnection ctx host port secure) closeMMConn+ Pool.createPool (mkConnection ctx host port secure >>= newMMConn) closeMMConn (cpStripesCount cpc) (cpIdleConnTimeout cpc) (cpMaxConnCount cpc) initConnectionData :: Hostname -> Port -> ConnectionPoolConfig -> IO ConnectionData@@ -107,7 +107,7 @@ initConnectionDataInsecure host port cpc = do ctx <- initConnectionContext pool <- createPool host port ctx cpc False- return (mkConnectionDataInsecure host port pool ctx)+ return (mkConnectionDataInsecure host port ctx pool) destroyConnectionData :: ConnectionData -> IO () destroyConnectionData = Pool.destroyAllResources . cdConnectionPool
src/Network/Mattermost/Util.hs view
@@ -22,12 +22,14 @@ import Network.Connection ( Connection , ConnectionContext , ConnectionParams(..)+ , ProxySettings(..) , TLSSettings(..) , connectionGet , connectTo ) import Network.Mattermost.Types.Base import Network.Mattermost.Types.Internal+import Network.Mattermost.Proxy -- | This unwraps a 'Maybe' value, throwing a provided exception -- if the value is 'Nothing'.@@ -64,16 +66,30 @@ -- | Creates a connection from a 'ConnectionData' value, returning it. It -- is the user's responsibility to close this appropriately.-mkConnection :: ConnectionContext -> Hostname -> Port -> Bool -> IO MMConn-mkConnection connectionCtx hostname port useTLS = do- newMMConn =<< (connectTo connectionCtx $ ConnectionParams- { connectionHostname = T.unpack hostname+--+-- This function respects ALL_PROXY, HTTP_PROXY, HTTPS_PROXY, and+-- NO_PROXY environment variables for controlling whether the resulting+-- connection uses a proxy. However, note:+--+-- * Only SOCKS version 4 and 5 proxies are supported using socks4://+-- and socks5:// URIs, and+-- * No proxy authentication is supported.+mkConnection :: ConnectionContext -> Hostname -> Port -> Bool -> IO Connection+mkConnection ctx host port secure = do+ proxy' <- if secure then proxyForScheme HTTPS else return Nothing+ canUseProxy <- proxyHostPermitted (T.unpack host)+ let proxy = if canUseProxy then proxy' else Nothing+ connectTo ctx $ ConnectionParams+ { connectionHostname = T.unpack host , connectionPort = fromIntegral port- , connectionUseSecure = if useTLS+ , connectionUseSecure = if secure then Just (TLSSettingsSimple False False False) else Nothing- , connectionUseSocks = Nothing- })+ , connectionUseSocks = do+ (ty, cHost, cPort) <- proxy+ case ty of+ Socks -> return $ SockSettingsSimple cHost (toEnum cPort)+ } -- | Get exact count of bytes from a connection. --
src/Network/Mattermost/WebSocket.hs view
@@ -111,7 +111,7 @@ -> IO () mmWithWebSocket (Session cd (Token tk)) recv body = do con <- mkConnection (cdConnectionCtx cd) (cdHostname cd) (cdPort cd) (cdUseTLS cd)- stream <- connectionToStream $ fromMMConn con+ stream <- connectionToStream con health <- newIORef 0 myId <- myThreadId let doLog = runLogger cd "websocket"