packages feed

matrix-client 0.1.2.0 → 0.1.3.0

raw patch · 5 files changed

+596/−6 lines, 5 filesdep +profunctorsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: profunctors

API changes (from Hackage documentation)

+ Network.Matrix.Client: DeviceId :: Text -> DeviceId
+ Network.Matrix.Client: InitialDeviceDisplayName :: Text -> InitialDeviceDisplayName
+ Network.Matrix.Client: LoginCredentials :: Username -> LoginSecret -> Text -> Maybe DeviceId -> Maybe InitialDeviceDisplayName -> LoginCredentials
+ Network.Matrix.Client: LoginResponse :: Text -> Text -> Text -> Text -> LoginResponse
+ Network.Matrix.Client: Password :: Text -> LoginSecret
+ Network.Matrix.Client: Token :: Text -> LoginSecret
+ Network.Matrix.Client: Username :: Text -> Username
+ Network.Matrix.Client: [deviceId] :: DeviceId -> Text
+ Network.Matrix.Client: [initialDeviceDisplayName] :: InitialDeviceDisplayName -> Text
+ Network.Matrix.Client: [lBaseUrl] :: LoginCredentials -> Text
+ Network.Matrix.Client: [lDeviceId] :: LoginCredentials -> Maybe DeviceId
+ Network.Matrix.Client: [lInitialDeviceDisplayName] :: LoginCredentials -> Maybe InitialDeviceDisplayName
+ Network.Matrix.Client: [lLoginSecret] :: LoginCredentials -> LoginSecret
+ Network.Matrix.Client: [lUsername] :: LoginCredentials -> Username
+ Network.Matrix.Client: [lrAccessToken] :: LoginResponse -> Text
+ Network.Matrix.Client: [lrDeviceId] :: LoginResponse -> Text
+ Network.Matrix.Client: [lrHomeServer] :: LoginResponse -> Text
+ Network.Matrix.Client: [lrUserId] :: LoginResponse -> Text
+ Network.Matrix.Client: [username] :: Username -> Text
+ Network.Matrix.Client: accountDataType :: AccountData a => proxy a -> Text
+ Network.Matrix.Client: class (FromJSON a, ToJSON a) => AccountData a
+ Network.Matrix.Client: data LoginCredentials
+ Network.Matrix.Client: data LoginResponse
+ Network.Matrix.Client: data LoginSecret
+ Network.Matrix.Client: getAccountData :: forall a. AccountData a => ClientSession -> UserID -> MatrixIO a
+ Network.Matrix.Client: getAccountData' :: FromJSON a => ClientSession -> UserID -> Text -> MatrixIO a
+ Network.Matrix.Client: login :: LoginCredentials -> IO ClientSession
+ Network.Matrix.Client: logout :: ClientSession -> MatrixIO ()
+ Network.Matrix.Client: newtype DeviceId
+ Network.Matrix.Client: newtype InitialDeviceDisplayName
+ Network.Matrix.Client: newtype Username
+ Network.Matrix.Client: setAccountData :: forall a. AccountData a => ClientSession -> UserID -> a -> MatrixIO ()
+ Network.Matrix.Client: setAccountData' :: ToJSON a => ClientSession -> UserID -> Text -> a -> MatrixIO ()
+ Network.Matrix.Client.Lens: _EventRoomEdit :: Prism' Event ((EventID, RoomMessage), RoomMessage)
+ Network.Matrix.Client.Lens: _EventRoomMessage :: Prism' Event RoomMessage
+ Network.Matrix.Client.Lens: _EventRoomReply :: Prism' Event (EventID, RoomMessage)
+ Network.Matrix.Client.Lens: _EventUnknown :: Prism' Event Object
+ Network.Matrix.Client.Lens: _RoomMessageText :: Lens' RoomMessage MessageText
+ Network.Matrix.Client.Lens: _efNotSenders :: Lens' EventFilter (Maybe [Text])
+ Network.Matrix.Client.Lens: _efNotTypes :: Lens' EventFilter (Maybe [Text])
+ Network.Matrix.Client.Lens: _efSenders :: Lens' EventFilter (Maybe [Text])
+ Network.Matrix.Client.Lens: _efTypes :: Lens' EventFilter (Maybe [Text])
+ Network.Matrix.Client.Lens: _filterAccountData :: Lens' Filter (Maybe EventFilter)
+ Network.Matrix.Client.Lens: _filterEventFields :: Lens' Filter (Maybe [Text])
+ Network.Matrix.Client.Lens: _filterEventFormat :: Lens' Filter (Maybe EventFormat)
+ Network.Matrix.Client.Lens: _filterPresence :: Lens' Filter (Maybe EventFilter)
+ Network.Matrix.Client.Lens: _filterRoom :: Lens' Filter (Maybe RoomFilter)
+ Network.Matrix.Client.Lens: _jrsSummary :: Lens' JoinedRoomSync (Maybe RoomSummary)
+ Network.Matrix.Client.Lens: _jrsTimeline :: Lens' JoinedRoomSync TimelineSync
+ Network.Matrix.Client.Lens: _mtBody :: Lens' MessageText Text
+ Network.Matrix.Client.Lens: _mtFormat :: Lens' MessageText (Maybe Text)
+ Network.Matrix.Client.Lens: _mtFormattedBody :: Lens' MessageText (Maybe Text)
+ Network.Matrix.Client.Lens: _mtType :: Lens' MessageText MessageTextType
+ Network.Matrix.Client.Lens: _reContent :: Lens' RoomEvent Event
+ Network.Matrix.Client.Lens: _reEventId :: Lens' RoomEvent EventID
+ Network.Matrix.Client.Lens: _reSender :: Lens' RoomEvent Author
+ Network.Matrix.Client.Lens: _reType :: Lens' RoomEvent Text
+ Network.Matrix.Client.Lens: _refContainsUrl :: Lens' RoomEventFilter (Maybe Bool)
+ Network.Matrix.Client.Lens: _refIncludeRedundantMembers :: Lens' RoomEventFilter (Maybe Bool)
+ Network.Matrix.Client.Lens: _refLazyLoadMembers :: Lens' RoomEventFilter (Maybe Bool)
+ Network.Matrix.Client.Lens: _refLimit :: Lens' RoomEventFilter (Maybe Int)
+ Network.Matrix.Client.Lens: _refNotRooms :: Lens' RoomEventFilter (Maybe [Text])
+ Network.Matrix.Client.Lens: _refNotSenders :: Lens' RoomEventFilter (Maybe [Text])
+ Network.Matrix.Client.Lens: _refNotTypes :: Lens' RoomEventFilter (Maybe [Text])
+ Network.Matrix.Client.Lens: _refRooms :: Lens' RoomEventFilter (Maybe [Text])
+ Network.Matrix.Client.Lens: _refSenders :: Lens' RoomEventFilter (Maybe [Text])
+ Network.Matrix.Client.Lens: _refTypes :: Lens' RoomEventFilter (Maybe [Text])
+ Network.Matrix.Client.Lens: _rfAccountData :: Lens' RoomFilter (Maybe RoomEventFilter)
+ Network.Matrix.Client.Lens: _rfEphemeral :: Lens' RoomFilter (Maybe RoomEventFilter)
+ Network.Matrix.Client.Lens: _rfIncludeLeave :: Lens' RoomFilter (Maybe Bool)
+ Network.Matrix.Client.Lens: _rfNotRooms :: Lens' RoomFilter (Maybe [Text])
+ Network.Matrix.Client.Lens: _rfRooms :: Lens' RoomFilter (Maybe [Text])
+ Network.Matrix.Client.Lens: _rfState :: Lens' RoomFilter (Maybe StateFilter)
+ Network.Matrix.Client.Lens: _rfTimeline :: Lens' RoomFilter (Maybe RoomEventFilter)
+ Network.Matrix.Client.Lens: _rsInvitedMemberCount :: Lens' RoomSummary (Maybe Int)
+ Network.Matrix.Client.Lens: _rsJoinedMemberCount :: Lens' RoomSummary (Maybe Int)
+ Network.Matrix.Client.Lens: _sfContainsUrl :: Lens' StateFilter (Maybe Bool)
+ Network.Matrix.Client.Lens: _sfIncludeRedundantMembers :: Lens' StateFilter (Maybe Bool)
+ Network.Matrix.Client.Lens: _sfLazyLoadMembers :: Lens' StateFilter (Maybe Bool)
+ Network.Matrix.Client.Lens: _sfLimit :: Lens' StateFilter (Maybe Int)
+ Network.Matrix.Client.Lens: _sfNotRooms :: Lens' StateFilter (Maybe [Text])
+ Network.Matrix.Client.Lens: _sfNotSenders :: Lens' StateFilter (Maybe [Text])
+ Network.Matrix.Client.Lens: _sfRooms :: Lens' StateFilter (Maybe [Text])
+ Network.Matrix.Client.Lens: _sfTypes :: Lens' StateFilter (Maybe [Text])
+ Network.Matrix.Client.Lens: _srNextBatch :: Lens' SyncResult Text
+ Network.Matrix.Client.Lens: _srRooms :: Lens' SyncResult (Maybe SyncResultRoom)
+ Network.Matrix.Client.Lens: _srrInvite :: Lens' SyncResultRoom (Maybe (Map Text InvitedRoomSync))
+ Network.Matrix.Client.Lens: _srrJoin :: Lens' SyncResultRoom (Maybe (Map Text JoinedRoomSync))
+ Network.Matrix.Client.Lens: _tsEvents :: Lens' TimelineSync (Maybe [RoomEvent])
+ Network.Matrix.Client.Lens: _tsLimited :: Lens' TimelineSync (Maybe Bool)
+ Network.Matrix.Client.Lens: _tsPrevBatch :: Lens' TimelineSync (Maybe Text)
+ Network.Matrix.Client.Lens: efLimit :: EventFilter -> Maybe Int
- Network.Matrix.Client: retry :: MatrixIO a -> MatrixIO a
+ Network.Matrix.Client: retry :: (MonadIO m, MonadMask m) => MatrixM m a -> MatrixM m a
- Network.Matrix.Identity: retry :: MatrixIO a -> MatrixIO a
+ Network.Matrix.Identity: retry :: (MonadIO m, MonadMask m) => MatrixM m a -> MatrixM m a

Files

CHANGELOG.md view
@@ -1,5 +1,12 @@ # Changelog +## 0.1.3.0++- Adds Lenses and Prisms+- Adds login/logout functiosn for generating and destroying Matrix Tokens+- Add functionality to set and retrieve non-room account data+- Generalize retry to arbitrary MatrixM+ ## 0.1.2.0  - Add filtering client function
matrix-client.cabal view
@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                matrix-client-version:             0.1.2.0+version:             0.1.3.0 synopsis:            A matrix client library description:     Matrix client is a library to interface with https://matrix.org.@@ -56,6 +56,7 @@                      , http-client            >= 0.5.0    && < 0.8                      , http-client-tls        >= 0.2.0    && < 0.4                      , http-types             >= 0.10.0   && < 0.13+                     , profunctors                      , retry                  ^>= 0.8                      , text                   >= 0.11.1.0 && < 1.3                      , time@@ -65,6 +66,7 @@   import:              common-options, lib-depends   hs-source-dirs:      src   exposed-modules:     Network.Matrix.Client+                     , Network.Matrix.Client.Lens                      , Network.Matrix.Identity                      , Network.Matrix.Tutorial   other-modules:       Network.Matrix.Events
src/Network/Matrix/Client.hs view
@@ -5,15 +5,25 @@ {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}  -- | This module contains the client-server API -- https://matrix.org/docs/spec/client_server/r0.6.1 module Network.Matrix.Client   ( -- * Client     ClientSession,+    LoginCredentials (..),     MatrixToken (..),+    Username (..),+    DeviceId (..),+    InitialDeviceDisplayName (..),+    LoginSecret (..),+    LoginResponse (..),     getTokenFromEnv,     createSession,+    login,+    logout,      -- * API     MatrixM,@@ -64,6 +74,14 @@     createFilter,     getFilter, +    -- * Account data++    AccountData(accountDataType),+    getAccountData,+    getAccountData',+    setAccountData,+    setAccountData',+     -- * Events     sync,     getTimelines,@@ -80,7 +98,7 @@   ) where -import Control.Monad (mzero)+import Control.Monad (mzero, void) import Control.Monad.IO.Class (MonadIO(liftIO)) import Data.Aeson (FromJSON (..), ToJSON (..), Value (Object, String), encode, genericParseJSON, genericToJSON, object, (.:), (.:?), (.=)) import qualified Data.Aeson as Aeson@@ -89,6 +107,7 @@ import Data.List.NonEmpty (NonEmpty (..)) import Data.Map.Strict (Map, foldrWithKey) import Data.Maybe (fromMaybe)+import Data.Proxy (Proxy(Proxy)) import Data.Text (Text, pack) import qualified Data.Text as Text import Data.Text.Encoding (decodeUtf8, encodeUtf8)@@ -102,6 +121,39 @@ -- $setup -- >>> import Data.Aeson (decode) +data LoginCredentials = LoginCredentials+  { lUsername :: Username+  , lLoginSecret :: LoginSecret+  , lBaseUrl :: Text+  , lDeviceId :: Maybe DeviceId+  , lInitialDeviceDisplayName :: Maybe InitialDeviceDisplayName+  }++mkLoginRequest :: LoginCredentials -> IO HTTP.Request+mkLoginRequest LoginCredentials {..} =+  mkLoginRequest' lBaseUrl lDeviceId lInitialDeviceDisplayName lUsername lLoginSecret++-- | 'login' allows you to generate a session token.+login :: LoginCredentials -> IO ClientSession+login cred = do+  req <- mkLoginRequest cred+  manager <- mkManager+  resp' <- doRequest' manager req+  case resp' of+    Right LoginResponse {..} -> pure $ ClientSession (lBaseUrl cred) (MatrixToken lrAccessToken) manager+    Left err ->+      -- NOTE: There is nothing to recover after a failed login attempt+      fail $ show err++mkLogoutRequest :: ClientSession -> IO HTTP.Request+mkLogoutRequest ClientSession {..} = mkLogoutRequest' baseUrl token++-- | 'logout' allows you to destroy a session token.+logout :: ClientSession -> MatrixIO ()+logout session@ClientSession {..} = do+  req <- mkLogoutRequest session+  fmap (() <$) $ doRequest' @Value manager req+ -- | The session record, use 'createSession' to create it. data ClientSession = ClientSession   { baseUrl :: Text,@@ -669,3 +721,31 @@  instance FromJSON SyncResultRoom where   parseJSON = genericParseJSON aesonOptions++getAccountData' :: (FromJSON a) => ClientSession -> UserID -> Text -> MatrixIO a+getAccountData' session userID t =+  mkRequest session True (accountDataPath userID t) >>= doRequest session++setAccountData' :: (ToJSON a) => ClientSession -> UserID -> Text -> a -> MatrixIO ()+setAccountData' session userID t value = do+  request <- mkRequest session True $ accountDataPath userID t+  void <$> (doRequest session $ request+             { HTTP.method = "PUT"+             , HTTP.requestBody = HTTP.RequestBodyLBS $ encode value+             } :: MatrixIO Aeson.Object+           )++accountDataPath :: UserID -> Text -> Text+accountDataPath (UserID userID) t =+  "/_matrix/client/r0/user/" <> userID <> "/account_data/" <> t++class (FromJSON a, ToJSON a) => AccountData a where+  accountDataType :: proxy a -> Text++getAccountData :: forall a. (AccountData a) => ClientSession -> UserID -> MatrixIO a+getAccountData session userID = getAccountData' session userID $+                                accountDataType (Proxy :: Proxy a)++setAccountData :: forall a. (AccountData a) => ClientSession -> UserID -> a -> MatrixIO ()+setAccountData session userID = setAccountData' session userID $+                                accountDataType (Proxy :: Proxy a)
+ src/Network/Matrix/Client/Lens.hs view
@@ -0,0 +1,456 @@+{-# LANGUAGE RankNTypes #-}+module Network.Matrix.Client.Lens+  ( -- MessageText+    _mtBody+  , _mtType+  , _mtFormat+  , _mtFormattedBody+    -- RoomMessage+  , _RoomMessageText+    -- Event+  , _EventRoomMessage+  , _EventRoomReply+  , _EventRoomEdit+  , _EventUnknown+    -- EventFilter+  , efLimit+  , _efNotSenders+  , _efNotTypes+  , _efSenders+  , _efTypes+    -- RoomEventFilter+  , _refLimit+  , _refNotSenders+  , _refNotTypes+  , _refSenders+  , _refTypes+  , _refLazyLoadMembers+  , _refIncludeRedundantMembers+  , _refNotRooms+  , _refRooms+  , _refContainsUrl+    -- StateFilter+  , _sfLimit+  , _sfNotSenders+  , _sfTypes+  , _sfLazyLoadMembers+  , _sfIncludeRedundantMembers+  , _sfNotRooms+  , _sfRooms+  , _sfContainsUrl+    -- RoomFilter+  , _rfNotRooms+  , _rfRooms+  , _rfEphemeral+  , _rfIncludeLeave+  , _rfState+  , _rfTimeline+  , _rfAccountData+    -- Filter+  , _filterEventFields+  , _filterEventFormat+  , _filterPresence+  , _filterAccountData+  , _filterRoom+    -- RoomEvent+  , _reContent+  , _reType+  , _reEventId+  , _reSender+    -- RoomSummary+  , _rsJoinedMemberCount+  , _rsInvitedMemberCount+    -- TimelineSync+  , _tsEvents+  , _tsLimited+  , _tsPrevBatch+    --  JoinedRoomSync+  , _jrsSummary+  , _jrsTimeline+    -- SyncResult+  , _srNextBatch+  , _srRooms+    -- SyncResultRoom+  , _srrJoin+  , _srrInvite+  ) where++import Network.Matrix.Client++import qualified Data.Aeson as J+import Data.Coerce+import qualified Data.Text as T+import qualified Data.Map.Strict as M+import Data.Profunctor (Choice, dimap, right')++type Lens' s a = forall f. Functor f => (a -> f a) -> s -> f s +type Prism' s a = forall p f. (Choice p, Applicative f) => p a (f a) -> p s (f s) ++lens :: (s -> a) -> (s -> a -> s) -> Lens' s a+lens sa sbt afb s = sbt s <$> afb (sa s)+{-# INLINE lens #-}++prism :: (a -> s) -> (s -> Either s a) -> Prism' s a+prism bt seta = dimap seta (either pure (fmap bt)) . right'++prism' :: (a -> s) -> (s -> Maybe a) -> Prism' s a+prism' bs sma = prism bs (\s -> maybe (Left s) Right (sma s))+{-# INLINE prism' #-}++_mtBody :: Lens' MessageText T.Text+_mtBody = lens getter setter+  where+    getter = mtBody+    setter mt t = mt { mtBody = t }++_mtType :: Lens' MessageText MessageTextType+_mtType = lens getter setter+  where+    getter = mtType+    setter mt t = mt { mtType = t }++_mtFormat :: Lens' MessageText (Maybe T.Text)+_mtFormat = lens getter setter+  where+    getter = mtFormat+    setter mt t = mt { mtFormat = t }++_mtFormattedBody :: Lens' MessageText (Maybe T.Text)+_mtFormattedBody = lens getter setter+  where+    getter = mtFormattedBody+    setter mt t = mt { mtFormattedBody = t}++_RoomMessageText :: Lens' RoomMessage MessageText+_RoomMessageText = lens getter setter+  where+    getter = coerce+    setter _ t = RoomMessageText t++_EventRoomMessage :: Prism' Event RoomMessage+_EventRoomMessage = prism' to from+  where+    to = EventRoomMessage+    from (EventRoomMessage msg) = Just msg+    from _ = Nothing++_EventRoomReply :: Prism' Event (EventID, RoomMessage)+_EventRoomReply = prism' to from+  where+    to (eid, rm) = EventRoomReply eid rm+    from (EventRoomReply eid rm) = Just (eid, rm)+    from _ = Nothing++_EventRoomEdit :: Prism' Event ((EventID, RoomMessage), RoomMessage)+_EventRoomEdit = prism' to from+  where+    to (oldEvent, newMsg) = EventRoomEdit oldEvent newMsg+    from (EventRoomEdit oldEvent newMsg) = Just (oldEvent, newMsg)+    from _ = Nothing++_EventUnknown :: Prism' Event J.Object+_EventUnknown = prism' to from+  where+    to = EventUnknown+    from (EventUnknown obj) = Just obj+    from _ = Nothing++_efLimit :: Lens' EventFilter (Maybe Int)+_efLimit = lens getter setter+  where+    getter = efLimit+    setter ef lim =  ef { efLimit = lim }++_efNotSenders :: Lens' EventFilter (Maybe [T.Text])+_efNotSenders = lens getter setter+  where+    getter = efNotSenders+    setter ef ns = ef { efNotSenders = ns }++_efNotTypes :: Lens' EventFilter (Maybe [T.Text])+_efNotTypes = lens getter setter+  where+    getter = efNotTypes+    setter ef nt = ef { efNotTypes = nt }++_efSenders :: Lens' EventFilter (Maybe [T.Text])+_efSenders = lens getter setter+  where+    getter = efSenders+    setter ef s = ef { efSenders = s }++_efTypes :: Lens' EventFilter (Maybe [T.Text])+_efTypes = lens getter setter+  where+    getter = efTypes+    setter ef t = ef { efTypes = t }++_refLimit :: Lens' RoomEventFilter (Maybe Int)+_refLimit = lens getter setter+  where+    getter = refLimit+    setter ref rl = ref { refLimit = rl }++_refNotSenders :: Lens' RoomEventFilter (Maybe [T.Text])+_refNotSenders = lens getter setter+  where+    getter = refNotSenders+    setter ref ns = ref { refNotSenders = ns }++_refNotTypes :: Lens' RoomEventFilter (Maybe [T.Text])+_refNotTypes = lens getter setter+  where+    getter = refNotTypes+    setter ref rnt = ref { refNotTypes = rnt }++_refSenders :: Lens' RoomEventFilter (Maybe [T.Text])+_refSenders = lens getter setter+ where+   getter = refSenders+   setter ref rs = ref { refSenders = rs }++_refTypes :: Lens' RoomEventFilter (Maybe [T.Text])+_refTypes = lens getter setter+  where+    getter = refTypes+    setter ref rt = ref { refTypes = rt }++_refLazyLoadMembers :: Lens' RoomEventFilter (Maybe Bool)+_refLazyLoadMembers = lens getter setter+  where+    getter = refLazyLoadMembers+    setter ref rldm = ref { refLazyLoadMembers = rldm }++_refIncludeRedundantMembers :: Lens' RoomEventFilter (Maybe Bool)+_refIncludeRedundantMembers = lens getter setter+  where+    getter = refIncludeRedundantMembers+    setter ref rirm = ref { refIncludeRedundantMembers = rirm }++_refNotRooms :: Lens' RoomEventFilter (Maybe [T.Text])+_refNotRooms = lens getter setter+  where+    getter = refNotRooms+    setter ref rnr = ref { refNotRooms = rnr }++_refRooms :: Lens' RoomEventFilter (Maybe [T.Text])+_refRooms = lens getter setter+  where+    getter = refRooms+    setter ref rr = ref { refRooms = rr }++_refContainsUrl :: Lens' RoomEventFilter (Maybe Bool)+_refContainsUrl = lens getter setter+  where+    getter = refContainsUrl+    setter ref rcu = ref { refContainsUrl = rcu }++_sfLimit :: Lens' StateFilter (Maybe Int)+_sfLimit = lens getter setter+  where+    getter = sfLimit+    setter sf sfl = sf { sfLimit = sfl }++_sfNotSenders :: Lens' StateFilter (Maybe [T.Text])+_sfNotSenders = lens getter setter+  where+    getter = sfNotSenders+    setter sf sfns = sf { sfNotSenders = sfns}++_sfTypes :: Lens' StateFilter (Maybe [T.Text])+_sfTypes = lens getter setter+  where+    getter = sfTypes+    setter sf sft = sf { sfTypes = sft }++_sfLazyLoadMembers :: Lens' StateFilter (Maybe Bool)+_sfLazyLoadMembers = lens getter setter+  where+    getter = sfLazyLoadMembers+    setter sf sflm = sf { sfLazyLoadMembers = sflm }++_sfIncludeRedundantMembers :: Lens' StateFilter (Maybe Bool)+_sfIncludeRedundantMembers = lens getter setter+  where+    getter = sfIncludeRedundantMembers+    setter sf sfirm = sf { sfIncludeRedundantMembers = sfirm }++_sfNotRooms :: Lens' StateFilter (Maybe [T.Text])+_sfNotRooms = lens getter setter+  where+    getter = sfNotRooms+    setter sf sfnr = sf { sfNotRooms = sfnr }++_sfRooms :: Lens' StateFilter (Maybe [T.Text])+_sfRooms = lens getter setter+  where+    getter = sfRooms+    setter sf sfr = sf { sfRooms = sfr }++_sfContainsUrl :: Lens' StateFilter (Maybe Bool)+_sfContainsUrl = lens getter setter+  where+    getter = sfContains_url+    setter sf cu = sf { sfContains_url = cu }++_rfNotRooms :: Lens' RoomFilter (Maybe [T.Text])+_rfNotRooms = lens getter setter+  where+    getter = rfNotRooms+    setter rm rfnr = rm { rfNotRooms = rfnr }++_rfRooms :: Lens' RoomFilter (Maybe [T.Text])+_rfRooms = lens getter setter+  where+    getter = rfRooms+    setter rm rfr = rm { rfRooms = rfr }++_rfEphemeral :: Lens' RoomFilter (Maybe RoomEventFilter)+_rfEphemeral = lens getter setter+  where+    getter = rfEphemeral+    setter rm rfe = rm { rfEphemeral = rfe }++_rfIncludeLeave :: Lens' RoomFilter (Maybe Bool)+_rfIncludeLeave = lens getter setter+  where+    getter = rfIncludeLeave+    setter rm rfil = rm { rfIncludeLeave = rfil }++_rfState :: Lens' RoomFilter (Maybe StateFilter)+_rfState = lens getter setter+  where+    getter = rfState+    setter rm rfs = rm { rfState = rfs }++_rfTimeline :: Lens' RoomFilter (Maybe RoomEventFilter)+_rfTimeline = lens getter setter+  where+    getter = rfTimeline+    setter rm rft = rm { rfTimeline = rft }++_rfAccountData :: Lens' RoomFilter (Maybe RoomEventFilter)+_rfAccountData = lens getter setter+  where+    getter = rfAccountData+    setter rm rfad = rm { rfAccountData = rfad }++_filterEventFields :: Lens' Filter (Maybe [T.Text])+_filterEventFields = lens getter setter+  where+    getter = filterEventFields+    setter fltr fef = fltr { filterEventFields = fef }++_filterEventFormat :: Lens' Filter (Maybe EventFormat)+_filterEventFormat = lens getter setter+  where+    getter = filterEventFormat+    setter fltr fef = fltr { filterEventFormat = fef }++_filterPresence :: Lens' Filter (Maybe EventFilter)+_filterPresence = lens getter setter+  where+    getter = filterPresence+    setter fltr fp = fltr { filterPresence = fp }++_filterAccountData :: Lens' Filter (Maybe EventFilter)+_filterAccountData = lens getter setter+  where+    getter = filterAccountData+    setter fltr fac = fltr { filterAccountData = fac }++_filterRoom :: Lens' Filter (Maybe RoomFilter)+_filterRoom = lens getter setter+  where+    getter = filterRoom+    setter fltr fr = fltr { filterRoom = fr }++_reContent :: Lens' RoomEvent Event+_reContent = lens getter setter+  where+    getter = reContent+    setter rEvent rc = rEvent { reContent = rc }++_reType :: Lens' RoomEvent T.Text+_reType = lens getter setter+  where+    getter = reType+    setter rEvent rt = rEvent { reType = rt }++_reEventId :: Lens' RoomEvent EventID+_reEventId = lens getter setter+  where+    getter = reEventId+    setter rEvent reid = rEvent { reEventId = reid }++_reSender :: Lens' RoomEvent Author+_reSender = lens getter setter+  where+    getter = reSender+    setter rEvent res = rEvent { reSender = res }++_rsJoinedMemberCount :: Lens' RoomSummary (Maybe Int)+_rsJoinedMemberCount = lens getter setter+  where+    getter = rsJoinedMemberCount+    setter rs rsjmc = rs { rsJoinedMemberCount = rsjmc }++_rsInvitedMemberCount :: Lens' RoomSummary (Maybe Int)+_rsInvitedMemberCount = lens getter setter+  where+    getter = rsInvitedMemberCount+    setter rs rsimc = rs { rsInvitedMemberCount = rsimc }++_tsEvents :: Lens' TimelineSync (Maybe [RoomEvent])+_tsEvents = lens getter setter+  where+    getter = tsEvents+    setter ts tse = ts { tsEvents = tse }++_tsLimited :: Lens' TimelineSync (Maybe Bool)+_tsLimited = lens getter setter+  where+    getter = tsLimited+    setter ts tsl = ts { tsLimited = tsl }++_tsPrevBatch :: Lens' TimelineSync (Maybe T.Text)+_tsPrevBatch = lens getter setter+  where+    getter = tsPrevBatch+    setter ts tspb = ts { tsPrevBatch = tspb }++_jrsSummary :: Lens' JoinedRoomSync (Maybe RoomSummary)+_jrsSummary = lens getter setter+  where+    getter = jrsSummary+    setter jrs jrss = jrs { jrsSummary = jrss }++_jrsTimeline :: Lens' JoinedRoomSync TimelineSync+_jrsTimeline = lens getter setter+  where+    getter = jrsTimeline+    setter jrs jrst = jrs { jrsTimeline = jrst }++_srNextBatch :: Lens' SyncResult T.Text+_srNextBatch = lens getter setter+  where+    getter = srNextBatch+    setter sr srnb = sr { srNextBatch = srnb }++_srRooms :: Lens' SyncResult (Maybe SyncResultRoom)+_srRooms = lens getter setter+  where+    getter = srRooms+    setter sr srr = sr { srRooms = srr }++_srrJoin :: Lens' SyncResultRoom (Maybe (M.Map T.Text JoinedRoomSync))+_srrJoin = lens getter setter+  where+    getter = srrJoin+    setter srr srrj = srr { srrJoin = srrj }++_srrInvite :: Lens' SyncResultRoom (Maybe (M.Map T.Text InvitedRoomSync))+_srrInvite = lens getter setter+  where+    getter = srrInvite+    setter srr srri = srr { srrInvite = srri }
src/Network/Matrix/Internal.hs view
@@ -14,10 +14,10 @@ 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.Aeson (FromJSON (..), Value (Object), encode, eitherDecode, object, withObject, (.:), (.:?), (.=)) import Data.ByteString.Lazy (ByteString, toStrict) import Data.Hashable (Hashable)-import Data.Maybe (fromMaybe)+import Data.Maybe (catMaybes, fromMaybe) import Data.Text (Text, pack, unpack) import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Text.IO (hPutStrLn)@@ -29,7 +29,26 @@ import System.IO (stderr)  newtype MatrixToken = MatrixToken Text+newtype Username = Username { username :: Text }+newtype DeviceId = DeviceId { deviceId :: Text }+newtype InitialDeviceDisplayName = InitialDeviceDisplayName { initialDeviceDisplayName :: Text} +data LoginSecret = Password Text | Token Text +data LoginResponse = LoginResponse+  { lrUserId :: Text+  , lrAccessToken :: Text+  , lrHomeServer :: Text+  , lrDeviceId :: Text+  }++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'+ getTokenFromEnv ::   -- | The envirnoment variable name   Text ->@@ -66,6 +85,32 @@     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"+  initRequest <- HTTP.parseUrlThrow (unpack $ baseUrl <> path)++  let (secretKey, secret, secretType) = case secret' of+        Password pass -> ("password", pass, "m.login.password")+        Token tok -> ("token", tok, "m.login.token")++  let body = HTTP.RequestBodyLBS $ encode $ object $+        [ "identifier" .= object [ "type" .= ("m.id.user" :: Text), "user" .= name ]+        , secretKey  .= secret+        , "type" .= (secretType :: Text)+        ] <> catMaybes [ fmap (("device_id" .=) . deviceId) did+                       , fmap (("initial_device_display_name" .=) . initialDeviceDisplayName) idn+                       ]++  pure $ initRequest { HTTP.method = "POST", HTTP.requestBody = body, HTTP.requestHeaders = [("Content-Type", "application/json")] }++mkLogoutRequest' :: Text -> MatrixToken -> IO HTTP.Request+mkLogoutRequest' baseUrl (MatrixToken token) = do+  let path = "/_matrix/client/r0/logout"+  initRequest <- HTTP.parseUrlThrow (unpack $ baseUrl <> path)+  let headers = [("Authorization", encodeUtf8 $ "Bearer " <> token)]+  pure $ initRequest { HTTP.method = "POST", HTTP.requestHeaders = headers }+ doRequest' :: FromJSON a => HTTP.Manager -> HTTP.Request -> IO (Either MatrixError a) doRequest' manager request = do   response <- HTTP.httpLbs request manager@@ -157,5 +202,5 @@         pure True       HTTP.InvalidUrlException _ _ -> pure False -retry :: MatrixIO a -> MatrixIO a-retry = retryWithLog 7 (hPutStrLn stderr)+retry :: (MonadIO m, MonadMask m) => MatrixM m a -> MatrixM m a+retry = retryWithLog 7 (liftIO . hPutStrLn stderr)