Rename Elm types

Credentials -> Vault

Context (upper level) -> Credentials

Context (lower level) remains called Context
pull/1/head
Bram van den Heuvel 2023-03-13 13:50:41 +01:00
parent d3637cf45f
commit e62b6a09c4
8 changed files with 354 additions and 343 deletions

View File

@ -1,4 +1,5 @@
module Internal.Api.Chain exposing (..) module Internal.Api.Chain exposing (..)
{-| This module aims to simplify chaining several API tasks together. {-| This module aims to simplify chaining several API tasks together.
Chaining tasks together is usually done through the `Task` submodule of `elm/core`, 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 < | 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.) superior ASCII snake model.)
Every task will add another value to an extensible record, which can be used 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` by later tasks in the chain. Additionally, every subtask can leave a `CredUpdate`
type as a message to the Credentials to update certain information. 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.Api.Context as Context exposing (Context)
import Internal.Tools.Exceptions as X
import Task exposing (Task) 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 type TaskChainPiece u a b
= TaskChainPiece = TaskChainPiece
@ -42,26 +49,27 @@ type TaskChainPiece u a b
, messages : List u , messages : List u
} }
{-| Chain two tasks together. The second task will only run if the first one succeeds. {-| 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 : TaskChain u b c -> TaskChain u a b -> TaskChain u a c
andThen f2 f1 = andThen f2 f1 =
(\context -> \context ->
f1 context f1 context
|> Task.andThen |> Task.andThen
(\(TaskChainPiece old) -> (\(TaskChainPiece old) ->
context context
|> old.contextChange |> old.contextChange
|> f2 |> f2
|> Task.map |> Task.map
(\(TaskChainPiece new) -> (\(TaskChainPiece new) ->
TaskChainPiece TaskChainPiece
{ contextChange = old.contextChange >> new.contextChange { contextChange = old.contextChange >> new.contextChange
, messages = List.append old.messages new.messages , 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.
@ -69,17 +77,19 @@ If the provided chain fails, it will be ignored. This way, the chain can be task
without needlessly breaking the whole chain if anything breaks in here. 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. You cannot use this function to execute a task chain that adds or removes context.
-} -}
maybe : IdemChain u a -> IdemChain u a maybe : IdemChain u a -> IdemChain u a
maybe f = maybe f =
{ contextChange = identity { contextChange = identity
, messages = [] , messages = []
} }
|> TaskChainPiece |> TaskChainPiece
|> Task.succeed |> Task.succeed
|> always |> always
|> Task.onError |> Task.onError
|> (>>) f |> (>>) f
{-| If the TaskChain fails, run this task otherwise. {-| 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 = otherwise f2 f1 context =
Task.onError (always <| f2 context) (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. {-| 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. The compiler will fail if the chain is missing a vital piece of information.
-} -}
toTask : TaskChain u {} b -> Task X.Error (List u) toTask : TaskChain u {} b -> Task X.Error (List u)
toTask f1 = toTask f1 =
Context.init Context.init
|> f1 |> f1
|> Task.map |> Task.map
(\(TaskChainPiece data) -> (\(TaskChainPiece data) ->
data.messages data.messages
) )
{-| If the TaskChain fails, this function will get it to retry. {-| If the TaskChain fails, this function will get it to retry.
When set to 1 or lower, the task will only try once. When set to 1 or lower, the task will only try once.
-} -}
tryNTimes : Int -> TaskChain u a b -> TaskChain u a b tryNTimes : Int -> TaskChain u a b -> TaskChain u a b
tryNTimes n f context = tryNTimes n f context =
if n <= 1 then if n <= 1 then
f context f context
else else
(\_ -> tryNTimes (n - 1) f context) (\_ -> tryNTimes (n - 1) f context)
|> Task.onError |> Task.onError
|> (|>) (f context) |> (|>) (f context)

View File

@ -1,7 +1,5 @@
module Internal.Api.CredUpdate exposing (..) module Internal.Api.CredUpdate exposing (..)
import Hash
import Html exposing (input)
import Internal.Api.Chain as Chain exposing (IdemChain, TaskChain) import Internal.Api.Chain as Chain exposing (IdemChain, TaskChain)
import Internal.Api.Context as Context exposing (VB, VBA, VBAT) import Internal.Api.Context as Context exposing (VB, VBA, VBAT)
import Internal.Api.GetEvent.Main as GetEvent import Internal.Api.GetEvent.Main as GetEvent

View File

@ -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

View File

@ -1,216 +1,73 @@
module Internal.Credentials exposing (..) module Internal.Credentials exposing (..)
{-| The Credentials type is the keychain that stores all tokens, values, {-| The `Credentials` type serves as an extra layer between the internal Room/Event types
numbers and other types that need to be remembered. 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.Versions.V1.Versions as V
import Internal.Api.Task as Api import Internal.Tools.LoginValues as Login exposing (AccessToken(..))
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)
{-| 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 type Credentials
= Credentials = Credentials
{ cred : Internal.ICredentials { access : AccessToken
, context : Context , homeserver : String
, vs : Maybe V.Versions
} }
{-| Get a Credentials type based on an unknown access token. {-| Retrieves the access token from a given `Credentials` value.
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 } -> Credentials accessToken : Credentials -> AccessToken
fromAccessToken { baseUrl, accessToken } = accessToken (Credentials { access }) =
Context.fromBaseUrl baseUrl access
|> Context.addToken accessToken
|> (\context ->
{ cred = Internal.init, context = context }
)
|> Credentials
{-| 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 addToken : String -> Credentials -> Credentials
fromLoginCredentials { username, password, baseUrl } = addToken token (Credentials ({ access } as data)) =
Context.fromBaseUrl baseUrl Credentials { data | access = Login.addToken token access }
|> Context.addUsernameAndPassword
{ username = username
, password = password
}
|> (\context ->
{ cred = Internal.init, context = context }
)
|> Credentials
{-| Get a room based on its id. {-| Add a username and password to the `Credentials` type.
-} -}
getRoomById : String -> Credentials -> Maybe Room.Room addUsernameAndPassword : { username : String, password : String } -> Credentials -> Credentials
getRoomById roomId (Credentials { cred, context }) = addUsernameAndPassword uap (Credentials ({ access } as data)) =
Internal.getRoomById roomId cred Credentials { data | access = Login.addUsernameAndPassword uap access }
|> Maybe.map (Room.withContext context)
{-| Insert an internal room type into the credentials. {-| Add known spec versions to the `Credentials` type.
-} -}
insertInternalRoom : IRoom.IRoom -> Credentials -> Credentials addVersions : V.Versions -> Credentials -> Credentials
insertInternalRoom iroom (Credentials data) = addVersions vs (Credentials data) =
Credentials { data | cred = Internal.insertRoom iroom data.cred } 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 baseUrl : Credentials -> String
insertRoom = baseUrl (Credentials { homeserver }) =
Room.withoutContext >> insertInternalRoom homeserver
{-| Update the Credentials type with new values {-| Creates a `Credentials` value from a base URL.
-} -}
updateWith : CredUpdate -> Credentials -> Credentials fromBaseUrl : String -> Credentials
updateWith credUpdate ((Credentials ({ cred, context } as data)) as credentials) = fromBaseUrl url =
case credUpdate of Credentials
MultipleUpdates updates -> { access = NoAccess
List.foldl updateWith credentials updates , homeserver = url
, vs = Nothing
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
} }
{-| Get a list of all synchronised rooms. {-| Retrieves the spec versions from a given `Credentials` value.
-} -}
rooms : Credentials -> List Room.Room versions : Credentials -> Maybe V.Versions
rooms (Credentials { cred, context }) = versions (Credentials { vs }) =
cred vs
|> Internal.getRooms
|> List.map (Room.withContext context)

View File

@ -10,7 +10,7 @@ resend other events or forward them elsewhere.
import Internal.Api.GetEvent.Main as GetEvent import Internal.Api.GetEvent.Main as GetEvent
import Internal.Api.GetEvent.V1.SpecObjects as GetEventSO import Internal.Api.GetEvent.V1.SpecObjects as GetEventSO
import Internal.Api.Sync.V2.SpecObjects as SyncSO 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.Tools.Timestamp exposing (Timestamp)
import Internal.Values.Event as Internal import Internal.Values.Event as Internal
import Json.Encode as E import Json.Encode as E
@ -21,15 +21,15 @@ import Json.Encode as E
type Event type Event
= Event = Event
{ event : Internal.IEvent { event : Internal.IEvent
, context : Context , context : Credentials
} }
{-| Using the credentials' background information and an internal event type, {-| Using the credentials' background information and an internal event type,
create an interactive event type. create an interactive event type.
-} -}
withContext : Context -> Internal.IEvent -> Event withCredentials : Credentials -> Internal.IEvent -> Event
withContext context event = withCredentials context event =
Event Event
{ event = event { event = event
, context = context , context = context
@ -90,8 +90,8 @@ initFromClientEventWithoutRoomId rId output =
{-| Get the internal event type that is hidden in the interactive event type. {-| Get the internal event type that is hidden in the interactive event type.
-} -}
withoutContext : Event -> Internal.IEvent withoutCredentials : Event -> Internal.IEvent
withoutContext (Event { event }) = withoutCredentials (Event { event }) =
event event
@ -101,42 +101,42 @@ withoutContext (Event { event }) =
content : Event -> E.Value content : Event -> E.Value
content = content =
withoutContext >> Internal.content withoutCredentials >> Internal.content
eventId : Event -> String eventId : Event -> String
eventId = eventId =
withoutContext >> Internal.eventId withoutCredentials >> Internal.eventId
originServerTs : Event -> Timestamp originServerTs : Event -> Timestamp
originServerTs = originServerTs =
withoutContext >> Internal.originServerTs withoutCredentials >> Internal.originServerTs
roomId : Event -> String roomId : Event -> String
roomId = roomId =
withoutContext >> Internal.roomId withoutCredentials >> Internal.roomId
sender : Event -> String sender : Event -> String
sender = sender =
withoutContext >> Internal.sender withoutCredentials >> Internal.sender
stateKey : Event -> Maybe String stateKey : Event -> Maybe String
stateKey = stateKey =
withoutContext >> Internal.stateKey withoutCredentials >> Internal.stateKey
contentType : Event -> String contentType : Event -> String
contentType = contentType =
withoutContext >> Internal.contentType withoutCredentials >> Internal.contentType
age : Event -> Maybe Int age : Event -> Maybe Int
age = age =
withoutContext >> Internal.age withoutCredentials >> Internal.age
redactedBecause : Event -> Maybe Event redactedBecause : Event -> Maybe Event
@ -151,4 +151,4 @@ redactedBecause (Event data) =
transactionId : Event -> Maybe String transactionId : Event -> Maybe String
transactionId = transactionId =
withoutContext >> Internal.transactionId withoutCredentials >> Internal.transactionId

View File

@ -7,7 +7,7 @@ import Dict
import Internal.Api.CredUpdate exposing (CredUpdate) import Internal.Api.CredUpdate exposing (CredUpdate)
import Internal.Api.Sync.V2.SpecObjects as Sync import Internal.Api.Sync.V2.SpecObjects as Sync
import Internal.Api.Task as Api 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.Event as Event exposing (Event)
import Internal.Tools.Exceptions as X import Internal.Tools.Exceptions as X
import Internal.Tools.Hashdict as Hashdict import Internal.Tools.Hashdict as Hashdict
@ -30,7 +30,7 @@ to it.
type Room type Room
= Room = Room
{ room : Internal.IRoom { room : Internal.IRoom
, context : Context , context : Credentials
} }
@ -98,13 +98,13 @@ addInternalEvent ievent (Room ({ room } as data)) =
-} -}
addEvent : Event -> Room -> Room addEvent : Event -> Room -> Room
addEvent = addEvent =
Event.withoutContext >> addInternalEvent Event.withoutCredentials >> addInternalEvent
{-| Creates a new `Room` object with the given parameters. {-| Creates a new `Room` object with the given parameters.
-} -}
withContext : Context -> Internal.IRoom -> Room withCredentials : Credentials -> Internal.IRoom -> Room
withContext context room = withCredentials context room =
Room Room
{ context = context { context = context
, room = room , room = room
@ -113,8 +113,8 @@ withContext context room =
{-| Retrieves the `Internal.IRoom` type contained within the given `Room`. {-| Retrieves the `Internal.IRoom` type contained within the given `Room`.
-} -}
withoutContext : Room -> Internal.IRoom withoutCredentials : Room -> Internal.IRoom
withoutContext (Room { room }) = withoutCredentials (Room { room }) =
room room
@ -124,14 +124,14 @@ mostRecentEvents : Room -> List Event
mostRecentEvents (Room { context, room }) = mostRecentEvents (Room { context, room }) =
room room
|> Internal.mostRecentEvents |> Internal.mostRecentEvents
|> List.map (Event.withContext context) |> List.map (Event.withCredentials context)
{-| Retrieves the ID of the Matrix room associated with the given `Room`. {-| Retrieves the ID of the Matrix room associated with the given `Room`.
-} -}
roomId : Room -> String roomId : Room -> String
roomId = roomId =
withoutContext >> Internal.roomId withoutCredentials >> Internal.roomId
{-| Sends a new event to the Matrix room associated with the given `Room`. {-| 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 -> { eventType : String, content : E.Value } -> Task X.Error CredUpdate
sendEvent (Room { context, room }) { eventType, content } = sendEvent (Room { context, room }) { eventType, content } =
Api.sendMessageEvent Api.sendMessageEvent
{ accessToken = Context.accessToken context { accessToken = Credentials.accessToken context
, baseUrl = Context.baseUrl context , baseUrl = Credentials.baseUrl context
, content = content , content = content
, eventType = eventType , eventType = eventType
, roomId = Internal.roomId room , roomId = Internal.roomId room
, versions = Context.versions context , versions = Credentials.versions context
, extraTransactionNoise = "content-value:<object>" , extraTransactionNoise = "content-value:<object>"
} }
@ -154,8 +154,8 @@ sendEvent (Room { context, room }) { eventType, content } =
sendMessage : Room -> String -> Task X.Error CredUpdate sendMessage : Room -> String -> Task X.Error CredUpdate
sendMessage (Room { context, room }) text = sendMessage (Room { context, room }) text =
Api.sendMessageEvent Api.sendMessageEvent
{ accessToken = Context.accessToken context { accessToken = Credentials.accessToken context
, baseUrl = Context.baseUrl context , baseUrl = Credentials.baseUrl context
, content = , content =
E.object E.object
[ ( "msgtype", E.string "m.text" ) [ ( "msgtype", E.string "m.text" )
@ -163,6 +163,6 @@ sendMessage (Room { context, room }) text =
] ]
, eventType = "m.room.message" , eventType = "m.room.message"
, roomId = Internal.roomId room , roomId = Internal.roomId room
, versions = Context.versions context , versions = Credentials.versions context
, extraTransactionNoise = "literal-message:" ++ text , extraTransactionNoise = "literal-message:" ++ text
} }

View File

@ -1,4 +1,4 @@
module Internal.Values.Credentials exposing (..) module Internal.Values.Vault exposing (..)
{-| The Credentials type is the keychain of the Matrix SDK. {-| The Credentials type is the keychain of the Matrix SDK.
It handles all communication with the homeserver. 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) import Internal.Values.Room as Room exposing (IRoom)
type ICredentials type IVault
= ICredentials = IVault
{ rooms : Hashdict IRoom { rooms : Hashdict IRoom
, since : Maybe String , since : Maybe String
} }
@ -17,37 +17,37 @@ type ICredentials
{-| Add a new `since` token to sync from. {-| Add a new `since` token to sync from.
-} -}
addSince : String -> ICredentials -> ICredentials addSince : String -> IVault -> IVault
addSince since (ICredentials data) = addSince since (IVault data) =
ICredentials { data | since = Just since } IVault { data | since = Just since }
{-| Get a room from the Credentials type by the room's id. {-| Get a room from the Credentials type by the room's id.
-} -}
getRoomById : String -> ICredentials -> Maybe IRoom getRoomById : String -> IVault -> Maybe IRoom
getRoomById roomId (ICredentials cred) = getRoomById roomId (IVault cred) =
Hashdict.get roomId cred.rooms Hashdict.get roomId cred.rooms
{-| Get a list of all synchronised rooms. {-| Get a list of all synchronised rooms.
-} -}
getRooms : ICredentials -> List IRoom getRooms : IVault -> List IRoom
getRooms (ICredentials { rooms }) = getRooms (IVault { rooms }) =
Hashdict.values rooms Hashdict.values rooms
{-| Get the latest `since` token. {-| Get the latest `since` token.
-} -}
getSince : ICredentials -> Maybe String getSince : IVault -> Maybe String
getSince (ICredentials { since }) = getSince (IVault { since }) =
since since
{-| Create new empty Credentials. {-| Create new empty Credentials.
-} -}
init : ICredentials init : IVault
init = init =
ICredentials IVault
{ rooms = Hashdict.empty Room.roomId { rooms = Hashdict.empty Room.roomId
, since = Nothing , since = Nothing
} }
@ -58,7 +58,7 @@ init =
This function can hence also be used as an update function for rooms. This function can hence also be used as an update function for rooms.
-} -}
insertRoom : IRoom -> ICredentials -> ICredentials insertRoom : IRoom -> IVault -> IVault
insertRoom room (ICredentials cred) = insertRoom room (IVault cred) =
ICredentials IVault
{ cred | rooms = Hashdict.insert room cred.rooms } { cred | rooms = Hashdict.insert room cred.rooms }

216
src/Internal/Vault.elm Normal file
View File

@ -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)