diff --git a/docs/before-merge.md b/docs/before-merge.md index aeeade8..094440b 100644 --- a/docs/before-merge.md +++ b/docs/before-merge.md @@ -8,6 +8,7 @@ If you wish to merge your branch to the `develop` branch, make sure to follow th - [ ] Run `elm-format` to ensure the correct formatting of the Elm files. - [ ] Use `elm-doc-preview` to verify whether the documentation is up to standards. +- [ ] Run `elm-test` to verify that all tests run successfully. ## The `develop` branch to `main` @@ -17,6 +18,7 @@ Before that is being done, however, the following tasks should be done: - [ ] Run `elm-format` to ensure the correct formatting of the Elm files. - [ ] Use `elm-doc-preview` to verify whether the documentation is up to standards. +- [ ] Run `elm-test --fuzz 1000` to verify that all tests run successfully. - [ ] Remove exposed modules from `elm.json` that do not need to be exposed modules in the release. - [ ] Run `elm bump` to update the library's version number - [ ] Update the version name in the [default values config file](../src/Internal/Config/Default.elm). diff --git a/elm.json b/elm.json index eecc97d..78baf2d 100644 --- a/elm.json +++ b/elm.json @@ -3,9 +3,10 @@ "name": "noordstar/elm-matrix-sdk-beta", "summary": "Matrix SDK for instant communication. Unstable beta version for testing only.", "license": "EUPL-1.1", - "version": "2.0.0", + "version": "2.1.0", "exposed-modules": [ "Matrix", + "Matrix.Event", "Matrix.Settings" ], "elm-version": "0.19.0 <= v < 0.20.0", diff --git a/src/Internal/Config/Default.elm b/src/Internal/Config/Default.elm index 9b89604..835c430 100644 --- a/src/Internal/Config/Default.elm +++ b/src/Internal/Config/Default.elm @@ -23,7 +23,7 @@ will assume until overriden by the user. -} currentVersion : String currentVersion = - "beta 2.0.0" + "beta 2.1.0" {-| The default device name that is being communicated with the Matrix API. diff --git a/src/Internal/Tools/Hashdict.elm b/src/Internal/Tools/Hashdict.elm index b8be6a9..f2e4fdb 100644 --- a/src/Internal/Tools/Hashdict.elm +++ b/src/Internal/Tools/Hashdict.elm @@ -1,7 +1,7 @@ module Internal.Tools.Hashdict exposing ( Hashdict , empty, singleton, insert, remove, removeKey - , isEmpty, member, memberKey, get, size + , isEmpty, member, memberKey, get, size, isEqual , keys, values, toList, fromList , rehash, union , encode, decoder, softDecoder @@ -25,7 +25,7 @@ This allows you to store values based on an externally defined identifier. ## Query -@docs isEmpty, member, memberKey, get, size +@docs isEmpty, member, memberKey, get, size, isEqual ## Lists @@ -151,6 +151,14 @@ insert v (Hashdict h) = Hashdict { h | values = Dict.insert (h.hash v) v h.values } +{-| Since the Hashdict contains a hash function, the == operator does not work +simply. Instead, you should use the isEqual operator. +-} +isEqual : Hashdict a -> Hashdict a -> Bool +isEqual h1 h2 = + toList h1 == toList h2 + + {-| Determine if a hashdict is empty. -} isEmpty : Hashdict a -> Bool diff --git a/src/Internal/Tools/Mashdict.elm b/src/Internal/Tools/Mashdict.elm new file mode 100644 index 0000000..22c27a8 --- /dev/null +++ b/src/Internal/Tools/Mashdict.elm @@ -0,0 +1,300 @@ +module Internal.Tools.Mashdict exposing + ( Mashdict + , empty, singleton, insert, remove, removeKey + , isEmpty, member, memberKey, get, size, isEqual + , keys, values, toList, fromList + , rehash, union + , encode, decoder, softDecoder + ) + +{-| + + +# Mashdict + +A **mashdict**, (short for "maybe mashdict") is a hashdict that uses a hash +function that _maybe_ returns a value. In this case, the mashdict exclusively +stores values for which the hashing algorithm returns a value, and it ignores +the outcome for all other scenarios. + +In general, you are advised to learn more about the +[Hashdict](Internal-Tools-Hashdict) before delving into the Mashdict. + + +## Dictionaries + +@docs Mashdict + + +## Build + +@docs empty, singleton, insert, remove, removeKey + + +## Query + +@docs isEmpty, member, memberKey, get, size, isEqual + + +## Lists + +@docs keys, values, toList, fromList + + +## Transform + +@docs rehash, union + + +## JSON coders + +@docs encode, decoder, softDecoder + +-} + +import FastDict as Dict exposing (Dict) +import Json.Decode as D +import Json.Encode as E + + +{-| A dictionary of keys and values where each key is defined by its value, but +a value is not always given. For example, this can be relevant when not all +inserted values are relevant: + + import Mashdict exposing (Mashdict) + + users : Mashdict Event + users = + Mashdict.fromList .location + [ Event "Graduation party" 8 (Just "park") + , Event "National holiday" 17 Nothing + , Event "Local fair" 11 (Just "town square") + ] + + -- National holiday will be ignored + -- because it does not hash + type alias Event = + { name : String + , participants : Int + , location : Maybe String + } + +In the example listed above, all events are stored by their specified location, +which means that all you need to know is the value "park" to retrieve all the +information about the event at the park. As a result of optimization, this means +all values without a hash, are filtered out, as we can never query them. + +-} +type Mashdict a + = Mashdict + { hash : a -> Maybe String + , values : Dict String a + } + + +{-| Decode a mashdict from a JSON value. To create a mashdict, you are expected +to insert a hash function. If the hash function doesn't properly hash the values +as expected, the decoder will fail to decode the mashdict. +-} +decoder : (a -> Maybe String) -> D.Decoder a -> D.Decoder (Mashdict a) +decoder f xDecoder = + D.keyValuePairs xDecoder + |> D.andThen + (\items -> + if List.all (\( hash, value ) -> f value == Just hash) items then + items + |> Dict.fromList + |> (\d -> { hash = f, values = d }) + |> Mashdict + |> D.succeed + + else + D.fail "Hash function fails to properly hash all values" + ) + + +{-| Create an empty mashdict. +-} +empty : (a -> Maybe String) -> Mashdict a +empty hash = + Mashdict { hash = hash, values = Dict.empty } + + +{-| Encode a Mashdict into a JSON value. Keep in mind that an Elm function +cannot be universally converted to JSON, so it is up to you to preserve that +hash function! +-} +encode : (a -> E.Value) -> Mashdict a -> E.Value +encode encodeX (Mashdict h) = + h.values + |> Dict.toList + |> List.map (Tuple.mapSecond encodeX) + |> E.object + + +{-| Convert an association list into a mashdict. +-} +fromList : (a -> Maybe String) -> List a -> Mashdict a +fromList hash xs = + Mashdict + { hash = hash + , values = + xs + |> List.filterMap (\x -> hash x |> Maybe.map (\hx -> ( hx, x ))) + |> Dict.fromList + } + + +{-| Get the value associated with a hash. If the hash is not found, return +`Nothing`. This is useful when you are not sure if a hash will be in the +mashdict. +-} +get : String -> Mashdict a -> Maybe a +get k (Mashdict h) = + Dict.get k h.values + + +{-| Insert a value into a mashdict. The key is automatically generated by the +hash function. If the function generates a collision, it replaces the existing +value in the mashdict. If the function returns `Nothing`, the value isn't +inserted and the original Mashdict is returned. +-} +insert : a -> Mashdict a -> Mashdict a +insert v (Mashdict h) = + case h.hash v of + Just hash -> + Mashdict { h | values = Dict.insert hash v h.values } + + Nothing -> + Mashdict h + + +{-| Determine if a mashdict is empty. +-} +isEmpty : Mashdict a -> Bool +isEmpty (Mashdict h) = + Dict.isEmpty h.values + + +{-| Since the Hashdict contains a hash function, the == operator does not work +simply. Instead, you should use the isEqual operator. +-} +isEqual : Mashdict a -> Mashdict a -> Bool +isEqual h1 h2 = + toList h1 == toList h2 + + +{-| Get all of the hashes in a mashdict, sorted from lowest to highest. +-} +keys : Mashdict a -> List String +keys (Mashdict h) = + Dict.keys h.values + + +{-| Determine if a value's hash is in a mashdict. +-} +member : a -> Mashdict a -> Bool +member value (Mashdict h) = + h.hash value + |> Maybe.map (\key -> Dict.member key h.values) + |> Maybe.withDefault False + + +{-| Determine if a hash is in a mashdict. +-} +memberKey : String -> Mashdict a -> Bool +memberKey key (Mashdict h) = + Dict.member key h.values + + +{-| Remap a mashdict using a new hashing algorithm. +-} +rehash : (a -> Maybe String) -> Mashdict a -> Mashdict a +rehash f (Mashdict h) = + Mashdict + { hash = f + , values = + h.values + |> Dict.values + |> List.filterMap + (\v -> Maybe.map (\hash -> ( hash, v )) (f v)) + |> Dict.fromList + } + + +{-| Remove a value from a mashdict. If the value's hash is found, the key-value +pair is removed. If the value's hash is not found, no changes are made. + + hdict |> Mashdict.remove (Event "Graduation party" 8 (Just "park")) + +-} +remove : a -> Mashdict a -> Mashdict a +remove v (Mashdict h) = + case h.hash v of + Just hash -> + Mashdict { h | values = Dict.remove hash h.values } + + Nothing -> + Mashdict h + + +{-| Remove a key from a mashdict. If the key is not found, no changes are made. + + hdict |> Mashdict.removeKey "park" + +-} +removeKey : String -> Mashdict a -> Mashdict a +removeKey k (Mashdict h) = + Mashdict { h | values = Dict.remove k h.values } + + +{-| Create a mashdict with a single key-value pair. +-} +singleton : (a -> Maybe String) -> a -> Mashdict a +singleton f v = + empty f |> insert v + + +{-| Determine the number of values in a mashdict. +-} +size : Mashdict a -> Int +size (Mashdict h) = + Dict.size h.values + + +{-| Decode a mashdict from a JSON value. If you cannot deduce the originally +used hash function, (or if you simply do not care) you can use this function to +decode and rehash the Mashdict using your new hash function. +-} +softDecoder : (a -> Maybe String) -> D.Decoder a -> D.Decoder (Mashdict a) +softDecoder f xDecoder = + D.keyValuePairs xDecoder + |> D.map (List.map Tuple.second >> fromList f) + + +{-| Convert a mashdict into an association list of key-value pairs, sorted by +keys. +-} +toList : Mashdict a -> List ( String, a ) +toList (Mashdict h) = + Dict.toList h.values + + +{-| Combine two mashdicts under the hash function of the first. If there is a +collision, preference is given to the first mashdict. +-} +union : Mashdict a -> Mashdict a -> Mashdict a +union (Mashdict h1) hd2 = + case rehash h1.hash hd2 of + Mashdict h2 -> + Mashdict + { hash = h1.hash + , values = Dict.union h1.values h2.values + } + + +{-| Get all values stored in the mashdict, in the order of their keys. +-} +values : Mashdict a -> List a +values (Mashdict h) = + Dict.values h.values diff --git a/src/Internal/Values/Envelope.elm b/src/Internal/Values/Envelope.elm index 617973c..dbbc815 100644 --- a/src/Internal/Values/Envelope.elm +++ b/src/Internal/Values/Envelope.elm @@ -46,6 +46,7 @@ import Internal.Config.Default as Default import Internal.Tools.Decode as D import Internal.Tools.Encode as E import Internal.Values.Context as Context exposing (Context) +import Internal.Values.Settings as Settings import Json.Decode as D import Json.Encode as E @@ -55,26 +56,19 @@ need the same values. The Envelope type wraps settings, tokens and values around each data type so they can all enjoy those values without needing to explicitly define them in their type. -} -type Envelope a - = Envelope - { content : a - , context : Context - , settings : Settings - } +type alias Envelope a = + { content : a + , context : Context + , settings : Settings + } -{-| Custom settings that can be manipulated by the user. These serve as a -configuration for how the Elm SDK should behave. - -Custom settings are always part of the Envelope, allowing all functions to -behave under the user's preferred settings. - +{-| Settings value from +[Internal.Values.Settings](Internal-Values-Settings#Settings). Can be used to +manipulate the Matrix Vault. -} type alias Settings = - { currentVersion : String - , deviceName : String - , syncTime : Int - } + Settings.Settings {-| Decode an enveloped type from a JSON value. The decoder also imports any @@ -82,67 +76,25 @@ potential tokens, values and settings included in the JSON. -} decoder : D.Decoder a -> D.Decoder (Envelope a) decoder xDecoder = - D.map3 (\a b c -> Envelope { content = a, context = b, settings = c }) + D.map3 Envelope (D.field "content" xDecoder) (D.field "context" Context.decoder) - (D.field "settings" decoderSettings) - - -{-| Decode settings from a JSON value. --} -decoderSettings : D.Decoder Settings -decoderSettings = - D.map3 Settings - (D.opFieldWithDefault "currentVersion" Default.currentVersion D.string) - (D.opFieldWithDefault "deviceName" Default.deviceName D.string) - (D.opFieldWithDefault "syncTime" Default.syncTime D.int) + (D.field "settings" Settings.decoder) {-| Encode an enveloped type into a JSON value. The function encodes all non-standard settings, tokens and values. -} encode : (a -> E.Value) -> Envelope a -> E.Value -encode encodeX (Envelope data) = +encode encodeX data = E.object [ ( "content", encodeX data.content ) , ( "context", Context.encode data.context ) - , ( "settings", encodeSettings data.settings ) + , ( "settings", Settings.encode data.settings ) , ( "version", E.string Default.currentVersion ) ] -{-| Encode the settings into a JSON value. --} -encodeSettings : Settings -> E.Value -encodeSettings settings = - let - differentFrom : b -> b -> Maybe b - differentFrom defaultValue currentValue = - if currentValue == defaultValue then - Nothing - - else - Just currentValue - in - E.maybeObject - [ ( "currentVersion" - , settings.currentVersion - |> differentFrom Default.currentVersion - |> Maybe.map E.string - ) - , ( "deviceName" - , settings.deviceName - |> differentFrom Default.deviceName - |> Maybe.map E.string - ) - , ( "syncTime" - , settings.syncTime - |> differentFrom Default.syncTime - |> Maybe.map E.int - ) - ] - - {-| Map a function, then get its content. This is useful for getting information from a data type inside an Envelope. @@ -155,7 +107,7 @@ from a data type inside an Envelope. -} extract : (a -> b) -> Envelope a -> b -extract f (Envelope data) = +extract f data = f data.content @@ -165,7 +117,7 @@ This can be helpful if you have a UI that displays custom settings to a user. -} extractSettings : (Settings -> b) -> Envelope a -> b -extractSettings f (Envelope data) = +extractSettings f data = f data.settings @@ -186,15 +138,10 @@ from the [Internal.Config.Default](Internal-Config-Default) module. -} init : a -> Envelope a init x = - Envelope - { content = x - , context = Context.init - , settings = - { currentVersion = Default.currentVersion - , deviceName = Default.deviceName - , syncTime = Default.syncTime - } - } + { content = x + , context = Context.init + , settings = Settings.init + } {-| Map a function on the content of the Envelope. @@ -208,23 +155,18 @@ init x = -} map : (a -> b) -> Envelope a -> Envelope b -map f (Envelope data) = - Envelope - { content = f data.content - , context = data.context - , settings = data.settings - } +map f data = + { content = f data.content + , context = data.context + , settings = data.settings + } {-| Update the Context in the Envelope. -} mapContext : (Context -> Context) -> Envelope a -> Envelope a -mapContext f (Envelope data) = - Envelope - { content = data.content - , context = f data.context - , settings = data.settings - } +mapContext f data = + { data | context = f data.context } {-| Map the contents of a function, where the result is wrapped in a `List` @@ -279,23 +221,19 @@ mapMaybe f = -} mapSettings : (Settings -> Settings) -> Envelope a -> Envelope a -mapSettings f (Envelope data) = - Envelope - { content = data.content - , context = data.context - , settings = f data.settings - } +mapSettings f data = + { data | settings = f data.settings } toList : Envelope (List a) -> List (Envelope a) -toList (Envelope data) = +toList data = List.map - (\content -> map (always content) (Envelope data)) + (\content -> map (always content) data) data.content toMaybe : Envelope (Maybe a) -> Maybe (Envelope a) -toMaybe (Envelope data) = +toMaybe data = Maybe.map - (\content -> map (always content) (Envelope data)) + (\content -> map (always content) data) data.content diff --git a/src/Internal/Values/Event.elm b/src/Internal/Values/Event.elm new file mode 100644 index 0000000..a3a37bb --- /dev/null +++ b/src/Internal/Values/Event.elm @@ -0,0 +1,147 @@ +module Internal.Values.Event exposing + ( Event + , UnsignedData(..), age, prevContent, redactedBecause, transactionId + , encode, decoder + ) + +{-| + + +# Event + +The `Event` module hosts all the information for a single event in the timeline +of a room. + +@docs Event + + +## Unsigned data + +@docs UnsignedData, age, prevContent, redactedBecause, transactionId + + +## JSON Coder + +@docs encode, decoder + +-} + +import Internal.Config.Default as Default +import Internal.Tools.Decode as D +import Internal.Tools.Encode as E +import Internal.Tools.Timestamp as Timestamp exposing (Timestamp) +import Json.Decode as D +import Json.Encode as E + + +{-| The Event type occurs everywhere on a user's timeline. +-} +type alias Event = + { content : E.Value + , eventId : String + , originServerTs : Timestamp + , roomId : String + , sender : String + , stateKey : Maybe String + , eventType : String + , unsigned : Maybe UnsignedData + } + + +{-| Unsigned Data contains a lot of extra information. You can access it through +helper functions. +-} +type UnsignedData + = UnsignedData + { age : Maybe Int + , prevContent : Maybe E.Value + , redactedBecause : Maybe Event + , transactionId : Maybe String + } + + +{-| Get the event's age, if at all provided by the homeserver. +-} +age : Event -> Maybe Int +age event = + Maybe.andThen (\(UnsignedData data) -> data.age) event.unsigned + + +{-| Decode an Event from a JSON value. +-} +decoder : D.Decoder Event +decoder = + D.map8 Event + (D.field "content" D.value) + (D.field "eventId" D.string) + (D.field "originServerTs" Timestamp.decoder) + (D.field "roomId" D.string) + (D.field "sender" D.string) + (D.opField "stateKey" D.string) + (D.field "eventType" D.string) + (D.opField "unsigned" decoderUnsignedData) + + +{-| Decode Unsigned Data from a JSON value. +-} +decoderUnsignedData : D.Decoder UnsignedData +decoderUnsignedData = + D.map4 (\a b c d -> UnsignedData { age = a, prevContent = b, redactedBecause = c, transactionId = d }) + (D.opField "age" D.int) + (D.opField "prevContent" D.value) + (D.opField "redactedBecause" (D.lazy (\_ -> decoder))) + (D.opField "transactionId" D.string) + + +{-| Encode an Event into a JSON value. +-} +encode : Event -> E.Value +encode event = + E.maybeObject + [ ( "content", Just event.content ) + , ( "eventId", Just <| E.string event.eventId ) + , ( "originServerTs", Just <| Timestamp.encode event.originServerTs ) + , ( "roomId", Just <| E.string event.roomId ) + , ( "sender", Just <| E.string event.sender ) + , ( "stateKey", Maybe.map E.string event.stateKey ) + , ( "eventType", Just <| E.string event.eventType ) + , ( "unsigned", Maybe.map encodeUnsignedData event.unsigned ) + , ( "version", Just <| E.string Default.currentVersion ) + ] + + +{-| Encode Unsigned Data into a JSON value. +-} +encodeUnsignedData : UnsignedData -> E.Value +encodeUnsignedData (UnsignedData data) = + E.maybeObject + [ ( "age", Maybe.map E.int data.age ) + , ( "prevContent", data.prevContent ) + , ( "redactedBecause", Maybe.map encode data.redactedBecause ) + , ( "transactionId", Maybe.map E.string data.transactionId ) + ] + + +{-| Determine the previous `content` value for this event. This field is only a +`Just value` if the event is a state event, and the Matrix Vault has permission +to see the previous content. +-} +prevContent : Event -> Maybe E.Value +prevContent event = + Maybe.andThen (\(UnsignedData data) -> data.prevContent) event.unsigned + + +{-| If the event has been redacted, the homeserver can display the event that +redacted it here. +-} +redactedBecause : Event -> Maybe Event +redactedBecause event = + Maybe.andThen (\(UnsignedData data) -> data.redactedBecause) event.unsigned + + +{-| If the user has sent this event to the homeserver, then the homeserver might +display the original transaction id used for the event. +-} +transactionId : Event -> Maybe String +transactionId event = + Maybe.andThen (\(UnsignedData data) -> data.transactionId) event.unsigned diff --git a/src/Internal/Values/Settings.elm b/src/Internal/Values/Settings.elm new file mode 100644 index 0000000..f9a266a --- /dev/null +++ b/src/Internal/Values/Settings.elm @@ -0,0 +1,93 @@ +module Internal.Values.Settings exposing + ( Settings, init + , encode, decoder + ) + +{-| + + +# Settings + +The Settings module exposes a data type to configure settings in the enveloped +data types. + +@docs Settings, init + + +## JSON coders + +@docs encode, decoder + +-} + +import Internal.Config.Default as Default +import Internal.Tools.Decode as D +import Internal.Tools.Encode as E +import Json.Decode as D +import Json.Encode as E + + +{-| Custom settings that can be manipulated by the user. These serve as a +configuration for how the Elm SDK should behave. + +Custom settings are always part of the Envelope, allowing all functions to +behave under the user's preferred settings. + +-} +type alias Settings = + { currentVersion : String + , deviceName : String + , syncTime : Int + } + + +{-| Decode settings from a JSON value. +-} +decoder : D.Decoder Settings +decoder = + D.map3 Settings + (D.opFieldWithDefault "currentVersion" Default.currentVersion D.string) + (D.opFieldWithDefault "deviceName" Default.deviceName D.string) + (D.opFieldWithDefault "syncTime" Default.syncTime D.int) + + +{-| Encode the settings into a JSON value. +-} +encode : Settings -> E.Value +encode settings = + let + differentFrom : b -> b -> Maybe b + differentFrom defaultValue currentValue = + if currentValue == defaultValue then + Nothing + + else + Just currentValue + in + E.maybeObject + [ ( "currentVersion" + , settings.currentVersion + |> differentFrom Default.currentVersion + |> Maybe.map E.string + ) + , ( "deviceName" + , settings.deviceName + |> differentFrom Default.deviceName + |> Maybe.map E.string + ) + , ( "syncTime" + , settings.syncTime + |> differentFrom Default.syncTime + |> Maybe.map E.int + ) + ] + + +{-| Create a new Settings module based on default values +-} +init : Settings +init = + { currentVersion = Default.currentVersion + , deviceName = Default.deviceName + , syncTime = Default.syncTime + } diff --git a/src/Internal/Values/StateManager.elm b/src/Internal/Values/StateManager.elm new file mode 100644 index 0000000..46282aa --- /dev/null +++ b/src/Internal/Values/StateManager.elm @@ -0,0 +1,277 @@ +module Internal.Values.StateManager exposing + ( StateManager + , empty, singleton, insert, remove, append + , isEmpty, member, memberKey, get, size, isEqual + , keys, values, fromList, toList + , encode, decoder + ) + +{-| The StateManager tracks the room state based on events, their event types +and the optional state keys they provide. Instead of making the user loop +through the room's timeline of events, the StateManager offers the user a +dictionary-like experience to navigate through the Matrix room state. + + +## Dictionaries + +@docs StateManager + + +## Build + +@docs empty, singleton, insert, remove, append + + +## Query + +@docs isEmpty, member, memberKey, get, size, isEqual + + +## Lists + +@docs keys, values, fromList, toList + + +## JSON coders + +@docs encode, decoder + +-} + +import FastDict as Dict exposing (Dict) +import Internal.Tools.Mashdict as Mashdict exposing (Mashdict) +import Internal.Values.Event as Event exposing (Event) +import Json.Decode as D +import Json.Encode as E + + +{-| The StateManager manages the room state by gathering events and looking at +their details. +-} +type StateManager + = StateManager (Dict String (Mashdict Event)) + + +{-| Add a new statemanager on top of an existing StateManager. This can be +useful when trying to calculate a room state based on two already existing +types. +-} +append : StateManager -> StateManager -> StateManager +append sm2 sm1 = + List.foldl insert sm1 (values sm2) + + + +-- {-| Remove any floating empty Mashdicts from ALL keys in the dictionary. +-- -} +-- cleanAll : StateManager -> StateManager +-- cleanAll ((StateManager manager) as sm) = +-- List.foldl cleanKey sm (Dict.keys manager) + + +{-| To keep the StateManager as simple as possible, you can keep the dictionary +clean by removing any floating empty Mashdicts in the dictionary. + +To save time, this function exclusively removes an empty Mashdict at a given +key. This way, you don't need to run a complete clean of a large dictionary +every time you just edit a single key in the dictionary. + +-} +cleanKey : String -> StateManager -> StateManager +cleanKey key (StateManager manager) = + manager + |> Dict.update key + (Maybe.andThen + (\dict -> + if Mashdict.isEmpty dict then + Nothing + + else + Just dict + ) + ) + |> StateManager + + +{-| Decode a StateManager from a JSON value. +-} +decoder : D.Decoder StateManager +decoder = + Event.decoder + |> Mashdict.decoder .stateKey + |> D.keyValuePairs + |> D.map Dict.fromList + |> D.map StateManager + + +{-| Create an empty StateManager. +-} +empty : StateManager +empty = + StateManager Dict.empty + + +{-| Encode a StateManager into a JSON value. +-} +encode : StateManager -> E.Value +encode (StateManager manager) = + manager + |> Dict.toCoreDict + |> E.dict identity (Mashdict.encode Event.encode) + + +{-| Build a StateManager using a list of events. +-} +fromList : List Event -> StateManager +fromList events = + List.foldl insert empty events + + +{-| Get an event based on its event type and state key. If there is no such +event sent in the room, the function returns `Nothing`. +-} +get : { eventType : String, stateKey : String } -> StateManager -> Maybe Event +get { eventType, stateKey } (StateManager manager) = + manager + |> Dict.get eventType + |> Maybe.andThen (Mashdict.get stateKey) + + +{-| Insert a new event into the state manager. If the event does not have a +state key, it is overlooked. +-} +insert : Event -> StateManager -> StateManager +insert event (StateManager manager) = + manager + |> Dict.update + event.eventType + (\typeDict -> + case typeDict of + Nothing -> + Just <| Mashdict.singleton .stateKey event + + Just md -> + Just <| Mashdict.insert event md + ) + |> StateManager + |> cleanKey event.eventType + + +{-| Determine whether the StateManager contains any events. +-} +isEmpty : StateManager -> Bool +isEmpty (StateManager manager) = + Dict.isEmpty manager + + +{-| Since the StateManager's internal structure prevents Elm from making (==) +comparisons, the `isEqual` function allows you to make comparisons that ignore +the incomparable function. +-} +isEqual : StateManager -> StateManager -> Bool +isEqual (StateManager sm1) (StateManager sm2) = + if Dict.size sm1 /= Dict.size sm2 then + False + + else if Dict.keys sm1 /= Dict.keys sm2 then + False + + else + List.all + (\key -> + case ( Dict.get key sm1, Dict.get key sm2 ) of + ( Just s1, Just s2 ) -> + Mashdict.isEqual s1 s2 + + ( _, _ ) -> + False + ) + (Dict.keys sm1) + + +{-| Retrieve all keys from a StateManager. +-} +keys : StateManager -> List { eventType : String, stateKey : String } +keys (StateManager manager) = + manager + |> Dict.toList + |> List.map + (\( eventType, dict ) -> + dict + |> Mashdict.keys + |> List.map + (\stateKey -> + { eventType = eventType, stateKey = stateKey } + ) + ) + |> List.concat + + +{-| Determine whether an event is part of the StateManager. +-} +member : Event -> StateManager -> Bool +member event (StateManager manager) = + case Dict.get event.eventType manager of + Just dict -> + Mashdict.member event dict + + Nothing -> + False + + +{-| Determine whether a given key is part of the StateManager. +-} +memberKey : { eventType : String, stateKey : String } -> StateManager -> Bool +memberKey { eventType, stateKey } (StateManager manager) = + case Dict.get eventType manager of + Just dict -> + Mashdict.memberKey stateKey dict + + Nothing -> + False + + +{-| Get a StateManager without a given event in it. If the StateManager already +doesn't have the event, nothing changes. +-} +remove : Event -> StateManager -> StateManager +remove event (StateManager manager) = + manager + |> Dict.update event.eventType (Maybe.map (Mashdict.remove event)) + |> StateManager + |> cleanKey event.eventType + + +{-| Create a StateManager that contains a single event. +-} +singleton : Event -> StateManager +singleton event = + insert event empty + + +{-| Determine the StateManager's size by the amount of events. +-} +size : StateManager -> Int +size (StateManager manager) = + manager + |> Dict.values + |> List.map Mashdict.size + |> List.sum + + +{-| Transform the StateManager to a list of events. +-} +toList : StateManager -> List Event +toList = + values + + +{-| Get the values from the StateManager, ordered by their event type (and by +their state key, if multiple events are of the same event type). +-} +values : StateManager -> List Event +values (StateManager manager) = + manager + |> Dict.values + |> List.map Mashdict.values + |> List.concat diff --git a/src/Internal/Values/Vault.elm b/src/Internal/Values/Vault.elm index fd6495b..af4383c 100644 --- a/src/Internal/Values/Vault.elm +++ b/src/Internal/Values/Vault.elm @@ -6,10 +6,8 @@ module Internal.Values.Vault exposing (Vault) -} -import Internal.Values.Envelope as Envelope - {-| This is the Vault type. -} type alias Vault = - Envelope.Envelope {} + () diff --git a/src/Matrix/Event.elm b/src/Matrix/Event.elm new file mode 100644 index 0000000..da6e114 --- /dev/null +++ b/src/Matrix/Event.elm @@ -0,0 +1,143 @@ +module Matrix.Event exposing + ( Event, content, eventType, stateKey + , eventId, roomId, sender, originServerTs + , previousContent, redactedBecause + ) + +{-| + + +# Matrix Events + +This module contains all the functions necessary to view and manipulate Matrix +events. + + +## Event + +@docs Event, content, eventType, stateKey + + +## Metadata + +@docs eventId, roomId, sender, originServerTs + + +## Optional data + +Occasionally, the Event might bring some extra information. Given how this +information isn't always applicable, it doesn't always exist. + +@docs previousContent, redactedBecause + +-} + +import Internal.Values.Envelope as Envelope +import Internal.Values.Event as Internal +import Json.Encode +import Time +import Types exposing (Event(..)) + + +{-| In Matrix, the primary form of communication is to send JSON values to one +another. These JSON values, together with their metadata, are bundled into Event +types. They contain information like: + + - Who sent the JSON value + - How they intend you to decode it + - When they sent it + - In what room they sent it + +-} +type alias Event = + Types.Event + + +{-| Receive the body of an Event, as created by the user that sent it. +-} +content : Event -> Json.Encode.Value +content (Event event) = + Envelope.extract .content event + + +{-| Determine the globally unique identifier for an event. +-} +eventId : Event -> String +eventId (Event event) = + Envelope.extract .eventId event + + +{-| To give a hint what the event's [content](#content) might look like, users +can use this eventType value to hint at how the JSON might be decoded. + +Standard examples of event types are `m.room.message`, `m.room.member` and +`me.noordstar.game.chess.move`. + +-} +eventType : Event -> String +eventType (Event event) = + Envelope.extract .eventType event + + +{-| Determine the timestamp of at what time the event was originally received by +the original homeserver. + +Generally, this timestamp offers a relatively accurate indicator of when a +message was sent. However, this number isn't completely reliable! The timestamp +can be far in the past due to long network lag, and a (malicious) homeserver can +spoof this number to make it seem like something was sent ridiculously far in +the past - or even in the future. + +-} +originServerTs : Event -> Time.Posix +originServerTs (Event event) = + Envelope.extract .originServerTs event + + +{-| Determine the previous `content` value for this event. This field is only a +`Just value` if the event is a state event, and the Matrix Vault has permission +to see the previous content. +-} +previousContent : Event -> Maybe Json.Encode.Value +previousContent (Event event) = + Envelope.extract Internal.prevContent event + + +{-| If the event has been redacted, the homeserver can display the event that +redacted it here. +-} +redactedBecause : Event -> Maybe Event +redactedBecause (Event event) = + Envelope.mapMaybe Internal.redactedBecause event + |> Maybe.map Event + + +{-| Unique id assigned to the Matrix room. You can use this room id to reference +or look up rooms. +-} +roomId : Event -> String +roomId (Event event) = + Envelope.extract .roomId event + + +{-| Determine the fully-qualified ID of the user who sent an event. +-} +sender : Event -> String +sender (Event event) = + Envelope.extract .sender event + + +{-| Determine an event's state key. + +It is present if, and only if, the event is a _state_ event. The key makes the +piece of state unique in the room. Note that it is often `Just ""`. If it is not +present, its value is `Nothing`. + +State keys starting with an `@` are reserved for referencing user IDs, such as +room members. With the exception of a few events, state events set with a given +user'd ID as the state key can only be set by that user. + +-} +stateKey : Event -> Maybe String +stateKey (Event event) = + Envelope.extract .stateKey event diff --git a/src/Types.elm b/src/Types.elm index 022835b..242bea7 100644 --- a/src/Types.elm +++ b/src/Types.elm @@ -1,4 +1,4 @@ -module Types exposing (Vault(..)) +module Types exposing (Vault(..), Event(..)) {-| 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,14 +12,22 @@ 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 +@docs Vault, Event -} +import Internal.Values.Envelope as Envelope +import Internal.Values.Event as Event import Internal.Values.Vault as Vault +{-| Opaque type for Matrix Event +-} +type Event + = Event (Envelope.Envelope Event.Event) + + {-| Opaque type for Matrix Vault -} type Vault - = Vault Vault.Vault + = Vault (Envelope.Envelope Vault.Vault) diff --git a/tests/Test/Matrix/Settings.elm b/tests/Test/Matrix/Settings.elm new file mode 100644 index 0000000..c1af931 --- /dev/null +++ b/tests/Test/Matrix/Settings.elm @@ -0,0 +1,35 @@ +module Test.Matrix.Settings exposing (..) + +import Expect +import Fuzz +import Matrix.Settings +import Test exposing (..) +import Test.Types as TestTypes + + +settings : Test +settings = + describe "Exposed Matrix.Settings" + [ describe "Set values" + [ fuzz2 TestTypes.vault + Fuzz.string + "Set device name" + (\vault name -> + vault + |> Matrix.Settings.setDeviceName name + |> Matrix.Settings.getDeviceName + |> Expect.equal name + ) + , fuzz2 TestTypes.vault + Fuzz.int + "Set sync time" + (\vault sync -> + vault + |> Matrix.Settings.setSyncTime sync + |> Matrix.Settings.getSyncTime + |> Expect.equal sync + ) + ] + + -- , describe "Read values" [] + ] diff --git a/tests/Test/Tools/Hashdict.elm b/tests/Test/Tools/Hashdict.elm new file mode 100644 index 0000000..500503c --- /dev/null +++ b/tests/Test/Tools/Hashdict.elm @@ -0,0 +1,174 @@ +module Test.Tools.Hashdict exposing (..) + +import Expect +import Fuzz exposing (Fuzzer) +import Internal.Tools.Hashdict as Hashdict exposing (Hashdict) +import Internal.Values.Event as Event +import Json.Decode as D +import Json.Encode as E +import Test exposing (..) +import Test.Values.Event as TestEvent + + +fuzzer : (a -> String) -> Fuzzer a -> Fuzzer (Hashdict a) +fuzzer toHash fuz = + Fuzz.map (Hashdict.fromList toHash) (Fuzz.list fuz) + + +eventFuzzer : Fuzzer (Hashdict Event.Event) +eventFuzzer = + fuzzer .eventId TestEvent.fuzzer + + +suite : Test +suite = + describe "Hashdict" + [ describe "empty" + [ test "empty isEmpty" + (Hashdict.empty identity + |> Hashdict.isEmpty + |> Expect.equal True + |> always + ) + , fuzz TestEvent.fuzzer + "Nothing is member" + (\event -> + Hashdict.empty .eventId + |> Hashdict.member event + |> Expect.equal False + ) + , fuzz Fuzz.string + "No key is member" + (\key -> + Hashdict.empty identity + |> Hashdict.memberKey key + |> Expect.equal False + ) + , fuzz Fuzz.string + "Get gets Nothing" + (\key -> + Hashdict.empty identity + |> Hashdict.get key + |> Expect.equal Nothing + ) + , test "Size is zero" + (Hashdict.empty identity + |> Hashdict.size + |> Expect.equal 0 + |> always + ) + , test "No keys" + (Hashdict.empty identity + |> Hashdict.keys + |> Expect.equal [] + |> always + ) + , test "No values" + (Hashdict.empty identity + |> Hashdict.values + |> Expect.equal [] + |> always + ) + , test "To list is []" + (Hashdict.empty identity + |> Hashdict.toList + |> Expect.equal [] + |> always + ) + , test "From list is empty" + ([] + |> Hashdict.fromList (\x -> x) + |> Hashdict.isEqual (Hashdict.empty identity) + |> Expect.equal True + |> always + ) + , test "Empty + empty == empty" + (Hashdict.empty identity + |> Hashdict.union (Hashdict.empty String.toUpper) + |> Hashdict.isEqual (Hashdict.empty String.toLower) + |> Expect.equal True + |> always + ) + , fuzz (Fuzz.intRange 0 10) + "JSON encode -> JSON decode" + (\indent -> + Hashdict.empty identity + |> Hashdict.encode E.string + |> E.encode indent + |> D.decodeString (Hashdict.decoder identity D.string) + |> Result.map (Hashdict.isEqual (Hashdict.empty String.toUpper)) + |> Expect.equal (Ok True) + ) + ] + , describe "singleton" + [ fuzz TestEvent.fuzzer + "singletong = empty + insert" + (\event -> + Hashdict.empty .eventId + |> Hashdict.insert event + |> Hashdict.isEqual (Hashdict.singleton .eventId event) + |> Expect.equal True + ) + , fuzz TestEvent.fuzzer + "Singleton - event = empty" + (\event -> + Hashdict.singleton .eventId event + |> Hashdict.remove event + |> Hashdict.isEqual (Hashdict.empty .sender) + |> Expect.equal True + ) + , fuzz TestEvent.fuzzer + "Singletong - event (key) = empty" + (\event -> + Hashdict.singleton .eventId event + |> Hashdict.removeKey event.eventId + |> Hashdict.isEqual (Hashdict.empty .sender) + |> Expect.equal True + ) + , fuzz TestEvent.fuzzer + "not isEmpty" + (\event -> + Hashdict.singleton .eventId event + |> Hashdict.isEmpty + |> Expect.equal False + ) + , fuzz TestEvent.fuzzer + "member" + (\event -> + Hashdict.singleton .eventId event + |> Hashdict.member event + |> Expect.equal True + ) + , fuzz TestEvent.fuzzer + "memberKey" + (\event -> + Hashdict.singleton .eventId event + |> Hashdict.memberKey event.eventId + |> Expect.equal True + ) + , fuzz TestEvent.fuzzer + "False memberKey" + (\event -> + if event.eventId == event.roomId then + Expect.pass + + else + Hashdict.singleton .eventId event + |> Hashdict.memberKey event.roomId + |> Expect.equal False + ) + ] + , describe "JSON" + [ fuzz2 eventFuzzer + (Fuzz.intRange 0 10) + "JSON encode -> JSON decode" + (\hashdict indent -> + hashdict + |> Hashdict.encode Event.encode + |> E.encode indent + |> D.decodeString (Hashdict.decoder .eventId Event.decoder) + |> Result.map Hashdict.toList + |> Expect.equal (Ok <| Hashdict.toList hashdict) + ) + ] + ] diff --git a/tests/Iddict.elm b/tests/Test/Tools/Iddict.elm similarity index 99% rename from tests/Iddict.elm rename to tests/Test/Tools/Iddict.elm index 09487fb..ac376e8 100644 --- a/tests/Iddict.elm +++ b/tests/Test/Tools/Iddict.elm @@ -1,4 +1,4 @@ -module Iddict exposing (..) +module Test.Tools.Iddict exposing (..) import Expect import Fuzz exposing (Fuzzer) diff --git a/tests/Test/Tools/Mashdict.elm b/tests/Test/Tools/Mashdict.elm new file mode 100644 index 0000000..dfddc6c --- /dev/null +++ b/tests/Test/Tools/Mashdict.elm @@ -0,0 +1,204 @@ +module Test.Tools.Mashdict exposing (..) + +import Expect +import Fuzz exposing (Fuzzer) +import Internal.Tools.Mashdict as Mashdict exposing (Mashdict) +import Internal.Values.Event as Event +import Json.Decode as D +import Json.Encode as E +import Test exposing (..) +import Test.Values.Event as TestEvent + + +fuzzer : (a -> Maybe String) -> Fuzzer a -> Fuzzer (Mashdict a) +fuzzer toHash fuz = + Fuzz.map (Mashdict.fromList toHash) (Fuzz.list fuz) + + +eventFuzzer : Fuzzer (Mashdict Event.Event) +eventFuzzer = + fuzzer .stateKey TestEvent.fuzzer + + +suite : Test +suite = + describe "Mashdict" + [ describe "empty" + [ test "empty isEmpty" + (Mashdict.empty identity + |> Mashdict.isEmpty + |> Expect.equal True + |> always + ) + , fuzz TestEvent.fuzzer + "Nothing is member" + (\event -> + Mashdict.empty .stateKey + |> Mashdict.member event + |> Expect.equal False + ) + , fuzz Fuzz.string + "No key is member" + (\key -> + Mashdict.empty identity + |> Mashdict.memberKey key + |> Expect.equal False + ) + , fuzz Fuzz.string + "Get gets Nothing" + (\key -> + Mashdict.empty identity + |> Mashdict.get key + |> Expect.equal Nothing + ) + , test "Size is zero" + (Mashdict.empty identity + |> Mashdict.size + |> Expect.equal 0 + |> always + ) + , test "No keys" + (Mashdict.empty identity + |> Mashdict.keys + |> Expect.equal [] + |> always + ) + , test "No values" + (Mashdict.empty identity + |> Mashdict.values + |> Expect.equal [] + |> always + ) + , test "To list is []" + (Mashdict.empty identity + |> Mashdict.toList + |> Expect.equal [] + |> always + ) + , test "From list is empty" + ([] + |> Mashdict.fromList (\x -> x) + |> Mashdict.isEqual (Mashdict.empty identity) + |> Expect.equal True + |> always + ) + , test "Empty + empty == empty" + (Mashdict.empty Maybe.Just + |> Mashdict.union (Mashdict.empty Maybe.Just) + |> Mashdict.isEqual (Mashdict.empty Maybe.Just) + |> Expect.equal True + |> always + ) + , fuzz (Fuzz.intRange 0 10) + "JSON encode -> JSON decode" + (\indent -> + Mashdict.empty Just + |> Mashdict.encode E.string + |> E.encode indent + |> D.decodeString (Mashdict.decoder Just D.string) + |> Result.map (Mashdict.isEqual (Mashdict.empty Just)) + |> Expect.equal (Ok True) + ) + ] + , describe "singleton" + [ fuzz TestEvent.fuzzer + "singleton = empty + insert" + (\event -> + Mashdict.empty .stateKey + |> Mashdict.insert event + |> Mashdict.isEqual (Mashdict.singleton .stateKey event) + |> Expect.equal True + ) + , fuzz TestEvent.fuzzer + "singleton - event = empty" + (\event -> + Mashdict.singleton .stateKey event + |> Mashdict.remove event + |> Mashdict.isEqual (Mashdict.empty (always Nothing)) + |> Expect.equal True + ) + , fuzz TestEvent.fuzzer + "singleton - event (key) = empty" + (\event -> + case event.stateKey of + Just key -> + Mashdict.singleton .stateKey event + |> Mashdict.removeKey key + |> Mashdict.isEqual (Mashdict.empty .stateKey) + |> Expect.equal True + + Nothing -> + Expect.pass + ) + , fuzz TestEvent.fuzzer + "Only isEmpty when not Nothing" + (\event -> + Expect.equal + (case event.stateKey of + Just _ -> + False + + Nothing -> + True + ) + (event + |> Mashdict.singleton .stateKey + |> Mashdict.isEmpty + ) + ) + , fuzz TestEvent.fuzzer + "member" + (\event -> + Expect.equal + (case event.stateKey of + Just _ -> + True + + Nothing -> + False + ) + (Mashdict.singleton .stateKey event + |> Mashdict.member event + ) + ) + , fuzz2 TestEvent.fuzzer + Fuzz.string + "memberKey" + (\event rkey -> + case event.stateKey of + Just key -> + Mashdict.singleton .stateKey event + |> Mashdict.memberKey key + |> Expect.equal True + + Nothing -> + Mashdict.singleton .stateKey event + |> Mashdict.memberKey rkey + |> Expect.equal False + ) + , fuzz TestEvent.fuzzer + "False memberKey" + (\event -> + if event.stateKey == Just event.roomId then + Expect.pass + + else + Mashdict.singleton .stateKey event + |> Mashdict.memberKey event.roomId + |> Expect.equal False + ) + ] + , describe "JSON" + [ fuzz2 eventFuzzer + (Fuzz.intRange 0 10) + "JSON encode -> JSON decode" + (\hashdict indent -> + hashdict + |> Mashdict.encode Event.encode + |> E.encode indent + |> D.decodeString (Mashdict.decoder .stateKey Event.decoder) + |> Result.map Mashdict.toList + |> Expect.equal (Ok <| Mashdict.toList hashdict) + ) + ] + ] diff --git a/tests/Test/Tools/Timestamp.elm b/tests/Test/Tools/Timestamp.elm new file mode 100644 index 0000000..d98cafb --- /dev/null +++ b/tests/Test/Tools/Timestamp.elm @@ -0,0 +1,66 @@ +module Test.Tools.Timestamp exposing (..) + +import Expect +import Fuzz exposing (Fuzzer) +import Internal.Tools.Timestamp as Timestamp exposing (Timestamp) +import Json.Decode as D +import Json.Encode as E +import Test exposing (..) +import Time + + +fuzzer : Fuzzer Timestamp +fuzzer = + Fuzz.map Time.millisToPosix Fuzz.int + + +suite : Test +suite = + describe "Timestamp" + [ describe "JSON" + [ fuzz2 fuzzer + Fuzz.int + "JSON encode -> JSON decode" + (\time indent -> + time + |> Timestamp.encode + |> E.encode indent + |> D.decodeString Timestamp.decoder + |> Expect.equal (Ok time) + ) + , fuzz fuzzer + "JSON decode -> millis" + (\time -> + time + |> Timestamp.encode + |> D.decodeValue D.int + |> Expect.equal (Ok <| Time.posixToMillis time) + ) + , fuzz Fuzz.int + "JSON decode -> time" + (\n -> + n + |> E.int + |> D.decodeValue Timestamp.decoder + |> Expect.equal (Ok <| Time.millisToPosix n) + ) + ] + , describe "Identity" + [ fuzz fuzzer + "Posix -> int -> Posix" + (\time -> + time + |> Time.posixToMillis + |> Time.millisToPosix + |> Expect.equal time + ) + , fuzz Fuzz.int + "int -> Posix -> int" + (\n -> + n + |> Time.millisToPosix + |> Time.posixToMillis + |> Expect.equal n + ) + ] + ] diff --git a/tests/Test/Types.elm b/tests/Test/Types.elm new file mode 100644 index 0000000..aa5858a --- /dev/null +++ b/tests/Test/Types.elm @@ -0,0 +1,17 @@ +module Test.Types exposing (..) + +import Fuzz exposing (Fuzzer) +import Test.Values.Envelope as TestEnvelope +import Test.Values.Event as TestEvent +import Test.Values.Vault as TestVault +import Types exposing (..) + + +event : Fuzzer Event +event = + Fuzz.map Event (TestEnvelope.fuzzer TestEvent.fuzzer) + + +vault : Fuzzer Vault +vault = + Fuzz.map Vault (TestEnvelope.fuzzer TestVault.vault) diff --git a/tests/Context.elm b/tests/Test/Values/Context.elm similarity index 98% rename from tests/Context.elm rename to tests/Test/Values/Context.elm index f06c911..1b6dc55 100644 --- a/tests/Context.elm +++ b/tests/Test/Values/Context.elm @@ -1,4 +1,4 @@ -module Context exposing (..) +module Test.Values.Context exposing (..) import Expect import Fuzz exposing (Fuzzer) diff --git a/tests/Test/Values/Envelope.elm b/tests/Test/Values/Envelope.elm new file mode 100644 index 0000000..deb5036 --- /dev/null +++ b/tests/Test/Values/Envelope.elm @@ -0,0 +1,65 @@ +module Test.Values.Envelope exposing (..) + +import Expect +import Fuzz exposing (Fuzzer) +import Internal.Config.Default as Default +import Internal.Values.Envelope as Envelope exposing (Envelope) +import Json.Decode as D +import Json.Encode as E +import Test exposing (..) +import Test.Values.Context as TestContext +import Test.Values.Settings as TestSettings + + +fuzzer : Fuzzer a -> Fuzzer (Envelope a) +fuzzer fuz = + Fuzz.map3 Envelope + fuz + TestContext.fuzzer + TestSettings.fuzzer + + +suite : Test +suite = + describe "Envelope value" + [ describe "init" + [ describe "Default settings" + [ fuzz Fuzz.string + "currentVersion" + (\s -> + s + |> Envelope.init + |> Envelope.extractSettings .currentVersion + |> Expect.equal Default.currentVersion + ) + , fuzz Fuzz.string + "deviceName" + (\s -> + s + |> Envelope.init + |> Envelope.extractSettings .deviceName + |> Expect.equal Default.deviceName + ) + , fuzz Fuzz.string + "syncTime" + (\s -> + s + |> Envelope.init + |> Envelope.extractSettings .syncTime + |> Expect.equal Default.syncTime + ) + ] + ] + , describe "JSON" + [ fuzz2 (fuzzer Fuzz.string) + Fuzz.int + "JSON encode -> JSON decode" + (\envelope indent -> + envelope + |> Envelope.encode E.string + |> E.encode indent + |> D.decodeString (Envelope.decoder D.string) + |> Expect.equal (Ok envelope) + ) + ] + ] diff --git a/tests/Test/Values/Event.elm b/tests/Test/Values/Event.elm new file mode 100644 index 0000000..d41abaa --- /dev/null +++ b/tests/Test/Values/Event.elm @@ -0,0 +1,67 @@ +module Test.Values.Event exposing (..) + +import Fuzz exposing (Fuzzer) +import Internal.Values.Event as Event exposing (Event) +import Json.Encode as E +import Test exposing (..) +import Test.Tools.Timestamp as TestTimestamp + + +fuzzer : Fuzzer Event +fuzzer = + Fuzz.map8 Event + valueFuzzer + Fuzz.string + TestTimestamp.fuzzer + Fuzz.string + Fuzz.string + (Fuzz.maybe Fuzz.string) + Fuzz.string + (Fuzz.maybe unsignedDataFuzzer) + + +{-| Fuzzer for an event with a set state key +-} +fuzzerState : Fuzzer Event +fuzzerState = + Fuzz.map2 + (\event default -> + { event + | stateKey = + event.stateKey + |> Maybe.withDefault default + |> Maybe.Just + } + ) + fuzzer + Fuzz.string + + +unsignedDataFuzzer : Fuzzer Event.UnsignedData +unsignedDataFuzzer = + Fuzz.map4 + (\age prev redact trans -> + Event.UnsignedData + { age = age + , prevContent = prev + , redactedBecause = redact + , transactionId = trans + } + ) + (Fuzz.maybe Fuzz.int) + (Fuzz.maybe valueFuzzer) + (Fuzz.maybe <| Fuzz.lazy (\_ -> fuzzer)) + (Fuzz.maybe Fuzz.string) + + +{-| Example values that can be used for arbitrary JSON values +-} +valueFuzzer : Fuzzer E.Value +valueFuzzer = + Fuzz.oneOf + [ Fuzz.map E.int Fuzz.int + , Fuzz.map E.string Fuzz.string + , Fuzz.map (E.list E.int) (Fuzz.list Fuzz.int) + , Fuzz.map (E.list E.string) (Fuzz.list Fuzz.string) + , Fuzz.map Event.encode (Fuzz.lazy (\_ -> fuzzer)) + ] diff --git a/tests/Test/Values/Settings.elm b/tests/Test/Values/Settings.elm new file mode 100644 index 0000000..8edf86c --- /dev/null +++ b/tests/Test/Values/Settings.elm @@ -0,0 +1,80 @@ +module Test.Values.Settings exposing (..) + +import Expect +import Fuzz exposing (Fuzzer) +import Internal.Config.Default as Default +import Internal.Values.Settings as Settings exposing (Settings) +import Json.Decode as D +import Json.Encode as E +import Test exposing (..) + + +fuzzer : Fuzzer Settings +fuzzer = + Fuzz.map3 Settings + (Fuzz.oneOf + [ Fuzz.constant Default.currentVersion + , Fuzz.string + ] + ) + (Fuzz.oneOf + [ Fuzz.constant Default.deviceName + , Fuzz.string + ] + ) + (Fuzz.oneOf + [ Fuzz.constant Default.syncTime + , Fuzz.int + ] + ) + + +suite : Test +suite = + describe "Settings" + [ describe "init" + [ test "Current version" + (Settings.init + |> .currentVersion + |> Expect.equal Default.currentVersion + |> always + ) + , test "Device name" + (Settings.init + |> .deviceName + |> Expect.equal Default.deviceName + |> always + ) + , test "Sync time" + (Settings.init + |> .syncTime + |> Expect.equal Default.syncTime + |> always + ) + , test "JSON encode init is {}" + (Settings.init + |> Settings.encode + |> E.encode 0 + |> Expect.equal "{}" + |> always + ) + , test "JSON decode {} is init" + ("{}" + |> D.decodeString Settings.decoder + |> Expect.equal (Ok Settings.init) + |> always + ) + ] + , describe "JSON" + [ fuzz2 fuzzer + Fuzz.int + "JSON encode -> JSON decode -> identical" + (\settings indent -> + settings + |> Settings.encode + |> E.encode indent + |> D.decodeString Settings.decoder + |> Expect.equal (Ok settings) + ) + ] + ] diff --git a/tests/Test/Values/StateManager.elm b/tests/Test/Values/StateManager.elm new file mode 100644 index 0000000..ec15032 --- /dev/null +++ b/tests/Test/Values/StateManager.elm @@ -0,0 +1,138 @@ +module Test.Values.StateManager exposing (..) + +import Expect +import Fuzz exposing (Fuzzer) +import Internal.Values.StateManager as StateManager exposing (StateManager) +import Json.Decode as D +import Json.Encode as E +import Test exposing (..) +import Test.Values.Event as TestEvent + + +fuzzer : Fuzzer StateManager +fuzzer = + TestEvent.fuzzer + |> Fuzz.list + |> Fuzz.map StateManager.fromList + + +fuzzerKey : Fuzzer { eventType : String, stateKey : String } +fuzzerKey = + Fuzz.map2 + (\a b -> { eventType = a, stateKey = b }) + Fuzz.string + Fuzz.string + + +suite : Test +suite = + describe "StateManager" + [ describe "empty" + [ test "empty isEmpty" + (StateManager.empty + |> StateManager.isEmpty + |> Expect.equal True + |> always + ) + , fuzz TestEvent.fuzzer + "empty has no member" + (\event -> + StateManager.empty + |> StateManager.member event + |> Expect.equal False + ) + , fuzz fuzzerKey + "empty has no memberKey" + (\key -> + StateManager.empty + |> StateManager.memberKey key + |> Expect.equal False + ) + , fuzz fuzzerKey + "Empty gets Nothing" + (\key -> + StateManager.empty + |> StateManager.get key + |> Expect.equal Nothing + ) + , test "Empty has no keys" + (StateManager.empty + |> StateManager.keys + |> Expect.equal [] + |> always + ) + , test "Empty has no values" + (StateManager.empty + |> StateManager.values + |> Expect.equal [] + |> always + ) + , test "toList empty equals []" + (StateManager.empty + |> StateManager.toList + |> Expect.equal [] + |> always + ) + , test "fromList [] equals empty" + ([] + |> StateManager.fromList + |> Expect.equal StateManager.empty + |> always + ) + , test "JSON encode -> JSON decode remains empty" + (StateManager.empty + |> StateManager.encode + |> E.encode 0 + |> D.decodeString StateManager.decoder + |> Expect.equal (Ok StateManager.empty) + |> always + ) + ] + , describe "singleton" + [ fuzz TestEvent.fuzzerState + "singleton = empty + event" + (\event -> + StateManager.empty + |> StateManager.insert event + |> StateManager.isEqual (StateManager.singleton event) + |> Expect.equal True + ) + , fuzz TestEvent.fuzzerState + "singleton - event = empty" + (\event -> + StateManager.singleton event + |> StateManager.remove event + |> StateManager.isEqual StateManager.empty + |> Expect.equal True + ) + , fuzz TestEvent.fuzzerState + "singleton has one member" + (\event -> + StateManager.singleton event + |> StateManager.member event + |> Expect.equal True + ) + + -- , fuzz2 TestEvent.fuzzerState TestEvent.fuzzerState + -- "singleton has no other members" + -- (\e1 e2 -> + -- if (Debug.log "To compare" e1) == e2 then + -- Expect.pass + -- else + -- () + -- |> Debug.log "Not equal" + -- |> always (StateManager.singleton e1) + -- |> StateManager.member e2 + -- |> Expect.equal False + -- ) + , fuzz TestEvent.fuzzerState + "singleton has one value" + (\event -> + StateManager.singleton event + |> StateManager.values + |> Expect.equal [ event ] + ) + ] + + -- Write other tests here + ] diff --git a/tests/Test/Values/Vault.elm b/tests/Test/Values/Vault.elm new file mode 100644 index 0000000..69125ae --- /dev/null +++ b/tests/Test/Values/Vault.elm @@ -0,0 +1,10 @@ +module Test.Values.Vault exposing (..) + +import Fuzz exposing (Fuzzer) +import Internal.Values.Vault exposing (Vault) +import Test exposing (..) + + +vault : Fuzzer Vault +vault = + Fuzz.unit diff --git a/tests/Vault.elm b/tests/Vault.elm deleted file mode 100644 index 31faa04..0000000 --- a/tests/Vault.elm +++ /dev/null @@ -1,53 +0,0 @@ -module Vault exposing (..) - -import Expect -import Fuzz exposing (Fuzzer) -import Internal.Config.Default as Default -import Internal.Values.Envelope as Envelope -import Matrix -import Matrix.Settings -import Test exposing (..) -import Types - - -fuzzer : Fuzzer Matrix.Vault -fuzzer = - Fuzz.constant <| Types.Vault <| Envelope.init {} - - -settings : Test -settings = - describe "Edit settings" - [ fuzz fuzzer - "Default device name" - (\vault -> - vault - |> Matrix.Settings.getDeviceName - |> Expect.equal Default.deviceName - ) - , fuzz2 fuzzer - Fuzz.string - "Set device name" - (\vault name -> - vault - |> Matrix.Settings.setDeviceName name - |> Matrix.Settings.getDeviceName - |> Expect.equal name - ) - , fuzz fuzzer - "Default sync time" - (\vault -> - vault - |> Matrix.Settings.getSyncTime - |> Expect.equal Default.syncTime - ) - , fuzz2 fuzzer - Fuzz.int - "Set sync time" - (\vault sync -> - vault - |> Matrix.Settings.setSyncTime sync - |> Matrix.Settings.getSyncTime - |> Expect.equal sync - ) - ]