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.Values.Context as Context exposing (AccessToken, Context, Versions)
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
@ -292,50 +294,91 @@ toMaybe data =
{-| Updates the Envelope with a given EnvelopeUpdate value.
-}
update : (au -> a -> a) -> EnvelopeUpdate au -> Envelope a -> Envelope a
update updateContent eu ({ context } as data) =
case eu of
ContentUpdate v ->
{ data | content = updateContent v data.content }
update updateContent eu startData =
Recursion.runRecursion
(\updt ->
case updt of
ContentUpdate v ->
Recursion.base
(\data ->
{ data | content = updateContent v data.content }
)
HttpRequest _ ->
data
HttpRequest _ ->
Recursion.base identity
More items ->
List.foldl (update updateContent) data items
More items ->
Recursion.Fold.foldList (<<) identity items
Optional (Just u) ->
update updateContent u data
Optional (Just u) ->
Recursion.recurse u
Optional Nothing ->
data
Optional Nothing ->
Recursion.base identity
RemoveAccessToken token ->
{ data | context = { context | accessTokens = Hashdict.removeKey token context.accessTokens } }
RemoveAccessToken token ->
Recursion.base
(\({ context } as data) ->
{ data
| context =
{ context
| accessTokens =
Hashdict.removeKey token context.accessTokens
}
}
)
RemovePasswordIfNecessary ->
if data.settings.removePasswordOnLogin then
{ data | context = { context | password = Nothing } }
RemovePasswordIfNecessary ->
Recursion.base
(\({ context } as data) ->
if data.settings.removePasswordOnLogin then
{ data | context = { context | password = Nothing } }
else
data
else
data
)
SetAccessToken a ->
{ data | context = { context | accessTokens = Hashdict.insert a context.accessTokens } }
SetAccessToken a ->
Recursion.base
(\({ context } as data) ->
{ data | context = { context | accessTokens = Hashdict.insert a context.accessTokens } }
)
SetBaseUrl b ->
{ data | context = { context | baseUrl = Just b } }
SetBaseUrl b ->
Recursion.base
(\({ context } as data) ->
{ data | context = { context | baseUrl = Just b } }
)
SetDeviceId d ->
{ data | context = { context | deviceId = Just d } }
SetDeviceId d ->
Recursion.base
(\({ context } as data) ->
{ data | context = { context | deviceId = Just d } }
)
SetNextBatch nextBatch ->
{ data | context = { context | nextBatch = Just nextBatch } }
SetNextBatch nextBatch ->
Recursion.base
(\{ context } as data ->
{ data | context = { context | nextBatch = Just nextBatch } }
)
SetNow n ->
Recursion.base
(\({ context } as data) ->
{ data | context = { context | now = Just n } }
)
SetNow n ->
{ data | context = { context | now = Just n } }
SetRefreshToken r ->
Recursion.base
(\({ context } as data) ->
{ data | context = { context | refreshToken = Just r } }
)
SetRefreshToken r ->
{ data | context = { context | refreshToken = Just r } }
SetVersions vs ->
{ data | context = { context | versions = Just vs } }
SetVersions vs ->
Recursion.base
(\({ context } as data) ->
{ 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.User exposing (User)
import Json.Encode as E
import Recursion
import Recursion.Fold
{-| 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 : RoomUpdate -> Room -> Room
update ru room =
case ru of
AddEvent _ ->
-- TODO: Add event
room
update roomUpdate startRoom =
Recursion.runRecursion
(\ru ->
case ru of
AddEvent _ ->
-- TODO: Add event
Recursion.base identity
AddSync batch ->
addSync batch room
AddSync batch ->
Recursion.base (addSync batch)
Invite _ ->
-- TODO: Invite user
room
Invite _ ->
-- TODO: Invite user
Recursion.base identity
More items ->
List.foldl update room items
More items ->
Recursion.Fold.foldList (<<) identity items
Optional (Just u) ->
update u room
Optional (Just u) ->
Recursion.recurse u
Optional Nothing ->
room
Optional Nothing ->
Recursion.base identity
SetAccountData key value ->
setAccountData key value room
SetAccountData key value ->
Recursion.base (setAccountData key value)
SetEphemeral eph ->
{ room | ephemeral = eph }
SetEphemeral 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.Values.Room as Room exposing (Room)
import Internal.Values.User as User exposing (User)
import Recursion
import Recursion.Fold
{-| This is the Vault type.
@ -157,30 +159,41 @@ updateRoom roomId f vault =
{-| Update the Vault using a VaultUpdate type.
-}
update : VaultUpdate -> Vault -> Vault
update vu vault =
case vu of
CreateRoomIfNotExists roomId ->
updateRoom roomId
(Maybe.withDefault (Room.init roomId) >> Maybe.Just)
vault
update vaultUpdate startVault =
Recursion.runRecursion
(\vu ->
case vu of
CreateRoomIfNotExists roomId ->
(Maybe.withDefault (Room.init roomId) >> Maybe.Just)
|> updateRoom roomId
|> Recursion.base
MapRoom roomId ru ->
mapRoom roomId (Room.update ru) vault
MapRoom roomId ru ->
Recursion.base (mapRoom roomId (Room.update ru))
More items ->
List.foldl update vault items
More items ->
Recursion.Fold.foldList (<<) identity items
Optional (Just u) ->
update u vault
Optional (Just u) ->
Recursion.recurse u
Optional Nothing ->
vault
Optional Nothing ->
Recursion.base identity
SetAccountData key value ->
setAccountData key value vault
SetAccountData key value ->
Recursion.base (setAccountData key value)
SetNextBatch nb ->
{ vault | nextBatch = Just nb }
SetNextBatch nb ->
Recursion.base
(\vault ->
{ vault | nextBatch = Just nb }
)
SetUser user ->
{ vault | user = Just user }
SetUser user ->
Recursion.base
(\vault ->
{ vault | user = Just user }
)
)
vaultUpdate
startVault