packages feed

matrix-client (empty) → 0.1.0.0

raw patch · 11 files changed

+863/−0 lines, 11 filesdep +SHAdep +aesondep +base

Dependencies added: SHA, aeson, base, base64, bytestring, doctest, exceptions, hashable, hspec, http-client, http-client-tls, matrix-client, retry, text, time, unordered-containers

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Changelog++## 0.1.0.0 (next)++- Initial release
+ LICENSE view
@@ -0,0 +1,201 @@+                                 Apache License+                           Version 2.0, January 2004+                        http://www.apache.org/licenses/++   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++   1. Definitions.++      "License" shall mean the terms and conditions for use, reproduction,+      and distribution as defined by Sections 1 through 9 of this document.++      "Licensor" shall mean the copyright owner or entity authorized by+      the copyright owner that is granting the License.++      "Legal Entity" shall mean the union of the acting entity and all+      other entities that control, are controlled by, or are under common+      control with that entity. For the purposes of this definition,+      "control" means (i) the power, direct or indirect, to cause the+      direction or management of such entity, whether by contract or+      otherwise, or (ii) ownership of fifty percent (50%) or more of the+      outstanding shares, or (iii) beneficial ownership of such entity.++      "You" (or "Your") shall mean an individual or Legal Entity+      exercising permissions granted by this License.++      "Source" form shall mean the preferred form for making modifications,+      including but not limited to software source code, documentation+      source, and configuration files.++      "Object" form shall mean any form resulting from mechanical+      transformation or translation of a Source form, including but+      not limited to compiled object code, generated documentation,+      and conversions to other media types.++      "Work" shall mean the work of authorship, whether in Source or+      Object form, made available under the License, as indicated by a+      copyright notice that is included in or attached to the work+      (an example is provided in the Appendix below).++      "Derivative Works" shall mean any work, whether in Source or Object+      form, that is based on (or derived from) the Work and for which the+      editorial revisions, annotations, elaborations, or other modifications+      represent, as a whole, an original work of authorship. For the purposes+      of this License, Derivative Works shall not include works that remain+      separable from, or merely link (or bind by name) to the interfaces of,+      the Work and Derivative Works thereof.++      "Contribution" shall mean any work of authorship, including+      the original version of the Work and any modifications or additions+      to that Work or Derivative Works thereof, that is intentionally+      submitted to Licensor for inclusion in the Work by the copyright owner+      or by an individual or Legal Entity authorized to submit on behalf of+      the copyright owner. For the purposes of this definition, "submitted"+      means any form of electronic, verbal, or written communication sent+      to the Licensor or its representatives, including but not limited to+      communication on electronic mailing lists, source code control systems,+      and issue tracking systems that are managed by, or on behalf of, the+      Licensor for the purpose of discussing and improving the Work, but+      excluding communication that is conspicuously marked or otherwise+      designated in writing by the copyright owner as "Not a Contribution."++      "Contributor" shall mean Licensor and any individual or Legal Entity+      on behalf of whom a Contribution has been received by Licensor and+      subsequently incorporated within the Work.++   2. Grant of Copyright License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      copyright license to reproduce, prepare Derivative Works of,+      publicly display, publicly perform, sublicense, and distribute the+      Work and such Derivative Works in Source or Object form.++   3. Grant of Patent License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      (except as stated in this section) patent license to make, have made,+      use, offer to sell, sell, import, and otherwise transfer the Work,+      where such license applies only to those patent claims licensable+      by such Contributor that are necessarily infringed by their+      Contribution(s) alone or by combination of their Contribution(s)+      with the Work to which such Contribution(s) was submitted. If You+      institute patent litigation against any entity (including a+      cross-claim or counterclaim in a lawsuit) alleging that the Work+      or a Contribution incorporated within the Work constitutes direct+      or contributory patent infringement, then any patent licenses+      granted to You under this License for that Work shall terminate+      as of the date such litigation is filed.++   4. Redistribution. You may reproduce and distribute copies of the+      Work or Derivative Works thereof in any medium, with or without+      modifications, and in Source or Object form, provided that You+      meet the following conditions:++      (a) You must give any other recipients of the Work or+          Derivative Works a copy of this License; and++      (b) You must cause any modified files to carry prominent notices+          stating that You changed the files; and++      (c) You must retain, in the Source form of any Derivative Works+          that You distribute, all copyright, patent, trademark, and+          attribution notices from the Source form of the Work,+          excluding those notices that do not pertain to any part of+          the Derivative Works; and++      (d) If the Work includes a "NOTICE" text file as part of its+          distribution, then any Derivative Works that You distribute must+          include a readable copy of the attribution notices contained+          within such NOTICE file, excluding those notices that do not+          pertain to any part of the Derivative Works, in at least one+          of the following places: within a NOTICE text file distributed+          as part of the Derivative Works; within the Source form or+          documentation, if provided along with the Derivative Works; or,+          within a display generated by the Derivative Works, if and+          wherever such third-party notices normally appear. The contents+          of the NOTICE file are for informational purposes only and+          do not modify the License. You may add Your own attribution+          notices within Derivative Works that You distribute, alongside+          or as an addendum to the NOTICE text from the Work, provided+          that such additional attribution notices cannot be construed+          as modifying the License.++      You may add Your own copyright statement to Your modifications and+      may provide additional or different license terms and conditions+      for use, reproduction, or distribution of Your modifications, or+      for any such Derivative Works as a whole, provided Your use,+      reproduction, and distribution of the Work otherwise complies with+      the conditions stated in this License.++   5. Submission of Contributions. Unless You explicitly state otherwise,+      any Contribution intentionally submitted for inclusion in the Work+      by You to the Licensor shall be under the terms and conditions of+      this License, without any additional terms or conditions.+      Notwithstanding the above, nothing herein shall supersede or modify+      the terms of any separate license agreement you may have executed+      with Licensor regarding such Contributions.++   6. Trademarks. This License does not grant permission to use the trade+      names, trademarks, service marks, or product names of the Licensor,+      except as required for reasonable and customary use in describing the+      origin of the Work and reproducing the content of the NOTICE file.++   7. Disclaimer of Warranty. Unless required by applicable law or+      agreed to in writing, Licensor provides the Work (and each+      Contributor provides its Contributions) on an "AS IS" BASIS,+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+      implied, including, without limitation, any warranties or conditions+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+      PARTICULAR PURPOSE. You are solely responsible for determining the+      appropriateness of using or redistributing the Work and assume any+      risks associated with Your exercise of permissions under this License.++   8. Limitation of Liability. In no event and under no legal theory,+      whether in tort (including negligence), contract, or otherwise,+      unless required by applicable law (such as deliberate and grossly+      negligent acts) or agreed to in writing, shall any Contributor be+      liable to You for damages, including any direct, indirect, special,+      incidental, or consequential damages of any character arising as a+      result of this License or out of the use or inability to use the+      Work (including but not limited to damages for loss of goodwill,+      work stoppage, computer failure or malfunction, or any and all+      other commercial damages or losses), even if such Contributor+      has been advised of the possibility of such damages.++   9. Accepting Warranty or Additional Liability. While redistributing+      the Work or Derivative Works thereof, You may choose to offer,+      and charge a fee for, acceptance of support, warranty, indemnity,+      or other liability obligations and/or rights consistent with this+      License. However, in accepting such obligations, You may act only+      on Your own behalf and on Your sole responsibility, not on behalf+      of any other Contributor, and only if You agree to indemnify,+      defend, and hold each Contributor harmless for any liability+      incurred by, or claims asserted against, such Contributor by reason+      of your accepting any such warranty or additional liability.++   END OF TERMS AND CONDITIONS++   APPENDIX: How to apply the Apache License to your work.++      To apply the Apache License to your work, attach the following+      boilerplate notice, with the fields enclosed by brackets "[]"+      replaced with your own identifying information. (Don't include+      the brackets!)  The text should be enclosed in the appropriate+      comment syntax for the file format. We also recommend that a+      file or class name and description of purpose be included on the+      same "printed page" as the copyright notice for easier+      identification within third-party archives.++   Copyright [yyyy] [name of copyright owner]++   Licensed under the Apache License, Version 2.0 (the "License");+   you may not use this file except in compliance with the License.+   You may obtain a copy of the License at++       http://www.apache.org/licenses/LICENSE-2.0++   Unless required by applicable law or agreed to in writing, software+   distributed under the License is distributed on an "AS IS" BASIS,+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+   See the License for the specific language governing permissions and+   limitations under the License.
+ README.md view
@@ -0,0 +1,21 @@+# matrix-client-haskell++[![Hackage](https://img.shields.io/hackage/v/matrix-client.svg)](https://hackage.haskell.org/package/matrix-client)++A client library for [matrix.org](https://matrix.org)++## Contribute++To work on this project you need a Haskell toolchain, for example on fedora:++```ShellSession+$ sudo dnf install -y ghc cabal-install && cabal update+```++Run the tests:++```ShellSession+$ cabal test+```++If you experience any difficulties, please don't hesistate to raise an issue.
+ matrix-client.cabal view
@@ -0,0 +1,84 @@+cabal-version:       2.4+name:                matrix-client+version:             0.1.0.0+synopsis:            A matrix client library+description:+    Matrix client is a library to interface with https://matrix.org.+    .+    Use this library to interact with matrix server.+    .+    Read the "Network.Matrix.Tutorial" for a detailed tutorial.+    .+homepage:            https://github.com/softwarefactory-project/matrix-client-haskell#readme+bug-reports:         https://github.com/softwarefactory-project/matrix-client-haskell/issues+license:             Apache-2.0+license-file:        LICENSE+author:              Tristan de Cacqueray+maintainer:          tdecacqu@redhat.com+copyright:           2021 Red Hat+category:            Network+build-type:          Simple+extra-doc-files:     CHANGELOG.md+                     README.md+tested-with:         GHC == 8.10.4++source-repository head+  type:                git+  location:            https://github.com/softwarefactory-project/matrix-client-haskell.git++common common-options+  build-depends:       base                   >= 4.11.0.0 && < 5+                     , aeson                  >= 1.0.0.0  && < 1.6+  ghc-options:         -Wall+                       -Wcompat+                       -Widentities+                       -Wincomplete-uni-patterns+                       -Wincomplete-record-updates+                       -Wredundant-constraints+                       --write-ghc-environment-files=always+  if impl(ghc >= 8.2)+    ghc-options:       -fhide-source-paths+  if impl(ghc >= 8.4)+    ghc-options:       -Wmissing-export-lists++  default-language:    Haskell2010++common lib-depends+  build-depends:       SHA                    ^>= 1.6+                     , base64+                     , bytestring+                     , exceptions+                     , hashable+                     , http-client            >= 0.5.0    && < 0.8+                     , http-client-tls        >= 0.2.0    && < 0.4+                     , retry                  ^>= 0.8+                     , text                   >= 0.11.1.0 && < 1.3+                     , time+                     , unordered-containers++library+  import:              common-options, lib-depends+  hs-source-dirs:      src+  exposed-modules:     Network.Matrix.Client+                     , Network.Matrix.Identity+                     , Network.Matrix.Tutorial+  other-modules:       Network.Matrix.Events+                     , Network.Matrix.Internal++test-suite unit+  import:             common-options, lib-depends+  type:               exitcode-stdio-1.0+  hs-source-dirs:     test, src+  main-is:            Spec.hs+  build-depends:      base+                    , matrix-client+                    , hspec >= 2++test-suite doctest+  type:               exitcode-stdio-1.0+  default-language:   Haskell2010+  hs-source-dirs:     test+  ghc-options:        -threaded -Wall+  main-is:            Doctest.hs+  build-depends:      base+                    , doctest >= 0.9.3
+ src/Network/Matrix/Client.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | This module contains the client-server API+-- https://matrix.org/docs/spec/client_server/r0.6.1+module Network.Matrix.Client+  ( -- * Client+    ClientSession,+    MatrixToken (..),+    getTokenFromEnv,+    createSession,++    -- * API+    MatrixIO,+    MatrixError (..),+    retry,++    -- * User data+    UserID (..),+    getTokenOwner,++    -- * Room participation+    TxnID (..),+    sendMessage,+    module Network.Matrix.Events,++    -- * Room membership+    RoomID (..),+    getJoinedRooms,+    joinRoomById,+  )+where++import Control.Monad (mzero)+import Data.Aeson (FromJSON (..), Value (Object), encode, (.:))+import Data.Hashable (Hashable)+import Data.Text (Text)+import qualified Network.HTTP.Client as HTTP+import Network.Matrix.Events+import Network.Matrix.Internal++-- $setup+-- >>> import Data.Aeson (decode)++-- | The session record, use 'createSession' to create it.+data ClientSession = ClientSession+  { baseUrl :: Text,+    token :: MatrixToken,+    manager :: HTTP.Manager+  }++-- | 'createSession' creates the session record.+createSession ::+  -- | The matrix client-server base url, e.g. "https://matrix.org"+  Text ->+  -- | The user token+  MatrixToken ->+  IO ClientSession+createSession baseUrl' token' = ClientSession baseUrl' token' <$> mkManager++mkRequest :: ClientSession -> Bool -> Text -> IO HTTP.Request+mkRequest ClientSession {..} = mkRequest' baseUrl token++doRequest :: FromJSON a => ClientSession -> HTTP.Request -> MatrixIO a+doRequest ClientSession {..} = doRequest' manager++-- | 'getTokenOwner' gets information about the owner of a given access token.+getTokenOwner :: ClientSession -> MatrixIO UserID+getTokenOwner session =+  doRequest session =<< mkRequest session True "/_matrix/client/r0/account/whoami"++newtype TxnID = TxnID Text deriving (Show, Eq)++sendMessage :: ClientSession -> RoomID -> Event -> TxnID -> MatrixIO EventID+sendMessage session (RoomID roomId) event (TxnID txnId) = do+  request <- mkRequest session True path+  doRequest+    session+    ( request+        { HTTP.method = "PUT",+          HTTP.requestBody = HTTP.RequestBodyLBS $ encode event+        }+    )+  where+    path = "/_matrix/client/r0/rooms/" <> roomId <> "/send/" <> eventId <> "/" <> txnId+    eventId = eventType event++newtype RoomID = RoomID Text deriving (Show, Eq, Hashable)++instance FromJSON RoomID where+  parseJSON (Object v) = RoomID <$> v .: "room_id"+  parseJSON _ = mzero++-- | A newtype wrapper to decoded nested list+--+-- >>> decode "{\"joined_rooms\": [\"!foo:example.com\"]}" :: Maybe JoinedRooms+-- Just (JoinedRooms {unRooms = [RoomID "!foo:example.com"]})+newtype JoinedRooms = JoinedRooms {unRooms :: [RoomID]} deriving (Show)++instance FromJSON JoinedRooms where+  parseJSON (Object v) = do+    rooms <- v .: "joined_rooms"+    pure . JoinedRooms $ RoomID <$> rooms+  parseJSON _ = mzero++getJoinedRooms :: ClientSession -> MatrixIO [RoomID]+getJoinedRooms session = do+  request <- mkRequest session True "/_matrix/client/r0/joined_rooms"+  response <- doRequest session request+  pure $ unRooms <$> response++joinRoomById :: ClientSession -> RoomID -> MatrixIO RoomID+joinRoomById session (RoomID roomId) = do+  request <- mkRequest session True $ "/_matrix/client/r0/rooms/" <> roomId <> "/join"+  doRequest session (request {HTTP.method = "POST"})
+ src/Network/Matrix/Events.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Matrix event data type+module Network.Matrix.Events+  ( MessageText (..),+    RoomMessage (..),+    Event (..),+    EventID (..),+    eventType,+  )+where++import Control.Monad (mzero)+import Data.Aeson (FromJSON (..), ToJSON (..), Value (Object), object, (.:), (.=))+import Data.Aeson.Types (Pair)+import Data.Text (Text)++data MessageText = MessageText+  { mtBody :: Text,+    mtFormat :: Maybe Text,+    mtFormattedBody :: Maybe Text+  }+  deriving (Show, Eq)++messageTextAttr :: MessageText -> [Pair]+messageTextAttr msg =+  ["body" .= mtBody msg] <> format <> formattedBody+  where+    omitNull k vM = maybe [] (\v -> [k .= v]) vM+    format = omitNull "format" $ mtFormat msg+    formattedBody = omitNull "formatted_body" $ mtFormattedBody msg++data RoomMessage+  = RoomMessageText MessageText+  | RoomMessageEmote MessageText+  | RoomMessageNotice MessageText+  deriving (Show, Eq)++roomMessageType :: RoomMessage -> Text+roomMessageType roomMessage = case roomMessage of+  RoomMessageText _ -> "m.text"+  RoomMessageEmote _ -> "m.emote"+  RoomMessageNotice _ -> "m.notice"++instance ToJSON RoomMessage where+  toJSON msg =+    let msgtype = roomMessageType msg+        attr = case msg of+          RoomMessageText mt -> messageTextAttr mt+          RoomMessageEmote mt -> messageTextAttr mt+          RoomMessageNotice mt -> messageTextAttr mt+     in object (["msgtype" .= msgtype] <> attr)++newtype Event = EventRoomMessage RoomMessage++instance ToJSON Event where+  toJSON event = case event of+    EventRoomMessage msg -> toJSON msg++eventType :: Event -> Text+eventType event = case event of+  EventRoomMessage _ -> "m.room.message"++newtype EventID = EventID Text deriving (Show)++instance FromJSON EventID where+  parseJSON (Object v) = EventID <$> v .: "event_id"+  parseJSON _ = mzero
+ src/Network/Matrix/Identity.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | This module contains the Identity service API+-- https://matrix.org/docs/spec/identity_service/r0.3.0.html+module Network.Matrix.Identity+  ( -- * Client+    IdentitySession,+    MatrixToken (..),+    getTokenFromEnv,+    createIdentitySession,++    -- * API+    MatrixIO,+    MatrixError (..),+    retry,++    -- * User data+    UserID (..),+    getIdentityTokenOwner,++    -- * Association lookup+    HashDetails (..),+    hashDetails,+    Identity (..),+    identityLookup,+    HashedAddress,+    IdentityLookupRequest,+    IdentityLookupResponse,+    identitiesLookup,+    mkIdentityLookupRequest,+    toHashedAddress,+    lookupIdentity,+  )+where++import Control.Monad (mzero)+import Data.Aeson (FromJSON (..), Value (Object, String), encode, object, (.:), (.=))+import Data.ByteString.Lazy (fromStrict)+import Data.ByteString.Lazy.Base64.URL (encodeBase64Unpadded)+import Data.Digest.Pure.SHA (bytestringDigest, sha256)+import qualified Data.HashMap.Strict as HM+import Data.List (lookup)+import Data.List.NonEmpty (NonEmpty)+import Data.Maybe (mapMaybe)+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)+import Data.Text.Lazy (toStrict)+import qualified Network.HTTP.Client as HTTP+import Network.Matrix.Internal++-- $setup+-- >>> import Data.Aeson (decode)++-- | The session record, use 'createSession' to create it.+data IdentitySession = IdentitySession+  { baseUrl :: Text,+    token :: MatrixToken,+    manager :: HTTP.Manager+  }++-- | 'createSession' creates the session record.+createIdentitySession ::+  -- | The matrix identity base url, e.g. "https://matrix.org"+  Text ->+  -- | The user identity token+  MatrixToken ->+  IO IdentitySession+createIdentitySession baseUrl' token' = IdentitySession baseUrl' token' <$> mkManager++mkRequest :: IdentitySession -> Bool -> Text -> IO HTTP.Request+mkRequest IdentitySession {..} = mkRequest' baseUrl token++doRequest :: FromJSON a => IdentitySession -> HTTP.Request -> MatrixIO a+doRequest IdentitySession {..} = doRequest' manager++-- | 'getIdentityTokenOwner' gets information about the owner of a given access token.+getIdentityTokenOwner :: IdentitySession -> MatrixIO UserID+getIdentityTokenOwner session =+  doRequest session =<< mkRequest session True "/_matrix/identity/v2/account"++data HashDetails = HashDetails+  { hdAlgorithms :: NonEmpty Text,+    hdPepper :: Text+  }+  deriving (Show, Eq)++instance FromJSON HashDetails where+  parseJSON (Object v) = HashDetails <$> v .: "algorithms" <*> v .: "lookup_pepper"+  parseJSON _ = mzero++hashDetails :: IdentitySession -> MatrixIO HashDetails+hashDetails session =+  doRequest session =<< mkRequest session True "/_matrix/identity/v2/hash_details"++-- | Use 'identityLookup' to lookup a single identity, otherwise uses the full 'identitiesLookup'.+identityLookup :: IdentitySession -> HashDetails -> Identity -> MatrixIO (Maybe UserID)+identityLookup session hd ident = do+  fmap toUserIDM <$> identitiesLookup session ilr+  where+    toUserIDM = lookupIdentity address+    address = toHashedAddress hd ident+    ilr = mkIdentityLookupRequest hd [address]++data IdentityLookupRequest = IdentityLookupRequest+  { ilrHash :: Text,+    ilrPepper :: Text,+    ilrAddresses :: [HashedAddress]+  }+  deriving (Show, Eq)++newtype HashedAddress = HashedAddress Text deriving (Show, Eq)++-- | A newtype wrapper to decoded nested list+--+-- >>> decode "{\"mappings\": {\"hash\": \"user\"}}" :: Maybe IdentityLookupResponse+-- Just (IdentityLookupResponse [(HashedAddress "hash",UserID "user")])+newtype IdentityLookupResponse = IdentityLookupResponse [(HashedAddress, UserID)]+  deriving (Show)++instance FromJSON IdentityLookupResponse where+  parseJSON (Object v) = do+    mappings <- v .: "mappings"+    case mappings of+      (Object kv) -> pure . IdentityLookupResponse $ mapMaybe toTuple (HM.toList kv)+      _ -> mzero+    where+      toTuple (k, String s) = Just (HashedAddress k, UserID s)+      toTuple _ = Nothing+  parseJSON _ = mzero++identitiesLookup :: IdentitySession -> IdentityLookupRequest -> MatrixIO IdentityLookupResponse+identitiesLookup session ilr = do+  request <- mkRequest session True "/_matrix/identity/v2/lookup"+  doRequest+    session+    ( request+        { HTTP.method = "POST",+          HTTP.requestBody = HTTP.RequestBodyLBS body+        }+    )+  where+    getAddr (HashedAddress x) = x+    body =+      encode $+        object+          [ "addresses" .= map getAddr (ilrAddresses ilr),+            "algorithm" .= ilrHash ilr,+            "pepper" .= ilrPepper ilr+          ]++-- | Hash encoding for lookup+-- >>> encodeSHA256 "alice@example.com email matrixrocks"+-- "4kenr7N9drpCJ4AfalmlGQVsOn3o2RHjkADUpXJWZUc"+encodeSHA256 :: Text -> Text+encodeSHA256 = toStrict . encodeBase64Unpadded . bytestringDigest . sha256 . fromStrict . encodeUtf8++data Identity = Email Text | Msisdn Text deriving (Show, Eq)++toHashedAddress :: HashDetails -> Identity -> HashedAddress+toHashedAddress hd ident = HashedAddress $ encodeSHA256 $ val <> " " <> hdPepper hd+  where+    val = case ident of+      Email x -> x <> " email"+      Msisdn x -> x <> " msisdn"++mkIdentityLookupRequest :: HashDetails -> [HashedAddress] -> IdentityLookupRequest+mkIdentityLookupRequest hd = IdentityLookupRequest hash (hdPepper hd)+  where+    hash =+      if "sha256" `elem` hdAlgorithms hd+        then "sha256"+        else error "Only sha256 is supported"++lookupIdentity :: HashedAddress -> IdentityLookupResponse -> Maybe UserID+lookupIdentity x (IdentityLookupResponse xs) = Data.List.lookup x xs
+ src/Network/Matrix/Internal.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-missing-export-lists #-}++-- | This module contains low-level HTTP utility+module Network.Matrix.Internal where++import Control.Monad (mzero)+import Control.Monad.Catch (Handler (Handler), MonadMask)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Retry (RetryStatus (..))+import qualified Control.Retry as Retry+import Data.Aeson (FromJSON (..), Value (Object), eitherDecode, (.:), (.:?))+import Data.ByteString.Lazy (ByteString)+import Data.Text (Text, pack, unpack)+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import Data.Text.IO (hPutStrLn)+import qualified Network.HTTP.Client as HTTP+import Network.HTTP.Client.TLS (tlsManagerSettings)+import System.Environment (getEnv)+import System.IO (stderr)++newtype MatrixToken = MatrixToken Text++getTokenFromEnv ::+  -- | The envirnoment variable name+  Text ->+  IO MatrixToken+getTokenFromEnv env = MatrixToken . pack <$> getEnv (unpack env)++mkManager :: IO HTTP.Manager+mkManager = HTTP.newManager tlsManagerSettings++mkRequest' :: Text -> MatrixToken -> Bool -> Text -> IO HTTP.Request+mkRequest' baseUrl (MatrixToken token) auth path = do+  initRequest <- HTTP.parseUrlThrow (unpack $ baseUrl <> path)+  pure $+    initRequest+      { HTTP.requestHeaders =+          [("Content-Type", "application/json")] <> authHeaders+      }+  where+    authHeaders =+      [("Authorization", "Bearer " <> encodeUtf8 token) | auth]++doRequest' :: FromJSON a => HTTP.Manager -> HTTP.Request -> IO (Either MatrixError a)+doRequest' manager request = do+  response <- HTTP.httpLbs request manager+  pure $ decodeResp (HTTP.responseBody response)++decodeResp :: FromJSON a => ByteString -> Either MatrixError a+decodeResp resp = case eitherDecode resp of+  Right a -> pure a+  Left err -> case eitherDecode resp of+    Right me -> Left me+    Left _ -> error $ "Could not decode: " <> err++newtype UserID = UserID Text deriving (Show, Eq)++instance FromJSON UserID where+  parseJSON (Object v) = UserID <$> v .: "user_id"+  parseJSON _ = mzero++data MatrixError = MatrixError+  { meErrcode :: Text,+    meError :: Text,+    meRetryAfterMS :: Maybe Int+  }+  deriving (Show, Eq)++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 = IO (Either MatrixError a)++-- | Retry 5 times network action, doubling backoff each time+retry :: (MonadMask m, MonadIO m) => m a -> m a+retry action =+  Retry.recovering+    (Retry.exponentialBackoff backoff <> Retry.limitRetries 5)+    [handler]+    (const action)+  where+    backoff = 500000 -- 500ms+    -- Log network error+    handler (RetryStatus num _ _) = Handler $ \case+      HTTP.HttpExceptionRequest req ctx -> do+        let url = decodeUtf8 (HTTP.host req) <> ":" <> pack (show (HTTP.port req)) <> decodeUtf8 (HTTP.path req)+            arg = decodeUtf8 $ HTTP.queryString req+            loc = if num == 0 then url <> arg else url+        liftIO $+          hPutStrLn stderr $+            "NetworkFailure: "+              <> pack (show num)+              <> "/5 "+              <> loc+              <> " failed: "+              <> pack (show ctx)+        pure True+      HTTP.InvalidUrlException _ _ -> pure False
+ src/Network/Matrix/Tutorial.hs view
@@ -0,0 +1,55 @@+-- | The @matrix-client@ library provides a simple interface for interacting with Matrix servers.+--+-- This tutorial introduces how to use the @matrix-client@ library.+--+-- You will need a token to create a session, if you already have an account, you can get it with the @element@ client+-- by visiting the account @Settings@ page, @Help & About@ panel, then click @Access Token@.+--+-- Alternatively, you can setup a test service by running these commands in a terminal:+--+-- > git clone https://github.com/matrix-org/dendrite+-- > cd dendrite; ./build.sh; ./bin/generate-keys --private-key matrix_key.pem; cp dendrite-config.yaml dendrite.yaml+-- > ./bin/dendrite-monolith-server --config dendrite.yaml+-- > curl -XPOST http://localhost:8008/_matrix/client/r0/register -d'{"username": "tristanC", "password": "supersecret", "auth": {"type": "mlogin.dummy"}}+--+-- To avoid manipulating the token directly, put it in your environment:+--+-- > export MATRIX_TOKEN="THE_ACCESS_TOKEN"+module Network.Matrix.Tutorial+  ( -- * Introduction+    -- $intro++    -- * Create a session+    -- $session+  )+where++-- $intro+--   To start using this library you need a haskell toolchain, on fedora run:+--+--   > $ sudo dnf install -y ghc cabal-install && cabal update+--+--   Then get a copy of the library by running:+--+--   > $ git clone https://github.com/softwarefactory-project/matrix-client-haskell+--   > $ cd matrix-client-haskell+--+--   Start a REPL:+--+--   > $ cabal repl+--   > Prelude> import Network.Matrix.Client+--   > Prelude Netowrk.Matrix.Client> :set prompt "> "+--   > > :set -XOverloadedStrings+--   > > :type getTokenOwner+--   > getTokenOwner :: ClientSession -> MatrixIO WhoAmI++-- $session+--   Most functions require 'ClientSession' which carries the+--   endpoint url and the http client manager.+--+--   The only way to get the client is through the 'Client.createSession' function:+--+--   > > token <- getTokenFromEnv "MATRIX_TOKEN"+--   > > sess <- createSession "https://matrix.org" token+--   > > getTokenOwner sess+--   > Right (WhoAmI "@tristanc_:matrix.org")
+ test/Doctest.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Test.DocTest++main :: IO ()+main = doctest ["src/", "-XOverloadedStrings"]
+ test/Spec.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings #-}++-- | The matrix client specification tests+module Main (main) where++import Data.Aeson (encode)+import Network.Matrix.Client+import Network.Matrix.Events+import Network.Matrix.Internal+import Test.Hspec++main :: IO ()+main = hspec spec++spec :: Spec+spec = describe "unit tests" $ do+  it "decode error" $+    (decodeResp "{\"errcode\": \"TEST\", \"error\":\"a error\"}" :: Either MatrixError String)+      `shouldBe` Left (MatrixError "TEST" "a error" Nothing)+  it "decode response" $+    decodeResp "{\"user_id\": \"@tristanc_:matrix.org\"}"+      `shouldBe` Right (UserID "@tristanc_:matrix.org")+  it "encode room message" $+    encode (RoomMessageText (MessageText "Hello" Nothing Nothing))+      `shouldBe` "{\"msgtype\":\"m.text\",\"body\":\"Hello\"}"