From 2d01802b86cfe76f6fbcf1b0a3d3d2a4f021b6ae Mon Sep 17 00:00:00 2001 From: Bram van den Heuvel Date: Tue, 9 Jan 2024 18:35:21 +0100 Subject: [PATCH 01/14] Rename Tools.Encode and Tools.Decode to Extra --- src/Internal/Tools/{Decode.elm => DecodeExtra.elm} | 2 +- src/Internal/Tools/{Encode.elm => EncodeExtra.elm} | 2 +- src/Internal/Values/Context.elm | 4 ++-- src/Internal/Values/Envelope.elm | 4 ++-- src/Internal/Values/Event.elm | 4 ++-- src/Internal/Values/Settings.elm | 4 ++-- 6 files changed, 10 insertions(+), 10 deletions(-) rename src/Internal/Tools/{Decode.elm => DecodeExtra.elm} (98%) rename src/Internal/Tools/{Encode.elm => EncodeExtra.elm} (94%) diff --git a/src/Internal/Tools/Decode.elm b/src/Internal/Tools/DecodeExtra.elm similarity index 98% rename from src/Internal/Tools/Decode.elm rename to src/Internal/Tools/DecodeExtra.elm index c0ea7b2..6460233 100644 --- a/src/Internal/Tools/Decode.elm +++ b/src/Internal/Tools/DecodeExtra.elm @@ -1,4 +1,4 @@ -module Internal.Tools.Decode exposing +module Internal.Tools.DecodeExtra exposing ( opField, opFieldWithDefault , map9, map10, map11 ) diff --git a/src/Internal/Tools/Encode.elm b/src/Internal/Tools/EncodeExtra.elm similarity index 94% rename from src/Internal/Tools/Encode.elm rename to src/Internal/Tools/EncodeExtra.elm index 53649d9..726d9b8 100644 --- a/src/Internal/Tools/Encode.elm +++ b/src/Internal/Tools/EncodeExtra.elm @@ -1,4 +1,4 @@ -module Internal.Tools.Encode exposing (maybeObject) +module Internal.Tools.EncodeExtra exposing (maybeObject) {-| diff --git a/src/Internal/Values/Context.elm b/src/Internal/Values/Context.elm index 88efd33..d25d906 100644 --- a/src/Internal/Values/Context.elm +++ b/src/Internal/Values/Context.elm @@ -50,8 +50,8 @@ information that can be inserted. -} import Internal.Config.Leaks as L -import Internal.Tools.Decode as D -import Internal.Tools.Encode as E +import Internal.Tools.DecodeExtra as D +import Internal.Tools.EncodeExtra as E import Json.Decode as D import Json.Encode as E diff --git a/src/Internal/Values/Envelope.elm b/src/Internal/Values/Envelope.elm index dbbc815..1037318 100644 --- a/src/Internal/Values/Envelope.elm +++ b/src/Internal/Values/Envelope.elm @@ -43,8 +43,8 @@ settings that can be adjusted manually. -} import Internal.Config.Default as Default -import Internal.Tools.Decode as D -import Internal.Tools.Encode as E +import Internal.Tools.DecodeExtra as D +import Internal.Tools.EncodeExtra as E import Internal.Values.Context as Context exposing (Context) import Internal.Values.Settings as Settings import Json.Decode as D diff --git a/src/Internal/Values/Event.elm b/src/Internal/Values/Event.elm index a3a37bb..b27848d 100644 --- a/src/Internal/Values/Event.elm +++ b/src/Internal/Values/Event.elm @@ -27,8 +27,8 @@ of a room. -} import Internal.Config.Default as Default -import Internal.Tools.Decode as D -import Internal.Tools.Encode as E +import Internal.Tools.DecodeExtra as D +import Internal.Tools.EncodeExtra as E import Internal.Tools.Timestamp as Timestamp exposing (Timestamp) import Json.Decode as D import Json.Encode as E diff --git a/src/Internal/Values/Settings.elm b/src/Internal/Values/Settings.elm index f9a266a..9ac52ac 100644 --- a/src/Internal/Values/Settings.elm +++ b/src/Internal/Values/Settings.elm @@ -21,8 +21,8 @@ data types. -} import Internal.Config.Default as Default -import Internal.Tools.Decode as D -import Internal.Tools.Encode as E +import Internal.Tools.DecodeExtra as D +import Internal.Tools.EncodeExtra as E import Json.Decode as D import Json.Encode as E From 06c048286c0a92d5d0a4320e9d0a4e1b275d949b Mon Sep 17 00:00:00 2001 From: Bram van den Heuvel Date: Wed, 10 Jan 2024 00:59:09 +0100 Subject: [PATCH 02/14] Add log module --- src/Internal/Config/Log.elm | 54 +++++++++++++++++++++++++++++++++++ src/Internal/Tools/Decode.elm | 19 ++++++++++++ 2 files changed, 73 insertions(+) create mode 100644 src/Internal/Config/Log.elm create mode 100644 src/Internal/Tools/Decode.elm diff --git a/src/Internal/Config/Log.elm b/src/Internal/Config/Log.elm new file mode 100644 index 0000000..c591ec0 --- /dev/null +++ b/src/Internal/Config/Log.elm @@ -0,0 +1,54 @@ +module Internal.Config.Log exposing (caughtError, debug, error, info, securityWarn, warn) +{-| # Logs + +The logs module exposes various log types that can be used to indicate logs. +This helps users filter for the logs that they care about. + +The logs are encoded as strings as to allow the addition of new log types +without triggering a major update. + +@docs caughtError, debug, error, info, securityWarn, warn +-} + +{-| A caught error is an error that has been caught elsewhere in the code, hence +functioning as a secondary debug channel. +-} +caughtError : String +caughtError = "caught-error" + +{-| Debug logs are logs that can be used to debug API interactions. +-} +debug : String +debug = "debug" + +{-| Error strings indicate that something unexpected has happened. As a result, +something has stopped working. +-} +error : String +error = "error" + +{-| Info contains relevant info for the user +-} +info : String +info = "info" + +{-| Security warnings are warnings that contain red flags. + +Of course, the Elm SDK is not aware of any security vulnerabilities that it +contains, but it can raise a user's attention to suspicious situations. + +For example, if the homeserver returns room ids that do not look like usernames +at all, the homeserver can raise a security warning, which indicates that: + +1. The homeserver might be bugged +2. The Elm SDK might be severaly outdated +3. The homeserver might be compromised and/or trying to attack the Elm SDK +-} +securityWarn : String +securityWarn = "security-warn" + +{-| Warning logs are logs that are unusual, but that can be dealt with. Warnings +are debug logs that are out of the ordinary. +-} +warn : String +warn = "warn" diff --git a/src/Internal/Tools/Decode.elm b/src/Internal/Tools/Decode.elm new file mode 100644 index 0000000..7948e91 --- /dev/null +++ b/src/Internal/Tools/Decode.elm @@ -0,0 +1,19 @@ +module Internal.Tools.Decode exposing (Decoder) +{-| # Advanced security Json.Decode + +This module extends the standard JSON encode / decode library for security +measures. Most Elm libraries do not access an API this often without insight +for the user, and hence this module aims to offer the user more insight into +what is going on. + +Additionally, the decoder will warn for suspicious values, and provide helpful +errors when the JSON fails to decode. + +## Primitives + +@docs Decoder +-} + +import Json.Decode as D + +type Decoder a = D.Decoder { value : a, messages : List String } \ No newline at end of file From ae38fe68786a7f9a4c78e43236f689a698f1aa35 Mon Sep 17 00:00:00 2001 From: Bram van den Heuvel Date: Wed, 10 Jan 2024 00:59:22 +0100 Subject: [PATCH 03/14] Introduce phantom file --- src/Internal/Config/Phantom.elm | 51 +++++++++++++++++++++++++++++++++ 1 file changed, 51 insertions(+) create mode 100644 src/Internal/Config/Phantom.elm diff --git a/src/Internal/Config/Phantom.elm b/src/Internal/Config/Phantom.elm new file mode 100644 index 0000000..7ad0489 --- /dev/null +++ b/src/Internal/Config/Phantom.elm @@ -0,0 +1,51 @@ +module Internal.Config.Phantom exposing (PString(..), PInt(..), PBool(..), PList(..)) + +{-| + + +# Phantom types + +This module contains a lot of phantom types that do not necessarily do anything, +but they force the compiler to create an error whenever something illegal is +done. + +Compiler errors may seem annoying, they can help you write good code. In a +functional programming language like Elm, the trick is to design your code in +such a way that if it compiles, it works. Phantom types can help you do so. + +The phantom types in this module help you in the following way: + +1. They can help force an compile to fault when you forget to run a function. + +2. They can help track values for security. + + +## Standard data types + +@docs PString, PInt, PBool, PList + +-} + + +{-| Opaque type that encapsulates a bool. +-} +type PBool a + = PBool Bool + + +{-| Opaque type that encapsulates an int. +-} +type PInt ph + = PInt Int + + +{-| Opaque type that encapsulates a list. +-} +type PList ph a + = PList (List a) + + +{-| Opaque type that encapsulates a string. +-} +type PString ph + = PString String From fd569aa476866932ab39ce70d089ccdba99b356b Mon Sep 17 00:00:00 2001 From: Bram van den Heuvel Date: Wed, 10 Jan 2024 09:22:12 +0100 Subject: [PATCH 04/14] Implement complex JSON decoder --- src/Internal/Config/Leaks.elm | 23 +- src/Internal/Config/Log.elm | 38 +- src/Internal/Config/Phantom.elm | 2 +- src/Internal/Config/Text.elm | 49 ++- src/Internal/Tools/Decode.elm | 680 +++++++++++++++++++++++++++++++- 5 files changed, 766 insertions(+), 26 deletions(-) diff --git a/src/Internal/Config/Leaks.elm b/src/Internal/Config/Leaks.elm index d9f2d07..f3125ca 100644 --- a/src/Internal/Config/Leaks.elm +++ b/src/Internal/Config/Leaks.elm @@ -1,4 +1,7 @@ -module Internal.Config.Leaks exposing (accessToken, baseUrl, transaction, versions) +module Internal.Config.Leaks exposing + ( accessToken, baseUrl, transaction, versions + , allLeaks + ) {-| @@ -29,8 +32,14 @@ know 100% sure that the value isn't `Nothing`. @docs accessToken, baseUrl, transaction, versions +For safety purposes, all leaking values are stored in the following value: + +@docs allLeaks + -} +import Set exposing (Set) + {-| Placeholder access token. -} @@ -39,6 +48,18 @@ accessToken = "elm-sdk-placeholder-access-token-leaks" +allLeaks : Set String +allLeaks = + Set.union + (Set.fromList versions) + (Set.fromList + [ accessToken + , baseUrl + , transaction + ] + ) + + {-| Placeholder base URL. -} baseUrl : String diff --git a/src/Internal/Config/Log.elm b/src/Internal/Config/Log.elm index c591ec0..ec50cb7 100644 --- a/src/Internal/Config/Log.elm +++ b/src/Internal/Config/Log.elm @@ -1,5 +1,9 @@ module Internal.Config.Log exposing (caughtError, debug, error, info, securityWarn, warn) -{-| # Logs + +{-| + + +# Logs The logs module exposes various log types that can be used to indicate logs. This helps users filter for the logs that they care about. @@ -8,29 +12,39 @@ The logs are encoded as strings as to allow the addition of new log types without triggering a major update. @docs caughtError, debug, error, info, securityWarn, warn + -} + {-| A caught error is an error that has been caught elsewhere in the code, hence functioning as a secondary debug channel. -} caughtError : String -caughtError = "caught-error" +caughtError = + "caught-error" + {-| Debug logs are logs that can be used to debug API interactions. -} debug : String -debug = "debug" +debug = + "debug" + {-| Error strings indicate that something unexpected has happened. As a result, something has stopped working. -} error : String -error = "error" +error = + "error" + {-| Info contains relevant info for the user -} info : String -info = "info" +info = + "info" + {-| Security warnings are warnings that contain red flags. @@ -40,15 +54,19 @@ contains, but it can raise a user's attention to suspicious situations. For example, if the homeserver returns room ids that do not look like usernames at all, the homeserver can raise a security warning, which indicates that: -1. The homeserver might be bugged -2. The Elm SDK might be severaly outdated -3. The homeserver might be compromised and/or trying to attack the Elm SDK +1. The homeserver might be bugged +2. The Elm SDK might be severaly outdated +3. The homeserver might be compromised and/or trying to attack the Elm SDK + -} securityWarn : String -securityWarn = "security-warn" +securityWarn = + "security-warn" + {-| Warning logs are logs that are unusual, but that can be dealt with. Warnings are debug logs that are out of the ordinary. -} warn : String -warn = "warn" +warn = + "warn" diff --git a/src/Internal/Config/Phantom.elm b/src/Internal/Config/Phantom.elm index 7ad0489..c378581 100644 --- a/src/Internal/Config/Phantom.elm +++ b/src/Internal/Config/Phantom.elm @@ -29,7 +29,7 @@ The phantom types in this module help you in the following way: {-| Opaque type that encapsulates a bool. -} -type PBool a +type PBool ph = PBool Bool diff --git a/src/Internal/Config/Text.elm b/src/Internal/Config/Text.elm index 0a7bd62..c86bd4c 100644 --- a/src/Internal/Config/Text.elm +++ b/src/Internal/Config/Text.elm @@ -1,7 +1,8 @@ module Internal.Config.Text exposing - ( versionsFoundLocally, versionsReceived, versionsFailedToDecode - , accessTokenFoundLocally, accessTokenExpired, accessTokenInvalid + ( accessTokenFoundLocally, accessTokenExpired, accessTokenInvalid + , versionsFoundLocally, versionsReceived, versionsFailedToDecode , unsupportedVersionForEndpoint + , decodedDictSize, leakingValueFound ) {-| Throughout the Elm SDK, there are lots of pieces of text being used for @@ -23,14 +24,6 @@ This is a risky feature, keep in mind that even a patch update might break this! You should only do this if you know what you're doing. -## API Versions - -Messages sent as API logs while the Elm SDK is figuring out how modern the -homeserver is and how it can best communicate. - -@docs versionsFoundLocally, versionsReceived, versionsFailedToDecode - - ## API Authentication Messages sent as API logs during the authentication phase of the API @@ -41,12 +34,27 @@ interaction. offers room for translation, re-wording and refactors. +## API Versions + +Messages sent as API logs while the Elm SDK is figuring out how modern the +homeserver is and how it can best communicate. + +@docs versionsFoundLocally, versionsReceived, versionsFailedToDecode + + ## API miscellaneous messages Messages sent as API logs during communication with the API. @docs unsupportedVersionForEndpoint + +## JSON decoder + +Messages sent as API logs when a JSON value is being decoded. + +@docs decodedDictSize, leakingValueFound + -} @@ -73,6 +81,27 @@ accessTokenInvalid = "Matrix API rejected access token as invalid" +decodedDictSize : Int -> Int -> String +decodedDictSize from to = + String.concat + [ "JSON dict contained duplicate keys (JSON had " + , String.fromInt from + , " keys, Elm dict has " + , String.fromInt to + , " keys)" + ] + + +{-| The Elm SDK occassionally uses [leaking values](Internal-Config-Leaks), +which might indicate exceptional behaviour. As such, this log is sent when one +of those leaking values is found: to alert the user that something fishy might +be going on. +-} +leakingValueFound : String -> String +leakingValueFound leaking_value = + "Found leaking value : " ++ leaking_value + + {-| The Matrix homeserver can specify how it wishes to communicate, and the Elm SDK aims to communicate accordingly. This may fail in some scenarios, however, in which case it will throw this error. diff --git a/src/Internal/Tools/Decode.elm b/src/Internal/Tools/Decode.elm index 7948e91..7e8068d 100644 --- a/src/Internal/Tools/Decode.elm +++ b/src/Internal/Tools/Decode.elm @@ -1,5 +1,17 @@ -module Internal.Tools.Decode exposing (Decoder) -{-| # Advanced security Json.Decode +module Internal.Tools.Decode exposing + ( Decoder, string, bool, int, float + , nullable, list, slowDict, fastDict, keyValuePairs + , field, at, index, opField, opFieldWithDefault + , maybe, oneOf + , map, map2, map3, map4, map5, map6, map7, map8, map9, map10, map11 + , lazy, value, null, succeed, fail, andThen + , pString, pBool, pInt, pList + ) + +{-| + + +# Advanced security Json.Decode This module extends the standard JSON encode / decode library for security measures. Most Elm libraries do not access an API this often without insight @@ -9,11 +21,671 @@ what is going on. Additionally, the decoder will warn for suspicious values, and provide helpful errors when the JSON fails to decode. + ## Primitives -@docs Decoder +@docs Decoder, string, bool, int, float + + +## Data structures + +@docs nullable, list, slowDict, fastDict, keyValuePairs + + +## Object primitives + +@docs field, at, index, opField, opFieldWithDefault + + +## Inconsistent structure + +@docs maybe, oneOf + + +## Mapping + +@docs map, map2, map3, map4, map5, map6, map7, map8, map9, map10, map11 + + +## Fancy decoding + +@docs lazy, value, null, succeed, fail, andThen + + +## Phantom decoding + +Phantom decoders allow you to create phantom types of standard Elm types. + +@docs pString, pBool, pInt, pList + -} +import Dict as SDict +import FastDict as FDict +import Internal.Config.Leaks as L +import Internal.Config.Log as Log +import Internal.Config.Phantom as Phantom +import Internal.Config.Text as Text +import Internal.Tools.DecodeExtra as D import Json.Decode as D +import Set -type Decoder a = D.Decoder { value : a, messages : List String } \ No newline at end of file + +{-| A value that knows how to decode JSON values. +-} +type alias Decoder a = + D.Decoder { content : a, messages : List ( String, String ) } + + +{-| Create decoders that depend on previous results. +-} +andThen : (a -> Decoder b) -> Decoder a -> Decoder b +andThen func = + D.andThen + (\a -> + D.map + (\b -> { b | messages = a.messages ++ b.messages }) + (func a.content) + ) + + +{-| Decode a nested JSON object, requiring certain fields. +-} +at : List String -> Decoder a -> Decoder a +at = + D.at + + +{-| Decode a JSON boolean into an Elm bool. +-} +bool : Decoder Bool +bool = + D.map empty D.bool + + +{-| Initialize a standard object for the decoder. +-} +empty : a -> { content : a, messages : List ( String, String ) } +empty x = + { content = x, messages = [] } + + +{-| Ignore the JSON and make the decoder fail. +-} +fail : String -> Decoder a +fail = + D.fail + + +{-| Decode a JSON object into a fast Elm dict from miniBill/elm-fast-dict. +-} +fastDict : Decoder a -> Decoder (FDict.Dict String a) +fastDict x = + keyValuePairs x + |> andThen + (\pairs -> + let + dict = + FDict.fromList pairs + + oldLength = + List.length pairs + + newLength = + FDict.size dict + in + if oldLength == newLength then + succeed dict + + else + D.succeed + { content = dict + , messages = + [ ( Log.warn, Text.decodedDictSize oldLength newLength ) ] + } + ) + + +{-| Decode a JSON object, requiring a particular field. +-} +field : String -> Decoder a -> Decoder a +field = + D.field + + +{-| Decode a JSON number into an Elm flaot. +-} +float : Decoder Float +float = + D.map empty D.float + + +{-| Decode a JSON array, requiring a particular index. +-} +index : Int -> Decoder a -> Decoder a +index = + D.index + + +{-| Decode a JSON number into an Elm int. +-} +int : Decoder Int +int = + D.map empty D.int + + +{-| Decode a JSON object into a list of pairs. +-} +keyValuePairs : Decoder a -> Decoder (List ( String, a )) +keyValuePairs x = + D.map + (\result -> + { content = List.map (Tuple.mapSecond .content) result + , messages = + result + |> List.map Tuple.second + |> List.map .messages + |> List.concat + } + ) + (D.keyValuePairs x) + + +{-| Sometimes you have JSON with recursive structure, like nested comments. +You can use `lazy` to make sure your decoder unrolls lazily. +-} +lazy : (() -> Decoder a) -> Decoder a +lazy = + D.lazy + + +{-| Decode a JSON array into an Elm list. +-} +list : Decoder a -> Decoder (List a) +list x = + D.map + (\result -> + { content = List.map .content result + , messages = + result + |> List.map .messages + |> List.concat + } + ) + (D.list x) + + +{-| Transform a decoder. +-} +map : (a -> value) -> Decoder a -> Decoder value +map func da = + D.map + (\a -> + { content = func a.content + , messages = a.messages + } + ) + da + + +{-| Try two decoders and combine the result. +-} +map2 : (a -> b -> value) -> Decoder a -> Decoder b -> Decoder value +map2 func da db = + D.map2 + (\a b -> + { content = func a.content b.content + , messages = + List.concat + [ a.messages + , b.messages + ] + } + ) + da + db + + +{-| Try three decoders and combine the result. +-} +map3 : (a -> b -> c -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder value +map3 func da db dc = + D.map3 + (\a b c -> + { content = func a.content b.content c.content + , messages = + List.concat + [ a.messages + , b.messages + , c.messages + ] + } + ) + da + db + dc + + +{-| Try four decoders and combine the result. +-} +map4 : (a -> b -> c -> d -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder d -> Decoder value +map4 func da db dc dd = + D.map4 + (\a b c d -> + { content = func a.content b.content c.content d.content + , messages = + List.concat + [ a.messages + , b.messages + , c.messages + , d.messages + ] + } + ) + da + db + dc + dd + + +{-| Try five decoders and combine the result. +-} +map5 : (a -> b -> c -> d -> e -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder d -> Decoder e -> Decoder value +map5 func da db dc dd de = + D.map5 + (\a b c d e -> + { content = func a.content b.content c.content d.content e.content + , messages = + List.concat + [ a.messages + , b.messages + , c.messages + , d.messages + , e.messages + ] + } + ) + da + db + dc + dd + de + + +{-| Try six decoders and combine the result. +-} +map6 : (a -> b -> c -> d -> e -> f -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder d -> Decoder e -> Decoder f -> Decoder value +map6 func da db dc dd de df = + D.map6 + (\a b c d e f -> + { content = func a.content b.content c.content d.content e.content f.content + , messages = + List.concat + [ a.messages + , b.messages + , c.messages + , d.messages + , e.messages + , f.messages + ] + } + ) + da + db + dc + dd + de + df + + +{-| Try seven decoders and combine the result. +-} +map7 : (a -> b -> c -> d -> e -> f -> g -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder d -> Decoder e -> Decoder f -> Decoder g -> Decoder value +map7 func da db dc dd de df dg = + D.map7 + (\a b c d e f g -> + { content = func a.content b.content c.content d.content e.content f.content g.content + , messages = + List.concat + [ a.messages + , b.messages + , c.messages + , d.messages + , e.messages + , f.messages + , g.messages + ] + } + ) + da + db + dc + dd + de + df + dg + + +{-| Try eight decoders and combine the result. +-} +map8 : (a -> b -> c -> d -> e -> f -> g -> h -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder d -> Decoder e -> Decoder f -> Decoder g -> Decoder h -> Decoder value +map8 func da db dc dd de df dg dh = + D.map8 + (\a b c d e f g h -> + { content = func a.content b.content c.content d.content e.content f.content g.content h.content + , messages = + List.concat + [ a.messages + , b.messages + , c.messages + , d.messages + , e.messages + , f.messages + , g.messages + , h.messages + ] + } + ) + da + db + dc + dd + de + df + dg + dh + + +{-| Try 9 decoders and combine the result. +-} +map9 : + (a -> b -> c -> d -> e -> f -> g -> h -> i -> value) + -> Decoder a + -> Decoder b + -> Decoder c + -> Decoder d + -> Decoder e + -> Decoder f + -> Decoder g + -> Decoder h + -> Decoder i + -> Decoder value +map9 func da db dc dd de df dg dh di = + D.map8 + (\a b c d e f g ( h, i ) -> + { content = func a.content b.content c.content d.content e.content f.content g.content h.content i.content + , messages = + List.concat + [ a.messages + , b.messages + , c.messages + , d.messages + , e.messages + , f.messages + , g.messages + , h.messages + , i.messages + ] + } + ) + da + db + dc + dd + de + df + dg + (D.map2 Tuple.pair dh di) + + +{-| Try 10 decoders and combine the result. +-} +map10 : + (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> value) + -> Decoder a + -> Decoder b + -> Decoder c + -> Decoder d + -> Decoder e + -> Decoder f + -> Decoder g + -> Decoder h + -> Decoder i + -> Decoder j + -> Decoder value +map10 func da db dc dd de df dg dh di dj = + D.map8 + (\a b c d e f ( g, h ) ( i, j ) -> + { content = func a.content b.content c.content d.content e.content f.content g.content h.content i.content j.content + , messages = + List.concat + [ a.messages + , b.messages + , c.messages + , d.messages + , e.messages + , f.messages + , g.messages + , h.messages + , i.messages + , j.messages + ] + } + ) + da + db + dc + dd + de + df + (D.map2 Tuple.pair dg dh) + (D.map2 Tuple.pair di dj) + + +{-| Try 11 decoders and combine the result. +-} +map11 : + (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> value) + -> Decoder a + -> Decoder b + -> Decoder c + -> Decoder d + -> Decoder e + -> Decoder f + -> Decoder g + -> Decoder h + -> Decoder i + -> Decoder j + -> Decoder k + -> Decoder value +map11 func da db dc dd de df dg dh di dj dk = + D.map8 + (\a b c d e ( f, g ) ( h, i ) ( j, k ) -> + { content = func a.content b.content c.content d.content e.content f.content g.content h.content i.content j.content k.content + , messages = + List.concat + [ a.messages + , b.messages + , c.messages + , d.messages + , e.messages + , f.messages + , g.messages + , h.messages + , i.messages + , j.messages + , k.messages + ] + } + ) + da + db + dc + dd + de + (D.map2 Tuple.pair df dg) + (D.map2 Tuple.pair dh di) + (D.map2 Tuple.pair dj dk) + + +{-| Helpful for dealing with optional fields +-} +maybe : Decoder a -> Decoder (Maybe a) +maybe x = + D.map + (\result -> + case result of + Just { content, messages } -> + { content = Just content, messages = messages } + + Nothing -> + empty Nothing + ) + (D.maybe x) + + +{-| Decode a `null` value into some Elm value. +-} +null : a -> Decoder a +null = + D.null >> D.map empty + + +{-| Decode a nullable JSON value into an Elm value. +-} +nullable : Decoder a -> Decoder (Maybe a) +nullable x = + D.map + (\result -> + case result of + Just { content, messages } -> + { content = Just content, messages = messages } + + Nothing -> + empty Nothing + ) + (D.nullable x) + + +{-| Try a bunch of different decoders. This can be useful if the JSON may come +in a couple different formats. +-} +oneOf : List (Decoder a) -> Decoder a +oneOf = + D.oneOf + + +{-| Decode a JSON object, requiring a particular field: + + - If the field does not exist, the decoder decodes `Nothing` + - If the field DOES exist, the decoder must always return a `Just content` or fail + +-} +opField : String -> Decoder a -> Decoder (Maybe a) +opField key x = + D.map + (\result -> + case result of + Just { content, messages } -> + { content = Just content, messages = messages } + + Nothing -> + empty Nothing + ) + (D.opField key x) + + +{-| Decode a JSON object, requiring a particular field or raising a default: + + - If the field does not exist, the decoder returns the default + - If the field DOES exist, the decoder must always return value or fail + +-} +opFieldWithDefault : String -> a -> Decoder a -> Decoder a +opFieldWithDefault key default x = + opField key x |> map (Maybe.withDefault default) + + +{-| Transform a JSON boolean into a phantom Elm bool. +-} +pBool : Decoder Bool -> Decoder (Phantom.PBool ph) +pBool = + map Phantom.PBool + + +{-| Transform a JSON number into a phantom Elm int. +-} +pInt : Decoder Int -> Decoder (Phantom.PInt ph) +pInt = + map Phantom.PInt + + +{-| Transform a JSON list into a phantom Elm list. +-} +pList : Decoder (List a) -> Decoder (Phantom.PList ph a) +pList = + map Phantom.PList + + +{-| Transform a JSON string into a phantom Elm string. +-} +pString : Decoder String -> Decoder (Phantom.PString ph) +pString = + map Phantom.PString + + +{-| Decode a JSON object into an Elm dict. +-} +slowDict : Decoder a -> Decoder (SDict.Dict String a) +slowDict x = + D.map + (\result -> + { content = + result + |> List.map (Tuple.mapSecond .content) + |> SDict.fromList + , messages = + result + |> List.map Tuple.second + |> List.map .messages + |> List.concat + } + ) + (D.keyValuePairs x) + + +{-| Decode a JSON string into an Elm string. + +This decoder also checks for suspicious inputs, such as the +[Leaking values](Internal-Config-Leaks), to look for suspicious inputs. + +-} +string : Decoder String +string = + D.map + (\content -> + { content = content + , messages = + if Set.member content L.allLeaks then + [ ( Log.securityWarn, Text.leakingValueFound content ) + ] + + else + [] + } + ) + D.string + + +{-| Ignore the JSON and produce a certain Elm value. +-} +succeed : a -> Decoder a +succeed = + D.succeed >> D.map empty + + +{-| Do not do anything with a JSON value, just bring it into Elm as a `Value`. +-} +value : Decoder D.Value +value = + D.map empty D.value From 6f42916a19978028057b2bcbc74f1c2bdc585ff0 Mon Sep 17 00:00:00 2001 From: Bram van den Heuvel Date: Tue, 16 Jan 2024 14:13:27 +0100 Subject: [PATCH 05/14] Add advanced JSON module --- src/Internal/Config/Log.elm | 33 +- src/Internal/Tools/Json.elm | 862 ++++++++++++++++++++++++++++++++++++ 2 files changed, 892 insertions(+), 3 deletions(-) create mode 100644 src/Internal/Tools/Json.elm diff --git a/src/Internal/Config/Log.elm b/src/Internal/Config/Log.elm index ec50cb7..b23ce17 100644 --- a/src/Internal/Config/Log.elm +++ b/src/Internal/Config/Log.elm @@ -1,4 +1,7 @@ -module Internal.Config.Log exposing (caughtError, debug, error, info, securityWarn, warn) +module Internal.Config.Log exposing + ( Log, log + , caughtError, debug, error, info, securityWarn, warn + ) {-| @@ -8,13 +11,37 @@ module Internal.Config.Log exposing (caughtError, debug, error, info, securityWa The logs module exposes various log types that can be used to indicate logs. This helps users filter for the logs that they care about. +@docs Log, log + The logs are encoded as strings as to allow the addition of new log types without triggering a major update. -@docs caughtError, debug, error, info, securityWarn, warn - -} +-- @docs caughtError, debug, error, info, securityWarn, warn + + +type alias Log = + { channel : String, content : String } + + +log : + { caughtError : String -> Log + , debug : String -> Log + , error : String -> Log + , info : String -> Log + , securityWarn : String -> Log + , warn : String -> Log + } +log = + { caughtError = Log caughtError + , debug = Log debug + , error = Log error + , info = Log info + , securityWarn = Log securityWarn + , warn = Log warn + } + {-| A caught error is an error that has been caught elsewhere in the code, hence functioning as a secondary debug channel. diff --git a/src/Internal/Tools/Json.elm b/src/Internal/Tools/Json.elm new file mode 100644 index 0000000..48c64e0 --- /dev/null +++ b/src/Internal/Tools/Json.elm @@ -0,0 +1,862 @@ +module Internal.Tools.Json exposing (..) + +{-| + + +# JSON module + +The JSON module wrapper helps define JSON encoders and decoders in a structural +manner. + +While developing the Elm SDK, a huge amount of encoders and decoders had to +be written that also gained more requirements as the project got more complex: + +1. Objects needed JSON encoders +2. Objects needed JSON decoders +3. Objects needed documentation about how their JSON encodes/decodes +4. Objects needed additional logs in case of special decoded values + +To meet all these requirements, this module helps translate between JSON and +data types. Because this module uses dynamic builder types, this also means it +is relatively easy to write documentation for any data type that uses this +module to build its encoders and decoders. + +-} + +import Dict as SlowDict +import FastDict +import Internal.Config.Log exposing (Log, log) +import Internal.Tools.DecodeExtra as D +import Internal.Tools.EncodeExtra as E +import Json.Decode as D +import Json.Encode as E + + +type Field a object + = Field + { fieldName : String + , description : List String + , encoder : a -> Maybe E.Value + , decoder : D.Decoder ( a, List Log ) + , docs : JSONDocs + , toField : object -> a + , requiredness : RequiredField + } + + +type JSONCoder a + = JSONCoder + { encoder : a -> E.Value + , decoder : D.Decoder ( a, List Log ) + , docs : JSONDocs + } + + +type JSONDocs + = DocsBool + | DocsDict JSONDocs + | DocsFloat + | DocsInt + | DocsList JSONDocs + | DocsObject + { name : String + , description : List String + , keys : + List + { field : String + , description : List String + , required : RequiredField + , content : JSONDocs + } + } + | DocsOptional JSONDocs + | DocsString + + +type RequiredField + = RequiredField + | OptionalField + | OptionalFieldWithDefault String + + +bool : JSONCoder Bool +bool = + JSONCoder + { encoder = E.bool + , decoder = D.map empty D.bool + , docs = DocsBool + } + + +{-| Get a JSON coder's decode value +-} +decode : JSONCoder a -> D.Decoder ( a, List Log ) +decode (JSONCoder data) = + data.decoder + + +{-| Create a tuple with no logs +-} +empty : a -> ( a, List Log ) +empty x = + ( x, [] ) + + +{-| Get a JSON coder's encode value +-} +encode : JSONCoder a -> (a -> E.Value) +encode (JSONCoder data) = + data.encoder + + +{-| Define a fast dict. The dict can only have strings as keys. +-} +fastDict : JSONCoder value -> JSONCoder (FastDict.Dict String value) +fastDict (JSONCoder value) = + JSONCoder + { encoder = FastDict.toCoreDict >> E.dict identity value.encoder + , decoder = + value.decoder + |> D.keyValuePairs + |> D.map + (\items -> + ( items + |> List.map (Tuple.mapSecond Tuple.first) + |> FastDict.fromList + , items + |> List.map Tuple.second + |> List.concatMap Tuple.second + ) + ) + , docs = DocsDict value.docs + } + + +{-| Create a new field +-} +field : + { required : { fieldName : String, toField : object -> a, description : List String, coder : JSONCoder a } -> Field a object + , optional : + { value : { fieldName : String, toField : object -> Maybe a, description : List String, coder : JSONCoder a } -> Field (Maybe a) object + , withDefault : { fieldName : String, toField : object -> a, description : List String, coder : JSONCoder a, default : ( a, List Log ), defaultToString : a -> String } -> Field a object + } + } +field = + { required = + \{ fieldName, toField, description, coder } -> + case coder of + JSONCoder { encoder, decoder, docs } -> + Field + { fieldName = fieldName + , toField = toField + , description = description + , encoder = encoder >> Maybe.Just + , decoder = decoder + , docs = docs + , requiredness = RequiredField + } + , optional = + { value = + \{ fieldName, toField, description, coder } -> + case coder of + JSONCoder { encoder, decoder, docs } -> + Field + { fieldName = fieldName + , toField = toField + , description = description + , encoder = Maybe.map encoder + , decoder = + decoder + |> D.opField fieldName + |> D.map + (\value -> + case value of + Just ( v, l ) -> + ( Just v, l ) + + Nothing -> + ( Nothing, [] ) + ) + , docs = docs + , requiredness = OptionalField + } + , withDefault = + \{ fieldName, toField, description, coder, default, defaultToString } -> + case coder of + JSONCoder { encoder, decoder, docs } -> + Field + { fieldName = fieldName + , toField = toField + , description = description + , encoder = encoder >> Maybe.Just + , decoder = D.opFieldWithDefault fieldName default decoder + , docs = docs + , requiredness = + default + |> Tuple.first + |> defaultToString + |> OptionalFieldWithDefault + } + } + } + + +{-| Define a float. +-} +float : JSONCoder Float +float = + JSONCoder + { encoder = E.float + , decoder = D.map empty D.float + , docs = DocsFloat + } + + +{-| Define an int. +-} +int : JSONCoder Int +int = + JSONCoder + { encoder = E.int + , decoder = D.map empty D.int + , docs = DocsInt + } + + +{-| Define a list. +-} +list : JSONCoder a -> JSONCoder (List a) +list (JSONCoder old) = + JSONCoder + { encoder = E.list old.encoder + , decoder = + old.decoder + |> D.list + |> D.map + (\items -> + ( List.map Tuple.first items + , List.concatMap Tuple.second items + ) + ) + , docs = DocsList old.docs + } + + +maybe : JSONCoder a -> JSONCoder (Maybe a) +maybe (JSONCoder old) = + JSONCoder + { encoder = Maybe.map old.encoder >> Maybe.withDefault E.null + , decoder = + old.decoder + |> D.nullable + |> D.map + (\value -> + case value of + Just ( v, logs ) -> + ( Just v, logs ) + + Nothing -> + empty Nothing + ) + , docs = DocsOptional old.docs + } + + +{-| Use an objectEncoder to encode a list of items into a single object. +-} +objectEncoder : List ( String, object -> Maybe E.Value ) -> object -> E.Value +objectEncoder items object = + items + |> List.map (Tuple.mapSecond (\f -> f object)) + |> E.maybeObject + + +{-| Define an object with 2 keys +-} +object2 : + { name : String, description : List String, init : a -> b -> object } + -> Field a object + -> Field b object + -> JSONCoder object +object2 { name, description, init } fa fb = + JSONCoder + { encoder = + objectEncoder + [ toEncodeField fa + , toEncodeField fb + ] + , decoder = + D.map2 + (\( a, la ) ( b, lb ) -> + ( init a b + , List.concat [ la, lb ] + ) + ) + (toDecoderField fa) + (toDecoderField fb) + , docs = + DocsObject + { name = name + , description = description + , keys = + [ toDocsField fa + , toDocsField fb + ] + } + } + + +{-| Define an object with 3 keys +-} +object3 : + { name : String, description : List String, init : a -> b -> c -> object } + -> Field a object + -> Field b object + -> Field c object + -> JSONCoder object +object3 { name, description, init } fa fb fc = + JSONCoder + { encoder = + objectEncoder + [ toEncodeField fa + , toEncodeField fb + , toEncodeField fc + ] + , decoder = + D.map3 + (\( a, la ) ( b, lb ) ( c, lc ) -> + ( init a b c + , List.concat [ la, lb, lc ] + ) + ) + (toDecoderField fa) + (toDecoderField fb) + (toDecoderField fc) + , docs = + DocsObject + { name = name + , description = description + , keys = + [ toDocsField fa + , toDocsField fb + , toDocsField fc + ] + } + } + + +{-| Define an object with 4 keys +-} +object4 : + { name : String, description : List String, init : a -> b -> c -> d -> object } + -> Field a object + -> Field b object + -> Field c object + -> Field d object + -> JSONCoder object +object4 { name, description, init } fa fb fc fd = + JSONCoder + { encoder = + objectEncoder + [ toEncodeField fa + , toEncodeField fb + , toEncodeField fc + , toEncodeField fd + ] + , decoder = + D.map4 + (\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) -> + ( init a b c d + , List.concat [ la, lb, lc, ld ] + ) + ) + (toDecoderField fa) + (toDecoderField fb) + (toDecoderField fc) + (toDecoderField fd) + , docs = + DocsObject + { name = name + , description = description + , keys = + [ toDocsField fa + , toDocsField fb + , toDocsField fc + , toDocsField fd + ] + } + } + + +{-| Define an object with 5 keys +-} +object5 : + { name : String, description : List String, init : a -> b -> c -> d -> e -> object } + -> Field a object + -> Field b object + -> Field c object + -> Field d object + -> Field e object + -> JSONCoder object +object5 { name, description, init } fa fb fc fd fe = + JSONCoder + { encoder = + objectEncoder + [ toEncodeField fa + , toEncodeField fb + , toEncodeField fc + , toEncodeField fd + , toEncodeField fe + ] + , decoder = + D.map5 + (\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) ( e, le ) -> + ( init a b c d e + , List.concat [ la, lb, lc, ld, le ] + ) + ) + (toDecoderField fa) + (toDecoderField fb) + (toDecoderField fc) + (toDecoderField fd) + (toDecoderField fe) + , docs = + DocsObject + { name = name + , description = description + , keys = + [ toDocsField fa + , toDocsField fb + , toDocsField fc + , toDocsField fd + , toDocsField fe + ] + } + } + + +{-| Define an object with 6 keys +-} +object6 : + { name : String, description : List String, init : a -> b -> c -> d -> e -> f -> object } + -> Field a object + -> Field b object + -> Field c object + -> Field d object + -> Field e object + -> Field f object + -> JSONCoder object +object6 { name, description, init } fa fb fc fd fe ff = + JSONCoder + { encoder = + objectEncoder + [ toEncodeField fa + , toEncodeField fb + , toEncodeField fc + , toEncodeField fd + , toEncodeField fe + , toEncodeField ff + ] + , decoder = + D.map6 + (\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) ( e, le ) ( f, lf ) -> + ( init a b c d e f + , List.concat [ la, lb, lc, ld, le, lf ] + ) + ) + (toDecoderField fa) + (toDecoderField fb) + (toDecoderField fc) + (toDecoderField fd) + (toDecoderField fe) + (toDecoderField ff) + , docs = + DocsObject + { name = name + , description = description + , keys = + [ toDocsField fa + , toDocsField fb + , toDocsField fc + , toDocsField fd + , toDocsField fe + , toDocsField ff + ] + } + } + + +{-| Define an object with 7 keys +-} +object7 : + { name : String, description : List String, init : a -> b -> c -> d -> e -> f -> g -> object } + -> Field a object + -> Field b object + -> Field c object + -> Field d object + -> Field e object + -> Field f object + -> Field g object + -> JSONCoder object +object7 { name, description, init } fa fb fc fd fe ff fg = + JSONCoder + { encoder = + objectEncoder + [ toEncodeField fa + , toEncodeField fb + , toEncodeField fc + , toEncodeField fd + , toEncodeField fe + , toEncodeField ff + , toEncodeField fg + ] + , decoder = + D.map7 + (\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) ( e, le ) ( f, lf ) ( g, lg ) -> + ( init a b c d e f g + , List.concat [ la, lb, lc, ld, le, lf, lg ] + ) + ) + (toDecoderField fa) + (toDecoderField fb) + (toDecoderField fc) + (toDecoderField fd) + (toDecoderField fe) + (toDecoderField ff) + (toDecoderField fg) + , docs = + DocsObject + { name = name + , description = description + , keys = + [ toDocsField fa + , toDocsField fb + , toDocsField fc + , toDocsField fd + , toDocsField fe + , toDocsField ff + , toDocsField fg + ] + } + } + + +{-| Define an object with 8 keys +-} +object8 : + { name : String, description : List String, init : a -> b -> c -> d -> e -> f -> g -> h -> object } + -> Field a object + -> Field b object + -> Field c object + -> Field d object + -> Field e object + -> Field f object + -> Field g object + -> Field h object + -> JSONCoder object +object8 { name, description, init } fa fb fc fd fe ff fg fh = + JSONCoder + { encoder = + objectEncoder + [ toEncodeField fa + , toEncodeField fb + , toEncodeField fc + , toEncodeField fd + , toEncodeField fe + , toEncodeField ff + , toEncodeField fg + , toEncodeField fh + ] + , decoder = + D.map8 + (\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) ( e, le ) ( f, lf ) ( g, lg ) ( h, lh ) -> + ( init a b c d e f g h + , List.concat [ la, lb, lc, ld, le, lf, lg, lh ] + ) + ) + (toDecoderField fa) + (toDecoderField fb) + (toDecoderField fc) + (toDecoderField fd) + (toDecoderField fe) + (toDecoderField ff) + (toDecoderField fg) + (toDecoderField fh) + , docs = + DocsObject + { name = name + , description = description + , keys = + [ toDocsField fa + , toDocsField fb + , toDocsField fc + , toDocsField fd + , toDocsField fe + , toDocsField ff + , toDocsField fg + , toDocsField fh + ] + } + } + + +{-| Define an object with 9 keys +-} +object9 : + { name : String, description : List String, init : a -> b -> c -> d -> e -> f -> g -> h -> i -> object } + -> Field a object + -> Field b object + -> Field c object + -> Field d object + -> Field e object + -> Field f object + -> Field g object + -> Field h object + -> Field i object + -> JSONCoder object +object9 { name, description, init } fa fb fc fd fe ff fg fh fi = + JSONCoder + { encoder = + objectEncoder + [ toEncodeField fa + , toEncodeField fb + , toEncodeField fc + , toEncodeField fd + , toEncodeField fe + , toEncodeField ff + , toEncodeField fg + , toEncodeField fh + , toEncodeField fi + ] + , decoder = + D.map9 + (\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) ( e, le ) ( f, lf ) ( g, lg ) ( h, lh ) ( i, li ) -> + ( init a b c d e f g h i + , List.concat [ la, lb, lc, ld, le, lf, lg, lh, li ] + ) + ) + (toDecoderField fa) + (toDecoderField fb) + (toDecoderField fc) + (toDecoderField fd) + (toDecoderField fe) + (toDecoderField ff) + (toDecoderField fg) + (toDecoderField fh) + (toDecoderField fi) + , docs = + DocsObject + { name = name + , description = description + , keys = + [ toDocsField fa + , toDocsField fb + , toDocsField fc + , toDocsField fd + , toDocsField fe + , toDocsField ff + , toDocsField fg + , toDocsField fh + , toDocsField fi + ] + } + } + + +{-| Define an object with 10 keys +-} +object10 : + { name : String, description : List String, init : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> object } + -> Field a object + -> Field b object + -> Field c object + -> Field d object + -> Field e object + -> Field f object + -> Field g object + -> Field h object + -> Field i object + -> Field j object + -> JSONCoder object +object10 { name, description, init } fa fb fc fd fe ff fg fh fi fj = + JSONCoder + { encoder = + objectEncoder + [ toEncodeField fa + , toEncodeField fb + , toEncodeField fc + , toEncodeField fd + , toEncodeField fe + , toEncodeField ff + , toEncodeField fg + , toEncodeField fh + , toEncodeField fi + , toEncodeField fj + ] + , decoder = + D.map10 + (\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) ( e, le ) ( f, lf ) ( g, lg ) ( h, lh ) ( i, li ) ( j, lj ) -> + ( init a b c d e f g h i j + , List.concat [ la, lb, lc, ld, le, lf, lg, lh, li, lj ] + ) + ) + (toDecoderField fa) + (toDecoderField fb) + (toDecoderField fc) + (toDecoderField fd) + (toDecoderField fe) + (toDecoderField ff) + (toDecoderField fg) + (toDecoderField fh) + (toDecoderField fi) + (toDecoderField fj) + , docs = + DocsObject + { name = name + , description = description + , keys = + [ toDocsField fa + , toDocsField fb + , toDocsField fc + , toDocsField fd + , toDocsField fe + , toDocsField ff + , toDocsField fg + , toDocsField fh + , toDocsField fi + , toDocsField fj + ] + } + } + + +{-| Define an object with 11 keys +-} +object11 : + { name : String, description : List String, init : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> object } + -> Field a object + -> Field b object + -> Field c object + -> Field d object + -> Field e object + -> Field f object + -> Field g object + -> Field h object + -> Field i object + -> Field j object + -> Field k object + -> JSONCoder object +object11 { name, description, init } fa fb fc fd fe ff fg fh fi fj fk = + JSONCoder + { encoder = + objectEncoder + [ toEncodeField fa + , toEncodeField fb + , toEncodeField fc + , toEncodeField fd + , toEncodeField fe + , toEncodeField ff + , toEncodeField fg + , toEncodeField fh + , toEncodeField fi + , toEncodeField fj + , toEncodeField fk + ] + , decoder = + D.map11 + (\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) ( e, le ) ( f, lf ) ( g, lg ) ( h, lh ) ( i, li ) ( j, lj ) ( k, lk ) -> + ( init a b c d e f g h i j k + , List.concat [ la, lb, lc, ld, le, lf, lg, lh, li, lj, lk ] + ) + ) + (toDecoderField fa) + (toDecoderField fb) + (toDecoderField fc) + (toDecoderField fd) + (toDecoderField fe) + (toDecoderField ff) + (toDecoderField fg) + (toDecoderField fh) + (toDecoderField fi) + (toDecoderField fj) + (toDecoderField fk) + , docs = + DocsObject + { name = name + , description = description + , keys = + [ toDocsField fa + , toDocsField fb + , toDocsField fc + , toDocsField fd + , toDocsField fe + , toDocsField ff + , toDocsField fg + , toDocsField fh + , toDocsField fi + , toDocsField fj + , toDocsField fk + ] + } + } + + +{-| Define a slow dict from the elm/core library. +-} +slowDict : JSONCoder value -> JSONCoder (SlowDict.Dict String value) +slowDict (JSONCoder data) = + JSONCoder + { encoder = E.dict identity data.encoder + , decoder = + data.decoder + |> D.keyValuePairs + |> D.map + (\items -> + ( items + |> List.map (Tuple.mapSecond Tuple.first) + |> SlowDict.fromList + , items + |> List.map Tuple.second + |> List.concatMap Tuple.second + ) + ) + , docs = DocsDict data.docs + } + + +{-| Define a string. +-} +string : JSONCoder String +string = + JSONCoder + { encoder = E.string + , decoder = D.map empty D.string + , docs = DocsString + } + + +{-| Turn a Field type into a usable JSON decoder +-} +toDecoderField : Field a object -> D.Decoder ( a, List Log ) +toDecoderField (Field data) = + data.decoder + + +{-| Turn a Field type into a descriptive field documentation +-} +toDocsField : Field a object -> { field : String, description : List String, required : RequiredField, content : JSONDocs } +toDocsField x = + case x of + Field { fieldName, description, docs, requiredness } -> + { field = fieldName + , description = description + , required = requiredness + , content = docs + } + + +{-| Turn a Field type into a usable object for a maybeObject type +-} +toEncodeField : Field a object -> ( String, object -> Maybe E.Value ) +toEncodeField (Field data) = + ( data.fieldName, data.toField >> data.encoder ) From 21dfa1e77f9413ebb090e612d30803e07972cf9b Mon Sep 17 00:00:00 2001 From: Bram Date: Tue, 16 Jan 2024 16:05:34 +0100 Subject: [PATCH 06/14] Fix documentation standards --- elm.json | 19 +++++++++++++++++++ src/Internal/Config/Leaks.elm | 2 ++ src/Internal/Config/Log.elm | 14 ++++++++++---- src/Internal/Config/Text.elm | 3 +++ 4 files changed, 34 insertions(+), 4 deletions(-) diff --git a/elm.json b/elm.json index 78baf2d..5025f40 100644 --- a/elm.json +++ b/elm.json @@ -5,6 +5,25 @@ "license": "EUPL-1.1", "version": "2.1.0", "exposed-modules": [ + "Internal.Config.Default", + "Internal.Config.Leaks", + "Internal.Config.Log", + "Internal.Config.Phantom", + "Internal.Config.Text", + "Internal.Tools.DecodeExtra", + "Internal.Tools.EncodeExtra", + "Internal.Tools.Hashdict", + "Internal.Tools.Iddict", + "Internal.Tools.Json", + "Internal.Tools.Mashdict", + "Internal.Tools.Timestamp", + "Internal.Tools.VersionControl", + "Internal.Values.Context", + "Internal.Values.Envelope", + "Internal.Values.Event", + "Internal.Values.Settings", + "Internal.Values.StateManager", + "Internal.Values.Vault", "Matrix", "Matrix.Event", "Matrix.Settings" diff --git a/src/Internal/Config/Leaks.elm b/src/Internal/Config/Leaks.elm index f3125ca..6562b0a 100644 --- a/src/Internal/Config/Leaks.elm +++ b/src/Internal/Config/Leaks.elm @@ -48,6 +48,8 @@ accessToken = "elm-sdk-placeholder-access-token-leaks" +{-| Complete set of all leaking values. Commonly using for testing purposes. +-} allLeaks : Set String allLeaks = Set.union diff --git a/src/Internal/Config/Log.elm b/src/Internal/Config/Log.elm index b23ce17..90a7abd 100644 --- a/src/Internal/Config/Log.elm +++ b/src/Internal/Config/Log.elm @@ -1,7 +1,4 @@ -module Internal.Config.Log exposing - ( Log, log - , caughtError, debug, error, info, securityWarn, warn - ) +module Internal.Config.Log exposing (Log, log) {-| @@ -21,10 +18,19 @@ without triggering a major update. -- @docs caughtError, debug, error, info, securityWarn, warn +{-| Common pattern for a log message. The log message consists of a log channel +like `debug`, `warn`, `error`, etc. and the content of the message. + +These logs are completely optional: they can be ignored, they can be sent to the +console, or a dialog may be created that presents the log messages. + +-} type alias Log = { channel : String, content : String } +{-| Create a log message of various log types. +-} log : { caughtError : String -> Log , debug : String -> Log diff --git a/src/Internal/Config/Text.elm b/src/Internal/Config/Text.elm index c86bd4c..745b15b 100644 --- a/src/Internal/Config/Text.elm +++ b/src/Internal/Config/Text.elm @@ -81,6 +81,9 @@ accessTokenInvalid = "Matrix API rejected access token as invalid" +{-| Logs when the JSON decoder detects that an imported dictionary contained +duplicate keys. +-} decodedDictSize : Int -> Int -> String decodedDictSize from to = String.concat From ecdc136f9e24fd6db89f7403c6bdf7aaaf6901e8 Mon Sep 17 00:00:00 2001 From: Bram Date: Tue, 16 Jan 2024 16:06:38 +0100 Subject: [PATCH 07/14] Write JSON test module --- src/Internal/Tools/Json.elm | 290 +++++++++++++++++++++++++++--------- tests/Test/Tools/Json.elm | 249 +++++++++++++++++++++++++++++++ 2 files changed, 472 insertions(+), 67 deletions(-) create mode 100644 tests/Test/Tools/Json.elm diff --git a/src/Internal/Tools/Json.elm b/src/Internal/Tools/Json.elm index 48c64e0..bbc22f5 100644 --- a/src/Internal/Tools/Json.elm +++ b/src/Internal/Tools/Json.elm @@ -1,4 +1,11 @@ -module Internal.Tools.Json exposing (..) +module Internal.Tools.Json exposing + ( Coder, string, bool, int, float + , encode, decode + , Docs(..), RequiredField(..), toDocs + , list, slowDict, fastDict, maybe + , Field, field + , object2, object3, object4, object5, object6, object7, object8, object9, object10, object11 + ) {-| @@ -21,6 +28,36 @@ data types. Because this module uses dynamic builder types, this also means it is relatively easy to write documentation for any data type that uses this module to build its encoders and decoders. +@docs Coder, string, bool, int, float + + +## JSON Coding + +@docs encode, decode + + +## Documentation + +@docs Docs, RequiredField, toDocs + + +## Data types + +@docs list, slowDict, fastDict, maybe + + +## Objects + +This section creates objects that can be (re)used in the library's JSON +specification. For this, the user needs to construct fields for the object +first. + +@docs Field, field + +Once all fields are constructed, the user can create JSON objects. + +@docs object2, object3, object4, object5, object6, object7, object8, object9, object10, object11 + -} import Dict as SlowDict @@ -32,32 +69,55 @@ import Json.Decode as D import Json.Encode as E +{-| A field of type `a` as a subtype of an object `object`. + +In concrete terms, to construct a data type + + type alias User = + { name : String + , age : Int + , hobbies : List String + } + +The user needs to construct the field types: + + - `Field String User`, + - `Field Int User`, + - and `Field (List String) User`. + +-} type Field a object = Field { fieldName : String , description : List String , encoder : a -> Maybe E.Value , decoder : D.Decoder ( a, List Log ) - , docs : JSONDocs + , docs : Docs , toField : object -> a , requiredness : RequiredField } -type JSONCoder a - = JSONCoder +{-| Builder type that helps create JSON encoders, JSON decoders, data type +documentation and various other data types. +-} +type Coder a + = Coder { encoder : a -> E.Value , decoder : D.Decoder ( a, List Log ) - , docs : JSONDocs + , docs : Docs } -type JSONDocs +{-| Structure of JSON documentation. It is up to an external module to turn the +documentation structure into a readable format. +-} +type Docs = DocsBool - | DocsDict JSONDocs + | DocsDict Docs | DocsFloat | DocsInt - | DocsList JSONDocs + | DocsList Docs | DocsObject { name : String , description : List String @@ -66,22 +126,28 @@ type JSONDocs { field : String , description : List String , required : RequiredField - , content : JSONDocs + , content : Docs } } - | DocsOptional JSONDocs + | DocsOptional Docs | DocsString +{-| Value that tells whether an object field is required to be included. If it +is not required, it can either be omitted - or a given default will be assumed. +The given default is a string representation, not the actual value. +-} type RequiredField = RequiredField | OptionalField | OptionalFieldWithDefault String -bool : JSONCoder Bool +{-| Define a boolean value. +-} +bool : Coder Bool bool = - JSONCoder + Coder { encoder = E.bool , decoder = D.map empty D.bool , docs = DocsBool @@ -90,11 +156,18 @@ bool = {-| Get a JSON coder's decode value -} -decode : JSONCoder a -> D.Decoder ( a, List Log ) -decode (JSONCoder data) = +decode : Coder a -> D.Decoder ( a, List Log ) +decode (Coder data) = data.decoder +{-| Generate documentation from a Coder definition. +-} +toDocs : Coder a -> Docs +toDocs (Coder data) = + data.docs + + {-| Create a tuple with no logs -} empty : a -> ( a, List Log ) @@ -103,17 +176,25 @@ empty x = {-| Get a JSON coder's encode value + + + text : Json.Encode.Value + text = + encode string "test" + + -- == Json.Encode.string "test" + -} -encode : JSONCoder a -> (a -> E.Value) -encode (JSONCoder data) = +encode : Coder a -> (a -> E.Value) +encode (Coder data) = data.encoder {-| Define a fast dict. The dict can only have strings as keys. -} -fastDict : JSONCoder value -> JSONCoder (FastDict.Dict String value) -fastDict (JSONCoder value) = - JSONCoder +fastDict : Coder value -> Coder (FastDict.Dict String value) +fastDict (Coder value) = + Coder { encoder = FastDict.toCoreDict >> E.dict identity value.encoder , decoder = value.decoder @@ -132,26 +213,63 @@ fastDict (JSONCoder value) = } -{-| Create a new field +{-| Create a new field using any of the three provided options. + +For example, suppose we are creating a `Field String User` to represent the +`name` field in + + type alias User = + { name : String + , age : Int + , hobbies : List String + } + +then the following field type would be used: + + field.required + { fieldName = "name" -- Field name when encoded into JSON + , toField = .name + , description = + [ "This description describes this field's information content." + , "Here's another paragraph!" + ] + , coder = string + } + +Suppose the JSO isn't obligated to provide a list of hobbies, and the list would +by default be overriden with an empty list, then we would use the following +field type: + + field.optional.withDefault + { fieldName = "hobbies" + , toField = .hobbies + , description = + [ "The hobbies of the person. Can be omitted." + ] + , coder = list string + , default = ( [], [] ) -- The `List Log` can be inserted in case you wish to insert a message when relying on a default + , defaultToString = always "[]" -- Default converted to a string + } + -} field : - { required : { fieldName : String, toField : object -> a, description : List String, coder : JSONCoder a } -> Field a object + { required : { fieldName : String, toField : object -> a, description : List String, coder : Coder a } -> Field a object , optional : - { value : { fieldName : String, toField : object -> Maybe a, description : List String, coder : JSONCoder a } -> Field (Maybe a) object - , withDefault : { fieldName : String, toField : object -> a, description : List String, coder : JSONCoder a, default : ( a, List Log ), defaultToString : a -> String } -> Field a object + { value : { fieldName : String, toField : object -> Maybe a, description : List String, coder : Coder a } -> Field (Maybe a) object + , withDefault : { fieldName : String, toField : object -> a, description : List String, coder : Coder a, default : ( a, List Log ), defaultToString : a -> String } -> Field a object } } field = { required = \{ fieldName, toField, description, coder } -> case coder of - JSONCoder { encoder, decoder, docs } -> + Coder { encoder, decoder, docs } -> Field { fieldName = fieldName , toField = toField , description = description , encoder = encoder >> Maybe.Just - , decoder = decoder + , decoder = D.field fieldName decoder , docs = docs , requiredness = RequiredField } @@ -159,7 +277,7 @@ field = { value = \{ fieldName, toField, description, coder } -> case coder of - JSONCoder { encoder, decoder, docs } -> + Coder { encoder, decoder, docs } -> Field { fieldName = fieldName , toField = toField @@ -183,7 +301,7 @@ field = , withDefault = \{ fieldName, toField, description, coder, default, defaultToString } -> case coder of - JSONCoder { encoder, decoder, docs } -> + Coder { encoder, decoder, docs } -> Field { fieldName = fieldName , toField = toField @@ -201,22 +319,22 @@ field = } -{-| Define a float. +{-| Define a float value. -} -float : JSONCoder Float +float : Coder Float float = - JSONCoder + Coder { encoder = E.float , decoder = D.map empty D.float , docs = DocsFloat } -{-| Define an int. +{-| Define an int value. -} -int : JSONCoder Int +int : Coder Int int = - JSONCoder + Coder { encoder = E.int , decoder = D.map empty D.int , docs = DocsInt @@ -225,9 +343,9 @@ int = {-| Define a list. -} -list : JSONCoder a -> JSONCoder (List a) -list (JSONCoder old) = - JSONCoder +list : Coder a -> Coder (List a) +list (Coder old) = + Coder { encoder = E.list old.encoder , decoder = old.decoder @@ -242,9 +360,15 @@ list (JSONCoder old) = } -maybe : JSONCoder a -> JSONCoder (Maybe a) -maybe (JSONCoder old) = - JSONCoder +{-| Define a maybe value. + +NOTE: most of the time, you wish to avoid this function! Make sure to look at +objects instead. + +-} +maybe : Coder a -> Coder (Maybe a) +maybe (Coder old) = + Coder { encoder = Maybe.map old.encoder >> Maybe.withDefault E.null , decoder = old.decoder @@ -272,14 +396,46 @@ objectEncoder items object = {-| Define an object with 2 keys + + type alias Human = + { name : String, age : Maybe Int } + + humanCoder : Coder Human + humanCoder = + object2 + { name = "Human" + , description = + [ "Documentation description of the human type." + ] + , init = Human + } + (field.required + { fieldName = "name" + , toField = .name + , description = + [ "Human's name." + ] + , coder = string + } + ) + (field.optional.value + { fieldName = "age" + , toField = .age + , description = + [ "(Optional) human's age" + ] + , coder = int + } + ) + -} object2 : { name : String, description : List String, init : a -> b -> object } -> Field a object -> Field b object - -> JSONCoder object + -> Coder object object2 { name, description, init } fa fb = - JSONCoder + Coder { encoder = objectEncoder [ toEncodeField fa @@ -313,9 +469,9 @@ object3 : -> Field a object -> Field b object -> Field c object - -> JSONCoder object + -> Coder object object3 { name, description, init } fa fb fc = - JSONCoder + Coder { encoder = objectEncoder [ toEncodeField fa @@ -353,9 +509,9 @@ object4 : -> Field b object -> Field c object -> Field d object - -> JSONCoder object + -> Coder object object4 { name, description, init } fa fb fc fd = - JSONCoder + Coder { encoder = objectEncoder [ toEncodeField fa @@ -397,9 +553,9 @@ object5 : -> Field c object -> Field d object -> Field e object - -> JSONCoder object + -> Coder object object5 { name, description, init } fa fb fc fd fe = - JSONCoder + Coder { encoder = objectEncoder [ toEncodeField fa @@ -445,9 +601,9 @@ object6 : -> Field d object -> Field e object -> Field f object - -> JSONCoder object + -> Coder object object6 { name, description, init } fa fb fc fd fe ff = - JSONCoder + Coder { encoder = objectEncoder [ toEncodeField fa @@ -497,9 +653,9 @@ object7 : -> Field e object -> Field f object -> Field g object - -> JSONCoder object + -> Coder object object7 { name, description, init } fa fb fc fd fe ff fg = - JSONCoder + Coder { encoder = objectEncoder [ toEncodeField fa @@ -553,9 +709,9 @@ object8 : -> Field f object -> Field g object -> Field h object - -> JSONCoder object + -> Coder object object8 { name, description, init } fa fb fc fd fe ff fg fh = - JSONCoder + Coder { encoder = objectEncoder [ toEncodeField fa @@ -613,9 +769,9 @@ object9 : -> Field g object -> Field h object -> Field i object - -> JSONCoder object + -> Coder object object9 { name, description, init } fa fb fc fd fe ff fg fh fi = - JSONCoder + Coder { encoder = objectEncoder [ toEncodeField fa @@ -677,9 +833,9 @@ object10 : -> Field h object -> Field i object -> Field j object - -> JSONCoder object + -> Coder object object10 { name, description, init } fa fb fc fd fe ff fg fh fi fj = - JSONCoder + Coder { encoder = objectEncoder [ toEncodeField fa @@ -745,9 +901,9 @@ object11 : -> Field i object -> Field j object -> Field k object - -> JSONCoder object + -> Coder object object11 { name, description, init } fa fb fc fd fe ff fg fh fi fj fk = - JSONCoder + Coder { encoder = objectEncoder [ toEncodeField fa @@ -801,11 +957,11 @@ object11 { name, description, init } fa fb fc fd fe ff fg fh fi fj fk = } -{-| Define a slow dict from the elm/core library. +{-| Define a slow dict from the `elm/core` library. -} -slowDict : JSONCoder value -> JSONCoder (SlowDict.Dict String value) -slowDict (JSONCoder data) = - JSONCoder +slowDict : Coder value -> Coder (SlowDict.Dict String value) +slowDict (Coder data) = + Coder { encoder = E.dict identity data.encoder , decoder = data.decoder @@ -824,11 +980,11 @@ slowDict (JSONCoder data) = } -{-| Define a string. +{-| Define a string value. -} -string : JSONCoder String +string : Coder String string = - JSONCoder + Coder { encoder = E.string , decoder = D.map empty D.string , docs = DocsString @@ -844,7 +1000,7 @@ toDecoderField (Field data) = {-| Turn a Field type into a descriptive field documentation -} -toDocsField : Field a object -> { field : String, description : List String, required : RequiredField, content : JSONDocs } +toDocsField : Field a object -> { field : String, description : List String, required : RequiredField, content : Docs } toDocsField x = case x of Field { fieldName, description, docs, requiredness } -> diff --git a/tests/Test/Tools/Json.elm b/tests/Test/Tools/Json.elm new file mode 100644 index 0000000..c4fce46 --- /dev/null +++ b/tests/Test/Tools/Json.elm @@ -0,0 +1,249 @@ +module Test.Tools.Json exposing (..) + +import Expect +import Fuzz exposing (Fuzzer) +import Internal.Tools.Json as Json +import Json.Decode as D +import Json.Encode as E +import Test exposing (..) + + +type alias Human2 = + { name : String, age : Maybe Int } + + +type alias Human3 = + { name : String, age : Maybe Int, hobbies : List String } + + +type alias Human4 = + { name : String + , age : Maybe Int + , hobbies : List String + , weight : Maybe Float + } + + +type alias Human5 = + { name : String + , age : Maybe Int + , hobbies : List String + , weight : Maybe Float + , height : Float + } + + +ageField : Json.Field (Maybe Int) { a | age : Maybe Int } +ageField = + Json.field.optional.value + { fieldName = "age" + , toField = .age + , description = [] + , coder = Json.int + } + + +ageFuzzer : Fuzzer (Maybe Int) +ageFuzzer = + Fuzz.maybe Fuzz.int + + +heightField : Json.Field Float { a | height : Float } +heightField = + Json.field.required + { fieldName = "height" + , toField = .height + , description = [] + , coder = Json.float + } + + +heightFuzzer : Fuzzer Float +heightFuzzer = + Fuzz.niceFloat + + +hobbiesField : Json.Field (List String) { a | hobbies : List String } +hobbiesField = + Json.field.optional.withDefault + { fieldName = "hobbies" + , toField = .hobbies + , description = [] + , coder = Json.list Json.string + , default = ( [], [] ) + , defaultToString = always "[]" + } + + +hobbiesFuzzer : Fuzzer (List String) +hobbiesFuzzer = + Fuzz.list Fuzz.string + + +nameField : Json.Field String { a | name : String } +nameField = + Json.field.required + { fieldName = "name" + , toField = .name + , description = [] + , coder = Json.string + } + + +nameFuzzer : Fuzzer String +nameFuzzer = + Fuzz.string + + +weightField : Json.Field (Maybe Float) { a | weight : Maybe Float } +weightField = + Json.field.optional.value + { fieldName = "weight" + , toField = .weight + , description = [] + , coder = Json.float + } + + +weightFuzzer : Fuzzer (Maybe Float) +weightFuzzer = + -- TODO: Maybe make Float not so nice? + Fuzz.maybe Fuzz.niceFloat + + +human2Coder : Json.Coder Human2 +human2Coder = + Json.object2 + { name = "Human2" + , description = [] + , init = Human2 + } + nameField + ageField + + +human2Fuzzer : Fuzzer Human2 +human2Fuzzer = + Fuzz.map2 Human2 + nameFuzzer + ageFuzzer + + +human3Coder : Json.Coder Human3 +human3Coder = + Json.object3 + { name = "Human3" + , description = [] + , init = Human3 + } + nameField + ageField + hobbiesField + + +human3Fuzzer : Fuzzer Human3 +human3Fuzzer = + Fuzz.map3 Human3 + nameFuzzer + ageFuzzer + hobbiesFuzzer + + +human4Coder : Json.Coder Human4 +human4Coder = + Json.object4 + { name = "Human4" + , description = [] + , init = Human4 + } + nameField + ageField + hobbiesField + weightField + + +human4Fuzzer : Fuzzer Human4 +human4Fuzzer = + Fuzz.map4 Human4 + nameFuzzer + ageFuzzer + hobbiesFuzzer + weightFuzzer + + +human5Coder : Json.Coder Human5 +human5Coder = + Json.object5 + { name = "Human5" + , description = [] + , init = Human5 + } + nameField + ageField + hobbiesField + weightField + heightField + + +human5Fuzzer : Fuzzer Human5 +human5Fuzzer = + Fuzz.map5 Human5 + nameFuzzer + ageFuzzer + hobbiesFuzzer + weightFuzzer + heightFuzzer + + +suite : Test +suite = + describe "JSON module" + [ describe "Human2" + [ fuzz human2Fuzzer + "Recoding succeeds" + (\human -> + human + |> Json.encode human2Coder + |> E.encode 0 + |> D.decodeString (Json.decode human2Coder) + |> Result.map Tuple.first + |> Expect.equal (Ok human) + ) + ] + , describe "Human3" + [ fuzz human3Fuzzer + "Recoding succeeds" + (\human -> + human + |> Json.encode human3Coder + |> E.encode 0 + |> D.decodeString (Json.decode human3Coder) + |> Result.map Tuple.first + |> Expect.equal (Ok human) + ) + ] + , describe "Human4" + [ fuzz human4Fuzzer + "Recoding succeeds" + (\human -> + human + |> Json.encode human4Coder + |> E.encode 0 + |> D.decodeString (Json.decode human4Coder) + |> Result.map Tuple.first + |> Expect.equal (Ok human) + ) + ] + , describe "Human5" + [ fuzz human5Fuzzer + "Recoding succeeds" + (\human -> + human + |> Json.encode human5Coder + |> E.encode 0 + |> D.decodeString (Json.decode human5Coder) + |> Result.map Tuple.first + |> Expect.equal (Ok human) + ) + ] + ] From 3f08e4a3e7ad99b9d2c10f12a80794b31e58f2c1 Mon Sep 17 00:00:00 2001 From: Bram Date: Thu, 18 Jan 2024 14:46:50 +0100 Subject: [PATCH 08/14] Add more high-level ary humans --- tests/Test/Tools/Json.elm | 259 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 259 insertions(+) diff --git a/tests/Test/Tools/Json.elm b/tests/Test/Tools/Json.elm index c4fce46..6124615 100644 --- a/tests/Test/Tools/Json.elm +++ b/tests/Test/Tools/Json.elm @@ -33,6 +33,50 @@ type alias Human5 = } +type alias Human6 = + { name : String + , age : Maybe Int + , hobbies : List String + , weight : Maybe Float + , height : Float + , invitedToParty : Bool + } + + +type alias Human7 = + { name : String + , age : Maybe Int + , hobbies : List String + , weight : Maybe Float + , height : Float + , invitedToParty : Bool + , presentGiven : Maybe String + } + + +type alias Human8 = + { name : String + , age : Maybe Int + , hobbies : List String + , weight : Maybe Float + , height : Float + , invitedToParty : Bool + , presentGiven : Maybe String + , grid : List (List Int) + } + + +type alias MegaHuman = + { human2 : Human2 + , human3 : Human3 + , human4 : Human4 + , human5 : Human5 + , human6 : Human6 + , human7 : Human7 + , human8 : Human8 + } + + ageField : Json.Field (Maybe Int) { a | age : Maybe Int } ageField = Json.field.optional.value @@ -48,6 +92,23 @@ ageFuzzer = Fuzz.maybe Fuzz.int +gridField : Json.Field (List (List Int)) { a | grid : List (List Int) } +gridField = + Json.field.optional.withDefault + { fieldName = "grid" + , toField = .grid + , description = [] + , coder = Json.list (Json.list Json.int) + , default = ( [], [] ) + , defaultToString = always "[]" + } + + +gridFuzzer : Fuzzer (List (List Int)) +gridFuzzer = + Fuzz.list (Fuzz.list Fuzz.int) + + heightField : Json.Field Float { a | height : Float } heightField = Json.field.required @@ -80,6 +141,29 @@ hobbiesFuzzer = Fuzz.list Fuzz.string +invitedToPartyField : Json.Field Bool { a | invitedToParty : Bool } +invitedToPartyField = + Json.field.optional.withDefault + { fieldName = "invitedToParty" + , toField = .invitedToParty + , description = [] + , coder = Json.bool + , default = ( False, [] ) + , defaultToString = + \b -> + if b then + "True" + + else + "False" + } + + +invitedToPartyFuzzer : Fuzzer Bool +invitedToPartyFuzzer = + Fuzz.bool + + nameField : Json.Field String { a | name : String } nameField = Json.field.required @@ -95,6 +179,21 @@ nameFuzzer = Fuzz.string +presentGivenField : Json.Field (Maybe String) { a | presentGiven : Maybe String } +presentGivenField = + Json.field.required + { fieldName = "presentGiven" + , toField = .presentGiven + , description = [] + , coder = Json.maybe Json.string + } + + +presentGivenFuzzer : Fuzzer (Maybe String) +presentGivenFuzzer = + Fuzz.maybe Fuzz.string + + weightField : Json.Field (Maybe Float) { a | weight : Maybe Float } weightField = Json.field.optional.value @@ -195,6 +294,118 @@ human5Fuzzer = heightFuzzer +human6Coder : Json.Coder Human6 +human6Coder = + Json.object6 + { name = "Human6" + , description = [] + , init = Human6 + } + nameField + ageField + hobbiesField + weightField + heightField + invitedToPartyField + + +human6Fuzzer : Fuzzer Human6 +human6Fuzzer = + Fuzz.map6 Human6 + nameFuzzer + ageFuzzer + hobbiesFuzzer + weightFuzzer + heightFuzzer + invitedToPartyFuzzer + + +human7Coder : Json.Coder Human7 +human7Coder = + Json.object7 + { name = "Human7" + , description = [] + , init = Human7 + } + nameField + ageField + hobbiesField + weightField + heightField + invitedToPartyField + presentGivenField + + +human7Fuzzer : Fuzzer Human7 +human7Fuzzer = + Fuzz.map7 Human7 + nameFuzzer + ageFuzzer + hobbiesFuzzer + weightFuzzer + heightFuzzer + invitedToPartyFuzzer + presentGivenFuzzer + + +human8Coder : Json.Coder Human8 +human8Coder = + Json.object8 + { name = "Human8" + , description = [] + , init = Human8 + } + nameField + ageField + hobbiesField + weightField + heightField + invitedToPartyField + presentGivenField + gridField + + +human8Fuzzer : Fuzzer Human8 +human8Fuzzer = + Fuzz.map8 Human8 + nameFuzzer + ageFuzzer + hobbiesFuzzer + weightFuzzer + heightFuzzer + invitedToPartyFuzzer + presentGivenFuzzer + gridFuzzer + + +megaHumanCoder : Json.Coder MegaHuman +megaHumanCoder = + Json.object7 + { name = "MegaHuman" + , description = [] + , init = MegaHuman + } + (Json.field.required { fieldName = "h2", toField = .human2, description = [], coder = human2Coder }) + (Json.field.required { fieldName = "h3", toField = .human3, description = [], coder = human3Coder }) + (Json.field.required { fieldName = "h4", toField = .human4, description = [], coder = human4Coder }) + (Json.field.required { fieldName = "h5", toField = .human5, description = [], coder = human5Coder }) + (Json.field.required { fieldName = "h6", toField = .human6, description = [], coder = human6Coder }) + (Json.field.required { fieldName = "h7", toField = .human7, description = [], coder = human7Coder }) + (Json.field.required { fieldName = "h8", toField = .human8, description = [], coder = human8Coder }) + + +megahumanFuzzer : Fuzzer MegaHuman +megahumanFuzzer = + Fuzz.map7 MegaHuman + human2Fuzzer + human3Fuzzer + human4Fuzzer + human5Fuzzer + human6Fuzzer + human7Fuzzer + human8Fuzzer + + suite : Test suite = describe "JSON module" @@ -246,4 +457,52 @@ suite = |> Expect.equal (Ok human) ) ] + , describe "Human6" + [ fuzz human6Fuzzer + "Recoding succeeds" + (\human -> + human + |> Json.encode human6Coder + |> E.encode 0 + |> D.decodeString (Json.decode human6Coder) + |> Result.map Tuple.first + |> Expect.equal (Ok human) + ) + ] + , describe "Human7" + [ fuzz human7Fuzzer + "Recoding succeeds" + (\human -> + human + |> Json.encode human7Coder + |> E.encode 0 + |> D.decodeString (Json.decode human7Coder) + |> Result.map Tuple.first + |> Expect.equal (Ok human) + ) + ] + , describe "Human8" + [ fuzz human8Fuzzer + "Recoding succeeds" + (\human -> + human + |> Json.encode human8Coder + |> E.encode 0 + |> D.decodeString (Json.decode human8Coder) + |> Result.map Tuple.first + |> Expect.equal (Ok human) + ) + ] + , describe "MegaHuman" + [ fuzz megahumanFuzzer + "Recoding succeeds" + (\megahuman -> + megahuman + |> Json.encode megaHumanCoder + |> E.encode 0 + |> D.decodeString (Json.decode megaHumanCoder) + |> Result.map Tuple.first + |> Expect.equal (Ok megahuman) + ) + ] ] From 28d2a17a103d666eddf5b5031a02880e4a7a125e Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 19 Jan 2024 16:21:41 +0100 Subject: [PATCH 09/14] Add final features to JSON coder module --- src/Internal/Tools/Decode.elm | 691 ---------------------------------- src/Internal/Tools/Json.elm | 192 ++++++++-- 2 files changed, 160 insertions(+), 723 deletions(-) delete mode 100644 src/Internal/Tools/Decode.elm diff --git a/src/Internal/Tools/Decode.elm b/src/Internal/Tools/Decode.elm deleted file mode 100644 index 7e8068d..0000000 --- a/src/Internal/Tools/Decode.elm +++ /dev/null @@ -1,691 +0,0 @@ -module Internal.Tools.Decode exposing - ( Decoder, string, bool, int, float - , nullable, list, slowDict, fastDict, keyValuePairs - , field, at, index, opField, opFieldWithDefault - , maybe, oneOf - , map, map2, map3, map4, map5, map6, map7, map8, map9, map10, map11 - , lazy, value, null, succeed, fail, andThen - , pString, pBool, pInt, pList - ) - -{-| - - -# Advanced security Json.Decode - -This module extends the standard JSON encode / decode library for security -measures. Most Elm libraries do not access an API this often without insight -for the user, and hence this module aims to offer the user more insight into -what is going on. - -Additionally, the decoder will warn for suspicious values, and provide helpful -errors when the JSON fails to decode. - - -## Primitives - -@docs Decoder, string, bool, int, float - - -## Data structures - -@docs nullable, list, slowDict, fastDict, keyValuePairs - - -## Object primitives - -@docs field, at, index, opField, opFieldWithDefault - - -## Inconsistent structure - -@docs maybe, oneOf - - -## Mapping - -@docs map, map2, map3, map4, map5, map6, map7, map8, map9, map10, map11 - - -## Fancy decoding - -@docs lazy, value, null, succeed, fail, andThen - - -## Phantom decoding - -Phantom decoders allow you to create phantom types of standard Elm types. - -@docs pString, pBool, pInt, pList - --} - -import Dict as SDict -import FastDict as FDict -import Internal.Config.Leaks as L -import Internal.Config.Log as Log -import Internal.Config.Phantom as Phantom -import Internal.Config.Text as Text -import Internal.Tools.DecodeExtra as D -import Json.Decode as D -import Set - - -{-| A value that knows how to decode JSON values. --} -type alias Decoder a = - D.Decoder { content : a, messages : List ( String, String ) } - - -{-| Create decoders that depend on previous results. --} -andThen : (a -> Decoder b) -> Decoder a -> Decoder b -andThen func = - D.andThen - (\a -> - D.map - (\b -> { b | messages = a.messages ++ b.messages }) - (func a.content) - ) - - -{-| Decode a nested JSON object, requiring certain fields. --} -at : List String -> Decoder a -> Decoder a -at = - D.at - - -{-| Decode a JSON boolean into an Elm bool. --} -bool : Decoder Bool -bool = - D.map empty D.bool - - -{-| Initialize a standard object for the decoder. --} -empty : a -> { content : a, messages : List ( String, String ) } -empty x = - { content = x, messages = [] } - - -{-| Ignore the JSON and make the decoder fail. --} -fail : String -> Decoder a -fail = - D.fail - - -{-| Decode a JSON object into a fast Elm dict from miniBill/elm-fast-dict. --} -fastDict : Decoder a -> Decoder (FDict.Dict String a) -fastDict x = - keyValuePairs x - |> andThen - (\pairs -> - let - dict = - FDict.fromList pairs - - oldLength = - List.length pairs - - newLength = - FDict.size dict - in - if oldLength == newLength then - succeed dict - - else - D.succeed - { content = dict - , messages = - [ ( Log.warn, Text.decodedDictSize oldLength newLength ) ] - } - ) - - -{-| Decode a JSON object, requiring a particular field. --} -field : String -> Decoder a -> Decoder a -field = - D.field - - -{-| Decode a JSON number into an Elm flaot. --} -float : Decoder Float -float = - D.map empty D.float - - -{-| Decode a JSON array, requiring a particular index. --} -index : Int -> Decoder a -> Decoder a -index = - D.index - - -{-| Decode a JSON number into an Elm int. --} -int : Decoder Int -int = - D.map empty D.int - - -{-| Decode a JSON object into a list of pairs. --} -keyValuePairs : Decoder a -> Decoder (List ( String, a )) -keyValuePairs x = - D.map - (\result -> - { content = List.map (Tuple.mapSecond .content) result - , messages = - result - |> List.map Tuple.second - |> List.map .messages - |> List.concat - } - ) - (D.keyValuePairs x) - - -{-| Sometimes you have JSON with recursive structure, like nested comments. -You can use `lazy` to make sure your decoder unrolls lazily. --} -lazy : (() -> Decoder a) -> Decoder a -lazy = - D.lazy - - -{-| Decode a JSON array into an Elm list. --} -list : Decoder a -> Decoder (List a) -list x = - D.map - (\result -> - { content = List.map .content result - , messages = - result - |> List.map .messages - |> List.concat - } - ) - (D.list x) - - -{-| Transform a decoder. --} -map : (a -> value) -> Decoder a -> Decoder value -map func da = - D.map - (\a -> - { content = func a.content - , messages = a.messages - } - ) - da - - -{-| Try two decoders and combine the result. --} -map2 : (a -> b -> value) -> Decoder a -> Decoder b -> Decoder value -map2 func da db = - D.map2 - (\a b -> - { content = func a.content b.content - , messages = - List.concat - [ a.messages - , b.messages - ] - } - ) - da - db - - -{-| Try three decoders and combine the result. --} -map3 : (a -> b -> c -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder value -map3 func da db dc = - D.map3 - (\a b c -> - { content = func a.content b.content c.content - , messages = - List.concat - [ a.messages - , b.messages - , c.messages - ] - } - ) - da - db - dc - - -{-| Try four decoders and combine the result. --} -map4 : (a -> b -> c -> d -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder d -> Decoder value -map4 func da db dc dd = - D.map4 - (\a b c d -> - { content = func a.content b.content c.content d.content - , messages = - List.concat - [ a.messages - , b.messages - , c.messages - , d.messages - ] - } - ) - da - db - dc - dd - - -{-| Try five decoders and combine the result. --} -map5 : (a -> b -> c -> d -> e -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder d -> Decoder e -> Decoder value -map5 func da db dc dd de = - D.map5 - (\a b c d e -> - { content = func a.content b.content c.content d.content e.content - , messages = - List.concat - [ a.messages - , b.messages - , c.messages - , d.messages - , e.messages - ] - } - ) - da - db - dc - dd - de - - -{-| Try six decoders and combine the result. --} -map6 : (a -> b -> c -> d -> e -> f -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder d -> Decoder e -> Decoder f -> Decoder value -map6 func da db dc dd de df = - D.map6 - (\a b c d e f -> - { content = func a.content b.content c.content d.content e.content f.content - , messages = - List.concat - [ a.messages - , b.messages - , c.messages - , d.messages - , e.messages - , f.messages - ] - } - ) - da - db - dc - dd - de - df - - -{-| Try seven decoders and combine the result. --} -map7 : (a -> b -> c -> d -> e -> f -> g -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder d -> Decoder e -> Decoder f -> Decoder g -> Decoder value -map7 func da db dc dd de df dg = - D.map7 - (\a b c d e f g -> - { content = func a.content b.content c.content d.content e.content f.content g.content - , messages = - List.concat - [ a.messages - , b.messages - , c.messages - , d.messages - , e.messages - , f.messages - , g.messages - ] - } - ) - da - db - dc - dd - de - df - dg - - -{-| Try eight decoders and combine the result. --} -map8 : (a -> b -> c -> d -> e -> f -> g -> h -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder d -> Decoder e -> Decoder f -> Decoder g -> Decoder h -> Decoder value -map8 func da db dc dd de df dg dh = - D.map8 - (\a b c d e f g h -> - { content = func a.content b.content c.content d.content e.content f.content g.content h.content - , messages = - List.concat - [ a.messages - , b.messages - , c.messages - , d.messages - , e.messages - , f.messages - , g.messages - , h.messages - ] - } - ) - da - db - dc - dd - de - df - dg - dh - - -{-| Try 9 decoders and combine the result. --} -map9 : - (a -> b -> c -> d -> e -> f -> g -> h -> i -> value) - -> Decoder a - -> Decoder b - -> Decoder c - -> Decoder d - -> Decoder e - -> Decoder f - -> Decoder g - -> Decoder h - -> Decoder i - -> Decoder value -map9 func da db dc dd de df dg dh di = - D.map8 - (\a b c d e f g ( h, i ) -> - { content = func a.content b.content c.content d.content e.content f.content g.content h.content i.content - , messages = - List.concat - [ a.messages - , b.messages - , c.messages - , d.messages - , e.messages - , f.messages - , g.messages - , h.messages - , i.messages - ] - } - ) - da - db - dc - dd - de - df - dg - (D.map2 Tuple.pair dh di) - - -{-| Try 10 decoders and combine the result. --} -map10 : - (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> value) - -> Decoder a - -> Decoder b - -> Decoder c - -> Decoder d - -> Decoder e - -> Decoder f - -> Decoder g - -> Decoder h - -> Decoder i - -> Decoder j - -> Decoder value -map10 func da db dc dd de df dg dh di dj = - D.map8 - (\a b c d e f ( g, h ) ( i, j ) -> - { content = func a.content b.content c.content d.content e.content f.content g.content h.content i.content j.content - , messages = - List.concat - [ a.messages - , b.messages - , c.messages - , d.messages - , e.messages - , f.messages - , g.messages - , h.messages - , i.messages - , j.messages - ] - } - ) - da - db - dc - dd - de - df - (D.map2 Tuple.pair dg dh) - (D.map2 Tuple.pair di dj) - - -{-| Try 11 decoders and combine the result. --} -map11 : - (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> value) - -> Decoder a - -> Decoder b - -> Decoder c - -> Decoder d - -> Decoder e - -> Decoder f - -> Decoder g - -> Decoder h - -> Decoder i - -> Decoder j - -> Decoder k - -> Decoder value -map11 func da db dc dd de df dg dh di dj dk = - D.map8 - (\a b c d e ( f, g ) ( h, i ) ( j, k ) -> - { content = func a.content b.content c.content d.content e.content f.content g.content h.content i.content j.content k.content - , messages = - List.concat - [ a.messages - , b.messages - , c.messages - , d.messages - , e.messages - , f.messages - , g.messages - , h.messages - , i.messages - , j.messages - , k.messages - ] - } - ) - da - db - dc - dd - de - (D.map2 Tuple.pair df dg) - (D.map2 Tuple.pair dh di) - (D.map2 Tuple.pair dj dk) - - -{-| Helpful for dealing with optional fields --} -maybe : Decoder a -> Decoder (Maybe a) -maybe x = - D.map - (\result -> - case result of - Just { content, messages } -> - { content = Just content, messages = messages } - - Nothing -> - empty Nothing - ) - (D.maybe x) - - -{-| Decode a `null` value into some Elm value. --} -null : a -> Decoder a -null = - D.null >> D.map empty - - -{-| Decode a nullable JSON value into an Elm value. --} -nullable : Decoder a -> Decoder (Maybe a) -nullable x = - D.map - (\result -> - case result of - Just { content, messages } -> - { content = Just content, messages = messages } - - Nothing -> - empty Nothing - ) - (D.nullable x) - - -{-| Try a bunch of different decoders. This can be useful if the JSON may come -in a couple different formats. --} -oneOf : List (Decoder a) -> Decoder a -oneOf = - D.oneOf - - -{-| Decode a JSON object, requiring a particular field: - - - If the field does not exist, the decoder decodes `Nothing` - - If the field DOES exist, the decoder must always return a `Just content` or fail - --} -opField : String -> Decoder a -> Decoder (Maybe a) -opField key x = - D.map - (\result -> - case result of - Just { content, messages } -> - { content = Just content, messages = messages } - - Nothing -> - empty Nothing - ) - (D.opField key x) - - -{-| Decode a JSON object, requiring a particular field or raising a default: - - - If the field does not exist, the decoder returns the default - - If the field DOES exist, the decoder must always return value or fail - --} -opFieldWithDefault : String -> a -> Decoder a -> Decoder a -opFieldWithDefault key default x = - opField key x |> map (Maybe.withDefault default) - - -{-| Transform a JSON boolean into a phantom Elm bool. --} -pBool : Decoder Bool -> Decoder (Phantom.PBool ph) -pBool = - map Phantom.PBool - - -{-| Transform a JSON number into a phantom Elm int. --} -pInt : Decoder Int -> Decoder (Phantom.PInt ph) -pInt = - map Phantom.PInt - - -{-| Transform a JSON list into a phantom Elm list. --} -pList : Decoder (List a) -> Decoder (Phantom.PList ph a) -pList = - map Phantom.PList - - -{-| Transform a JSON string into a phantom Elm string. --} -pString : Decoder String -> Decoder (Phantom.PString ph) -pString = - map Phantom.PString - - -{-| Decode a JSON object into an Elm dict. --} -slowDict : Decoder a -> Decoder (SDict.Dict String a) -slowDict x = - D.map - (\result -> - { content = - result - |> List.map (Tuple.mapSecond .content) - |> SDict.fromList - , messages = - result - |> List.map Tuple.second - |> List.map .messages - |> List.concat - } - ) - (D.keyValuePairs x) - - -{-| Decode a JSON string into an Elm string. - -This decoder also checks for suspicious inputs, such as the -[Leaking values](Internal-Config-Leaks), to look for suspicious inputs. - --} -string : Decoder String -string = - D.map - (\content -> - { content = content - , messages = - if Set.member content L.allLeaks then - [ ( Log.securityWarn, Text.leakingValueFound content ) - ] - - else - [] - } - ) - D.string - - -{-| Ignore the JSON and produce a certain Elm value. --} -succeed : a -> Decoder a -succeed = - D.succeed >> D.map empty - - -{-| Do not do anything with a JSON value, just bring it into Elm as a `Value`. --} -value : Decoder D.Value -value = - D.map empty D.value diff --git a/src/Internal/Tools/Json.elm b/src/Internal/Tools/Json.elm index bbc22f5..d8f21cd 100644 --- a/src/Internal/Tools/Json.elm +++ b/src/Internal/Tools/Json.elm @@ -1,10 +1,12 @@ module Internal.Tools.Json exposing - ( Coder, string, bool, int, float - , encode, decode + ( Coder, string, bool, int, float, value + , Encoder, encode, Decoder, decode, Value + , succeed, fail, andThen, lazy , Docs(..), RequiredField(..), toDocs , list, slowDict, fastDict, maybe , Field, field , object2, object3, object4, object5, object6, object7, object8, object9, object10, object11 + , map ) {-| @@ -28,12 +30,17 @@ data types. Because this module uses dynamic builder types, this also means it is relatively easy to write documentation for any data type that uses this module to build its encoders and decoders. -@docs Coder, string, bool, int, float +@docs Coder, string, bool, int, float, value ## JSON Coding -@docs encode, decode +@docs Encoder, encode, Decoder, decode, Value + + +## Optional coding + +@docs succeed, fail, andThen, lazy ## Documentation @@ -109,6 +116,22 @@ type Coder a } +type DecodeResult a + = Success ( a, List Log ) + | Fail ( String, List Log ) + + +{-| Decoder type that describes the format of a JSON value that can be decoded +as a given type. +-} +type alias Decoder a = + D.Decoder ( a, List Log ) + + +type alias Descriptive a = + { a | name : String, description : List String } + + {-| Structure of JSON documentation. It is up to an external module to turn the documentation structure into a readable format. -} @@ -117,20 +140,30 @@ type Docs | DocsDict Docs | DocsFloat | DocsInt + | DocsLazy (() -> Docs) | DocsList Docs + | DocsMap (Descriptive { content : Docs }) | DocsObject - { name : String - , description : List String - , keys : - List - { field : String - , description : List String - , required : RequiredField - , content : Docs - } - } + (Descriptive + { keys : + List + { field : String + , description : List String + , required : RequiredField + , content : Docs + } + } + ) | DocsOptional Docs + | DocsRiskyMap (Descriptive { content : Docs, failure : List String }) | DocsString + | DocsValue + + +{-| Encoder type that takes an input and converts it to a JSON value. +-} +type alias Encoder a = + a -> E.Value {-| Value that tells whether an object field is required to be included. If it @@ -143,6 +176,42 @@ type RequiredField | OptionalFieldWithDefault String +type alias Value = + E.Value + + +{-| Continue decoding a result. This function tests if it meets the criteria, +and then it manages the results. +-} +andThen : Descriptive { back : b -> a, forth : a -> DecodeResult b, failure : List String } -> Coder a -> Coder b +andThen { name, description, failure, back, forth } (Coder old) = + Coder + { encoder = back >> old.encoder + , decoder = + old.decoder + |> D.andThen + (\result -> + case result of + ( out, logs ) -> + case forth out of + Success x -> + x + |> Tuple.mapSecond (List.append logs) + |> D.succeed + + Fail ( f, _ ) -> + D.fail f + ) + , docs = + DocsRiskyMap + { name = name + , description = description + , content = old.docs + , failure = failure + } + } + + {-| Define a boolean value. -} bool : Coder Bool @@ -190,14 +259,21 @@ encode (Coder data) = data.encoder +{-| Fail a decoder. +-} +fail : String -> List Log -> DecodeResult a +fail reason logs = + Fail ( reason, logs ) + + {-| Define a fast dict. The dict can only have strings as keys. -} fastDict : Coder value -> Coder (FastDict.Dict String value) -fastDict (Coder value) = +fastDict (Coder old) = Coder - { encoder = FastDict.toCoreDict >> E.dict identity value.encoder + { encoder = FastDict.toCoreDict >> E.dict identity old.encoder , decoder = - value.decoder + old.decoder |> D.keyValuePairs |> D.map (\items -> @@ -209,7 +285,7 @@ fastDict (Coder value) = |> List.concatMap Tuple.second ) ) - , docs = DocsDict value.docs + , docs = DocsDict old.docs } @@ -287,8 +363,8 @@ field = decoder |> D.opField fieldName |> D.map - (\value -> - case value of + (\out -> + case out of Just ( v, l ) -> ( Just v, l ) @@ -341,6 +417,25 @@ int = } +lazy : (() -> Coder value) -> Coder value +lazy f = + Coder + { encoder = + \v -> + case f () of + Coder old -> + old.encoder v + , decoder = + D.lazy + (\() -> + case f () of + Coder old -> + old.decoder + ) + , docs = DocsLazy (f >> toDocs) + } + + {-| Define a list. -} list : Coder a -> Coder (List a) @@ -360,6 +455,23 @@ list (Coder old) = } +{-| Map a value. + +Given that the value needs to be both encoded and decoded, the map function +should be invertible. + +-} +map : Descriptive { back : b -> a, forth : a -> b } -> Coder a -> Coder b +map { name, description, back, forth } (Coder old) = + Coder + { encoder = back >> old.encoder + , decoder = D.map (Tuple.mapFirst forth) old.decoder + , docs = + DocsMap + { name = name, description = description, content = old.docs } + } + + {-| Define a maybe value. NOTE: most of the time, you wish to avoid this function! Make sure to look at @@ -374,8 +486,8 @@ maybe (Coder old) = old.decoder |> D.nullable |> D.map - (\value -> - case value of + (\out -> + case out of Just ( v, logs ) -> ( Just v, logs ) @@ -430,7 +542,7 @@ objectEncoder items object = -} object2 : - { name : String, description : List String, init : a -> b -> object } + Descriptive { init : a -> b -> object } -> Field a object -> Field b object -> Coder object @@ -465,7 +577,7 @@ object2 { name, description, init } fa fb = {-| Define an object with 3 keys -} object3 : - { name : String, description : List String, init : a -> b -> c -> object } + Descriptive { init : a -> b -> c -> object } -> Field a object -> Field b object -> Field c object @@ -504,7 +616,7 @@ object3 { name, description, init } fa fb fc = {-| Define an object with 4 keys -} object4 : - { name : String, description : List String, init : a -> b -> c -> d -> object } + Descriptive { init : a -> b -> c -> d -> object } -> Field a object -> Field b object -> Field c object @@ -547,7 +659,7 @@ object4 { name, description, init } fa fb fc fd = {-| Define an object with 5 keys -} object5 : - { name : String, description : List String, init : a -> b -> c -> d -> e -> object } + Descriptive { init : a -> b -> c -> d -> e -> object } -> Field a object -> Field b object -> Field c object @@ -594,7 +706,7 @@ object5 { name, description, init } fa fb fc fd fe = {-| Define an object with 6 keys -} object6 : - { name : String, description : List String, init : a -> b -> c -> d -> e -> f -> object } + Descriptive { init : a -> b -> c -> d -> e -> f -> object } -> Field a object -> Field b object -> Field c object @@ -645,7 +757,7 @@ object6 { name, description, init } fa fb fc fd fe ff = {-| Define an object with 7 keys -} object7 : - { name : String, description : List String, init : a -> b -> c -> d -> e -> f -> g -> object } + Descriptive { init : a -> b -> c -> d -> e -> f -> g -> object } -> Field a object -> Field b object -> Field c object @@ -700,7 +812,7 @@ object7 { name, description, init } fa fb fc fd fe ff fg = {-| Define an object with 8 keys -} object8 : - { name : String, description : List String, init : a -> b -> c -> d -> e -> f -> g -> h -> object } + Descriptive { init : a -> b -> c -> d -> e -> f -> g -> h -> object } -> Field a object -> Field b object -> Field c object @@ -759,7 +871,7 @@ object8 { name, description, init } fa fb fc fd fe ff fg fh = {-| Define an object with 9 keys -} object9 : - { name : String, description : List String, init : a -> b -> c -> d -> e -> f -> g -> h -> i -> object } + Descriptive { init : a -> b -> c -> d -> e -> f -> g -> h -> i -> object } -> Field a object -> Field b object -> Field c object @@ -822,7 +934,7 @@ object9 { name, description, init } fa fb fc fd fe ff fg fh fi = {-| Define an object with 10 keys -} object10 : - { name : String, description : List String, init : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> object } + Descriptive { init : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> object } -> Field a object -> Field b object -> Field c object @@ -889,7 +1001,7 @@ object10 { name, description, init } fa fb fc fd fe ff fg fh fi fj = {-| Define an object with 11 keys -} object11 : - { name : String, description : List String, init : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> object } + Descriptive { init : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> object } -> Field a object -> Field b object -> Field c object @@ -991,6 +1103,13 @@ string = } +{-| Succeed a decoder. +-} +succeed : a -> List Log -> DecodeResult a +succeed x logs = + Success ( x, logs ) + + {-| Turn a Field type into a usable JSON decoder -} toDecoderField : Field a object -> D.Decoder ( a, List Log ) @@ -1016,3 +1135,12 @@ toDocsField x = toEncodeField : Field a object -> ( String, object -> Maybe E.Value ) toEncodeField (Field data) = ( data.fieldName, data.toField >> data.encoder ) + + +value : Coder Value +value = + Coder + { encoder = identity + , decoder = D.map (\v -> ( v, [] )) D.value + , docs = DocsValue + } From d1fbc87730b2143bbd9f34db938c808d5f4438e0 Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 19 Jan 2024 16:22:51 +0100 Subject: [PATCH 10/14] Refactor to new JSON coders --- src/Internal/Config/Text.elm | 131 +++++++++++++++++++- src/Internal/Tools/Hashdict.elm | 82 ++++++++----- src/Internal/Tools/Mashdict.elm | 80 ++++++++----- src/Internal/Tools/Timestamp.elm | 30 +++-- src/Internal/Values/Event.elm | 172 ++++++++++++++++++--------- src/Internal/Values/StateManager.elm | 37 +++--- tests/Test/Tools/Hashdict.elm | 17 +-- tests/Test/Tools/Mashdict.elm | 17 +-- tests/Test/Tools/Timestamp.elm | 4 +- tests/Test/Values/StateManager.elm | 2 +- 10 files changed, 414 insertions(+), 158 deletions(-) diff --git a/src/Internal/Config/Text.elm b/src/Internal/Config/Text.elm index 745b15b..1159868 100644 --- a/src/Internal/Config/Text.elm +++ b/src/Internal/Config/Text.elm @@ -1,8 +1,9 @@ module Internal.Config.Text exposing - ( accessTokenFoundLocally, accessTokenExpired, accessTokenInvalid + ( docs, failures, fields + , accessTokenFoundLocally, accessTokenExpired, accessTokenInvalid , versionsFoundLocally, versionsReceived, versionsFailedToDecode , unsupportedVersionForEndpoint - , decodedDictSize, leakingValueFound + , decodedDictSize, invalidHashInHashdict, invalidHashInMashdict, leakingValueFound ) {-| Throughout the Elm SDK, there are lots of pieces of text being used for @@ -24,6 +25,11 @@ This is a risky feature, keep in mind that even a patch update might break this! You should only do this if you know what you're doing. +## Type documentation + +@docs docs, failures, fields + + ## API Authentication Messages sent as API logs during the authentication phase of the API @@ -53,11 +59,19 @@ Messages sent as API logs during communication with the API. Messages sent as API logs when a JSON value is being decoded. -@docs decodedDictSize, leakingValueFound +@docs decodedDictSize, invalidHashInHashdict, invalidHashInMashdict, leakingValueFound -} +type alias Desc = + List String + + +type alias TypeDocs = + { name : String, description : Desc } + + {-| Logs when the Matrix API returns that an access token is no longer valid. -} accessTokenExpired : String @@ -95,6 +109,117 @@ decodedDictSize from to = ] +{-| Documentation used for all functions and data types in JSON coders +-} +docs : + { event : TypeDocs + , hashdict : TypeDocs + , mashdict : TypeDocs + , stateManager : TypeDocs + , unsigned : TypeDocs + } +docs = + { event = + { name = "Event" + , description = + [ "The Event type represents a single value that contains all the information for a single event in the room." + ] + } + , hashdict = + { name = "Hashdict" + , description = + [ "This allows you to store values based on an externally defined identifier." + , "For example, the hashdict can store events and use their event id as their key." + ] + } + , mashdict = + { name = "Mashdict" + , description = + [ "The mashdict exclusively stores values for which the hashing algorithm returns a value, and it ignores the outcome for all other scenarios." + ] + } + , stateManager = + { name = "StateManager" + , description = + [ "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." + ] + } + , unsigned = + { name = "Unsigned Data" + , description = + [ "Unsigned data is optional data that might come along with the event." + , "This information is often supportive but not necessary to the context." + ] + } + } + + +{-| Description of all edge cases where a JSON decoder can fail. +-} +failures : { hashdict : Desc, mashdict : Desc } +failures = + { hashdict = + [ "Not all values map to thir respected hash with the given hash function." + ] + , mashdict = + [ "Not all values map to thir respected hash with the given hash function." + ] + } + + + +-- TODO + + +fields : + { event : + { content : Desc + , eventId : Desc + , originServerTs : Desc + , roomId : Desc + , sender : Desc + , stateKey : Desc + , eventType : Desc + , unsigned : Desc + } + , unsigned : + { age : Desc + , prevContent : Desc + , redactedBecause : Desc + , transactionId : Desc + } + } +fields = + { event = + { content = [] + , eventId = [] + , originServerTs = [] + , roomId = [] + , sender = [] + , stateKey = [] + , eventType = [] + , unsigned = [] + } + , unsigned = + { age = [] + , prevContent = [] + , redactedBecause = [] + , transactionId = [] + } + } + + +invalidHashInHashdict : String +invalidHashInHashdict = + "Invalid hash function: not all elements hash to their JSON-stored hashes" + + +invalidHashInMashdict : String +invalidHashInMashdict = + "Invalid hash function: not all elements hash to their JSON-stored hashes" + + {-| The Elm SDK occassionally uses [leaking values](Internal-Config-Leaks), which might indicate exceptional behaviour. As such, this log is sent when one of those leaking values is found: to alert the user that something fishy might diff --git a/src/Internal/Tools/Hashdict.elm b/src/Internal/Tools/Hashdict.elm index f2e4fdb..3b46f30 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, isEqual , keys, values, toList, fromList , rehash, union - , encode, decoder, softDecoder + , coder, encode, decoder, softDecoder ) {-| This module abstracts the `Dict` type with one function that assigns a @@ -40,13 +40,14 @@ This allows you to store values based on an externally defined identifier. ## JSON coders -@docs encode, decoder, softDecoder +@docs coder, encode, decoder, softDecoder -} import FastDict as Dict exposing (Dict) -import Json.Decode as D -import Json.Encode as E +import Internal.Config.Log as Log +import Internal.Config.Text as Text +import Internal.Tools.Json as Json {-| A dictionary of keys and values where each key is defined by its value. For @@ -80,25 +81,41 @@ type Hashdict a } +coder : (a -> String) -> Json.Coder a -> Json.Coder (Hashdict a) +coder f c1 = + Json.andThen + { name = Text.docs.hashdict.name + , description = Text.docs.hashdict.description + , forth = + -- TODO: Implement fastDictWithFilter function + \items -> + case List.filter (\( k, v ) -> f v /= k) (Dict.toList items) of + [] -> + { hash = f, values = items } + |> Hashdict + |> Json.succeed + |> (|>) [] + + wrongHashes -> + wrongHashes + |> List.map Tuple.first + |> List.map ((++) "Invalid hash") + |> List.map Log.log.error + |> Json.fail Text.invalidHashInHashdict + , back = \(Hashdict h) -> h.values + , failure = + Text.failures.hashdict + } + (Json.fastDict c1) + + {-| Decode a hashdict from a JSON value. To create a hashdict, 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 hashdict. -} -decoder : (a -> String) -> D.Decoder a -> D.Decoder (Hashdict a) -decoder f xDecoder = - D.keyValuePairs xDecoder - |> D.andThen - (\items -> - if List.all (\( hash, value ) -> f value == hash) items then - items - |> Dict.fromList - |> (\d -> { hash = f, values = d }) - |> Hashdict - |> D.succeed - - else - D.fail "Hash function fails to properly hash all values" - ) +decoder : (a -> String) -> Json.Coder a -> Json.Decoder (Hashdict a) +decoder f c1 = + Json.decode (coder f c1) {-| Create an empty hashdict. @@ -112,12 +129,9 @@ empty hash = cannot be universally converted to JSON, so it is up to you to preserve that hash function! -} -encode : (a -> E.Value) -> Hashdict a -> E.Value -encode encodeX (Hashdict h) = - h.values - |> Dict.toList - |> List.map (Tuple.mapSecond encodeX) - |> E.object +encode : Json.Coder a -> Json.Encoder (Hashdict a) +encode c1 (Hashdict h) = + Json.encode (coder h.hash c1) (Hashdict h) {-| Convert an association list into a hashdict. @@ -240,10 +254,20 @@ size (Hashdict h) = used hash function, (or if you simply do not care) you can use this function to decode and rehash the Hashdict using your new hash function. -} -softDecoder : (a -> String) -> D.Decoder a -> D.Decoder (Hashdict a) -softDecoder f xDecoder = - D.keyValuePairs xDecoder - |> D.map (List.map Tuple.second >> fromList f) +softDecoder : (a -> String) -> Json.Coder a -> Json.Decoder (Hashdict a) +softDecoder f c1 = + c1 + |> Json.fastDict + |> Json.map + { name = Text.docs.hashdict.name + , description = Text.docs.hashdict.description + , forth = + \items -> + Hashdict { hash = f, values = items } + |> rehash f + , back = \(Hashdict h) -> h.values + } + |> Json.decode {-| Convert a hashdict into an association list of key-value pairs, sorted by diff --git a/src/Internal/Tools/Mashdict.elm b/src/Internal/Tools/Mashdict.elm index 22c27a8..7ede8c3 100644 --- a/src/Internal/Tools/Mashdict.elm +++ b/src/Internal/Tools/Mashdict.elm @@ -4,7 +4,7 @@ module Internal.Tools.Mashdict exposing , isEmpty, member, memberKey, get, size, isEqual , keys, values, toList, fromList , rehash, union - , encode, decoder, softDecoder + , coder, encode, decoder, softDecoder ) {-| @@ -48,13 +48,14 @@ In general, you are advised to learn more about the ## JSON coders -@docs encode, decoder, softDecoder +@docs coder, encode, decoder, softDecoder -} import FastDict as Dict exposing (Dict) -import Json.Decode as D -import Json.Encode as E +import Internal.Config.Log as Log +import Internal.Config.Text as Text +import Internal.Tools.Json as Json {-| A dictionary of keys and values where each key is defined by its value, but @@ -92,25 +93,39 @@ type Mashdict a } +coder : (a -> Maybe String) -> Json.Coder a -> Json.Coder (Mashdict a) +coder f c1 = + Json.andThen + { name = Text.docs.mashdict.name + , description = Text.docs.mashdict.description + , forth = + \items -> + case List.filter (\( k, v ) -> f v /= Just k) (Dict.toList items) of + [] -> + { hash = f, values = items } + |> Mashdict + |> Json.succeed + |> (|>) [] + + wrongHashes -> + wrongHashes + |> List.map Tuple.first + |> List.map ((++) "Invalid hash") + |> List.map Log.log.error + |> Json.fail Text.invalidHashInMashdict + , back = \(Mashdict h) -> h.values + , failure = Text.failures.mashdict + } + (Json.fastDict c1) + + {-| 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" - ) +decoder : (a -> Maybe String) -> Json.Coder a -> Json.Decoder (Mashdict a) +decoder f c1 = + Json.decode (coder f c1) {-| Create an empty mashdict. @@ -124,12 +139,9 @@ empty hash = 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 +encode : Json.Coder a -> Json.Encoder (Mashdict a) +encode c1 (Mashdict h) = + Json.encode (coder h.hash c1) (Mashdict h) {-| Convert an association list into a mashdict. @@ -266,10 +278,20 @@ size (Mashdict h) = 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) +softDecoder : (a -> Maybe String) -> Json.Coder a -> Json.Decoder (Mashdict a) +softDecoder f c1 = + c1 + |> Json.fastDict + |> Json.map + { name = Text.docs.hashdict.name + , description = Text.docs.hashdict.description + , forth = + \items -> + Mashdict { hash = f, values = items } + |> rehash f + , back = \(Mashdict h) -> h.values + } + |> Json.decode {-| Convert a mashdict into an association list of key-value pairs, sorted by diff --git a/src/Internal/Tools/Timestamp.elm b/src/Internal/Tools/Timestamp.elm index a0ed35c..0f96a77 100644 --- a/src/Internal/Tools/Timestamp.elm +++ b/src/Internal/Tools/Timestamp.elm @@ -1,6 +1,6 @@ module Internal.Tools.Timestamp exposing ( Timestamp - , encode, decoder + , coder, encode, decoder ) {-| The Timestamp module is a simplification of the Timestamp as delivered by @@ -14,12 +14,11 @@ elm/time. This module offers ways to work with the timestamp in meaningful ways. ## JSON coders -@docs encode, decoder +@docs coder, encode, decoder -} -import Json.Decode as D -import Json.Encode as E +import Internal.Tools.Json as Json import Time @@ -29,15 +28,30 @@ type alias Timestamp = Time.Posix +{-| Create a Json coder +-} +coder : Json.Coder Timestamp +coder = + Json.map + { back = Time.posixToMillis + , forth = Time.millisToPosix + , name = "Milliseconds to POSIX" + , description = + [ "Converts the timestamp from milliseconds to a POSIX timestamp." + ] + } + Json.int + + {-| Encode a timestamp into a JSON value. -} -encode : Timestamp -> E.Value +encode : Json.Encoder Timestamp encode = - Time.posixToMillis >> E.int + Json.encode coder {-| Decode a timestamp from a JSON value. -} -decoder : D.Decoder Timestamp +decoder : Json.Decoder Timestamp decoder = - D.map Time.millisToPosix D.int + Json.decode coder diff --git a/src/Internal/Values/Event.elm b/src/Internal/Values/Event.elm index b27848d..304e7cb 100644 --- a/src/Internal/Values/Event.elm +++ b/src/Internal/Values/Event.elm @@ -1,7 +1,7 @@ module Internal.Values.Event exposing ( Event , UnsignedData(..), age, prevContent, redactedBecause, transactionId - , encode, decoder + , coder, encode, decoder ) {-| @@ -22,22 +22,20 @@ of a room. ## JSON Coder -@docs encode, decoder +@docs coder, encode, decoder -} import Internal.Config.Default as Default -import Internal.Tools.DecodeExtra as D -import Internal.Tools.EncodeExtra as E +import Internal.Config.Text as Text +import Internal.Tools.Json as Json 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 + { content : Json.Value , eventId : String , originServerTs : Timestamp , roomId : String @@ -54,7 +52,7 @@ helper functions. type UnsignedData = UnsignedData { age : Maybe Int - , prevContent : Maybe E.Value + , prevContent : Maybe Json.Value , redactedBecause : Maybe Event , transactionId : Maybe String } @@ -67,66 +65,93 @@ age event = Maybe.andThen (\(UnsignedData data) -> data.age) event.unsigned +coder : Json.Coder Event +coder = + Json.object8 + { name = Text.docs.event.name + , description = Text.docs.event.description + , init = Event + } + (Json.field.required + { fieldName = "content" + , toField = .content + , description = Text.fields.event.content + , coder = Json.value + } + ) + (Json.field.required + { fieldName = "eventId" + , toField = .eventId + , description = Text.fields.event.eventId + , coder = Json.string + } + ) + (Json.field.required + { fieldName = "originServerTs" + , toField = .originServerTs + , description = Text.fields.event.originServerTs + , coder = Timestamp.coder + } + ) + (Json.field.required + { fieldName = "roomId" + , toField = .roomId + , description = Text.fields.event.roomId + , coder = Json.string + } + ) + (Json.field.required + { fieldName = "sender" + , toField = .sender + , description = Text.fields.event.sender + , coder = Json.string + } + ) + (Json.field.optional.value + { fieldName = "stateKey" + , toField = .stateKey + , description = Text.fields.event.stateKey + , coder = Json.string + } + ) + (Json.field.required + -- NOTE! | In JSON we call it `type`, not `eventType`, + -- NOTE! | so that the data is easier to read for other non-Elm + -- NOTE! | JSON parsers + { fieldName = "type" + , toField = .eventType + , description = Text.fields.event.eventType + , coder = Json.string + } + ) + (Json.field.optional.value + { fieldName = "unsigned" + , toField = .unsigned + , description = Text.fields.event.unsigned + , coder = unsignedCoder + } + ) + + {-| Decode an Event from a JSON value. -} -decoder : D.Decoder Event +decoder : Json.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) + Json.decode coder {-| 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 ) - ] +encode : Json.Encoder Event +encode = + Json.encode coder {-| Determine the previous `content` value for this event. This field is only a `Just value` if the event is a state event, and the Matrix Vault has permission to see the previous content. -} -prevContent : Event -> Maybe E.Value +prevContent : Event -> Maybe Json.Value prevContent event = Maybe.andThen (\(UnsignedData data) -> data.prevContent) event.unsigned @@ -145,3 +170,40 @@ display the original transaction id used for the event. transactionId : Event -> Maybe String transactionId event = Maybe.andThen (\(UnsignedData data) -> data.transactionId) event.unsigned + + +unsignedCoder : Json.Coder UnsignedData +unsignedCoder = + Json.object4 + { name = Text.docs.unsigned.name + , description = Text.docs.unsigned.description + , init = \a b c d -> UnsignedData { age = a, prevContent = b, redactedBecause = c, transactionId = d } + } + (Json.field.optional.value + { fieldName = "age" + , toField = \(UnsignedData data) -> data.age + , description = Text.fields.unsigned.age + , coder = Json.int + } + ) + (Json.field.optional.value + { fieldName = "prevContent" + , toField = \(UnsignedData data) -> data.prevContent + , description = Text.fields.unsigned.prevContent + , coder = Json.value + } + ) + (Json.field.optional.value + { fieldName = "redactedBecause" + , toField = \(UnsignedData data) -> data.redactedBecause + , description = Text.fields.unsigned.redactedBecause + , coder = Json.lazy (\_ -> coder) + } + ) + (Json.field.optional.value + { fieldName = "transactionId" + , toField = \(UnsignedData data) -> data.transactionId + , description = Text.fields.unsigned.transactionId + , coder = Json.string + } + ) diff --git a/src/Internal/Values/StateManager.elm b/src/Internal/Values/StateManager.elm index 46282aa..635470a 100644 --- a/src/Internal/Values/StateManager.elm +++ b/src/Internal/Values/StateManager.elm @@ -3,7 +3,7 @@ module Internal.Values.StateManager exposing , empty, singleton, insert, remove, append , isEmpty, member, memberKey, get, size, isEqual , keys, values, fromList, toList - , encode, decoder + , coder, encode, decoder ) {-| The StateManager tracks the room state based on events, their event types @@ -34,15 +34,15 @@ dictionary-like experience to navigate through the Matrix room state. ## JSON coders -@docs encode, decoder +@docs coder, encode, decoder -} import FastDict as Dict exposing (Dict) +import Internal.Config.Text as Text +import Internal.Tools.Json as Json 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 @@ -93,15 +93,24 @@ cleanKey key (StateManager manager) = |> StateManager +coder : Json.Coder StateManager +coder = + Event.coder + |> Mashdict.coder .stateKey + |> Json.fastDict + |> Json.map + { name = Text.docs.stateManager.name + , description = Text.docs.stateManager.description + , forth = StateManager + , back = \(StateManager manager) -> manager + } + + {-| Decode a StateManager from a JSON value. -} -decoder : D.Decoder StateManager +decoder : Json.Decoder StateManager decoder = - Event.decoder - |> Mashdict.decoder .stateKey - |> D.keyValuePairs - |> D.map Dict.fromList - |> D.map StateManager + Json.decode coder {-| Create an empty StateManager. @@ -113,11 +122,9 @@ 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) +encode : Json.Encoder StateManager +encode = + Json.encode coder {-| Build a StateManager using a list of events. diff --git a/tests/Test/Tools/Hashdict.elm b/tests/Test/Tools/Hashdict.elm index 500503c..cdfdf43 100644 --- a/tests/Test/Tools/Hashdict.elm +++ b/tests/Test/Tools/Hashdict.elm @@ -3,6 +3,7 @@ module Test.Tools.Hashdict exposing (..) import Expect import Fuzz exposing (Fuzzer) import Internal.Tools.Hashdict as Hashdict exposing (Hashdict) +import Internal.Tools.Json as Json import Internal.Values.Event as Event import Json.Decode as D import Json.Encode as E @@ -93,11 +94,11 @@ suite = "JSON encode -> JSON decode" (\indent -> Hashdict.empty identity - |> Hashdict.encode E.string + |> Json.encode (Hashdict.coder identity Json.string) |> E.encode indent - |> D.decodeString (Hashdict.decoder identity D.string) - |> Result.map (Hashdict.isEqual (Hashdict.empty String.toUpper)) - |> Expect.equal (Ok True) + |> D.decodeString (Json.decode <| Hashdict.coder identity Json.string) + |> Result.map (Tuple.mapFirst (Hashdict.isEqual (Hashdict.empty String.toUpper))) + |> Expect.equal (Ok ( True, [] )) ) ] , describe "singleton" @@ -164,11 +165,11 @@ suite = "JSON encode -> JSON decode" (\hashdict indent -> hashdict - |> Hashdict.encode Event.encode + |> Json.encode (Hashdict.coder .eventId Event.coder) |> E.encode indent - |> D.decodeString (Hashdict.decoder .eventId Event.decoder) - |> Result.map Hashdict.toList - |> Expect.equal (Ok <| Hashdict.toList hashdict) + |> D.decodeString (Json.decode <| Hashdict.coder .eventId Event.coder) + |> Result.map (Tuple.mapFirst Hashdict.toList) + |> Expect.equal (Ok ( Hashdict.toList hashdict, [] )) ) ] ] diff --git a/tests/Test/Tools/Mashdict.elm b/tests/Test/Tools/Mashdict.elm index dfddc6c..0425dc0 100644 --- a/tests/Test/Tools/Mashdict.elm +++ b/tests/Test/Tools/Mashdict.elm @@ -2,6 +2,7 @@ module Test.Tools.Mashdict exposing (..) import Expect import Fuzz exposing (Fuzzer) +import Internal.Tools.Json as Json import Internal.Tools.Mashdict as Mashdict exposing (Mashdict) import Internal.Values.Event as Event import Json.Decode as D @@ -93,11 +94,11 @@ suite = "JSON encode -> JSON decode" (\indent -> Mashdict.empty Just - |> Mashdict.encode E.string + |> Json.encode (Mashdict.coder Just Json.string) |> E.encode indent - |> D.decodeString (Mashdict.decoder Just D.string) - |> Result.map (Mashdict.isEqual (Mashdict.empty Just)) - |> Expect.equal (Ok True) + |> D.decodeString (Json.decode <| Mashdict.coder Just Json.string) + |> Result.map (Tuple.mapFirst <| Mashdict.isEqual (Mashdict.empty Just)) + |> Expect.equal (Ok ( True, [] )) ) ] , describe "singleton" @@ -194,11 +195,11 @@ suite = "JSON encode -> JSON decode" (\hashdict indent -> hashdict - |> Mashdict.encode Event.encode + |> Json.encode (Mashdict.coder .stateKey Event.coder) |> E.encode indent - |> D.decodeString (Mashdict.decoder .stateKey Event.decoder) - |> Result.map Mashdict.toList - |> Expect.equal (Ok <| Mashdict.toList hashdict) + |> D.decodeString (Json.decode <| Mashdict.coder .stateKey Event.coder) + |> Result.map (Tuple.mapFirst Mashdict.toList) + |> Expect.equal (Ok ( Mashdict.toList hashdict, [] )) ) ] ] diff --git a/tests/Test/Tools/Timestamp.elm b/tests/Test/Tools/Timestamp.elm index d98cafb..5721821 100644 --- a/tests/Test/Tools/Timestamp.elm +++ b/tests/Test/Tools/Timestamp.elm @@ -26,7 +26,7 @@ suite = |> Timestamp.encode |> E.encode indent |> D.decodeString Timestamp.decoder - |> Expect.equal (Ok time) + |> Expect.equal (Ok ( time, [] )) ) , fuzz fuzzer "JSON decode -> millis" @@ -42,7 +42,7 @@ suite = n |> E.int |> D.decodeValue Timestamp.decoder - |> Expect.equal (Ok <| Time.millisToPosix n) + |> Expect.equal (Ok ( Time.millisToPosix n, [] )) ) ] , describe "Identity" diff --git a/tests/Test/Values/StateManager.elm b/tests/Test/Values/StateManager.elm index ec15032..7e0839e 100644 --- a/tests/Test/Values/StateManager.elm +++ b/tests/Test/Values/StateManager.elm @@ -84,7 +84,7 @@ suite = |> StateManager.encode |> E.encode 0 |> D.decodeString StateManager.decoder - |> Expect.equal (Ok StateManager.empty) + |> Expect.equal (Ok ( StateManager.empty, [] )) |> always ) ] From dd5f298fd3ed17b3e11a8407e7e93294ec6e0d11 Mon Sep 17 00:00:00 2001 From: Bram Date: Mon, 22 Jan 2024 17:44:22 +0100 Subject: [PATCH 11/14] Migrate remaining objects to new JSON coders --- src/Internal/Config/Text.elm | 68 +++++++++++++++++++++-- src/Internal/Tools/Json.elm | 11 +++- src/Internal/Values/Context.elm | 93 +++++++++++++++++++++++--------- src/Internal/Values/Envelope.elm | 61 ++++++++++++++------- src/Internal/Values/Event.elm | 1 - src/Internal/Values/Settings.elm | 84 +++++++++++++++-------------- tests/Test/Values/Context.elm | 2 +- tests/Test/Values/Envelope.elm | 7 +-- tests/Test/Values/Settings.elm | 4 +- 9 files changed, 233 insertions(+), 98 deletions(-) diff --git a/src/Internal/Config/Text.elm b/src/Internal/Config/Text.elm index 1159868..7cd0932 100644 --- a/src/Internal/Config/Text.elm +++ b/src/Internal/Config/Text.elm @@ -112,14 +112,30 @@ decodedDictSize from to = {-| Documentation used for all functions and data types in JSON coders -} docs : - { event : TypeDocs + { context : TypeDocs + , envelope : TypeDocs + , event : TypeDocs , hashdict : TypeDocs , mashdict : TypeDocs + , settings : TypeDocs , stateManager : TypeDocs , unsigned : TypeDocs } docs = - { event = + { context = + { name = "Context" + , description = + [ "The Context is the set of variables that the user (mostly) cannot control." + , "The Context contains tokens, values and other bits that the Vault receives from the Matrix API." + ] + } + , envelope = + { name = "Envelope" + , description = + [ "The Envelope module wraps existing data types with lots of values and settings that can be adjusted manually." + ] + } + , event = { name = "Event" , description = [ "The Event type represents a single value that contains all the information for a single event in the room." @@ -138,6 +154,12 @@ docs = [ "The mashdict exclusively stores values for which the hashing algorithm returns a value, and it ignores the outcome for all other scenarios." ] } + , settings = + { name = "Settings" + , description = + [ "The settings type is a data type to configure settings in the enveloped data type." + ] + } , stateManager = { name = "StateManager" , description = @@ -173,7 +195,21 @@ failures = fields : - { event : + { context : + { accessToken : Desc + , baseUrl : Desc + , password : Desc + , refreshToken : Desc + , username : Desc + , transaction : Desc + , versions : Desc + } + , envelope : + { content : Desc + , context : Desc + , settings : Desc + } + , event : { content : Desc , eventId : Desc , originServerTs : Desc @@ -183,6 +219,11 @@ fields : , eventType : Desc , unsigned : Desc } + , settings : + { currentVersion : Desc + , deviceName : Desc + , syncTime : Desc + } , unsigned : { age : Desc , prevContent : Desc @@ -191,7 +232,21 @@ fields : } } fields = - { event = + { context = + { accessToken = [] + , baseUrl = [] + , password = [] + , refreshToken = [] + , username = [] + , transaction = [] + , versions = [] + } + , envelope = + { content = [] + , context = [] + , settings = [] + } + , event = { content = [] , eventId = [] , originServerTs = [] @@ -201,6 +256,11 @@ fields = , eventType = [] , unsigned = [] } + , settings = + { currentVersion = [] + , deviceName = [] + , syncTime = [] + } , unsigned = { age = [] , prevContent = [] diff --git a/src/Internal/Tools/Json.elm b/src/Internal/Tools/Json.elm index d8f21cd..9a68f14 100644 --- a/src/Internal/Tools/Json.elm +++ b/src/Internal/Tools/Json.elm @@ -69,7 +69,7 @@ Once all fields are constructed, the user can create JSON objects. import Dict as SlowDict import FastDict -import Internal.Config.Log exposing (Log, log) +import Internal.Config.Log exposing (Log) import Internal.Tools.DecodeExtra as D import Internal.Tools.EncodeExtra as E import Json.Decode as D @@ -382,7 +382,14 @@ field = { fieldName = fieldName , toField = toField , description = description - , encoder = encoder >> Maybe.Just + , encoder = + \o -> + -- If the value matches the default, do not record + if o == Tuple.first default then + Nothing + + else + Maybe.Just (encoder o) , decoder = D.opFieldWithDefault fieldName default decoder , docs = docs , requiredness = diff --git a/src/Internal/Values/Context.elm b/src/Internal/Values/Context.elm index d25d906..6d2319b 100644 --- a/src/Internal/Values/Context.elm +++ b/src/Internal/Values/Context.elm @@ -1,5 +1,5 @@ module Internal.Values.Context exposing - ( Context, init, encode, decoder + ( Context, init, coder, encode, decoder , APIContext, apiFormat , setAccessToken, getAccessToken , setBaseUrl, getBaseUrl @@ -14,7 +14,7 @@ the Matrix API. ## Context -@docs Context, init, encode, decoder +@docs Context, init, coder, encode, decoder ## APIContext @@ -50,10 +50,8 @@ information that can be inserted. -} import Internal.Config.Leaks as L -import Internal.Tools.DecodeExtra as D -import Internal.Tools.EncodeExtra as E -import Json.Decode as D -import Json.Encode as E +import Internal.Config.Text as Text +import Internal.Tools.Json as Json {-| The Context type stores all the information in the Vault. This data type is @@ -97,33 +95,76 @@ apiFormat context = } +coder : Json.Coder Context +coder = + Json.object7 + { name = Text.docs.context.name + , description = Text.docs.context.description + , init = Context + } + (Json.field.optional.value + { fieldName = "accessToken" + , toField = .accessToken + , description = Text.fields.context.accessToken + , coder = Json.string + } + ) + (Json.field.optional.value + { fieldName = "baseUrl" + , toField = .baseUrl + , description = Text.fields.context.baseUrl + , coder = Json.string + } + ) + (Json.field.optional.value + { fieldName = "password" + , toField = .password + , description = Text.fields.context.password + , coder = Json.string + } + ) + (Json.field.optional.value + { fieldName = "refreshToken" + , toField = .refreshToken + , description = Text.fields.context.refreshToken + , coder = Json.string + } + ) + (Json.field.optional.value + { fieldName = "username" + , toField = .username + , description = Text.fields.context.username + , coder = Json.string + } + ) + (Json.field.optional.value + { fieldName = "transaction" + , toField = .transaction + , description = Text.fields.context.transaction + , coder = Json.string + } + ) + (Json.field.optional.value + { fieldName = "versions" + , toField = .versions + , description = Text.fields.context.versions + , coder = Json.list Json.string + } + ) + + {-| Decode a Context type from a JSON value. -} -decoder : D.Decoder Context +decoder : Json.Decoder Context decoder = - D.map7 Context - (D.opField "accessToken" D.string) - (D.opField "baseUrl" D.string) - (D.opField "password" D.string) - (D.opField "refreshToken" D.string) - (D.opField "username" D.string) - (D.opField "transaction" D.string) - (D.opField "versions" (D.list D.string)) + Json.decode coder {-| Encode a Context type into a JSON value. -} -encode : Context -> E.Value -encode context = - E.maybeObject - [ ( "accessToken", Maybe.map E.string context.accessToken ) - , ( "baseUrl", Maybe.map E.string context.baseUrl ) - , ( "password", Maybe.map E.string context.password ) - , ( "refreshToken", Maybe.map E.string context.refreshToken ) - , ( "username", Maybe.map E.string context.username ) - , ( "transaction", Maybe.map E.string context.transaction ) - , ( "versions", Maybe.map (E.list E.string) context.versions ) - ] +encode : Json.Encoder Context +encode = + Json.encode coder {-| A basic, untouched version of the Context, containing no information. diff --git a/src/Internal/Values/Envelope.elm b/src/Internal/Values/Envelope.elm index 1037318..3c0fec0 100644 --- a/src/Internal/Values/Envelope.elm +++ b/src/Internal/Values/Envelope.elm @@ -38,17 +38,14 @@ settings that can be adjusted manually. ## JSON coders -@docs encode, decoder +@docs coder, encode, decoder -} -import Internal.Config.Default as Default -import Internal.Tools.DecodeExtra as D -import Internal.Tools.EncodeExtra as E +import Internal.Config.Text as Text +import Internal.Tools.Json as Json import Internal.Values.Context as Context exposing (Context) import Internal.Values.Settings as Settings -import Json.Decode as D -import Json.Encode as E {-| There are lots of different data types in the Elm SDK, and many of them @@ -71,28 +68,52 @@ type alias Settings = Settings.Settings +coder : Json.Coder a -> Json.Coder (Envelope a) +coder c1 = + Json.object3 + { name = Text.docs.envelope.name + , description = Text.docs.envelope.description + , init = Envelope + } + (Json.field.required + { fieldName = "content" + , toField = .content + , description = Text.fields.envelope.content + , coder = c1 + } + ) + (Json.field.required + { fieldName = "context" + , toField = .context + , description = Text.fields.envelope.context + , coder = Context.coder + } + ) + (Json.field.optional.withDefault + { fieldName = "settings" + , toField = .settings + , description = Text.fields.envelope.settings + , coder = Settings.coder + , default = Tuple.pair Settings.init [] + , defaultToString = always "" + } + ) + + {-| Decode an enveloped type from a JSON value. The decoder also imports any potential tokens, values and settings included in the JSON. -} -decoder : D.Decoder a -> D.Decoder (Envelope a) -decoder xDecoder = - D.map3 Envelope - (D.field "content" xDecoder) - (D.field "context" Context.decoder) - (D.field "settings" Settings.decoder) +decoder : Json.Coder a -> Json.Decoder (Envelope a) +decoder c1 = + Json.decode (coder c1) {-| 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 data = - E.object - [ ( "content", encodeX data.content ) - , ( "context", Context.encode data.context ) - , ( "settings", Settings.encode data.settings ) - , ( "version", E.string Default.currentVersion ) - ] +encode : Json.Coder a -> Json.Encoder (Envelope a) +encode c1 = + Json.encode (coder c1) {-| Map a function, then get its content. This is useful for getting information diff --git a/src/Internal/Values/Event.elm b/src/Internal/Values/Event.elm index 304e7cb..4f61693 100644 --- a/src/Internal/Values/Event.elm +++ b/src/Internal/Values/Event.elm @@ -26,7 +26,6 @@ of a room. -} -import Internal.Config.Default as Default import Internal.Config.Text as Text import Internal.Tools.Json as Json import Internal.Tools.Timestamp as Timestamp exposing (Timestamp) diff --git a/src/Internal/Values/Settings.elm b/src/Internal/Values/Settings.elm index 9ac52ac..aa7d24a 100644 --- a/src/Internal/Values/Settings.elm +++ b/src/Internal/Values/Settings.elm @@ -1,6 +1,6 @@ module Internal.Values.Settings exposing ( Settings, init - , encode, decoder + , coder, encode, decoder ) {-| @@ -16,15 +16,13 @@ data types. ## JSON coders -@docs encode, decoder +@docs coder, encode, decoder -} import Internal.Config.Default as Default -import Internal.Tools.DecodeExtra as D -import Internal.Tools.EncodeExtra as E -import Json.Decode as D -import Json.Encode as E +import Internal.Config.Text as Text +import Internal.Tools.Json as Json {-| Custom settings that can be manipulated by the user. These serve as a @@ -41,46 +39,54 @@ type alias Settings = } +coder : Json.Coder Settings +coder = + Json.object3 + { name = Text.docs.settings.name + , description = Text.docs.settings.description + , init = Settings + } + (Json.field.optional.withDefault + { fieldName = "currentVersion" + , toField = .currentVersion + , description = Text.fields.settings.currentVersion + , coder = Json.string + , default = Tuple.pair Default.currentVersion [] + , defaultToString = identity + } + ) + (Json.field.optional.withDefault + { fieldName = "deviceName" + , toField = .deviceName + , description = Text.fields.settings.deviceName + , coder = Json.string + , default = Tuple.pair Default.deviceName [] + , defaultToString = identity + } + ) + (Json.field.optional.withDefault + { fieldName = "syncTime" + , toField = .syncTime + , description = Text.fields.settings.syncTime + , coder = Json.int + , default = Tuple.pair Default.syncTime [] + , defaultToString = String.fromInt + } + ) + + {-| Decode settings from a JSON value. -} -decoder : D.Decoder Settings +decoder : Json.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) + Json.decode coder {-| 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 - ) - ] +encode : Json.Encoder Settings +encode = + Json.encode coder {-| Create a new Settings module based on default values diff --git a/tests/Test/Values/Context.elm b/tests/Test/Values/Context.elm index 1b6dc55..c412daf 100644 --- a/tests/Test/Values/Context.elm +++ b/tests/Test/Values/Context.elm @@ -138,6 +138,6 @@ json = context |> Context.encode |> D.decodeValue Context.decoder - |> Expect.equal (Ok context) + |> Expect.equal (Ok ( context, [] )) ) ] diff --git a/tests/Test/Values/Envelope.elm b/tests/Test/Values/Envelope.elm index deb5036..e147b8d 100644 --- a/tests/Test/Values/Envelope.elm +++ b/tests/Test/Values/Envelope.elm @@ -3,6 +3,7 @@ module Test.Values.Envelope exposing (..) import Expect import Fuzz exposing (Fuzzer) import Internal.Config.Default as Default +import Internal.Tools.Json as Json import Internal.Values.Envelope as Envelope exposing (Envelope) import Json.Decode as D import Json.Encode as E @@ -56,10 +57,10 @@ suite = "JSON encode -> JSON decode" (\envelope indent -> envelope - |> Envelope.encode E.string + |> Envelope.encode Json.string |> E.encode indent - |> D.decodeString (Envelope.decoder D.string) - |> Expect.equal (Ok envelope) + |> D.decodeString (Envelope.decoder Json.string) + |> Expect.equal (Ok ( envelope, [] )) ) ] ] diff --git a/tests/Test/Values/Settings.elm b/tests/Test/Values/Settings.elm index 8edf86c..d48a851 100644 --- a/tests/Test/Values/Settings.elm +++ b/tests/Test/Values/Settings.elm @@ -61,7 +61,7 @@ suite = , test "JSON decode {} is init" ("{}" |> D.decodeString Settings.decoder - |> Expect.equal (Ok Settings.init) + |> Expect.equal (Ok ( Settings.init, [] )) |> always ) ] @@ -74,7 +74,7 @@ suite = |> Settings.encode |> E.encode indent |> D.decodeString Settings.decoder - |> Expect.equal (Ok settings) + |> Expect.equal (Ok ( settings, [] )) ) ] ] From acd13ac67a7f06f0d7c8097d6a03969d411dc388 Mon Sep 17 00:00:00 2001 From: Bram Date: Mon, 22 Jan 2024 18:09:08 +0100 Subject: [PATCH 12/14] Complete documentation --- src/Internal/Config/Text.elm | 13 +++++++++---- src/Internal/Tools/Hashdict.elm | 2 ++ src/Internal/Tools/Json.elm | 12 +++++++++--- src/Internal/Tools/Mashdict.elm | 2 ++ src/Internal/Values/Context.elm | 2 ++ src/Internal/Values/Envelope.elm | 4 +++- src/Internal/Values/Event.elm | 2 ++ src/Internal/Values/Settings.elm | 2 ++ src/Internal/Values/StateManager.elm | 2 ++ 9 files changed, 33 insertions(+), 8 deletions(-) diff --git a/src/Internal/Config/Text.elm b/src/Internal/Config/Text.elm index 7cd0932..93c9d5a 100644 --- a/src/Internal/Config/Text.elm +++ b/src/Internal/Config/Text.elm @@ -190,10 +190,9 @@ failures = } - --- TODO - - +{-| Objects contain multiple fields. These fields are here described, explaining +what they do and what they are for. +-} fields : { context : { accessToken : Desc @@ -270,11 +269,17 @@ fields = } +{-| This message will be shown when a [Hashdict](Internal-Tools-Hashdict) +encounters a hash-value pair where the value does not hash to the provided hash. +-} invalidHashInHashdict : String invalidHashInHashdict = "Invalid hash function: not all elements hash to their JSON-stored hashes" +{-| This message will be shown when a [Mashdict](Internal-Tools-Mashdict) +encounters a hash-value pair where the value does not hash to the provided hash. +-} invalidHashInMashdict : String invalidHashInMashdict = "Invalid hash function: not all elements hash to their JSON-stored hashes" diff --git a/src/Internal/Tools/Hashdict.elm b/src/Internal/Tools/Hashdict.elm index 3b46f30..49a178d 100644 --- a/src/Internal/Tools/Hashdict.elm +++ b/src/Internal/Tools/Hashdict.elm @@ -81,6 +81,8 @@ type Hashdict a } +{-| Define how Hashdict can be encoded to and decoded from a JSON object. +-} coder : (a -> String) -> Json.Coder a -> Json.Coder (Hashdict a) coder f c1 = Json.andThen diff --git a/src/Internal/Tools/Json.elm b/src/Internal/Tools/Json.elm index 9a68f14..1a9ca12 100644 --- a/src/Internal/Tools/Json.elm +++ b/src/Internal/Tools/Json.elm @@ -1,12 +1,11 @@ module Internal.Tools.Json exposing ( Coder, string, bool, int, float, value , Encoder, encode, Decoder, decode, Value - , succeed, fail, andThen, lazy + , succeed, fail, andThen, lazy, map , Docs(..), RequiredField(..), toDocs , list, slowDict, fastDict, maybe , Field, field , object2, object3, object4, object5, object6, object7, object8, object9, object10, object11 - , map ) {-| @@ -40,7 +39,7 @@ module to build its encoders and decoders. ## Optional coding -@docs succeed, fail, andThen, lazy +@docs succeed, fail, andThen, lazy, map ## Documentation @@ -176,6 +175,8 @@ type RequiredField | OptionalFieldWithDefault String +{-| Represents an arbitary JavaScript value. +-} type alias Value = E.Value @@ -424,6 +425,8 @@ int = } +{-| Define a lazy coder. This is useful when defining recursive structures. +-} lazy : (() -> Coder value) -> Coder value lazy f = Coder @@ -1144,6 +1147,9 @@ toEncodeField (Field data) = ( data.fieldName, data.toField >> data.encoder ) +{-| Do not do anything useful with a JSON value, just bring it to Elm as a +JavaScript value. +-} value : Coder Value value = Coder diff --git a/src/Internal/Tools/Mashdict.elm b/src/Internal/Tools/Mashdict.elm index 7ede8c3..1b570ab 100644 --- a/src/Internal/Tools/Mashdict.elm +++ b/src/Internal/Tools/Mashdict.elm @@ -93,6 +93,8 @@ type Mashdict a } +{-| Define how a Mashdict can be encoded to and decoded from a JSON object. +-} coder : (a -> Maybe String) -> Json.Coder a -> Json.Coder (Mashdict a) coder f c1 = Json.andThen diff --git a/src/Internal/Values/Context.elm b/src/Internal/Values/Context.elm index 6d2319b..d8f67e8 100644 --- a/src/Internal/Values/Context.elm +++ b/src/Internal/Values/Context.elm @@ -95,6 +95,8 @@ apiFormat context = } +{-| Define how a Context can be encoded to and decoded from a JSON object. +-} coder : Json.Coder Context coder = Json.object7 diff --git a/src/Internal/Values/Envelope.elm b/src/Internal/Values/Envelope.elm index 3c0fec0..e8cb64e 100644 --- a/src/Internal/Values/Envelope.elm +++ b/src/Internal/Values/Envelope.elm @@ -4,7 +4,7 @@ module Internal.Values.Envelope exposing , Settings, mapSettings, extractSettings , mapContext , getContent, extract - , encode, decoder + , coder, encode, decoder ) {-| The Envelope module wraps existing data types with lots of values and @@ -68,6 +68,8 @@ type alias Settings = Settings.Settings +{-| Define how an Envelope can be encoded to and decoded from a JSON object. +-} coder : Json.Coder a -> Json.Coder (Envelope a) coder c1 = Json.object3 diff --git a/src/Internal/Values/Event.elm b/src/Internal/Values/Event.elm index 4f61693..3a52bcf 100644 --- a/src/Internal/Values/Event.elm +++ b/src/Internal/Values/Event.elm @@ -64,6 +64,8 @@ age event = Maybe.andThen (\(UnsignedData data) -> data.age) event.unsigned +{-| Define how an Event can be encoded to and decoded from a JSON object. +-} coder : Json.Coder Event coder = Json.object8 diff --git a/src/Internal/Values/Settings.elm b/src/Internal/Values/Settings.elm index aa7d24a..4696b7a 100644 --- a/src/Internal/Values/Settings.elm +++ b/src/Internal/Values/Settings.elm @@ -39,6 +39,8 @@ type alias Settings = } +{-| Define how a Settings type can be encoded to and decoded from a JSON object. +-} coder : Json.Coder Settings coder = Json.object3 diff --git a/src/Internal/Values/StateManager.elm b/src/Internal/Values/StateManager.elm index 635470a..0517d60 100644 --- a/src/Internal/Values/StateManager.elm +++ b/src/Internal/Values/StateManager.elm @@ -93,6 +93,8 @@ cleanKey key (StateManager manager) = |> StateManager +{-| Define how a StateManager can be encoded to and decoded from a JSON object. +-} coder : Json.Coder StateManager coder = Event.coder From ead65c07f5207ee7b8016e58c8e5c8549e9013ab Mon Sep 17 00:00:00 2001 From: Bram van den Heuvel Date: Thu, 25 Jan 2024 14:47:54 +0100 Subject: [PATCH 13/14] Write object field documentation --- src/Internal/Config/Text.elm | 102 ++++++++++++++++++++++++++--------- 1 file changed, 77 insertions(+), 25 deletions(-) diff --git a/src/Internal/Config/Text.elm b/src/Internal/Config/Text.elm index 93c9d5a..df063b5 100644 --- a/src/Internal/Config/Text.elm +++ b/src/Internal/Config/Text.elm @@ -232,39 +232,91 @@ fields : } fields = { context = - { accessToken = [] - , baseUrl = [] - , password = [] - , refreshToken = [] - , username = [] - , transaction = [] - , versions = [] + { accessToken = + [ "The access token used for authentication with the Matrix server." + ] + , baseUrl = + [ "The base URL of the Matrix server." + ] + , password = + [ "The user's password for authentication purposes." + ] + , refreshToken = + [ "The token used to obtain a new access token upon expiration of the current access token." + ] + , username = + [ "The username of the Matrix account." + ] + , transaction = + [ "A unique identifier for a transaction initiated by the user." + ] + , versions = + [ "The versions of the Matrix protocol that are supported by the server." + ] } , envelope = - { content = [] - , context = [] - , settings = [] + { content = + [ "The actual data or payload that is wrapped within the envelope." + ] + , context = + [ "The context information associated with the envelope, such as environment or session details." + , "In general, this data cannot be directly configured by the user." + ] + , settings = + [ "The configurable settings that affect how the enveloped data is handled or processed." + ] } , event = - { content = [] - , eventId = [] - , originServerTs = [] - , roomId = [] - , sender = [] - , stateKey = [] - , eventType = [] - , unsigned = [] + { content = + [ "The body of this event, as created by the client which sent it." + ] + , eventId = + [ "The globally unique identifier for this event." + ] + , originServerTs = + [ "Timestamp (in milliseconds since the unix epoch) on originating homeserver when this event was sent." + ] + , roomId = + [ "The ID of the room associated with this event." + ] + , sender = + [ "Contains the fully-qualified ID of the user who sent this event." + ] + , stateKey = + [ "Present if, and only if, this event is a state event. The key making this piece of state unique in the room. Note that it is often an empty string." + , "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’s ID as the state key MUST only be set by that user." + ] + , eventType = + [ "The type of the event." + ] + , unsigned = + [ "Contains optional extra information about the event." + ] } , settings = - { currentVersion = [] - , deviceName = [] - , syncTime = [] + { currentVersion = + [ "Indicates the current version of the Elm SDK." + ] + , deviceName = + [ "Indicates the device name that is communicated to the Matrix API." + ] + , syncTime = + [ "Indicates the frequency in miliseconds with which the Elm SDK should long-poll the /sync endpoint." + ] } , unsigned = - { age = [] - , prevContent = [] - , redactedBecause = [] - , transactionId = [] + { age = + [ "The time in milliseconds that has elapsed since the event was sent. This field is generated by the local homeserver, and may be incorrect if the local time on at least one of the two servers is out of sync, which can cause the age to either be negative or greater than it actually is." + ] + , prevContent = + [ "The previous content for this event. This field is generated by the local homeserver, and is only returned if the event is a state event, and the client has permission to see the previous content." + ] + , redactedBecause = + [ "The event that redacted this event, if any." + ] + , transactionId = + [ "The client-supplied transaction ID, for example, provided via PUT /_matrix/client/v3/rooms/{roomId}/send/{eventType}/{txnId}, if the client being given the event is the same one which sent it." + ] } } From bbe1eeef12eedb8fd08c2f8f8edd9b5b1806834b Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 2 Feb 2024 12:15:50 +0100 Subject: [PATCH 14/14] Prepare develop for master elm-test --fuzz 10000 --seed 49678983951728 --- elm.json | 21 +-------------------- src/Internal/Config/Default.elm | 2 +- 2 files changed, 2 insertions(+), 21 deletions(-) diff --git a/elm.json b/elm.json index d9064c1..66e87bf 100644 --- a/elm.json +++ b/elm.json @@ -3,27 +3,8 @@ "name": "noordstar/elm-matrix-sdk-beta", "summary": "Matrix SDK for instant communication. Unstable beta version for testing only.", "license": "EUPL-1.1", - "version": "2.1.1", + "version": "2.1.2", "exposed-modules": [ - "Internal.Config.Default", - "Internal.Config.Leaks", - "Internal.Config.Log", - "Internal.Config.Phantom", - "Internal.Config.Text", - "Internal.Tools.DecodeExtra", - "Internal.Tools.EncodeExtra", - "Internal.Tools.Hashdict", - "Internal.Tools.Iddict", - "Internal.Tools.Json", - "Internal.Tools.Mashdict", - "Internal.Tools.Timestamp", - "Internal.Tools.VersionControl", - "Internal.Values.Context", - "Internal.Values.Envelope", - "Internal.Values.Event", - "Internal.Values.Settings", - "Internal.Values.StateManager", - "Internal.Values.Vault", "Matrix", "Matrix.Event", "Matrix.Settings" diff --git a/src/Internal/Config/Default.elm b/src/Internal/Config/Default.elm index ffbd273..c4cd6ad 100644 --- a/src/Internal/Config/Default.elm +++ b/src/Internal/Config/Default.elm @@ -23,7 +23,7 @@ will assume until overriden by the user. -} currentVersion : String currentVersion = - "beta 2.1.1" + "beta 2.1.2" {-| The default device name that is being communicated with the Matrix API.