From e62b6a09c4b4bd9c7af3b3b2fa11bce6b49ad00c Mon Sep 17 00:00:00 2001 From: Bram van den Heuvel Date: Mon, 13 Mar 2023 13:50:41 +0100 Subject: [PATCH] Rename Elm types Credentials -> Vault Context (upper level) -> Credentials Context (lower level) remains called Context --- src/Internal/Api/Chain.elm | 89 ++++--- src/Internal/Api/CredUpdate.elm | 2 - src/Internal/Context.elm | 73 ------ src/Internal/Credentials.elm | 223 ++++-------------- src/Internal/Event.elm | 30 +-- src/Internal/Room.elm | 30 +-- .../Values/{Credentials.elm => Vault.elm} | 34 +-- src/Internal/Vault.elm | 216 +++++++++++++++++ 8 files changed, 354 insertions(+), 343 deletions(-) delete mode 100644 src/Internal/Context.elm rename src/Internal/Values/{Credentials.elm => Vault.elm} (60%) create mode 100644 src/Internal/Vault.elm diff --git a/src/Internal/Api/Chain.elm b/src/Internal/Api/Chain.elm index b958d01..5a64550 100644 --- a/src/Internal/Api/Chain.elm +++ b/src/Internal/Api/Chain.elm @@ -1,4 +1,5 @@ module Internal.Api.Chain exposing (..) + {-| This module aims to simplify chaining several API tasks together. Chaining tasks together is usually done through the `Task` submodule of `elm/core`, @@ -18,23 +19,29 @@ The model is like a snake: _____ /-|------------ | ------- | ------------- | -------- | |\/\/ < | accessToken | baseUrl | transactionId | API call | |------< Final API call \-|------------ | ------- | ------------- | -------- | |/\/\ - ------/ -(You're not allowed to judge my ASCII art skills unless you submit a PR with a + \-----/ + +(You're not allowed to judge my ASCII art skills unless you submit a PR with a superior ASCII snake model.) Every task will add another value to an extensible record, which can be used by later tasks in the chain. Additionally, every subtask can leave a `CredUpdate` type as a message to the Credentials to update certain information. + -} -import Internal.Tools.Exceptions as X import Internal.Api.Context as Context exposing (Context) +import Internal.Tools.Exceptions as X import Task exposing (Task) -type alias TaskChain u a b = - (Context a -> Task X.Error (TaskChainPiece u a b)) -type alias IdemChain u a = TaskChain u a a +type alias TaskChain u a b = + Context a -> Task X.Error (TaskChainPiece u a b) + + +type alias IdemChain u a = + TaskChain u a a + type TaskChainPiece u a b = TaskChainPiece @@ -42,44 +49,47 @@ type TaskChainPiece u a b , messages : List u } + {-| Chain two tasks together. The second task will only run if the first one succeeds. -} andThen : TaskChain u b c -> TaskChain u a b -> TaskChain u a c andThen f2 f1 = - (\context -> + \context -> f1 context - |> Task.andThen - (\(TaskChainPiece old) -> - context - |> old.contextChange - |> f2 - |> Task.map - (\(TaskChainPiece new) -> - TaskChainPiece - { contextChange = old.contextChange >> new.contextChange - , messages = List.append old.messages new.messages - } - ) - ) - ) + |> Task.andThen + (\(TaskChainPiece old) -> + context + |> old.contextChange + |> f2 + |> Task.map + (\(TaskChainPiece new) -> + TaskChainPiece + { contextChange = old.contextChange >> new.contextChange + , messages = List.append old.messages new.messages + } + ) + ) -{-| Optionally run a task that may provide additional information. + +{-| Optionally run a task that may provide additional information. If the provided chain fails, it will be ignored. This way, the chain can be tasked without needlessly breaking the whole chain if anything breaks in here. You cannot use this function to execute a task chain that adds or removes context. + -} maybe : IdemChain u a -> IdemChain u a maybe f = - { contextChange = identity - , messages = [] - } - |> TaskChainPiece - |> Task.succeed - |> always - |> Task.onError - |> (>>) f + { contextChange = identity + , messages = [] + } + |> TaskChainPiece + |> Task.succeed + |> always + |> Task.onError + |> (>>) f + {-| If the TaskChain fails, run this task otherwise. -} @@ -87,30 +97,33 @@ otherwise : TaskChain u a b -> TaskChain u a b -> TaskChain u a b otherwise f2 f1 context = Task.onError (always <| f2 context) (f1 context) + {-| Once all the pieces of the chain have been assembled, you can turn it into a task. The compiler will fail if the chain is missing a vital piece of information. + -} toTask : TaskChain u {} b -> Task X.Error (List u) toTask f1 = Context.init - |> f1 - |> Task.map - (\(TaskChainPiece data) -> - data.messages - ) + |> f1 + |> Task.map + (\(TaskChainPiece data) -> + data.messages + ) {-| If the TaskChain fails, this function will get it to retry. When set to 1 or lower, the task will only try once. + -} tryNTimes : Int -> TaskChain u a b -> TaskChain u a b tryNTimes n f context = if n <= 1 then f context + else (\_ -> tryNTimes (n - 1) f context) - |> Task.onError - |> (|>) (f context) - + |> Task.onError + |> (|>) (f context) diff --git a/src/Internal/Api/CredUpdate.elm b/src/Internal/Api/CredUpdate.elm index 9da7594..bd6f037 100644 --- a/src/Internal/Api/CredUpdate.elm +++ b/src/Internal/Api/CredUpdate.elm @@ -1,7 +1,5 @@ module Internal.Api.CredUpdate exposing (..) -import Hash -import Html exposing (input) import Internal.Api.Chain as Chain exposing (IdemChain, TaskChain) import Internal.Api.Context as Context exposing (VB, VBA, VBAT) import Internal.Api.GetEvent.Main as GetEvent diff --git a/src/Internal/Context.elm b/src/Internal/Context.elm deleted file mode 100644 index 5ab7ea4..0000000 --- a/src/Internal/Context.elm +++ /dev/null @@ -1,73 +0,0 @@ -module Internal.Context exposing (..) - -{-| The `Context` type serves as an extra layer between the internal Room/Event types -and the types that the user may deal with directly. - -Since pointers cannot point to values that the `Credentials` type has, -the `Credentials` type passes information down in the form of a `Context` type. - --} - -import Internal.Api.Versions.V1.Versions as V -import Internal.Tools.LoginValues as Login exposing (AccessToken(..)) - - -type Context - = Context - { access : AccessToken - , homeserver : String - , vs : Maybe V.Versions - } - - -{-| Retrieves the access token from a given `Context` value. --} -accessToken : Context -> AccessToken -accessToken (Context { access }) = - access - - -{-| Add a new access token to the `Context` type. --} -addToken : String -> Context -> Context -addToken token (Context ({ access } as data)) = - Context { data | access = Login.addToken token access } - - -{-| Add a username and password to the `Context` type. --} -addUsernameAndPassword : { username : String, password : String } -> Context -> Context -addUsernameAndPassword uap (Context ({ access } as data)) = - Context { data | access = Login.addUsernameAndPassword uap access } - - -{-| Add known spec versions to the `Context` type. --} -addVersions : V.Versions -> Context -> Context -addVersions vs (Context data) = - Context { data | vs = Just vs } - - -{-| Retrieves the base url from a given `Context` value. --} -baseUrl : Context -> String -baseUrl (Context { homeserver }) = - homeserver - - -{-| Creates a `Context` value from a base URL. --} -fromBaseUrl : String -> Context -fromBaseUrl url = - Context - { access = NoAccess - , homeserver = url - , vs = Nothing - } - - -{-| Retrieves the spec versions from a given `Context` value. --} -versions : Context -> Maybe V.Versions -versions (Context { vs }) = - vs diff --git a/src/Internal/Credentials.elm b/src/Internal/Credentials.elm index 9f8a77e..319b16e 100644 --- a/src/Internal/Credentials.elm +++ b/src/Internal/Credentials.elm @@ -1,216 +1,73 @@ module Internal.Credentials exposing (..) -{-| The Credentials type is the keychain that stores all tokens, values, -numbers and other types that need to be remembered. +{-| The `Credentials` type serves as an extra layer between the internal Room/Event types +and the types that the user may deal with directly. -This file combines the internal functions with the API endpoints to create a fully functional Credentials keychain. +Since pointers cannot point to values that the `Vault` type has, +the `Vault` type passes information down in the form of a `Credentials` type. -} -import Dict -import Internal.Api.Task as Api -import Internal.Api.CredUpdate exposing (CredUpdate(..)) -import Internal.Context as Context exposing (Context) -import Internal.Event as Event -import Internal.Room as Room -import Internal.Tools.Exceptions as X -import Internal.Values.Credentials as Internal -import Internal.Values.Event as IEvent -import Internal.Values.Room as IRoom -import Internal.Values.StateManager as StateManager -import Task exposing (Task) +import Internal.Api.Versions.V1.Versions as V +import Internal.Tools.LoginValues as Login exposing (AccessToken(..)) -{-| You can consider the `Credentials` type as a large ring of keys, -and Elm will figure out which key to use. -If you pass the `Credentials` into any function, then the library will look for -the right keys and tokens to get the right information. --} type Credentials = Credentials - { cred : Internal.ICredentials - , context : Context + { access : AccessToken + , homeserver : String + , vs : Maybe V.Versions } -{-| Get a Credentials type based on an unknown access token. - -This is an easier way to connect to a Matrix homeserver, but your access may end -when the access token expires, is revoked or something else happens. - +{-| Retrieves the access token from a given `Credentials` value. -} -fromAccessToken : { baseUrl : String, accessToken : String } -> Credentials -fromAccessToken { baseUrl, accessToken } = - Context.fromBaseUrl baseUrl - |> Context.addToken accessToken - |> (\context -> - { cred = Internal.init, context = context } - ) - |> Credentials +accessToken : Credentials -> AccessToken +accessToken (Credentials { access }) = + access -{-| Get a Credentials type using a username and password. +{-| Add a new access token to the `Credentials` type. -} -fromLoginCredentials : { username : String, password : String, baseUrl : String } -> Credentials -fromLoginCredentials { username, password, baseUrl } = - Context.fromBaseUrl baseUrl - |> Context.addUsernameAndPassword - { username = username - , password = password - } - |> (\context -> - { cred = Internal.init, context = context } - ) - |> Credentials +addToken : String -> Credentials -> Credentials +addToken token (Credentials ({ access } as data)) = + Credentials { data | access = Login.addToken token access } -{-| Get a room based on its id. +{-| Add a username and password to the `Credentials` type. -} -getRoomById : String -> Credentials -> Maybe Room.Room -getRoomById roomId (Credentials { cred, context }) = - Internal.getRoomById roomId cred - |> Maybe.map (Room.withContext context) +addUsernameAndPassword : { username : String, password : String } -> Credentials -> Credentials +addUsernameAndPassword uap (Credentials ({ access } as data)) = + Credentials { data | access = Login.addUsernameAndPassword uap access } -{-| Insert an internal room type into the credentials. +{-| Add known spec versions to the `Credentials` type. -} -insertInternalRoom : IRoom.IRoom -> Credentials -> Credentials -insertInternalRoom iroom (Credentials data) = - Credentials { data | cred = Internal.insertRoom iroom data.cred } +addVersions : V.Versions -> Credentials -> Credentials +addVersions vs (Credentials data) = + Credentials { data | vs = Just vs } -{-| Internal a full room type into the credentials. +{-| Retrieves the base url from a given `Credentials` value. -} -insertRoom : Room.Room -> Credentials -> Credentials -insertRoom = - Room.withoutContext >> insertInternalRoom +baseUrl : Credentials -> String +baseUrl (Credentials { homeserver }) = + homeserver -{-| Update the Credentials type with new values +{-| Creates a `Credentials` value from a base URL. -} -updateWith : CredUpdate -> Credentials -> Credentials -updateWith credUpdate ((Credentials ({ cred, context } as data)) as credentials) = - case credUpdate of - MultipleUpdates updates -> - List.foldl updateWith credentials updates - - GetEvent input output -> - case getRoomById input.roomId credentials of - Just room -> - output - |> Event.initFromGetEvent - |> Room.addInternalEvent - |> (|>) room - |> insertRoom - |> (|>) credentials - - Nothing -> - credentials - - -- TODO - InviteSent _ _ -> - credentials - - JoinedMembersToRoom _ _ -> - credentials - - -- TODO - MessageEventSent _ _ -> - credentials - - -- TODO - RedactedEvent _ _ -> - credentials - - -- TODO - StateEventSent _ _ -> - credentials - - -- TODO - SyncUpdate input output -> - let - jRooms : List IRoom.IRoom - jRooms = - output.rooms - |> Maybe.map .join - |> Maybe.withDefault Dict.empty - |> Dict.toList - |> List.map - (\( roomId, jroom ) -> - case getRoomById roomId credentials of - -- Update existing room - Just room -> - case jroom.timeline of - Just timeline -> - room - |> Room.withoutContext - |> IRoom.addEvents - { events = - List.map - (Event.initFromClientEventWithoutRoomId roomId) - timeline.events - , limited = timeline.limited - , nextBatch = output.nextBatch - , prevBatch = - timeline.prevBatch - |> Maybe.withDefault - (Maybe.withDefault "" input.since) - , stateDelta = - jroom.state - |> Maybe.map - (.events - >> List.map (Event.initFromClientEventWithoutRoomId roomId) - >> StateManager.fromEventList - ) - } - - Nothing -> - Room.withoutContext room - - -- Add new room - Nothing -> - jroom - |> Room.initFromJoinedRoom { nextBatch = output.nextBatch, roomId = roomId } - ) - in - cred - |> Internal.addSince output.nextBatch - |> List.foldl Internal.insertRoom - |> (|>) jRooms - |> (\x -> { cred = x, context = context }) - |> Credentials - - UpdateAccessToken token -> - Credentials { data | context = Context.addToken token context } - - UpdateVersions versions -> - Credentials { data | context = Context.addVersions versions context } - - -- TODO: Save all info - LoggedInWithUsernameAndPassword _ output -> - Credentials { data | context = Context.addToken output.accessToken context } - - -{-| Synchronize credentials --} -sync : Credentials -> Task X.Error CredUpdate -sync (Credentials { cred, context }) = - Api.sync - { accessToken = Context.accessToken context - , baseUrl = Context.baseUrl context - , filter = Nothing - , fullState = Nothing - , setPresence = Nothing - , since = Internal.getSince cred - , timeout = Just 30 - , versions = Context.versions context +fromBaseUrl : String -> Credentials +fromBaseUrl url = + Credentials + { access = NoAccess + , homeserver = url + , vs = Nothing } -{-| Get a list of all synchronised rooms. +{-| Retrieves the spec versions from a given `Credentials` value. -} -rooms : Credentials -> List Room.Room -rooms (Credentials { cred, context }) = - cred - |> Internal.getRooms - |> List.map (Room.withContext context) +versions : Credentials -> Maybe V.Versions +versions (Credentials { vs }) = + vs diff --git a/src/Internal/Event.elm b/src/Internal/Event.elm index 778274f..b64b2d1 100644 --- a/src/Internal/Event.elm +++ b/src/Internal/Event.elm @@ -10,7 +10,7 @@ resend other events or forward them elsewhere. import Internal.Api.GetEvent.Main as GetEvent import Internal.Api.GetEvent.V1.SpecObjects as GetEventSO import Internal.Api.Sync.V2.SpecObjects as SyncSO -import Internal.Context exposing (Context) +import Internal.Credentials exposing (Credentials) import Internal.Tools.Timestamp exposing (Timestamp) import Internal.Values.Event as Internal import Json.Encode as E @@ -21,15 +21,15 @@ import Json.Encode as E type Event = Event { event : Internal.IEvent - , context : Context + , context : Credentials } {-| Using the credentials' background information and an internal event type, create an interactive event type. -} -withContext : Context -> Internal.IEvent -> Event -withContext context event = +withCredentials : Credentials -> Internal.IEvent -> Event +withCredentials context event = Event { event = event , context = context @@ -90,8 +90,8 @@ initFromClientEventWithoutRoomId rId output = {-| Get the internal event type that is hidden in the interactive event type. -} -withoutContext : Event -> Internal.IEvent -withoutContext (Event { event }) = +withoutCredentials : Event -> Internal.IEvent +withoutCredentials (Event { event }) = event @@ -101,42 +101,42 @@ withoutContext (Event { event }) = content : Event -> E.Value content = - withoutContext >> Internal.content + withoutCredentials >> Internal.content eventId : Event -> String eventId = - withoutContext >> Internal.eventId + withoutCredentials >> Internal.eventId originServerTs : Event -> Timestamp originServerTs = - withoutContext >> Internal.originServerTs + withoutCredentials >> Internal.originServerTs roomId : Event -> String roomId = - withoutContext >> Internal.roomId + withoutCredentials >> Internal.roomId sender : Event -> String sender = - withoutContext >> Internal.sender + withoutCredentials >> Internal.sender stateKey : Event -> Maybe String stateKey = - withoutContext >> Internal.stateKey + withoutCredentials >> Internal.stateKey contentType : Event -> String contentType = - withoutContext >> Internal.contentType + withoutCredentials >> Internal.contentType age : Event -> Maybe Int age = - withoutContext >> Internal.age + withoutCredentials >> Internal.age redactedBecause : Event -> Maybe Event @@ -151,4 +151,4 @@ redactedBecause (Event data) = transactionId : Event -> Maybe String transactionId = - withoutContext >> Internal.transactionId + withoutCredentials >> Internal.transactionId diff --git a/src/Internal/Room.elm b/src/Internal/Room.elm index 5feaff6..70dc638 100644 --- a/src/Internal/Room.elm +++ b/src/Internal/Room.elm @@ -7,7 +7,7 @@ import Dict import Internal.Api.CredUpdate exposing (CredUpdate) import Internal.Api.Sync.V2.SpecObjects as Sync import Internal.Api.Task as Api -import Internal.Context as Context exposing (Context) +import Internal.Credentials as Credentials exposing (Credentials) import Internal.Event as Event exposing (Event) import Internal.Tools.Exceptions as X import Internal.Tools.Hashdict as Hashdict @@ -30,7 +30,7 @@ to it. type Room = Room { room : Internal.IRoom - , context : Context + , context : Credentials } @@ -98,13 +98,13 @@ addInternalEvent ievent (Room ({ room } as data)) = -} addEvent : Event -> Room -> Room addEvent = - Event.withoutContext >> addInternalEvent + Event.withoutCredentials >> addInternalEvent {-| Creates a new `Room` object with the given parameters. -} -withContext : Context -> Internal.IRoom -> Room -withContext context room = +withCredentials : Credentials -> Internal.IRoom -> Room +withCredentials context room = Room { context = context , room = room @@ -113,8 +113,8 @@ withContext context room = {-| Retrieves the `Internal.IRoom` type contained within the given `Room`. -} -withoutContext : Room -> Internal.IRoom -withoutContext (Room { room }) = +withoutCredentials : Room -> Internal.IRoom +withoutCredentials (Room { room }) = room @@ -124,14 +124,14 @@ mostRecentEvents : Room -> List Event mostRecentEvents (Room { context, room }) = room |> Internal.mostRecentEvents - |> List.map (Event.withContext context) + |> List.map (Event.withCredentials context) {-| Retrieves the ID of the Matrix room associated with the given `Room`. -} roomId : Room -> String roomId = - withoutContext >> Internal.roomId + withoutCredentials >> Internal.roomId {-| Sends a new event to the Matrix room associated with the given `Room`. @@ -139,12 +139,12 @@ roomId = sendEvent : Room -> { eventType : String, content : E.Value } -> Task X.Error CredUpdate sendEvent (Room { context, room }) { eventType, content } = Api.sendMessageEvent - { accessToken = Context.accessToken context - , baseUrl = Context.baseUrl context + { accessToken = Credentials.accessToken context + , baseUrl = Credentials.baseUrl context , content = content , eventType = eventType , roomId = Internal.roomId room - , versions = Context.versions context + , versions = Credentials.versions context , extraTransactionNoise = "content-value:" } @@ -154,8 +154,8 @@ sendEvent (Room { context, room }) { eventType, content } = sendMessage : Room -> String -> Task X.Error CredUpdate sendMessage (Room { context, room }) text = Api.sendMessageEvent - { accessToken = Context.accessToken context - , baseUrl = Context.baseUrl context + { accessToken = Credentials.accessToken context + , baseUrl = Credentials.baseUrl context , content = E.object [ ( "msgtype", E.string "m.text" ) @@ -163,6 +163,6 @@ sendMessage (Room { context, room }) text = ] , eventType = "m.room.message" , roomId = Internal.roomId room - , versions = Context.versions context + , versions = Credentials.versions context , extraTransactionNoise = "literal-message:" ++ text } diff --git a/src/Internal/Values/Credentials.elm b/src/Internal/Values/Vault.elm similarity index 60% rename from src/Internal/Values/Credentials.elm rename to src/Internal/Values/Vault.elm index 21d3edd..01b7ad1 100644 --- a/src/Internal/Values/Credentials.elm +++ b/src/Internal/Values/Vault.elm @@ -1,4 +1,4 @@ -module Internal.Values.Credentials exposing (..) +module Internal.Values.Vault exposing (..) {-| The Credentials type is the keychain of the Matrix SDK. It handles all communication with the homeserver. @@ -8,8 +8,8 @@ import Internal.Tools.Hashdict as Hashdict exposing (Hashdict) import Internal.Values.Room as Room exposing (IRoom) -type ICredentials - = ICredentials +type IVault + = IVault { rooms : Hashdict IRoom , since : Maybe String } @@ -17,37 +17,37 @@ type ICredentials {-| Add a new `since` token to sync from. -} -addSince : String -> ICredentials -> ICredentials -addSince since (ICredentials data) = - ICredentials { data | since = Just since } +addSince : String -> IVault -> IVault +addSince since (IVault data) = + IVault { data | since = Just since } {-| Get a room from the Credentials type by the room's id. -} -getRoomById : String -> ICredentials -> Maybe IRoom -getRoomById roomId (ICredentials cred) = +getRoomById : String -> IVault -> Maybe IRoom +getRoomById roomId (IVault cred) = Hashdict.get roomId cred.rooms {-| Get a list of all synchronised rooms. -} -getRooms : ICredentials -> List IRoom -getRooms (ICredentials { rooms }) = +getRooms : IVault -> List IRoom +getRooms (IVault { rooms }) = Hashdict.values rooms {-| Get the latest `since` token. -} -getSince : ICredentials -> Maybe String -getSince (ICredentials { since }) = +getSince : IVault -> Maybe String +getSince (IVault { since }) = since {-| Create new empty Credentials. -} -init : ICredentials +init : IVault init = - ICredentials + IVault { rooms = Hashdict.empty Room.roomId , since = Nothing } @@ -58,7 +58,7 @@ init = This function can hence also be used as an update function for rooms. -} -insertRoom : IRoom -> ICredentials -> ICredentials -insertRoom room (ICredentials cred) = - ICredentials +insertRoom : IRoom -> IVault -> IVault +insertRoom room (IVault cred) = + IVault { cred | rooms = Hashdict.insert room cred.rooms } diff --git a/src/Internal/Vault.elm b/src/Internal/Vault.elm new file mode 100644 index 0000000..6a9328b --- /dev/null +++ b/src/Internal/Vault.elm @@ -0,0 +1,216 @@ +module Internal.Vault exposing (..) + +{-| The Vault type is the keychain that stores all tokens, values, +numbers and other types that need to be remembered. + +This file combines the internal functions with the API endpoints to create a fully functional Vault keychain. + +-} + +import Dict +import Internal.Api.CredUpdate exposing (CredUpdate(..)) +import Internal.Api.Task as Api +import Internal.Context as Context exposing (Context) +import Internal.Event as Event +import Internal.Room as Room +import Internal.Tools.Exceptions as X +import Internal.Values.Event as IEvent +import Internal.Values.Room as IRoom +import Internal.Values.StateManager as StateManager +import Internal.Values.Vault as Internal +import Task exposing (Task) + + +{-| You can consider the `Vault` type as a large ring of keys, +and Elm will figure out which key to use. +If you pass the `Vault` into any function, then the library will look for +the right keys and tokens to get the right information. +-} +type Vault + = Vault + { cred : Internal.IVault + , context : Context + } + + +{-| Get a Vault type based on an unknown access token. + +This is an easier way to connect to a Matrix homeserver, but your access may end +when the access token expires, is revoked or something else happens. + +-} +fromAccessToken : { baseUrl : String, accessToken : String } -> Vault +fromAccessToken { baseUrl, accessToken } = + Context.fromBaseUrl baseUrl + |> Context.addToken accessToken + |> (\context -> + { cred = Internal.init, context = context } + ) + |> Vault + + +{-| Get a Vault type using a username and password. +-} +fromLoginVault : { username : String, password : String, baseUrl : String } -> Vault +fromLoginVault { username, password, baseUrl } = + Context.fromBaseUrl baseUrl + |> Context.addUsernameAndPassword + { username = username + , password = password + } + |> (\context -> + { cred = Internal.init, context = context } + ) + |> Vault + + +{-| Get a room based on its id. +-} +getRoomById : String -> Vault -> Maybe Room.Room +getRoomById roomId (Vault { cred, context }) = + Internal.getRoomById roomId cred + |> Maybe.map (Room.withContext context) + + +{-| Insert an internal room type into the credentials. +-} +insertInternalRoom : IRoom.IRoom -> Vault -> Vault +insertInternalRoom iroom (Vault data) = + Vault { data | cred = Internal.insertRoom iroom data.cred } + + +{-| Internal a full room type into the credentials. +-} +insertRoom : Room.Room -> Vault -> Vault +insertRoom = + Room.withoutContext >> insertInternalRoom + + +{-| Update the Vault type with new values +-} +updateWith : CredUpdate -> Vault -> Vault +updateWith credUpdate ((Vault ({ cred, context } as data)) as credentials) = + case credUpdate of + MultipleUpdates updates -> + List.foldl updateWith credentials updates + + GetEvent input output -> + case getRoomById input.roomId credentials of + Just room -> + output + |> Event.initFromGetEvent + |> Room.addInternalEvent + |> (|>) room + |> insertRoom + |> (|>) credentials + + Nothing -> + credentials + + -- TODO + InviteSent _ _ -> + credentials + + JoinedMembersToRoom _ _ -> + credentials + + -- TODO + MessageEventSent _ _ -> + credentials + + -- TODO + RedactedEvent _ _ -> + credentials + + -- TODO + StateEventSent _ _ -> + credentials + + -- TODO + SyncUpdate input output -> + let + jRooms : List IRoom.IRoom + jRooms = + output.rooms + |> Maybe.map .join + |> Maybe.withDefault Dict.empty + |> Dict.toList + |> List.map + (\( roomId, jroom ) -> + case getRoomById roomId credentials of + -- Update existing room + Just room -> + case jroom.timeline of + Just timeline -> + room + |> Room.withoutContext + |> IRoom.addEvents + { events = + List.map + (Event.initFromClientEventWithoutRoomId roomId) + timeline.events + , limited = timeline.limited + , nextBatch = output.nextBatch + , prevBatch = + timeline.prevBatch + |> Maybe.withDefault + (Maybe.withDefault "" input.since) + , stateDelta = + jroom.state + |> Maybe.map + (.events + >> List.map (Event.initFromClientEventWithoutRoomId roomId) + >> StateManager.fromEventList + ) + } + + Nothing -> + Room.withoutContext room + + -- Add new room + Nothing -> + jroom + |> Room.initFromJoinedRoom { nextBatch = output.nextBatch, roomId = roomId } + ) + in + cred + |> Internal.addSince output.nextBatch + |> List.foldl Internal.insertRoom + |> (|>) jRooms + |> (\x -> { cred = x, context = context }) + |> Vault + + UpdateAccessToken token -> + Vault { data | context = Context.addToken token context } + + UpdateVersions versions -> + Vault { data | context = Context.addVersions versions context } + + -- TODO: Save all info + LoggedInWithUsernameAndPassword _ output -> + Vault { data | context = Context.addToken output.accessToken context } + + +{-| Synchronize credentials +-} +sync : Vault -> Task X.Error CredUpdate +sync (Vault { cred, context }) = + Api.sync + { accessToken = Context.accessToken context + , baseUrl = Context.baseUrl context + , filter = Nothing + , fullState = Nothing + , setPresence = Nothing + , since = Internal.getSince cred + , timeout = Just 30 + , versions = Context.versions context + } + + +{-| Get a list of all synchronised rooms. +-} +rooms : Vault -> List Room.Room +rooms (Vault { cred, context }) = + cred + |> Internal.getRooms + |> List.map (Room.withContext context)