mattermost-api 50200.1.3 → 50200.1.4
raw patch · 4 files changed
+25/−26 lines, 4 filesdep +http-mediaPVP ok
version bump matches the API change (PVP)
Dependencies added: http-media
API changes (from Hackage documentation)
Files
- CHANGELOG.md +7/−0
- mattermost-api.cabal +2/−1
- src/Network/Mattermost.hs +3/−14
- src/Network/Mattermost/Connection.hs +13/−11
CHANGELOG.md view
@@ -1,3 +1,10 @@+50200.1.4+=========++Bug fixes:+ * Content-type headers in server API responses are now parsed correctly+ in the presence of media type parameters as per RFC 2616.+ 50200.1.3 =========
mattermost-api.cabal view
@@ -1,5 +1,5 @@ name: mattermost-api-version: 50200.1.3+version: 50200.1.4 synopsis: Client API for Mattermost chat system description: Client API for Mattermost chat system. Mattermost is a@@ -60,6 +60,7 @@ , bytestring , process , HTTP+ , http-media , network-uri , text , time
src/Network/Mattermost.hs view
@@ -130,7 +130,7 @@ import qualified Data.ByteString.Lazy.Char8 as BL import Network.HTTP.Headers ( HeaderName(..) , mkHeader- , lookupHeader )+ ) import Network.HTTP.Base ( Request(..) , RequestMethod(..) , defaultUserAgent@@ -154,7 +154,7 @@ import qualified Data.Text as T import Control.Arrow ( left ) -import Network.Mattermost.Connection()+import Network.Mattermost.Connection (assertJSONResponse, mmGetHeader) import Network.Mattermost.Exceptions import Network.Mattermost.Util import Network.Mattermost.Types.Base@@ -174,12 +174,7 @@ -- 'application/json' response, or if the parsing failed mmGetJSONBody :: FromJSON t => String -> Response_String -> IO (Value, t) mmGetJSONBody label rsp = do- contentType <- mmGetHeader rsp HdrContentType- assertE (contentType ~= "application/json")- (ContentTypeException- ("mmGetJSONBody: " ++ label ++ ": " ++- "Expected content type 'application/json'" ++- " found " ++ contentType))+ assertJSONResponse rsp let value = left (\s -> JSONDecodeException ("mmGetJSONBody: " ++ label ++ ": " ++ s) (rspBody rsp))@@ -191,12 +186,6 @@ x <- rawVal y <- value return (x, y)---- | Grab a header from the response, failing if it isn't present-mmGetHeader :: Response_String -> HeaderName -> IO String-mmGetHeader rsp hdr =- noteE (lookupHeader hdr (rspHeaders rsp))- (HeaderNotFoundException ("mmGetHeader: " ++ show hdr)) -- API calls
src/Network/Mattermost/Connection.hs view
@@ -5,6 +5,7 @@ import Control.Arrow (left) import Control.Exception (throwIO, IOException, try, throwIO) import Control.Monad (when)+import Data.Maybe (isJust) import Data.Monoid ((<>)) import Data.Pool (destroyAllResources) import qualified Data.Aeson as A@@ -16,6 +17,7 @@ import qualified Network.HTTP.Base as HTTP import qualified Network.HTTP.Headers as HTTP import qualified Network.HTTP.Stream as HTTP+import qualified Network.HTTP.Media as HTTPM import qualified Network.URI as URI import System.IO.Error (isEOFError) @@ -30,16 +32,21 @@ noteE (URI.parseRelativeReference str) (URIParseException ("mmPath: " ++ str)) +assertJSONResponse :: HTTP.Response_String -> IO ()+assertJSONResponse rsp = do+ contentType <- mmGetHeader rsp HTTP.HdrContentType + let allowedTypes = [B.pack "application/json"]+ assertE (isJust $ HTTPM.matchContent allowedTypes $ B.pack contentType)+ (ContentTypeException+ ("Expected content type 'application/json';" +++ " found " ++ contentType))+ -- | 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))+ assertJSONResponse rsp hoistE $ left (\s -> JSONDecodeException s (HTTP.rspBody rsp)) (A.eitherDecode (BL.pack (HTTP.rspBody rsp)))@@ -65,12 +72,7 @@ -- '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))+ assertJSONResponse rsp let value = left (\s -> JSONDecodeException ("mmGetJSONBody: " ++ label ++ ": " ++ s) (HTTP.rspBody rsp))