Enable safe recursion in VaultUpdate type

Merge pull request #33 from noordstar/safe-recursion
pull/34/head
BramvdnHeuvel 2024-07-15 16:08:34 +02:00 committed by GitHub
commit eb8d90ab8b
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
3 changed files with 137 additions and 74 deletions

View File

@ -56,6 +56,8 @@ import Internal.Tools.Json as Json
import Internal.Tools.Timestamp exposing (Timestamp) import Internal.Tools.Timestamp exposing (Timestamp)
import Internal.Values.Context as Context exposing (AccessToken, Context, Versions) import Internal.Values.Context as Context exposing (AccessToken, Context, Versions)
import Internal.Values.Settings as Settings import Internal.Values.Settings as Settings
import Recursion
import Recursion.Fold
{-| There are lots of different data types in the Elm SDK, and many of them {-| There are lots of different data types in the Elm SDK, and many of them
@ -292,50 +294,91 @@ toMaybe data =
{-| Updates the Envelope with a given EnvelopeUpdate value. {-| Updates the Envelope with a given EnvelopeUpdate value.
-} -}
update : (au -> a -> a) -> EnvelopeUpdate au -> Envelope a -> Envelope a update : (au -> a -> a) -> EnvelopeUpdate au -> Envelope a -> Envelope a
update updateContent eu ({ context } as data) = update updateContent eu startData =
case eu of Recursion.runRecursion
(\updt ->
case updt of
ContentUpdate v -> ContentUpdate v ->
Recursion.base
(\data ->
{ data | content = updateContent v data.content } { data | content = updateContent v data.content }
)
HttpRequest _ -> HttpRequest _ ->
data Recursion.base identity
More items -> More items ->
List.foldl (update updateContent) data items Recursion.Fold.foldList (<<) identity items
Optional (Just u) -> Optional (Just u) ->
update updateContent u data Recursion.recurse u
Optional Nothing -> Optional Nothing ->
data Recursion.base identity
RemoveAccessToken token -> RemoveAccessToken token ->
{ data | context = { context | accessTokens = Hashdict.removeKey token context.accessTokens } } Recursion.base
(\({ context } as data) ->
{ data
| context =
{ context
| accessTokens =
Hashdict.removeKey token context.accessTokens
}
}
)
RemovePasswordIfNecessary -> RemovePasswordIfNecessary ->
Recursion.base
(\({ context } as data) ->
if data.settings.removePasswordOnLogin then if data.settings.removePasswordOnLogin then
{ data | context = { context | password = Nothing } } { data | context = { context | password = Nothing } }
else else
data data
)
SetAccessToken a -> SetAccessToken a ->
Recursion.base
(\({ context } as data) ->
{ data | context = { context | accessTokens = Hashdict.insert a context.accessTokens } } { data | context = { context | accessTokens = Hashdict.insert a context.accessTokens } }
)
SetBaseUrl b -> SetBaseUrl b ->
Recursion.base
(\({ context } as data) ->
{ data | context = { context | baseUrl = Just b } } { data | context = { context | baseUrl = Just b } }
)
SetDeviceId d -> SetDeviceId d ->
Recursion.base
(\({ context } as data) ->
{ data | context = { context | deviceId = Just d } } { data | context = { context | deviceId = Just d } }
)
SetNextBatch nextBatch -> SetNextBatch nextBatch ->
Recursion.base
(\{ context } as data ->
{ data | context = { context | nextBatch = Just nextBatch } } { data | context = { context | nextBatch = Just nextBatch } }
)
SetNow n -> SetNow n ->
Recursion.base
(\({ context } as data) ->
{ data | context = { context | now = Just n } } { data | context = { context | now = Just n } }
)
SetRefreshToken r -> SetRefreshToken r ->
Recursion.base
(\({ context } as data) ->
{ data | context = { context | refreshToken = Just r } } { data | context = { context | refreshToken = Just r } }
)
SetVersions vs -> SetVersions vs ->
Recursion.base
(\({ context } as data) ->
{ data | context = { context | versions = Just vs } } { data | context = { context | versions = Just vs } }
)
)
eu
startData

View File

@ -59,6 +59,8 @@ import Internal.Values.StateManager as StateManager exposing (StateManager)
import Internal.Values.Timeline as Timeline exposing (Timeline) import Internal.Values.Timeline as Timeline exposing (Timeline)
import Internal.Values.User exposing (User) import Internal.Values.User exposing (User)
import Json.Encode as E import Json.Encode as E
import Recursion
import Recursion.Fold
{-| The Batch is a group of new events from somewhere in the timeline. {-| The Batch is a group of new events from somewhere in the timeline.
@ -255,30 +257,35 @@ setAccountData key value room =
{-| Update the Room based on given instructions. {-| Update the Room based on given instructions.
-} -}
update : RoomUpdate -> Room -> Room update : RoomUpdate -> Room -> Room
update ru room = update roomUpdate startRoom =
Recursion.runRecursion
(\ru ->
case ru of case ru of
AddEvent _ -> AddEvent _ ->
-- TODO: Add event -- TODO: Add event
room Recursion.base identity
AddSync batch -> AddSync batch ->
addSync batch room Recursion.base (addSync batch)
Invite _ -> Invite _ ->
-- TODO: Invite user -- TODO: Invite user
room Recursion.base identity
More items -> More items ->
List.foldl update room items Recursion.Fold.foldList (<<) identity items
Optional (Just u) -> Optional (Just u) ->
update u room Recursion.recurse u
Optional Nothing -> Optional Nothing ->
room Recursion.base identity
SetAccountData key value -> SetAccountData key value ->
setAccountData key value room Recursion.base (setAccountData key value)
SetEphemeral eph -> SetEphemeral eph ->
{ room | ephemeral = eph } Recursion.base (\room -> { room | ephemeral = eph })
)
roomUpdate
startRoom

View File

@ -38,6 +38,8 @@ import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
import Internal.Tools.Json as Json import Internal.Tools.Json as Json
import Internal.Values.Room as Room exposing (Room) import Internal.Values.Room as Room exposing (Room)
import Internal.Values.User as User exposing (User) import Internal.Values.User as User exposing (User)
import Recursion
import Recursion.Fold
{-| This is the Vault type. {-| This is the Vault type.
@ -157,30 +159,41 @@ updateRoom roomId f vault =
{-| Update the Vault using a VaultUpdate type. {-| Update the Vault using a VaultUpdate type.
-} -}
update : VaultUpdate -> Vault -> Vault update : VaultUpdate -> Vault -> Vault
update vu vault = update vaultUpdate startVault =
Recursion.runRecursion
(\vu ->
case vu of case vu of
CreateRoomIfNotExists roomId -> CreateRoomIfNotExists roomId ->
updateRoom roomId
(Maybe.withDefault (Room.init roomId) >> Maybe.Just) (Maybe.withDefault (Room.init roomId) >> Maybe.Just)
vault |> updateRoom roomId
|> Recursion.base
MapRoom roomId ru -> MapRoom roomId ru ->
mapRoom roomId (Room.update ru) vault Recursion.base (mapRoom roomId (Room.update ru))
More items -> More items ->
List.foldl update vault items Recursion.Fold.foldList (<<) identity items
Optional (Just u) -> Optional (Just u) ->
update u vault Recursion.recurse u
Optional Nothing -> Optional Nothing ->
vault Recursion.base identity
SetAccountData key value -> SetAccountData key value ->
setAccountData key value vault Recursion.base (setAccountData key value)
SetNextBatch nb -> SetNextBatch nb ->
Recursion.base
(\vault ->
{ vault | nextBatch = Just nb } { vault | nextBatch = Just nb }
)
SetUser user -> SetUser user ->
Recursion.base
(\vault ->
{ vault | user = Just user } { vault | user = Just user }
)
)
vaultUpdate
startVault