matrix-client 0.1.8.0 → 0.1.9.0

raw patch · 5 files changed

+47/−36 lines, 5 filesdep −aeson-casingPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: aeson-casing

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• matrix-client.cabal +1/−2
• src/Network/Matrix/Client.hs +3/−7
• src/Network/Matrix/Internal.hs +37/−24
• src/Network/Matrix/Room.hs +2/−3

@@ -1,5 +1,9 @@ # Changelog +## 0.1.9.0++- Add support for login API v3 [#50](https://github.com/softwarefactory-project/matrix-client-haskell/pull/50)+ ## 0.1.8.0  - Add support for reaction [#48](https://github.com/softwarefactory-project/matrix-client-haskell/pull/48)

@@ -1,6 +1,6 @@ cabal-version: 2.4 name: matrix-client-version: 0.1.8.0+version: 0.1.9.0 synopsis: A matrix client library description:   Matrix client is a library to interface with https://matrix.org.@@ -32,7 +32,6 @@ common common-options   build-depends:     aeson >=1.0.0.0 && <3,-    aeson-casing >=0.2.0.0 && <0.3.0.0,     base >=4.11.0.0 && <5,    ghc-options:

@@ -141,8 +141,6 @@ import Control.Monad (mzero) import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Aeson (FromJSON (..), ToJSON (..), Value (Object, String), encode, genericParseJSON, genericToJSON, object, withObject, withText, (.:), (.:?), (.=))-import qualified Data.Aeson as Aeson-import Data.Aeson.Casing (aesonPrefix, snakeCase) import Data.Aeson.Types (Parser) import Data.Bifunctor (bimap) import qualified Data.ByteString as B@@ -177,8 +175,9 @@     }  mkLoginRequest :: LoginCredentials -> IO HTTP.Request-mkLoginRequest LoginCredentials{..} =-    mkLoginRequest' lBaseUrl lDeviceId lInitialDeviceDisplayName lUsername lLoginSecret+mkLoginRequest LoginCredentials{..} = let+        enableRefreshTokens = False+    in mkLoginRequest' lBaseUrl lDeviceId lInitialDeviceDisplayName enableRefreshTokens lUsername lLoginSecret  -- | 'login' allows you to generate a session token. login :: LoginCredentials -> IO ClientSession@@ -925,9 +924,6 @@ -- | A filter that should match nothing eventFilterAll :: EventFilter eventFilterAll = defaultEventFilter{efLimit = Just 0, efNotTypes = Just ["*"]}--aesonOptions :: Aeson.Options-aesonOptions = (aesonPrefix snakeCase){Aeson.omitNothingFields = True}  instance ToJSON EventFilter where     toJSON = genericToJSON aesonOptions

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NumericUnderscores #-}@@ -7,6 +8,7 @@ -- | This module contains low-level HTTP utility module Network.Matrix.Internal where +import GHC.Generics (Generic) import Control.Concurrent (threadDelay) import Control.Exception (Exception, throw, throwIO) import Control.Monad (mzero, unless, void)@@ -14,7 +16,7 @@ import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Retry (RetryStatus (..)) import qualified Control.Retry as Retry-import Data.Aeson (FromJSON (..), FromJSONKey (..), Value (Object), eitherDecode, encode, object, withObject, (.:), (.:?), (.=))+import Data.Aeson (FromJSON (..), FromJSONKey (..), Value (Object), eitherDecode, encode, object, (.:), (.=), defaultOptions, Options (..), camelTo2, genericParseJSON) import Data.ByteString.Lazy (ByteString, toStrict) import Data.Hashable (Hashable) import Data.Maybe (catMaybes, fromMaybe)@@ -27,6 +29,7 @@ import Network.HTTP.Types.Status (statusIsSuccessful) import System.Environment (getEnv) import System.IO (stderr)+import Data.Char (isUpper)  newtype MatrixToken = MatrixToken Text newtype Username = Username {username :: Text}@@ -34,20 +37,18 @@ newtype InitialDeviceDisplayName = InitialDeviceDisplayName {initialDeviceDisplayName :: Text} data LoginSecret = Password Text | Token Text +-- https://spec.matrix.org/v1.17/client-server-api/#post_matrixclientv3login data LoginResponse = LoginResponse-    { lrUserId :: Text-    , lrAccessToken :: Text-    , lrHomeServer :: Maybe Text+    { lrAccessToken :: Text     , lrDeviceId :: Text-    }+    , lrExpiresInMs :: Maybe Int    -- Added in v1.3+    , lrHomeServer :: Maybe Text+    , lrRefreshToken :: Maybe Text  -- Added in v1.3+    , lrUserId :: Text+    } deriving (Generic, Show)  instance FromJSON LoginResponse where-    parseJSON = withObject "LoginResponse" $ \v -> do-        userId' <- v .: "user_id"-        accessToken' <- v .: "access_token"-        homeServer' <- v .:? "home_server"-        deviceId' <- v .: "device_id"-        pure $ LoginResponse userId' accessToken' homeServer' deviceId'+    parseJSON = genericParseJSON aesonOptions  getTokenFromEnv ::     -- | The envirnoment variable name@@ -85,9 +86,10 @@     authHeaders =         [("Authorization", "Bearer " <> encodeUtf8 token) | auth] -mkLoginRequest' :: Text -> Maybe DeviceId -> Maybe InitialDeviceDisplayName -> Username -> LoginSecret -> IO HTTP.Request-mkLoginRequest' baseUrl did idn (Username name) secret' = do-    let path = "/_matrix/client/r0/login"+-- https://spec.matrix.org/v1.17/client-server-api/#post_matrixclientv3login+mkLoginRequest' :: Text -> Maybe DeviceId -> Maybe InitialDeviceDisplayName -> Bool -> Username -> LoginSecret -> IO HTTP.Request+mkLoginRequest' baseUrl did idn enableRefreshTokens (Username name) secret' = do+    let path = "/_matrix/client/v3/login"     initRequest <- HTTP.parseUrlThrow (unpack $ baseUrl <> path)      let (secretKey, secret, secretType) = case secret' of@@ -100,6 +102,7 @@                     object $                         [ "identifier" .= object ["type" .= ("m.id.user" :: Text), "user" .= name]                         , secretKey .= secret+                        , "refresh_token" .= enableRefreshTokens    -- Added in v1.3                         , "type" .= (secretType :: Text)                         ]                             <> catMaybes@@ -111,7 +114,7 @@  mkLogoutRequest' :: Text -> MatrixToken -> IO HTTP.Request mkLogoutRequest' baseUrl (MatrixToken token) = do-    let path = "/_matrix/client/r0/logout"+    let path = "/_matrix/client/v3/logout"     initRequest <- HTTP.parseUrlThrow (unpack $ baseUrl <> path)     let headers = [("Authorization", encodeUtf8 $ "Bearer " <> token)]     pure $ initRequest{HTTP.method = "POST", HTTP.requestHeaders = headers}@@ -145,20 +148,15 @@     , meError :: Text     , meRetryAfterMS :: Maybe Int     }-    deriving (Show, Eq)+    deriving (Generic, Show, Eq) +instance FromJSON MatrixError where+    parseJSON = genericParseJSON aesonOptions+ data MatrixException = MatrixRateLimit deriving (Show)  instance Exception MatrixException -instance FromJSON MatrixError where-    parseJSON (Object v) =-        MatrixError-            <$> v .: "errcode"-            <*> v .: "error"-            <*> v .:? "retry_after_ms"-    parseJSON _ = mzero- -- | 'MatrixIO' is a convenient type alias for server response type MatrixIO a = MatrixM IO a @@ -211,3 +209,18 @@  retry :: (MonadIO m, MonadMask m) => MatrixM m a -> MatrixM m a retry = retryWithLog 7 (liftIO . hPutStrLn stderr)++-------------------------------------------------------------------------------+-- Utils++aesonOptions :: Options+aesonOptions = defaultOptions+    { fieldLabelModifier = camelTo2 '_' . dropPrefix+    , omitNothingFields = True+    }+    where+        -- drops lower case prefix+        dropPrefix :: String -> String+        dropPrefix []                 = []+        dropPrefix (x:xs) | isUpper x = x : xs+                          | otherwise = dropPrefix xs

@@ -4,9 +4,8 @@ -- | Matrix room related data types module Network.Matrix.Room (RoomCreatePreset (..), RoomCreateRequest (..)) where +import Network.Matrix.Internal (aesonOptions) import Data.Aeson (ToJSON (..), Value (..), genericToJSON)-import qualified Data.Aeson as Aeson-import Data.Aeson.Casing (aesonPrefix, snakeCase) import Data.Text (Text) import GHC.Generics (Generic) @@ -32,4 +31,4 @@     deriving (Eq, Show, Generic)  instance ToJSON RoomCreateRequest where-    toJSON = genericToJSON $ (aesonPrefix snakeCase){Aeson.omitNothingFields = True}+    toJSON = genericToJSON aesonOptions