From 14058f4b696559b0898e6a8d7feb8aba96dce0ac Mon Sep 17 00:00:00 2001 From: Bram Date: Tue, 19 Dec 2023 02:46:23 +0100 Subject: [PATCH 01/18] Add Event type --- elm.json | 1 + src/Internal/Values/Event.elm | 145 ++++++++++++++++++++++++++++++++++ 2 files changed, 146 insertions(+) create mode 100644 src/Internal/Values/Event.elm diff --git a/elm.json b/elm.json index 3c502e6..f1e9b67 100644 --- a/elm.json +++ b/elm.json @@ -18,6 +18,7 @@ "Internal.Tools.VersionControl", "Internal.Values.Context", "Internal.Values.Envelope", + "Internal.Values.Event", "Internal.Values.Vault", "Types" ], diff --git a/src/Internal/Values/Event.elm b/src/Internal/Values/Event.elm new file mode 100644 index 0000000..fb78c02 --- /dev/null +++ b/src/Internal/Values/Event.elm @@ -0,0 +1,145 @@ +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 ) + ] + + +{-| Get the old content, if the event has changed or it has been edited. +-} +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 From ce83d1260f94bf0e48b45b6ff1707bd1f126c147 Mon Sep 17 00:00:00 2001 From: Bram van den Heuvel Date: Fri, 22 Dec 2023 16:59:45 +0100 Subject: [PATCH 02/18] Add reader functions for Event types --- src/Internal/Values/Event.elm | 154 +++++++++++++++++++++++++++++----- src/Types.elm | 11 ++- 2 files changed, 142 insertions(+), 23 deletions(-) diff --git a/src/Internal/Values/Event.elm b/src/Internal/Values/Event.elm index fb78c02..15743d5 100644 --- a/src/Internal/Values/Event.elm +++ b/src/Internal/Values/Event.elm @@ -1,5 +1,6 @@ module Internal.Values.Event exposing ( Event + , content, eventId, eventType, originServerTs, roomId, sender, stateKey , UnsignedData, age, prevContent, redactedBecause, transactionId , encode, decoder ) @@ -15,6 +16,11 @@ of a room. @docs Event +## Get information + +@docs content, eventId, eventType, originServerTs, roomId, sender, stateKey + + ## Unsigned data @docs UnsignedData, age, prevContent, redactedBecause, transactionId @@ -30,6 +36,7 @@ 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 Internal.Values.Envelope as Envelope import Json.Decode as D import Json.Encode as E @@ -37,6 +44,10 @@ import Json.Encode as E {-| The Event type occurs everywhere on a user's timeline. -} type alias Event = + Envelope.Envelope IEvent + + +type alias IEvent = { content : E.Value , eventId : String , originServerTs : Timestamp @@ -63,15 +74,30 @@ type UnsignedData {-| 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 +age envelope = + Envelope.extract + (\event -> + Maybe.andThen + (\(UnsignedData data) -> data.age) + event.unsigned + ) + envelope + + +{-| The Matrix protocol revolves around users being able to send each other +JSON objects. This function reveals the JSON value that the user has sent to +the room. +-} +content : Event -> E.Value +content = + Envelope.extract .content {-| Decode an Event from a JSON value. -} decoder : D.Decoder Event decoder = - D.map8 Event + D.map8 IEvent (D.field "content" D.value) (D.field "eventId" D.string) (D.field "originServerTs" Timestamp.decoder) @@ -80,6 +106,7 @@ decoder = (D.opField "stateKey" D.string) (D.field "eventType" D.string) (D.opField "unsigned" decoderUnsignedData) + |> Envelope.decoder {-| Decode Unsigned Data from a JSON value. @@ -96,18 +123,22 @@ decoderUnsignedData = {-| 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 envelope = + Envelope.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 ) + ] + ) + envelope {-| Encode Unsigned Data into a JSON value. @@ -122,24 +153,105 @@ encodeUnsignedData (UnsignedData data) = ] +{-| Every event is assigned a unique id in the room. You can use this event id +to reference or look up events. +-} +eventId : Event -> String +eventId = + Envelope.extract .eventId + + +{-| 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 = + Envelope.extract .eventType + + +{-| Timestamp of at what time the event was originally received by the original +homeserver. + +Generally, this timestamp offers a relalatively 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 -> Timestamp +originServerTs = + Envelope.extract .originServerTs + + {-| Get the old content, if the event has changed or it has been edited. -} prevContent : Event -> Maybe E.Value -prevContent event = - Maybe.andThen (\(UnsignedData data) -> data.prevContent) event.unsigned +prevContent envelope = + Envelope.extract + (\event -> + Maybe.andThen + (\(UnsignedData data) -> data.prevContent) + event.unsigned + ) + envelope {-| 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 +redactedBecause envelope = + Envelope.extract + (\event -> + Maybe.andThen + (\(UnsignedData data) -> data.redactedBecause) + event.unsigned + ) + envelope + + +{-| Unique id assigned to the Matrix room. You can use this room id to reference +or look up rooms. +-} +roomId : Event -> String +roomId = + Envelope.extract .roomId + + +{-| User id of the user that sent this event. You can use this user id to +reference or look up users. +-} +sender : Event -> String +sender = + Envelope.extract .sender + + +{-| When an event's state key is `Nothing`, it is an ordinary message event in +the timeline. + +When the state key is `Just ""` or some other `Just string`, then it is a state +event that affects how the room works. TODO: Explain state events. + +-} +stateKey : Event -> Maybe String +stateKey = + Envelope.extract .stateKey {-| 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 +transactionId envelope = + Envelope.extract + (\event -> + Maybe.andThen + (\(UnsignedData data) -> data.transactionId) + event.unsigned + ) + envelope diff --git a/src/Types.elm b/src/Types.elm index 022835b..36da9e0 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,13 +12,20 @@ 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.Event as Event import Internal.Values.Vault as Vault +{-| Opaque type for Matrix Event +-} +type Event + = Event Event.Event + + {-| Opaque type for Matrix Vault -} type Vault From 0448b746093e130edc85f70f2e98020eb4d54b3c Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 22 Dec 2023 22:20:19 +0100 Subject: [PATCH 03/18] Improve Event documentation --- src/Internal/Values/Event.elm | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/src/Internal/Values/Event.elm b/src/Internal/Values/Event.elm index 15743d5..61414f9 100644 --- a/src/Internal/Values/Event.elm +++ b/src/Internal/Values/Event.elm @@ -84,9 +84,7 @@ age envelope = envelope -{-| The Matrix protocol revolves around users being able to send each other -JSON objects. This function reveals the JSON value that the user has sent to -the room. +{-| Determine the body of this event, as created by the user that sent it. -} content : Event -> E.Value content = @@ -153,8 +151,7 @@ encodeUnsignedData (UnsignedData data) = ] -{-| Every event is assigned a unique id in the room. You can use this event id -to reference or look up events. +{-| Determine the globally unique identifier for an event. -} eventId : Event -> String eventId = @@ -173,10 +170,10 @@ eventType = Envelope.extract .eventType -{-| Timestamp of at what time the event was originally received by the original -homeserver. +{-| Determine the timestamp of at what time the event was originally received by +the original homeserver. -Generally, this timestamp offers a relalatively accurate indicator of when a +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 @@ -188,7 +185,9 @@ originServerTs = Envelope.extract .originServerTs -{-| Get the old content, if the event has changed or it has been edited. +{-| 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 envelope = @@ -223,19 +222,22 @@ roomId = Envelope.extract .roomId -{-| User id of the user that sent this event. You can use this user id to -reference or look up users. +{-| Determine the fully-qualified ID of the user who sent an event. -} sender : Event -> String sender = Envelope.extract .sender -{-| When an event's state key is `Nothing`, it is an ordinary message event in -the timeline. +{-| Determine an event's state key. -When the state key is `Just ""` or some other `Just string`, then it is a state -event that affects how the room works. TODO: Explain state events. +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 From 5065ed05ffde049b1f41275920d9a56ae41a2d01 Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 22 Dec 2023 23:44:46 +0100 Subject: [PATCH 04/18] Add Event tests --- src/Internal/Values/Event.elm | 2 +- tests/Event.elm | 84 +++++++++++++++++++++++++++++++++++ tests/Timestamp.elm | 11 +++++ 3 files changed, 96 insertions(+), 1 deletion(-) create mode 100644 tests/Event.elm create mode 100644 tests/Timestamp.elm diff --git a/src/Internal/Values/Event.elm b/src/Internal/Values/Event.elm index 61414f9..e0ad27f 100644 --- a/src/Internal/Values/Event.elm +++ b/src/Internal/Values/Event.elm @@ -1,7 +1,7 @@ module Internal.Values.Event exposing ( Event , content, eventId, eventType, originServerTs, roomId, sender, stateKey - , UnsignedData, age, prevContent, redactedBecause, transactionId + , UnsignedData(..), age, prevContent, redactedBecause, transactionId , encode, decoder ) diff --git a/tests/Event.elm b/tests/Event.elm new file mode 100644 index 0000000..f7be57c --- /dev/null +++ b/tests/Event.elm @@ -0,0 +1,84 @@ +module Event exposing (..) + +import Expect +import Fuzz exposing (Fuzzer) +import Iddict as TestIddict +import Internal.Tools.Iddict as Iddict +import Internal.Tools.Timestamp as Timestamp +import Internal.Values.Envelope as Envelope +import Internal.Values.Event as Event +import Json.Decode as D +import Json.Encode as E +import Test exposing (..) +import Timestamp as TestTimestamp + + +{-| Example values that can be used for arbitrary JSON values +-} +valueFuzzer : Fuzzer E.Value +valueFuzzer = + Fuzz.oneOf + [ Fuzz.map (Iddict.encode E.int) (TestIddict.fuzzer Fuzz.int) + , Fuzz.map Timestamp.encode TestTimestamp.fuzzer + , 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)) + ] + + +fuzzer : Fuzzer Event.Event +fuzzer = + Fuzz.map8 + (\c ei et o r se sk u -> + Envelope.init + { content = c + , eventId = ei + , eventType = et + , originServerTs = o + , roomId = r + , sender = se + , stateKey = sk + , unsigned = u + } + ) + valueFuzzer + Fuzz.string + Fuzz.string + TestTimestamp.fuzzer + Fuzz.string + Fuzz.string + (Fuzz.maybe Fuzz.string) + (Fuzz.maybe unsignedDataFuzzer) + + +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) + + +json : Test +json = + describe "JSON tests" + [ fuzz fuzzer + "JSON encode + JSON decode" + (\event -> + event + |> Event.encode + |> D.decodeValue Event.decoder + |> Expect.equal (Ok event) + ) + ] diff --git a/tests/Timestamp.elm b/tests/Timestamp.elm new file mode 100644 index 0000000..f8b7dd4 --- /dev/null +++ b/tests/Timestamp.elm @@ -0,0 +1,11 @@ +module Timestamp exposing (..) + +import Fuzz exposing (Fuzzer) +import Internal.Tools.Timestamp exposing (Timestamp) +import Test exposing (..) +import Time + + +fuzzer : Fuzzer Timestamp +fuzzer = + Fuzz.map Time.millisToPosix Fuzz.int From 1a819cbe3957aa085439859f9f47127c015388bf Mon Sep 17 00:00:00 2001 From: Bram Date: Sun, 24 Dec 2023 00:03:07 +0100 Subject: [PATCH 05/18] Add exposed Event module --- elm.json | 1 + src/Internal/Values/Event.elm | 50 ++++++------ src/Matrix/Event.elm | 142 ++++++++++++++++++++++++++++++++++ 3 files changed, 170 insertions(+), 23 deletions(-) create mode 100644 src/Matrix/Event.elm diff --git a/elm.json b/elm.json index f2c7767..72bead6 100644 --- a/elm.json +++ b/elm.json @@ -6,6 +6,7 @@ "version": "2.0.0", "exposed-modules": [ "Matrix", + "Matrix.Event", "Matrix.Settings", "Internal.Config.Default", "Internal.Config.Leaks", diff --git a/src/Internal/Values/Event.elm b/src/Internal/Values/Event.elm index e0ad27f..954e935 100644 --- a/src/Internal/Values/Event.elm +++ b/src/Internal/Values/Event.elm @@ -66,7 +66,7 @@ type UnsignedData = UnsignedData { age : Maybe Int , prevContent : Maybe E.Value - , redactedBecause : Maybe Event + , redactedBecause : Maybe IEvent , transactionId : Maybe String } @@ -95,6 +95,11 @@ content = -} decoder : D.Decoder Event decoder = + Envelope.decoder decoderInternal + + +decoderInternal : D.Decoder IEvent +decoderInternal = D.map8 IEvent (D.field "content" D.value) (D.field "eventId" D.string) @@ -104,7 +109,6 @@ decoder = (D.opField "stateKey" D.string) (D.field "eventType" D.string) (D.opField "unsigned" decoderUnsignedData) - |> Envelope.decoder {-| Decode Unsigned Data from a JSON value. @@ -114,29 +118,30 @@ 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 "redactedBecause" (D.lazy (\_ -> decoderInternal))) (D.opField "transactionId" D.string) {-| Encode an Event into a JSON value. -} encode : Event -> E.Value -encode envelope = - Envelope.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 ) - ] - ) - envelope +encode = + Envelope.encode encodeInternal + + +encodeInternal : IEvent -> E.Value +encodeInternal 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. @@ -146,7 +151,7 @@ encodeUnsignedData (UnsignedData data) = E.maybeObject [ ( "age", Maybe.map E.int data.age ) , ( "prevContent", data.prevContent ) - , ( "redactedBecause", Maybe.map encode data.redactedBecause ) + , ( "redactedBecause", Maybe.map encodeInternal data.redactedBecause ) , ( "transactionId", Maybe.map E.string data.transactionId ) ] @@ -204,14 +209,13 @@ prevContent envelope = redacted it here. -} redactedBecause : Event -> Maybe Event -redactedBecause envelope = - Envelope.extract +redactedBecause = + Envelope.mapMaybe (\event -> Maybe.andThen (\(UnsignedData data) -> data.redactedBecause) event.unsigned ) - envelope {-| Unique id assigned to the Matrix room. You can use this room id to reference diff --git a/src/Matrix/Event.elm b/src/Matrix/Event.elm new file mode 100644 index 0000000..016df69 --- /dev/null +++ b/src/Matrix/Event.elm @@ -0,0 +1,142 @@ +module Matrix.Event exposing + ( Event, content, eventType, stateKey + , eventId, originServerTs, roomId, sender + , 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, originServerTs, roomId, sender + + +## 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.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) = + Internal.content event + + +{-| Determine the globally unique identifier for an event. +-} +eventId : Event -> String +eventId (Event event) = + Internal.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) = + Internal.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) = + Internal.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) = + 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) = + 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) = + Internal.roomId event + + +{-| Determine the fully-qualified ID of the user who sent an event. +-} +sender : Event -> String +sender (Event event) = + Internal.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) = + Internal.stateKey event From 5ac3e7eb6ad232e6b418f3f26d48beea0571ae9c Mon Sep 17 00:00:00 2001 From: Bram Date: Sun, 24 Dec 2023 00:37:22 +0100 Subject: [PATCH 06/18] Fix Event test This commit is starting to show how the definition of the Envelope wrapper is better done on a different level --- src/Internal/Values/Envelope.elm | 2 +- src/Internal/Values/Event.elm | 1 + src/Matrix/Event.elm | 4 +-- tests/Envelope.elm | 42 ++++++++++++++++++++++++++++++++ tests/Event.elm | 31 +++++++++++++---------- 5 files changed, 64 insertions(+), 16 deletions(-) create mode 100644 tests/Envelope.elm diff --git a/src/Internal/Values/Envelope.elm b/src/Internal/Values/Envelope.elm index 617973c..96d09cb 100644 --- a/src/Internal/Values/Envelope.elm +++ b/src/Internal/Values/Envelope.elm @@ -1,5 +1,5 @@ module Internal.Values.Envelope exposing - ( Envelope, init + ( Envelope(..), init , map, mapMaybe, mapList , Settings, mapSettings, extractSettings , mapContext diff --git a/src/Internal/Values/Event.elm b/src/Internal/Values/Event.elm index 954e935..a23a1d4 100644 --- a/src/Internal/Values/Event.elm +++ b/src/Internal/Values/Event.elm @@ -3,6 +3,7 @@ module Internal.Values.Event exposing , content, eventId, eventType, originServerTs, roomId, sender, stateKey , UnsignedData(..), age, prevContent, redactedBecause, transactionId , encode, decoder + , IEvent ) {-| diff --git a/src/Matrix/Event.elm b/src/Matrix/Event.elm index 016df69..5d9190f 100644 --- a/src/Matrix/Event.elm +++ b/src/Matrix/Event.elm @@ -1,6 +1,6 @@ module Matrix.Event exposing ( Event, content, eventType, stateKey - , eventId, originServerTs, roomId, sender + , eventId, roomId, sender, originServerTs , previousContent, redactedBecause ) @@ -20,7 +20,7 @@ events. ## Metadata -@docs eventId, originServerTs, roomId, sender +@docs eventId, roomId, sender, originServerTs ## Optional data diff --git a/tests/Envelope.elm b/tests/Envelope.elm new file mode 100644 index 0000000..85dcdb1 --- /dev/null +++ b/tests/Envelope.elm @@ -0,0 +1,42 @@ +module Envelope exposing (..) + +import Context as TestContext +import Fuzz exposing (Fuzzer) +import Internal.Config.Default as Default +import Internal.Values.Envelope exposing (Envelope(..), Settings) +import Test exposing (..) + + +fuzzer : Fuzzer a -> Fuzzer (Envelope a) +fuzzer fuzz = + Fuzz.map3 + (\content context settings -> + Envelope + { content = content + , context = context + , settings = settings + } + ) + fuzz + TestContext.fuzzer + fuzzerSettings + + +fuzzerSettings : Fuzzer Settings +fuzzerSettings = + 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 + ] + ) diff --git a/tests/Event.elm b/tests/Event.elm index f7be57c..e7cd84d 100644 --- a/tests/Event.elm +++ b/tests/Event.elm @@ -1,5 +1,6 @@ module Event exposing (..) +import Envelope as TestEnvelope import Expect import Fuzz exposing (Fuzzer) import Iddict as TestIddict @@ -24,24 +25,23 @@ valueFuzzer = , 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)) + , Fuzz.map Event.encode (Fuzz.lazy (\_ -> TestEnvelope.fuzzer fuzzer)) ] -fuzzer : Fuzzer Event.Event +fuzzer : Fuzzer Event.IEvent fuzzer = Fuzz.map8 (\c ei et o r se sk u -> - Envelope.init - { content = c - , eventId = ei - , eventType = et - , originServerTs = o - , roomId = r - , sender = se - , stateKey = sk - , unsigned = u - } + { content = c + , eventId = ei + , eventType = et + , originServerTs = o + , roomId = r + , sender = se + , stateKey = sk + , unsigned = u + } ) valueFuzzer Fuzz.string @@ -53,6 +53,11 @@ fuzzer = (Fuzz.maybe unsignedDataFuzzer) +fuzzerFull : Fuzzer Event.Event +fuzzerFull = + TestEnvelope.fuzzer fuzzer + + unsignedDataFuzzer : Fuzzer Event.UnsignedData unsignedDataFuzzer = Fuzz.map4 @@ -73,7 +78,7 @@ unsignedDataFuzzer = json : Test json = describe "JSON tests" - [ fuzz fuzzer + [ fuzz fuzzerFull "JSON encode + JSON decode" (\event -> event From 3e54ea9cbe0719e43d75f9cb2d949ba1e4ea5abe Mon Sep 17 00:00:00 2001 From: Bram Date: Sun, 24 Dec 2023 01:26:06 +0100 Subject: [PATCH 07/18] Add separate Settings module --- elm.json | 3 +- src/Internal/Values/Settings.elm | 93 ++++++++++++++++++++++++++++++++ tests/Test/Values/Settings.elm | 80 +++++++++++++++++++++++++++ 3 files changed, 174 insertions(+), 2 deletions(-) create mode 100644 src/Internal/Values/Settings.elm create mode 100644 tests/Test/Values/Settings.elm diff --git a/elm.json b/elm.json index 72bead6..ac0cd72 100644 --- a/elm.json +++ b/elm.json @@ -6,7 +6,6 @@ "version": "2.0.0", "exposed-modules": [ "Matrix", - "Matrix.Event", "Matrix.Settings", "Internal.Config.Default", "Internal.Config.Leaks", @@ -19,7 +18,7 @@ "Internal.Tools.VersionControl", "Internal.Values.Context", "Internal.Values.Envelope", - "Internal.Values.Event", + "Internal.Values.Settings", "Internal.Values.Vault", "Types" ], 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/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) + ) + ] + ] From 959642499b3bf180a2aec3a5faa60093d3b46cdc Mon Sep 17 00:00:00 2001 From: Bram Date: Sun, 24 Dec 2023 02:16:52 +0100 Subject: [PATCH 08/18] Envelope refactor Effectively, the Envelope type has been moved to the Types module, effectively keeping it separate from other data types. --- src/Internal/Values/Envelope.elm | 130 +++++++----------------- src/Internal/Values/Event.elm | 145 +++------------------------ src/Internal/Values/Vault.elm | 3 +- src/Matrix/Event.elm | 19 ++-- src/Types.elm | 5 +- tests/Envelope.elm | 42 -------- tests/Event.elm | 89 ---------------- tests/{ => Test/Tools}/Timestamp.elm | 2 +- tests/{ => Test/Values}/Context.elm | 2 +- tests/Test/Values/Envelope.elm | 65 ++++++++++++ tests/Test/Values/Event.elm | 50 +++++++++ tests/Vault.elm | 2 +- 12 files changed, 179 insertions(+), 375 deletions(-) delete mode 100644 tests/Envelope.elm delete mode 100644 tests/Event.elm rename tests/{ => Test/Tools}/Timestamp.elm (82%) rename tests/{ => Test/Values}/Context.elm (98%) create mode 100644 tests/Test/Values/Envelope.elm create mode 100644 tests/Test/Values/Event.elm diff --git a/src/Internal/Values/Envelope.elm b/src/Internal/Values/Envelope.elm index 96d09cb..dbbc815 100644 --- a/src/Internal/Values/Envelope.elm +++ b/src/Internal/Values/Envelope.elm @@ -1,5 +1,5 @@ module Internal.Values.Envelope exposing - ( Envelope(..), init + ( Envelope, init , map, mapMaybe, mapList , Settings, mapSettings, extractSettings , mapContext @@ -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 index a23a1d4..722867b 100644 --- a/src/Internal/Values/Event.elm +++ b/src/Internal/Values/Event.elm @@ -1,9 +1,7 @@ module Internal.Values.Event exposing ( Event - , content, eventId, eventType, originServerTs, roomId, sender, stateKey , UnsignedData(..), age, prevContent, redactedBecause, transactionId , encode, decoder - , IEvent ) {-| @@ -17,11 +15,6 @@ of a room. @docs Event -## Get information - -@docs content, eventId, eventType, originServerTs, roomId, sender, stateKey - - ## Unsigned data @docs UnsignedData, age, prevContent, redactedBecause, transactionId @@ -37,7 +30,6 @@ 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 Internal.Values.Envelope as Envelope import Json.Decode as D import Json.Encode as E @@ -45,10 +37,6 @@ import Json.Encode as E {-| The Event type occurs everywhere on a user's timeline. -} type alias Event = - Envelope.Envelope IEvent - - -type alias IEvent = { content : E.Value , eventId : String , originServerTs : Timestamp @@ -67,7 +55,7 @@ type UnsignedData = UnsignedData { age : Maybe Int , prevContent : Maybe E.Value - , redactedBecause : Maybe IEvent + , redactedBecause : Maybe Event , transactionId : Maybe String } @@ -75,33 +63,13 @@ type UnsignedData {-| Get the event's age, if at all provided by the homeserver. -} age : Event -> Maybe Int -age envelope = - Envelope.extract - (\event -> - Maybe.andThen - (\(UnsignedData data) -> data.age) - event.unsigned - ) - envelope +age event = + Maybe.andThen (\(UnsignedData data) -> data.age) event.unsigned -{-| Determine the body of this event, as created by the user that sent it. --} -content : Event -> E.Value -content = - Envelope.extract .content - - -{-| Decode an Event from a JSON value. --} decoder : D.Decoder Event decoder = - Envelope.decoder decoderInternal - - -decoderInternal : D.Decoder IEvent -decoderInternal = - D.map8 IEvent + D.map8 Event (D.field "content" D.value) (D.field "eventId" D.string) (D.field "originServerTs" Timestamp.decoder) @@ -119,19 +87,14 @@ 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 (\_ -> decoderInternal))) + (D.opField "redactedBecause" (D.lazy (\_ -> decoder))) (D.opField "transactionId" D.string) {-| Encode an Event into a JSON value. -} encode : Event -> E.Value -encode = - Envelope.encode encodeInternal - - -encodeInternal : IEvent -> E.Value -encodeInternal event = +encode event = E.maybeObject [ ( "content", Just event.content ) , ( "eventId", Just <| E.string event.eventId ) @@ -152,113 +115,31 @@ encodeUnsignedData (UnsignedData data) = E.maybeObject [ ( "age", Maybe.map E.int data.age ) , ( "prevContent", data.prevContent ) - , ( "redactedBecause", Maybe.map encodeInternal data.redactedBecause ) + , ( "redactedBecause", Maybe.map encode data.redactedBecause ) , ( "transactionId", Maybe.map E.string data.transactionId ) ] -{-| Determine the globally unique identifier for an event. --} -eventId : Event -> String -eventId = - Envelope.extract .eventId - - -{-| 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 = - Envelope.extract .eventType - - -{-| 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 -> Timestamp -originServerTs = - Envelope.extract .originServerTs - - {-| 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 envelope = - Envelope.extract - (\event -> - Maybe.andThen - (\(UnsignedData data) -> data.prevContent) - event.unsigned - ) - envelope +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 = - Envelope.mapMaybe - (\event -> - Maybe.andThen - (\(UnsignedData data) -> data.redactedBecause) - event.unsigned - ) - - -{-| Unique id assigned to the Matrix room. You can use this room id to reference -or look up rooms. --} -roomId : Event -> String -roomId = - Envelope.extract .roomId - - -{-| Determine the fully-qualified ID of the user who sent an event. --} -sender : Event -> String -sender = - Envelope.extract .sender - - -{-| 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 = - Envelope.extract .stateKey +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 envelope = - Envelope.extract - (\event -> - Maybe.andThen - (\(UnsignedData data) -> data.transactionId) - event.unsigned - ) - envelope +transactionId event = + Maybe.andThen (\(UnsignedData data) -> data.transactionId) event.unsigned diff --git a/src/Internal/Values/Vault.elm b/src/Internal/Values/Vault.elm index fd6495b..72df622 100644 --- a/src/Internal/Values/Vault.elm +++ b/src/Internal/Values/Vault.elm @@ -11,5 +11,4 @@ import Internal.Values.Envelope as Envelope {-| This is the Vault type. -} -type alias Vault = - Envelope.Envelope {} +type alias Vault = () diff --git a/src/Matrix/Event.elm b/src/Matrix/Event.elm index 5d9190f..da6e114 100644 --- a/src/Matrix/Event.elm +++ b/src/Matrix/Event.elm @@ -32,6 +32,7 @@ information isn't always applicable, it doesn't always exist. -} +import Internal.Values.Envelope as Envelope import Internal.Values.Event as Internal import Json.Encode import Time @@ -56,14 +57,14 @@ type alias Event = -} content : Event -> Json.Encode.Value content (Event event) = - Internal.content event + Envelope.extract .content event {-| Determine the globally unique identifier for an event. -} eventId : Event -> String eventId (Event event) = - Internal.eventId event + Envelope.extract .eventId event {-| To give a hint what the event's [content](#content) might look like, users @@ -75,7 +76,7 @@ Standard examples of event types are `m.room.message`, `m.room.member` and -} eventType : Event -> String eventType (Event event) = - Internal.eventType event + Envelope.extract .eventType event {-| Determine the timestamp of at what time the event was originally received by @@ -90,7 +91,7 @@ the past - or even in the future. -} originServerTs : Event -> Time.Posix originServerTs (Event event) = - Internal.originServerTs event + Envelope.extract .originServerTs event {-| Determine the previous `content` value for this event. This field is only a @@ -99,7 +100,7 @@ to see the previous content. -} previousContent : Event -> Maybe Json.Encode.Value previousContent (Event event) = - Internal.prevContent event + Envelope.extract Internal.prevContent event {-| If the event has been redacted, the homeserver can display the event that @@ -107,7 +108,7 @@ redacted it here. -} redactedBecause : Event -> Maybe Event redactedBecause (Event event) = - Internal.redactedBecause event + Envelope.mapMaybe Internal.redactedBecause event |> Maybe.map Event @@ -116,14 +117,14 @@ or look up rooms. -} roomId : Event -> String roomId (Event event) = - Internal.roomId event + Envelope.extract .roomId event {-| Determine the fully-qualified ID of the user who sent an event. -} sender : Event -> String sender (Event event) = - Internal.sender event + Envelope.extract .sender event {-| Determine an event's state key. @@ -139,4 +140,4 @@ user'd ID as the state key can only be set by that user. -} stateKey : Event -> Maybe String stateKey (Event event) = - Internal.stateKey event + Envelope.extract .stateKey event diff --git a/src/Types.elm b/src/Types.elm index 36da9e0..242bea7 100644 --- a/src/Types.elm +++ b/src/Types.elm @@ -16,6 +16,7 @@ safely access all exposed data types without risking to create circular imports. -} +import Internal.Values.Envelope as Envelope import Internal.Values.Event as Event import Internal.Values.Vault as Vault @@ -23,10 +24,10 @@ import Internal.Values.Vault as Vault {-| Opaque type for Matrix Event -} type Event - = Event Event.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/Envelope.elm b/tests/Envelope.elm deleted file mode 100644 index 85dcdb1..0000000 --- a/tests/Envelope.elm +++ /dev/null @@ -1,42 +0,0 @@ -module Envelope exposing (..) - -import Context as TestContext -import Fuzz exposing (Fuzzer) -import Internal.Config.Default as Default -import Internal.Values.Envelope exposing (Envelope(..), Settings) -import Test exposing (..) - - -fuzzer : Fuzzer a -> Fuzzer (Envelope a) -fuzzer fuzz = - Fuzz.map3 - (\content context settings -> - Envelope - { content = content - , context = context - , settings = settings - } - ) - fuzz - TestContext.fuzzer - fuzzerSettings - - -fuzzerSettings : Fuzzer Settings -fuzzerSettings = - 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 - ] - ) diff --git a/tests/Event.elm b/tests/Event.elm deleted file mode 100644 index e7cd84d..0000000 --- a/tests/Event.elm +++ /dev/null @@ -1,89 +0,0 @@ -module Event exposing (..) - -import Envelope as TestEnvelope -import Expect -import Fuzz exposing (Fuzzer) -import Iddict as TestIddict -import Internal.Tools.Iddict as Iddict -import Internal.Tools.Timestamp as Timestamp -import Internal.Values.Envelope as Envelope -import Internal.Values.Event as Event -import Json.Decode as D -import Json.Encode as E -import Test exposing (..) -import Timestamp as TestTimestamp - - -{-| Example values that can be used for arbitrary JSON values --} -valueFuzzer : Fuzzer E.Value -valueFuzzer = - Fuzz.oneOf - [ Fuzz.map (Iddict.encode E.int) (TestIddict.fuzzer Fuzz.int) - , Fuzz.map Timestamp.encode TestTimestamp.fuzzer - , 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 (\_ -> TestEnvelope.fuzzer fuzzer)) - ] - - -fuzzer : Fuzzer Event.IEvent -fuzzer = - Fuzz.map8 - (\c ei et o r se sk u -> - { content = c - , eventId = ei - , eventType = et - , originServerTs = o - , roomId = r - , sender = se - , stateKey = sk - , unsigned = u - } - ) - valueFuzzer - Fuzz.string - Fuzz.string - TestTimestamp.fuzzer - Fuzz.string - Fuzz.string - (Fuzz.maybe Fuzz.string) - (Fuzz.maybe unsignedDataFuzzer) - - -fuzzerFull : Fuzzer Event.Event -fuzzerFull = - TestEnvelope.fuzzer fuzzer - - -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) - - -json : Test -json = - describe "JSON tests" - [ fuzz fuzzerFull - "JSON encode + JSON decode" - (\event -> - event - |> Event.encode - |> D.decodeValue Event.decoder - |> Expect.equal (Ok event) - ) - ] diff --git a/tests/Timestamp.elm b/tests/Test/Tools/Timestamp.elm similarity index 82% rename from tests/Timestamp.elm rename to tests/Test/Tools/Timestamp.elm index f8b7dd4..e10a64e 100644 --- a/tests/Timestamp.elm +++ b/tests/Test/Tools/Timestamp.elm @@ -1,4 +1,4 @@ -module Timestamp exposing (..) +module Test.Tools.Timestamp exposing (..) import Fuzz exposing (Fuzzer) import Internal.Tools.Timestamp exposing (Timestamp) 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..89c80a5 --- /dev/null +++ b/tests/Test/Values/Event.elm @@ -0,0 +1,50 @@ +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) + + +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/Vault.elm b/tests/Vault.elm index 31faa04..35a2842 100644 --- a/tests/Vault.elm +++ b/tests/Vault.elm @@ -12,7 +12,7 @@ import Types fuzzer : Fuzzer Matrix.Vault fuzzer = - Fuzz.constant <| Types.Vault <| Envelope.init {} + Fuzz.constant <| Types.Vault <| Envelope.init () settings : Test From bf64d5911f6026e3479f963f050b1ef203eeb231 Mon Sep 17 00:00:00 2001 From: Bram Date: Sun, 24 Dec 2023 11:17:43 +0100 Subject: [PATCH 09/18] Add Timestamp test --- src/Internal/Values/Vault.elm | 5 ++- tests/Test/Tools/Timestamp.elm | 57 +++++++++++++++++++++++++++++++++- 2 files changed, 58 insertions(+), 4 deletions(-) diff --git a/src/Internal/Values/Vault.elm b/src/Internal/Values/Vault.elm index 72df622..af4383c 100644 --- a/src/Internal/Values/Vault.elm +++ b/src/Internal/Values/Vault.elm @@ -6,9 +6,8 @@ module Internal.Values.Vault exposing (Vault) -} -import Internal.Values.Envelope as Envelope - {-| This is the Vault type. -} -type alias Vault = () +type alias Vault = + () diff --git a/tests/Test/Tools/Timestamp.elm b/tests/Test/Tools/Timestamp.elm index e10a64e..d98cafb 100644 --- a/tests/Test/Tools/Timestamp.elm +++ b/tests/Test/Tools/Timestamp.elm @@ -1,7 +1,10 @@ module Test.Tools.Timestamp exposing (..) +import Expect import Fuzz exposing (Fuzzer) -import Internal.Tools.Timestamp exposing (Timestamp) +import Internal.Tools.Timestamp as Timestamp exposing (Timestamp) +import Json.Decode as D +import Json.Encode as E import Test exposing (..) import Time @@ -9,3 +12,55 @@ 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 + ) + ] + ] From fa642b46d64cfeb0118dc3261886c114d7f6dede Mon Sep 17 00:00:00 2001 From: Bram Date: Sun, 24 Dec 2023 11:30:50 +0100 Subject: [PATCH 10/18] Refactor test suite --- tests/Test/Matrix/Settings.elm | 35 ++++++++++++++++++++ tests/{ => Test/Tools}/Iddict.elm | 2 +- tests/Test/Types.elm | 17 ++++++++++ tests/Test/Values/Vault.elm | 10 ++++++ tests/Vault.elm | 53 ------------------------------- 5 files changed, 63 insertions(+), 54 deletions(-) create mode 100644 tests/Test/Matrix/Settings.elm rename tests/{ => Test/Tools}/Iddict.elm (99%) create mode 100644 tests/Test/Types.elm create mode 100644 tests/Test/Values/Vault.elm delete mode 100644 tests/Vault.elm 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/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/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/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 35a2842..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 - ) - ] From 4905b7341da9deb24018a1fab7e1143c2240c1b4 Mon Sep 17 00:00:00 2001 From: Bram Date: Sun, 24 Dec 2023 11:36:34 +0100 Subject: [PATCH 11/18] Complete documentation --- elm.json | 2 ++ src/Internal/Values/Event.elm | 2 ++ 2 files changed, 4 insertions(+) diff --git a/elm.json b/elm.json index ac0cd72..d5b89d2 100644 --- a/elm.json +++ b/elm.json @@ -6,6 +6,7 @@ "version": "2.0.0", "exposed-modules": [ "Matrix", + "Matrix.Event", "Matrix.Settings", "Internal.Config.Default", "Internal.Config.Leaks", @@ -18,6 +19,7 @@ "Internal.Tools.VersionControl", "Internal.Values.Context", "Internal.Values.Envelope", + "Internal.Values.Event", "Internal.Values.Settings", "Internal.Values.Vault", "Types" diff --git a/src/Internal/Values/Event.elm b/src/Internal/Values/Event.elm index 722867b..a3a37bb 100644 --- a/src/Internal/Values/Event.elm +++ b/src/Internal/Values/Event.elm @@ -67,6 +67,8 @@ 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 From 26ca6600d735dfe0339ec10b88f6815b934037c2 Mon Sep 17 00:00:00 2001 From: Bram Date: Sun, 24 Dec 2023 15:49:55 +0100 Subject: [PATCH 12/18] Add Hashdict test --- tests/Test/Tools/Hashdict.elm | 38 +++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) create mode 100644 tests/Test/Tools/Hashdict.elm diff --git a/tests/Test/Tools/Hashdict.elm b/tests/Test/Tools/Hashdict.elm new file mode 100644 index 0000000..d389f42 --- /dev/null +++ b/tests/Test/Tools/Hashdict.elm @@ -0,0 +1,38 @@ +module Test.Tools.Hashdict exposing (..) + +import Test exposing (..) +import Fuzz exposing (Fuzzer) +import Internal.Tools.Hashdict as Hashdict exposing (Hashdict) +import Test.Values.Event as TestEvent +import Internal.Values.Event as Event +import Json.Encode as E +import Json.Decode as D +import Expect + +fuzzer : (a -> String) -> Fuzzer a -> Fuzzer (Hashdict a) +fuzzer toHash fuz = + Fuzz.map (Hashdict.fromList toHash) (Fuzz.list fuz) + +suite : Test +suite = + describe "Hashdict" + [ describe "init" + [ test "init isEmpty" + ( Hashdict.empty identity + |> Hashdict.isEmpty + |> Expect.equal True + |> always + ) + ] + , describe "JSON" + [ fuzz2 (fuzzer .eventId TestEvent.fuzzer) (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 ) + ) + ] + ] From f465c9cbb1865d5410389e769e68edeef28ef29f Mon Sep 17 00:00:00 2001 From: Bram Date: Tue, 26 Dec 2023 12:59:50 +0100 Subject: [PATCH 13/18] Add isEqual function for Hashdict + tests --- src/Internal/Tools/Hashdict.elm | 10 ++++- tests/Test/Tools/Hashdict.elm | 75 +++++++++++++++++++++++++++++++-- 2 files changed, 80 insertions(+), 5 deletions(-) diff --git a/src/Internal/Tools/Hashdict.elm b/src/Internal/Tools/Hashdict.elm index b8be6a9..6020381 100644 --- a/src/Internal/Tools/Hashdict.elm +++ b/src/Internal/Tools/Hashdict.elm @@ -4,7 +4,7 @@ module Internal.Tools.Hashdict exposing , isEmpty, member, memberKey, get, size , keys, values, toList, fromList , rehash, union - , encode, decoder, softDecoder + , encode, decoder, softDecoder, isEqual ) {-| This module abstracts the `Dict` type with one function that assigns a @@ -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 @@ -150,6 +150,12 @@ insert : a -> Hashdict a -> Hashdict a 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. -} diff --git a/tests/Test/Tools/Hashdict.elm b/tests/Test/Tools/Hashdict.elm index d389f42..45a21e0 100644 --- a/tests/Test/Tools/Hashdict.elm +++ b/tests/Test/Tools/Hashdict.elm @@ -13,19 +13,88 @@ 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 "init" - [ test "init isEmpty" + [ 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 "JSON" - [ fuzz2 (fuzzer .eventId TestEvent.fuzzer) (Fuzz.intRange 0 10) "JSON encode -> JSON decode" + [ fuzz2 eventFuzzer (Fuzz.intRange 0 10) "JSON encode -> JSON decode" (\hashdict indent -> hashdict |> Hashdict.encode Event.encode From c7a3fe804b7e55e47d23c4814ef72121be0e495e Mon Sep 17 00:00:00 2001 From: Bram Date: Tue, 26 Dec 2023 16:11:51 +0100 Subject: [PATCH 14/18] elm-format + add more tests --- src/Internal/Tools/Hashdict.elm | 6 +- tests/Test/Tools/Hashdict.elm | 101 ++++++++++++++++++++++++++------ 2 files changed, 88 insertions(+), 19 deletions(-) diff --git a/src/Internal/Tools/Hashdict.elm b/src/Internal/Tools/Hashdict.elm index 6020381..f2e4fdb 100644 --- a/src/Internal/Tools/Hashdict.elm +++ b/src/Internal/Tools/Hashdict.elm @@ -1,10 +1,10 @@ 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, isEqual + , encode, decoder, softDecoder ) {-| This module abstracts the `Dict` type with one function that assigns a @@ -150,6 +150,7 @@ insert : a -> Hashdict a -> Hashdict a 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. -} @@ -157,6 +158,7 @@ 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/tests/Test/Tools/Hashdict.elm b/tests/Test/Tools/Hashdict.elm index 45a21e0..500503c 100644 --- a/tests/Test/Tools/Hashdict.elm +++ b/tests/Test/Tools/Hashdict.elm @@ -1,89 +1,96 @@ module Test.Tools.Hashdict exposing (..) -import Test exposing (..) +import Expect import Fuzz exposing (Fuzzer) import Internal.Tools.Hashdict as Hashdict exposing (Hashdict) -import Test.Values.Event as TestEvent import Internal.Values.Event as Event -import Json.Encode as E import Json.Decode as D -import Expect +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.empty identity |> Hashdict.isEmpty |> Expect.equal True |> always ) - , fuzz TestEvent.fuzzer "Nothing is member" + , fuzz TestEvent.fuzzer + "Nothing is member" (\event -> Hashdict.empty .eventId |> Hashdict.member event |> Expect.equal False ) - , fuzz Fuzz.string "No key is member" + , fuzz Fuzz.string + "No key is member" (\key -> Hashdict.empty identity |> Hashdict.memberKey key |> Expect.equal False ) - , fuzz Fuzz.string "Get gets Nothing" + , fuzz Fuzz.string + "Get gets Nothing" (\key -> Hashdict.empty identity |> Hashdict.get key |> Expect.equal Nothing ) , test "Size is zero" - ( Hashdict.empty identity + (Hashdict.empty identity |> Hashdict.size |> Expect.equal 0 |> always ) , test "No keys" - ( Hashdict.empty identity + (Hashdict.empty identity |> Hashdict.keys |> Expect.equal [] |> always ) , test "No values" - ( Hashdict.empty identity + (Hashdict.empty identity |> Hashdict.values |> Expect.equal [] |> always ) , test "To list is []" - ( Hashdict.empty identity + (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.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" + , fuzz (Fuzz.intRange 0 10) + "JSON encode -> JSON decode" (\indent -> Hashdict.empty identity |> Hashdict.encode E.string @@ -93,15 +100,75 @@ suite = |> 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" + [ 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 ) + |> Expect.equal (Ok <| Hashdict.toList hashdict) ) ] ] From 277c15c7e1cc93d80c6280a742cf81bfb162f2aa Mon Sep 17 00:00:00 2001 From: Bram Date: Tue, 26 Dec 2023 17:43:06 +0100 Subject: [PATCH 15/18] Add Mashdict --- elm.json | 1 + src/Internal/Tools/Mashdict.elm | 300 ++++++++++++++++++++++++++++++++ tests/Test/Tools/Mashdict.elm | 204 ++++++++++++++++++++++ 3 files changed, 505 insertions(+) create mode 100644 src/Internal/Tools/Mashdict.elm create mode 100644 tests/Test/Tools/Mashdict.elm diff --git a/elm.json b/elm.json index d5b89d2..a1c9977 100644 --- a/elm.json +++ b/elm.json @@ -15,6 +15,7 @@ "Internal.Tools.Encode", "Internal.Tools.Hashdict", "Internal.Tools.Iddict", + "Internal.Tools.Mashdict", "Internal.Tools.Timestamp", "Internal.Tools.VersionControl", "Internal.Values.Context", 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/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) + ) + ] + ] From e1a4bcab9b2b75b674101aa3e605d497e8b2c63b Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 29 Dec 2023 14:50:43 +0100 Subject: [PATCH 16/18] Add StateManager type --- elm.json | 1 + src/Internal/Values/StateManager.elm | 276 +++++++++++++++++++++++++++ tests/Test/Values/Event.elm | 16 ++ tests/Test/Values/StateManager.elm | 137 +++++++++++++ 4 files changed, 430 insertions(+) create mode 100644 src/Internal/Values/StateManager.elm create mode 100644 tests/Test/Values/StateManager.elm diff --git a/elm.json b/elm.json index a1c9977..405b455 100644 --- a/elm.json +++ b/elm.json @@ -22,6 +22,7 @@ "Internal.Values.Envelope", "Internal.Values.Event", "Internal.Values.Settings", + "Internal.Values.StateManager", "Internal.Values.Vault", "Types" ], diff --git a/src/Internal/Values/StateManager.elm b/src/Internal/Values/StateManager.elm new file mode 100644 index 0000000..976415f --- /dev/null +++ b/src/Internal/Values/StateManager.elm @@ -0,0 +1,276 @@ +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/tests/Test/Values/Event.elm b/tests/Test/Values/Event.elm index 89c80a5..68dbd8a 100644 --- a/tests/Test/Values/Event.elm +++ b/tests/Test/Values/Event.elm @@ -19,6 +19,22 @@ fuzzer = 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 = diff --git a/tests/Test/Values/StateManager.elm b/tests/Test/Values/StateManager.elm new file mode 100644 index 0000000..43580c7 --- /dev/null +++ b/tests/Test/Values/StateManager.elm @@ -0,0 +1,137 @@ +module Test.Values.StateManager exposing (..) + +import Expect +import Fuzz exposing (Fuzzer) +import Internal.Values.Event as Event +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 + ] From 5cdb4fad33b871dbf63f6cb5b9829a0c92932be9 Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 29 Dec 2023 14:57:59 +0100 Subject: [PATCH 17/18] Remove warnings --- src/Internal/Values/StateManager.elm | 10 +++++----- tests/Test/Values/StateManager.elm | 1 - 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/src/Internal/Values/StateManager.elm b/src/Internal/Values/StateManager.elm index 976415f..19464a2 100644 --- a/src/Internal/Values/StateManager.elm +++ b/src/Internal/Values/StateManager.elm @@ -61,11 +61,11 @@ 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) +-- {-| 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 diff --git a/tests/Test/Values/StateManager.elm b/tests/Test/Values/StateManager.elm index 43580c7..f96a0a3 100644 --- a/tests/Test/Values/StateManager.elm +++ b/tests/Test/Values/StateManager.elm @@ -2,7 +2,6 @@ module Test.Values.StateManager exposing (..) import Expect import Fuzz exposing (Fuzzer) -import Internal.Values.Event as Event import Internal.Values.StateManager as StateManager exposing (StateManager) import Json.Decode as D import Json.Encode as E From 20b4ea2f5cc90af3fd92027538818cd2a0515a04 Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 29 Dec 2023 14:58:50 +0100 Subject: [PATCH 18/18] elm-format --- src/Internal/Values/StateManager.elm | 1 + tests/Test/Values/Event.elm | 9 +++++---- tests/Test/Values/StateManager.elm | 4 +++- 3 files changed, 9 insertions(+), 5 deletions(-) diff --git a/src/Internal/Values/StateManager.elm b/src/Internal/Values/StateManager.elm index 19464a2..46282aa 100644 --- a/src/Internal/Values/StateManager.elm +++ b/src/Internal/Values/StateManager.elm @@ -61,6 +61,7 @@ append sm2 sm1 = List.foldl insert sm1 (values sm2) + -- {-| Remove any floating empty Mashdicts from ALL keys in the dictionary. -- -} -- cleanAll : StateManager -> StateManager diff --git a/tests/Test/Values/Event.elm b/tests/Test/Values/Event.elm index 68dbd8a..d41abaa 100644 --- a/tests/Test/Values/Event.elm +++ b/tests/Test/Values/Event.elm @@ -19,6 +19,7 @@ fuzzer = Fuzz.string (Fuzz.maybe unsignedDataFuzzer) + {-| Fuzzer for an event with a set state key -} fuzzerState : Fuzzer Event @@ -26,10 +27,10 @@ fuzzerState = Fuzz.map2 (\event default -> { event - | stateKey = - event.stateKey - |> Maybe.withDefault default - |> Maybe.Just + | stateKey = + event.stateKey + |> Maybe.withDefault default + |> Maybe.Just } ) fuzzer diff --git a/tests/Test/Values/StateManager.elm b/tests/Test/Values/StateManager.elm index f96a0a3..ec15032 100644 --- a/tests/Test/Values/StateManager.elm +++ b/tests/Test/Values/StateManager.elm @@ -112,6 +112,7 @@ suite = |> StateManager.member event |> Expect.equal True ) + -- , fuzz2 TestEvent.fuzzerState TestEvent.fuzzerState -- "singleton has no other members" -- (\e1 e2 -> @@ -124,7 +125,8 @@ suite = -- |> StateManager.member e2 -- |> Expect.equal False -- ) - , fuzz TestEvent.fuzzerState "singleton has one value" + , fuzz TestEvent.fuzzerState + "singleton has one value" (\event -> StateManager.singleton event |> StateManager.values