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 +7/−0
- matrix-client.cabal +3/−1
- src/Network/Matrix/Client.hs +81/−1
- src/Network/Matrix/Client/Lens.hs +456/−0
- src/Network/Matrix/Internal.hs +49/−4
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)