noordstar
/
elm-matrix-sdk-beta
mirror of https://github.com/noordstar/elm-matrix-sdk-beta
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #15 from noordstar/json-extra 

Json reintroduction
pull/16/head
BramvdnHeuvel 2024-01-29 21:52:31 +01:00 committed by GitHub
parent ef9b007730 ead65c07f5
commit 16a7e7e66b
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
24 changed files with 2609 additions and 257 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
elm.json
View File

@ -5,6 +5,25 @@
"license": "EUPL-1.1",
"version": "2.1.1",
"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"

25
src/Internal/Config/Leaks.elm
View File

@ -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,20 @@ accessToken =
"elm-sdk-placeholder-access-token-leaks"
{-| Complete set of all leaking values. Commonly using for testing purposes.
-}
allLeaks : Set String
allLeaks =
Set.union
(Set.fromList versions)
(Set.fromList
[ accessToken
, baseUrl
, transaction
]
)
{-| Placeholder base URL.
-}
baseUrl : String

105
src/Internal/Config/Log.elm Normal file
View File

@ -0,0 +1,105 @@
module Internal.Config.Log exposing (Log, log)
{-|
# 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.
@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
{-| 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
, 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.
-}
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"

51
src/Internal/Config/Phantom.elm Normal file
View File

@ -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 ph
= 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

286
src/Internal/Config/Text.elm
View File

@ -1,7 +1,9 @@
module Internal.Config.Text exposing
( versionsFoundLocally, versionsReceived, versionsFailedToDecode
( docs, failures, fields
, accessTokenFoundLocally, accessTokenExpired, accessTokenInvalid
, versionsFoundLocally, versionsReceived, versionsFailedToDecode
, unsupportedVersionForEndpoint
, decodedDictSize, invalidHashInHashdict, invalidHashInMashdict, leakingValueFound
)
{-| Throughout the Elm SDK, there are lots of pieces of text being used for
@ -23,12 +25,9 @@ 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
## Type documentation
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
@docs docs, failures, fields
## API Authentication
@ -41,15 +40,38 @@ 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, 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
@ -73,6 +95,258 @@ 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
[ "JSON dict contained duplicate keys (JSON had "
, String.fromInt from
, " keys, Elm dict has "
, String.fromInt to
, " keys)"
]
{-| Documentation used for all functions and data types in JSON coders
-}
docs :
{ context : TypeDocs
, envelope : TypeDocs
, event : TypeDocs
, hashdict : TypeDocs
, mashdict : TypeDocs
, settings : TypeDocs
, stateManager : TypeDocs
, unsigned : TypeDocs
}
docs =
{ 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."
]
}
, 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."
]
}
, settings =
{ name = "Settings"
, description =
[ "The settings type is a data type to configure settings in the enveloped data type."
]
}
, 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."
]
}
{-| Objects contain multiple fields. These fields are here described, explaining
what they do and what they are for.
-}
fields :
{ 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
, roomId : Desc
, sender : Desc
, stateKey : Desc
, eventType : Desc
, unsigned : Desc
}
, settings :
{ currentVersion : Desc
, deviceName : Desc
, syncTime : Desc
}
, unsigned :
{ age : Desc
, prevContent : Desc
, redactedBecause : Desc
, transactionId : Desc
}
}
fields =
{ context =
{ 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 =
[ "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 =
[ "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 =
[ "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 =
[ "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."
]
}
}
{-| 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"
{-| 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.

2
src/Internal/Tools/Decode.elm → src/Internal/Tools/DecodeExtra.elm
View File

@ -1,4 +1,4 @@
module Internal.Tools.Decode exposing
module Internal.Tools.DecodeExtra exposing
( opField, opFieldWithDefault
, map9, map10, map11
)

2
src/Internal/Tools/Encode.elm → src/Internal/Tools/EncodeExtra.elm
View File

@ -1,4 +1,4 @@
module Internal.Tools.Encode exposing (maybeObject)
module Internal.Tools.EncodeExtra exposing (maybeObject)
{-|

84
src/Internal/Tools/Hashdict.elm
View File

@ -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,43 @@ 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
{ 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 +131,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 +256,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

1159
src/Internal/Tools/Json.elm Normal file
View File

File diff suppressed because it is too large Load Diff

82
src/Internal/Tools/Mashdict.elm
View File

@ -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,41 @@ 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
{ 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 +141,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 +280,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

30
src/Internal/Tools/Timestamp.elm
View File

@ -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

95
src/Internal/Values/Context.elm
View File

@ -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.Decode as D
import Internal.Tools.Encode 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,78 @@ apiFormat context =
}
{-| Define how a Context can be encoded to and decoded from a JSON object.
-}
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.

65
src/Internal/Values/Envelope.elm
View File

@ -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
@ -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.Decode as D
import Internal.Tools.Encode 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,54 @@ 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
{ 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 "<Default settings>"
}
)
{-| 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

175
src/Internal/Values/Event.elm
View File

@ -1,7 +1,7 @@
module Internal.Values.Event exposing
( Event
, UnsignedData(..), age, prevContent, redactedBecause, transactionId
, encode, decoder
, coder, encode, decoder
)
{-|
@ -22,22 +22,19 @@ of a room.
## JSON Coder
@docs encode, decoder
@docs coder, encode, decoder
-}
import Internal.Config.Default as Default
import Internal.Tools.Decode as D
import Internal.Tools.Encode 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 +51,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 +64,95 @@ 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
{ 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 +171,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
}
)

86
src/Internal/Values/Settings.elm
View File

@ -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.Decode as D
import Internal.Tools.Encode 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,56 @@ 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
{ 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

39
src/Internal/Values/StateManager.elm
View File

@ -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,26 @@ 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
|> 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 +124,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.

17
tests/Test/Tools/Hashdict.elm
View File

@ -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, [] ))
)
]
]

508
tests/Test/Tools/Json.elm Normal file
View File

@ -0,0 +1,508 @@
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
}
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
{ fieldName = "age"
, toField = .age
, description = []
, coder = Json.int
}
ageFuzzer : Fuzzer (Maybe Int)
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
{ 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
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
{ fieldName = "name"
, toField = .name
, description = []
, coder = Json.string
}
nameFuzzer : Fuzzer String
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
{ 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
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"
[ 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)
)
]
, 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)
)
]
]

17
tests/Test/Tools/Mashdict.elm
View File

@ -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, [] ))
)
]
]

4
tests/Test/Tools/Timestamp.elm
View File

@ -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"

2
tests/Test/Values/Context.elm
View File

@ -138,6 +138,6 @@ json =
context
|> Context.encode
|> D.decodeValue Context.decoder
|> Expect.equal (Ok context)
|> Expect.equal (Ok ( context, [] ))
)
]

7
tests/Test/Values/Envelope.elm
View File

@ -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, [] ))
)
]
]

4
tests/Test/Values/Settings.elm
View File

@ -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, [] ))
)
]
]

2
tests/Test/Values/StateManager.elm
View File

@ -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
)
]