Merge pull request #22 from noordstar/3-vault

Add Vault as data type

src/Internal/Config/Text.elm

@@ -126,6 +126,7 @@ docs :
     , timeline : TypeDocs
     , timelineFilter : TypeDocs
     , unsigned : TypeDocs
+    , vault : TypeDocs
     }
 docs =
     { context =
@@ -216,6 +217,12 @@ docs =
             , "This information is often supportive but not necessary to the context."
             ]
         }
+    , vault =
+        { name = "Vault"
+        , description =
+            [ "Main type storing all relevant information from the Matrix API."
+            ]
+        }
     }
 
 
@@ -309,6 +316,10 @@ fields :
         , redactedBecause : Desc
         , transactionId : Desc
         }
+    , vault :
+        { accountData : Desc
+        , rooms : Desc
+        }
     }
 fields =
     { context =
@@ -483,6 +494,14 @@ fields =
             [ "The client-supplied transaction ID, for example, provided via PUT /_matrix/client/v3/rooms/{roomId}/send/{eventType}/{txnId}, if the client being given the event is the same one which sent it."
             ]
         }
+    , vault =
+        { accountData =
+            [ "The account's global private data."
+            ]
+        , rooms =
+            [ "Directory of joined rooms that the user is a member of."
+            ]
+        }
     }
 
 

src/Internal/Tools/Hashdict.elm

@@ -3,7 +3,7 @@ module Internal.Tools.Hashdict exposing
     , empty, singleton, insert, remove, removeKey
     , isEmpty, member, memberKey, get, size, isEqual
     , keys, values, toList, fromList
-    , rehash, union, map
+    , rehash, union, map, update
     , coder, encode, decoder, softDecoder
     )
 
@@ -35,7 +35,7 @@ This allows you to store values based on an externally defined identifier.
 
 ## Transform
 
-@docs rehash, union, map
+@docs rehash, union, map, update
 
 
 ## JSON coders
@@ -321,6 +321,23 @@ union (Hashdict h1) hd2 =
                 }
 
 
+{-| Update a dict to maybe contain a value (or not). If the output does not
+have the originally expected key, it is not updated.
+-}
+update : String -> (Maybe a -> Maybe a) -> Hashdict a -> Hashdict a
+update key f ((Hashdict h) as hd) =
+    case f (get key hd) of
+        Just v ->
+            if h.hash v == key then
+                insert v hd
+
+            else
+                hd
+
+        Nothing ->
+            removeKey key hd
+
+
 {-| Get all values stored in the hashdict, in the order of their keys.
 -}
 values : Hashdict a -> List a

src/Internal/Tools/ParserExtra.elm

@@ -1,8 +1,21 @@
-module Internal.Tools.ParserExtra exposing (..)
+module Internal.Tools.ParserExtra exposing (zeroOrMore, oneOrMore, exactly, atLeast, atMost, times, maxLength)
+
+{-|
+
+
+# Extra parsers
+
+To help the Elm SDK with parsing complex text values, this modules offers a few functions.
+
+@docs zeroOrMore, oneOrMore, exactly, atLeast, atMost, times, maxLength
+
+-}
 
 import Parser as P exposing ((|.), (|=), Parser)
 
 
+{-| Parses an item zero or more times. The result is combined into a list.
+-}
 zeroOrMore : Parser a -> Parser (List a)
 zeroOrMore parser =
     P.loop []
@@ -15,6 +28,9 @@ zeroOrMore parser =
         )
 
 
+{-| Parses an item at least once, but up to any number of times.
+The result is combined into a list.
+-}
 oneOrMore : Parser a -> Parser (List a)
 oneOrMore parser =
     P.succeed (::)
@@ -22,6 +38,9 @@ oneOrMore parser =
         |= zeroOrMore parser
 
 
+{-| Parses an item at least a given number of times, but up to any number.
+The result is combined into a list.
+-}
 atLeast : Int -> Parser a -> Parser (List a)
 atLeast n parser =
     P.loop []
@@ -39,6 +58,10 @@ atLeast n parser =
         )
 
 
+{-| Parses an item any number of times (can be zero), but does not exceed a
+given number of times.
+The result is combined into a list.
+-}
 atMost : Int -> Parser a -> Parser (List a)
 atMost n parser =
     P.loop []
@@ -55,6 +78,10 @@ atMost n parser =
         )
 
 
+{-| Parses an item a given number of times, ranging from the given minimum up
+to the given maximum.
+The result is combined into a list.
+-}
 times : Int -> Int -> Parser a -> Parser (List a)
 times inf sup parser =
     let
@@ -84,11 +111,21 @@ times inf sup parser =
         )
 
 
+{-| Repeat pasing an item an exact number of times.
+The result is combined into a list.
+-}
 exactly : Int -> Parser a -> Parser (List a)
 exactly n =
     times n n
 
 
+{-| After having parsed the item, make sure that the parsed text has not
+exceeded a given length. If so, the parser fails.
+
+This modification can be useful if a text has a maximum length requirement -
+for example, usernames on Matrix cannot have a length of over 255 characters.
+
+-}
 maxLength : Int -> Parser a -> Parser a
 maxLength n parser =
     P.succeed

src/Internal/Values/Envelope.elm

@@ -4,6 +4,7 @@ module Internal.Values.Envelope exposing
     , Settings, mapSettings, extractSettings
     , mapContext
     , getContent, extract
+    , EnvelopeUpdate(..), update
     , coder, encode, decoder
     )
 
@@ -36,6 +37,11 @@ settings that can be adjusted manually.
 @docs getContent, extract
 
 
+## Update
+
+@docs EnvelopeUpdate, update
+
+
 ## JSON coders
 
 @docs coder, encode, decoder
@@ -60,6 +66,16 @@ type alias Envelope a =
     }
 
 
+{-| The Envelope update type helps update either the envelope or a content type.
+-}
+type EnvelopeUpdate a
+    = ContentUpdate a
+    | More (List (EnvelopeUpdate a))
+    | SetAccessToken String
+    | SetRefreshToken String
+    | SetVersions (List String)
+
+
 {-| Settings value from
 [Internal.Values.Settings](Internal-Values-Settings#Settings). Can be used to
 manipulate the Matrix Vault.
@@ -260,3 +276,24 @@ toMaybe data =
     Maybe.map
         (\content -> map (always content) data)
         data.content
+
+
+{-| 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 }
+
+        More items ->
+            List.foldl (update updateContent) data items
+
+        SetAccessToken a ->
+            { data | context = { context | accessToken = Just a } }
+
+        SetRefreshToken r ->
+            { data | context = { context | refreshToken = Just r } }
+
+        SetVersions vs ->
+            { data | context = { context | versions = Just vs } }

src/Internal/Values/Room.elm

@@ -1,5 +1,6 @@
 module Internal.Values.Room exposing
     ( Room, init
+    , RoomUpdate, update
     , Batch, addBatch, addSync, addEvents, mostRecentEvents
     , getAccountData, setAccountData
     , coder, encode, decode
@@ -25,6 +26,11 @@ room state reflect the homeserver state of the room.
 @docs Room, init
 
 
+## Update
+
+@docs RoomUpdate, update
+
+
 ## Timeline
 
 @docs Batch, addBatch, addSync, addEvents, mostRecentEvents
@@ -71,6 +77,15 @@ type alias Room =
     }
 
 
+{-| The RoomUpdate type explains how to update a room based on new information
+from the Matrix API.
+-}
+type RoomUpdate
+    = AddSync Batch
+    | More (List RoomUpdate)
+    | SetAccountData String Json.Value
+
+
 {-| Add new events to the Room's event directory + Room's timeline.
 -}
 addEventsToTimeline : (Timeline.Batch -> Timeline -> Timeline) -> Batch -> Room -> Room
@@ -223,3 +238,18 @@ mostRecentEvents room =
 setAccountData : String -> Json.Value -> Room -> Room
 setAccountData key value room =
     { room | accountData = Dict.insert key value room.accountData }
+
+
+{-| Update the Room based on given instructions.
+-}
+update : RoomUpdate -> Room -> Room
+update ru room =
+    case ru of
+        AddSync batch ->
+            addSync batch room
+
+        More items ->
+            List.foldl update room items
+
+        SetAccountData key value ->
+            setAccountData key value room

src/Internal/Values/Vault.elm

@@ -1,13 +1,136 @@
-module Internal.Values.Vault exposing (Vault)
+module Internal.Values.Vault exposing
+    ( Vault
+    , VaultUpdate(..), update
+    , fromRoomId, mapRoom, updateRoom
+    , getAccountData, setAccountData
+    )
 
-{-| This module hosts the Vault module.
+{-| This module hosts the Vault module. The Vault is the data type storing all
+credentials, all user information and all other information that the user
+can receive from the Matrix API.
+
+
+## Vault type
 
 @docs Vault
 
+To update the Vault, one uses VaultUpdate types.
+
+@docs VaultUpdate, update
+
+
+## Rooms
+
+Rooms are environments where people can have a conversation with each other.
+
+@docs fromRoomId, mapRoom, updateRoom
+
+
+## Account data
+
+@docs getAccountData, setAccountData
+
 -}
 
+import FastDict as Dict exposing (Dict)
+import Internal.Config.Text as Text
+import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
+import Internal.Tools.Json as Json
+import Internal.Values.Room as Room exposing (Room)
+
 
 {-| This is the Vault type.
 -}
 type alias Vault =
-    ()
+    { accountData : Dict String Json.Value
+    , rooms : Hashdict Room
+    }
+
+
+{-| The VaultUpdate type is a type that instructs the Vault to update itself
+based on new information provided by the Matrix API.
+-}
+type VaultUpdate
+    = CreateRoomIfNotExists String
+    | MapRoom String Room.RoomUpdate
+    | More (List VaultUpdate)
+    | SetAccountData String Json.Value
+
+
+coder : Json.Coder Vault
+coder =
+    Json.object2
+        { name = Text.docs.vault.name
+        , description = Text.docs.vault.description
+        , init = Vault
+        }
+        (Json.field.required
+            { fieldName = "accountData"
+            , toField = .accountData
+            , description = Text.fields.vault.accountData
+            , coder = Json.fastDict Json.value
+            }
+        )
+        (Json.field.required
+            { fieldName = "rooms"
+            , toField = .rooms
+            , description = Text.fields.vault.rooms
+            , coder = Hashdict.coder .roomId Room.coder
+            }
+        )
+
+
+{-| Get a given room by its room id.
+-}
+fromRoomId : String -> Vault -> Maybe Room
+fromRoomId roomId vault =
+    Hashdict.get roomId vault.rooms
+
+
+{-| Get a piece of account data as information from the room.
+-}
+getAccountData : String -> Vault -> Maybe Json.Value
+getAccountData key vault =
+    Dict.get key vault.accountData
+
+
+{-| Update a room, if it exists. If the room isn´t known, this operation is
+ignored.
+-}
+mapRoom : String -> (Room -> Room) -> Vault -> Vault
+mapRoom roomId f vault =
+    { vault | rooms = Hashdict.map roomId f vault.rooms }
+
+
+{-| Set a piece of account data as information in the global vault data.
+-}
+setAccountData : String -> Json.Value -> Vault -> Vault
+setAccountData key value vault =
+    { vault | accountData = Dict.insert key value vault.accountData }
+
+
+{-| Update a Room based on whether it exists or not.
+-}
+updateRoom : String -> (Maybe Room -> Maybe Room) -> Vault -> Vault
+updateRoom roomId f vault =
+    { vault | rooms = Hashdict.update roomId f vault.rooms }
+
+
+{-| 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
+
+        MapRoom roomId ru ->
+            mapRoom roomId (Room.update ru) vault
+
+        More items ->
+            List.foldl update vault items
+
+        SetAccountData key value ->
+            setAccountData key value vault

src/Matrix.elm

@@ -1,12 +1,15 @@
-module Matrix exposing (Vault)
+module Matrix exposing
+    ( Vault
+    , VaultUpdate, update
+    )
 
 {-|
 
 
 # Matrix SDK
 
-This first version forms a mere basis from which we will create iterative builds
+This library forms a mere basis from which an entire functional SDK is
-that slowly improve the codebase.
+developed for the Matrix protocol.
 
 It is generally quite unusual to regularly publish iterative beta versions on
 the public registry, but it is also generally quite unusual to exclusively
@@ -17,15 +20,42 @@ support a monolithic public registry. (:
 
 @docs Vault
 
+
+## Keeping the Vault up-to-date
+
+@docs VaultUpdate, update
+
 -}
 
-import Types
+import Internal.Values.Envelope as Envelope
+import Internal.Values.Vault as Internal
+import Types exposing (Vault(..), VaultUpdate(..))
 
 
 {-| The Vault type stores all relevant information about the Matrix API.
 
-It currently supports no functionality and it will just stay here - for fun.
+If you make sure that the data type stays up-to-date, you can use it to explore
+the latest information about an account.
 
 -}
 type alias Vault =
     Types.Vault
+
+
+{-| The VaultUpdate type is the central type that keeps the Vault up-to-date.
+-}
+type alias VaultUpdate =
+    Types.VaultUpdate
+
+
+{-| Using new VaultUpdate information, update the Vault accordingly.
+
+This allows us to change our perception of the Matrix environment: has anyone
+sent a new message? Did someone send us an invite for a new room?
+
+-}
+update : VaultUpdate -> Vault -> Vault
+update (VaultUpdate vu) (Vault vault) =
+    vault
+        |> Envelope.update Internal.update vu
+        |> Vault

src/Types.elm

@@ -1,4 +1,4 @@
-module Types exposing (Vault(..), Event(..), Room(..), User(..))
+module Types exposing (Vault(..), Event(..), Room(..), User(..), VaultUpdate(..))
 
 {-| The Elm SDK uses a lot of records and values that are easy to manipulate.
 Yet, the [Elm design guidelines](https://package.elm-lang.org/help/design-guidelines#keep-tags-and-record-constructors-secret)
@@ -12,7 +12,7 @@ access their content directly.
 The opaque types are placed in a central module so all exposed modules can
 safely access all exposed data types without risking to create circular imports.
 
-@docs Vault, Event, Room, User
+@docs Vault, Event, Room, User, VaultUpdate
 
 -}
 
@@ -45,3 +45,9 @@ type User
 -}
 type Vault
     = Vault (Envelope.Envelope Vault.Vault)
+
+
+{-| Opaque type for Matrix VaultUpdate
+-}
+type VaultUpdate
+    = VaultUpdate (Envelope.EnvelopeUpdate Vault.VaultUpdate)

tests/Test/Tools/Hashdict.elm

@@ -103,7 +103,7 @@ suite =
             ]
         , describe "singleton"
             [ fuzz TestEvent.fuzzer
-                "singletong = empty + insert"
+                "singleton = empty + insert"
                 (\event ->
                     Hashdict.empty .eventId
                         |> Hashdict.insert event
@@ -159,6 +159,26 @@ suite =
                             |> Expect.equal False
                 )
             ]
+        , describe "update"
+            [ fuzz2 (fuzzer identity Fuzz.string)
+                Fuzz.string
+                "add = insert"
+                (\hashdict value ->
+                    Hashdict.isEqual
+                        (Hashdict.insert value hashdict)
+                        (Hashdict.update value (always (Just value)) hashdict)
+                        |> Expect.equal True
+                )
+            , fuzz2 (fuzzer identity Fuzz.string)
+                Fuzz.string
+                "remove = removeKey"
+                (\hashdict value ->
+                    Hashdict.isEqual
+                        (Hashdict.removeKey value hashdict)
+                        (Hashdict.update value (always Nothing) hashdict)
+                        |> Expect.equal True
+                )
+            ]
         , describe "JSON"
             [ fuzz2 eventFuzzer
                 (Fuzz.intRange 0 10)

tests/Test/Values/Vault.elm

@@ -1,10 +1,20 @@
 module Test.Values.Vault exposing (..)
 
+import FastDict as Dict exposing (Dict)
 import Fuzz exposing (Fuzzer)
+import Internal.Tools.Json as Json
 import Internal.Values.Vault exposing (Vault)
 import Test exposing (..)
+import Test.Tools.Hashdict as TestHashdict
+import Test.Values.Room as TestRoom
 
 
 vault : Fuzzer Vault
 vault =
-    Fuzz.unit
+    Fuzz.map2 Vault
+        (Fuzz.string
+            |> Fuzz.map (\k -> ( k, Json.encode Json.int 0 ))
+            |> Fuzz.list
+            |> Fuzz.map Dict.fromList
+        )
+        (TestHashdict.fuzzer .roomId TestRoom.fuzzer)