.
A decoder for Eclipse Ditto JSON messages into useful ELM union types.
The decoder that enables you to go from one single JSON payload into one or more
DittoMessage
s. Special paths such as /
, /attributes
, /features
can yield more
that one DittoMessage
.
The root union type for the interpretation of the content of the JSON message.
A single constructor union type to encapsulate that a Thing is always represented by a namespace and an id.
When an attribute or a feature of a thing get created or modified, we have access to the properties that were created/modified.
When an attribute or a feature of a thing get deleted, we only have access to the path that was deleted.
A single constructor union type to encapsulate the namespace of a Thing.
A single constructor union type to encapsulate the id of a Thing.
A single constructor union type, used together with DeepAttribute
and DeepFeature
,
to convey what is the path beyond /attributes/attributeId/
or /features/featureId/properties/
.
As a simple example, "path": "/attributes/topLevel"
would convert into
RootAttribute (AttributeId "topLevel")
.
On the other hand, "path": "/attributes/someAttribute/deep/deeper"
would
convert into DeepAttribute (AttributeId "someAttribute") (PropertyPath "deep/deeper")
.
A single construtor union type, to encapsulate the id of an attribute of a thing.
A single constructor union type, to encapsulate the JSON Value payload of the attribute.
As a simple example, "path": "/features/simpleFeature"
would convert into
RootFeature (FeatureId "simpleFeature")
.
On the other hand, "path": "/features/complexFeature/properties/complex-child"
would
convert into DeepFeature (FeatureId "complexFeature") (PropertyPath "complex-child")
A single constructor union type, to encapsulate the id of a feature of a thing.
A single constructor union type, to encapsulate the JSON Value payload of the feature.
A single constructor union type to encapsulate the JSON Value payload of the headers of the message.
A single constructor union type to encapsulate a Ditto Revision.
A single construtor union type to encapsulate the properties of a Ditto Error.
A single construtor union type to encapsulate a Ditto Status.
module DittoMessageDecoder
exposing
( AttributeId(AttributeId)
, AttributePath(DeepAttribute, RootAttribute)
, AttributeProperties(AttributeProperties)
, DittoMessage(Created, Deleted, DittoError, Modified)
, ErrorProperties(ErrorProperties)
, FeatureId(FeatureId)
, FeaturePath(DeepFeature, RootFeature)
, FeatureProperties(FeatureProperties)
, Headers(Headers)
, PropertyPath(PropertyPath)
, Revision(Revision)
, Status(Status)
, Thing(Thing)
, ThingId(ThingId)
, ThingNamespace(ThingNamespace)
, What(Attribute, Feature)
, WhatWasDeleted(AllAttributes, AllFeatures, SingleAttribute, SingleFeature)
, dittoMessagesDecoder
)
{-| .
# DittoMessageDecoder
A decoder for [Eclipse Ditto](https://eclipse.org/ditto/protocol-specification.html)
JSON messages into useful ELM [union types](https://guide.elm-lang.org/types/union_types.html).
## Decoder
@docs dittoMessagesDecoder
## Exposed Union Types
@docs DittoMessage, Thing, What, WhatWasDeleted
@docs ThingNamespace, ThingId
@docs PropertyPath
@docs AttributePath, AttributeId, AttributeProperties
@docs FeaturePath, FeatureId, FeatureProperties
@docs Headers, Revision
@docs ErrorProperties, Status
-}
import Dict
import Json.Decode exposing (Decoder, andThen, at, decodeString, decodeValue, fail, field, int, list, maybe, string, succeed, value)
import Json.Encode exposing (Value)
-- PUBLIC TYPES
{-| The root union type for the interpretation of the content of the JSON message.
-}
type DittoMessage
= Created Thing What Headers Revision
| Modified Thing What Headers Revision
| Deleted Thing WhatWasDeleted Headers Revision
| DittoError Headers ErrorProperties Status
{-| A single constructor union type to encapsulate that a Thing is always
represented by a namespace and an id.
-}
type Thing
= Thing ThingNamespace ThingId
{-| A single constructor union type to encapsulate the namespace of a Thing.
-}
type ThingNamespace
= ThingNamespace String
{-| A single constructor union type to encapsulate the id of a Thing.
-}
type ThingId
= ThingId String
{-| When an attribute or a feature of a thing get created or modified, we have
access to the properties that were created/modified.
-}
type What
= Attribute AttributePath AttributeProperties
| Feature FeaturePath FeatureProperties
{-| When an attribute or a feature of a thing get deleted, we only have access
to the path that was deleted.
-}
type WhatWasDeleted
= AllAttributes
| SingleAttribute AttributePath
| AllFeatures
| SingleFeature FeaturePath
{-| As a simple example, `"path": "/attributes/topLevel"` would convert into
`RootAttribute (AttributeId "topLevel")`.
On the other hand, `"path": "/attributes/someAttribute/deep/deeper"` would
convert into `DeepAttribute (AttributeId "someAttribute") (PropertyPath "deep/deeper")`.
-}
type AttributePath
= RootAttribute AttributeId
| DeepAttribute AttributeId PropertyPath
{-| A single construtor union type, to encapsulate the id of an attribute of a thing.
-}
type AttributeId
= AttributeId String
{-| A single constructor union type, to encapsulate the JSON Value payload of the attribute.
-}
type AttributeProperties
= AttributeProperties Value
{-| A single constructor union type, used together with `DeepAttribute` and `DeepFeature`,
to convey what is the path beyond `/attributes/attributeId/` or `/features/featureId/properties/`.
-}
type PropertyPath
= PropertyPath String
{-| A single constructor union type, to encapsulate the id of a feature of a thing.
-}
type FeatureId
= FeatureId String
{-| A single constructor union type, to encapsulate the JSON Value payload of the feature.
-}
type FeatureProperties
= FeatureProperties Value
{-| As a simple example, `"path": "/features/simpleFeature"` would convert into
`RootFeature (FeatureId "simpleFeature")`.
On the other hand, `"path": "/features/complexFeature/properties/complex-child"` would
convert into `DeepFeature (FeatureId "complexFeature") (PropertyPath "complex-child")`
-}
type FeaturePath
= RootFeature FeatureId
| DeepFeature FeatureId PropertyPath
{-| A single constructor union type to encapsulate the JSON Value payload of the
[headers](https://eclipse.org/ditto/protocol-specification.html#headers) of the message.
-}
type Headers
= Headers Value
{-| A single constructor union type to encapsulate a
[Ditto Revision](https://eclipse.org/ditto/protocol-specification-things.html#api-version-2).
-}
type Revision
= Revision Int
{-| A single construtor union type to encapsulate a
[Ditto Status](https://eclipse.org/ditto/protocol-specification.html#status).
-}
type Status
= Status Int
{-| A single construtor union type to encapsulate the properties of a
[Ditto Error](https://eclipse.org/ditto/docson/index.html#../jsonschema/protocol-error_response.json$$expand).
-}
type ErrorProperties
= ErrorProperties Value
-- PUBLIC FUNCTIONS
{-| The decoder that enables you to go from one single JSON payload into one or more
`DittoMessage`s. Special paths such as `/`, `/attributes`, `/features` can yield more
that one `DittoMessage`.
-}
dittoMessagesDecoder : Decoder (List DittoMessage)
dittoMessagesDecoder =
decodeEventEnvelope
|> andThen parseEnvelope
|> andThen interpretEnvelope
-- PRIVATE TYPES
type PayloadValue
= PayloadValue Value
type Topic
= CreatedEvent Thing
| ModifiedEvent Thing
| DeletedEvent Thing
| Error
type Path
= Root
| FeaturesRoot
| TopLevelFeature FeatureId
| TopLevelFeatureProperties FeatureId
| FeatureProperty FeatureId PropertyPath
| AttributesRoot
| TopLevelAttribute AttributeId
| AttributeProperty AttributeId PropertyPath
type ParsedEventEnvelope
= EventEnvelope Topic Headers Path PayloadValue Revision
| ErrorEnvelope Topic Headers Path PayloadValue Status
type alias RawEventEnvelope =
{ topic : String
, headers : Value
, path : String
, value : Maybe Value
, revision : Maybe Int
, status : Maybe Int
}
-- PRIVATE FUNCTIONS
decodeEventEnvelope : Decoder RawEventEnvelope
decodeEventEnvelope =
Json.Decode.map6
RawEventEnvelope
(field "topic" string)
(field "headers" value)
(field "path" string)
(maybe (field "value" value))
(maybe (field "revision" int))
(maybe (field "status" int))
parseEnvelope : RawEventEnvelope -> Decoder ParsedEventEnvelope
parseEnvelope rawEventEnvelope =
let
topicDecodeResult =
rawEventEnvelope.topic |> topicDecoder
pathDecodeResult =
rawEventEnvelope.path |> pathDecoder
headers =
Headers rawEventEnvelope.headers
payloadValue =
PayloadValue (rawEventEnvelope.value |> Maybe.withDefault Json.Encode.null)
in
Json.Decode.map2
(\topic path ->
case topic of
CreatedEvent thing ->
EventEnvelope topic headers path payloadValue (rawEventEnvelope.revision |> Maybe.withDefault 0 |> Revision)
ModifiedEvent thing ->
EventEnvelope topic headers path payloadValue (rawEventEnvelope.revision |> Maybe.withDefault 0 |> Revision)
DeletedEvent thing ->
EventEnvelope topic headers path payloadValue (rawEventEnvelope.revision |> Maybe.withDefault 0 |> Revision)
Error ->
ErrorEnvelope topic headers path payloadValue (rawEventEnvelope.status |> Maybe.withDefault 0 |> Status)
)
topicDecodeResult
pathDecodeResult
interpretEnvelope : ParsedEventEnvelope -> Decoder (List DittoMessage)
interpretEnvelope envelope =
case envelope of
-- CREATED ROOT
EventEnvelope (CreatedEvent thing) headers Root (PayloadValue payloadValue) revision ->
let
attributesDecodeResult =
payloadValue
|> decodeValue (field "attributes" attributeModificationsDecoder)
|> Result.map
(List.map
(\attributeModification ->
Created thing attributeModification headers revision
)
)
featuresDecodeResult =
payloadValue
|> decodeValue (field "features" (featureModificationsDecoder (field "properties" value)))
|> Result.map
(List.map
(\featureModification ->
Created thing featureModification headers revision
)
)
in
case ( attributesDecodeResult, featuresDecodeResult ) of
( Ok attributeModifications, Ok featureModifications ) ->
succeed <| attributeModifications ++ featureModifications
( Err reason, _ ) ->
fail reason
( _, Err reason ) ->
fail reason
-- CREATED ATTRIBUTES
EventEnvelope (CreatedEvent thing) headers (TopLevelAttribute attributeId) (PayloadValue payloadValue) revision ->
succeed <| [ Created thing (Attribute (RootAttribute attributeId) (AttributeProperties payloadValue)) headers revision ]
EventEnvelope (CreatedEvent thing) headers (AttributeProperty attributeId propertyPath) (PayloadValue payloadValue) revision ->
succeed <| [ Created thing (Attribute (DeepAttribute attributeId propertyPath) (AttributeProperties payloadValue)) headers revision ]
-- CREATED FEATURES
EventEnvelope (CreatedEvent thing) headers FeaturesRoot (PayloadValue payloadValue) revision ->
let
featuresDecodeResult =
payloadValue
|> decodeValue (featureModificationsDecoder (field "properties" value))
|> Result.map
(List.map
(\featureModification ->
Created thing featureModification headers revision
)
)
in
case featuresDecodeResult of
Ok featureCreations ->
succeed <| featureCreations
Err reason ->
fail reason
EventEnvelope (CreatedEvent thing) headers (TopLevelFeature featureId) (PayloadValue payloadValue) revision ->
let
featuresDecodeResult =
payloadValue
|> decodeValue (field "properties" value)
in
case featuresDecodeResult of
Ok featurePayload ->
succeed <| [ Created thing (Feature (RootFeature featureId) (FeatureProperties featurePayload)) headers revision ]
Err reason ->
fail reason
EventEnvelope (CreatedEvent thing) headers (TopLevelFeatureProperties featureId) (PayloadValue payloadValue) revision ->
succeed <| [ Created thing (Feature (RootFeature featureId) (FeatureProperties payloadValue)) headers revision ]
EventEnvelope (CreatedEvent thing) headers (FeatureProperty featureId propertyPath) (PayloadValue payloadValue) revision ->
succeed <| [ Created thing (Feature (DeepFeature featureId propertyPath) (FeatureProperties payloadValue)) headers revision ]
-- MODIFIED ROOT
EventEnvelope (ModifiedEvent thing) headers Root (PayloadValue payloadValue) revision ->
let
attributesDecodeResult =
payloadValue
|> decodeValue (field "attributes" attributeModificationsDecoder)
|> Result.map
(List.map
(\attributeModification ->
Modified thing attributeModification headers revision
)
)
featuresDecodeResult =
payloadValue
|> decodeValue (field "features" (featureModificationsDecoder (field "properties" value)))
|> Result.map
(List.map
(\featureModification ->
Modified thing featureModification headers revision
)
)
in
case ( attributesDecodeResult, featuresDecodeResult ) of
( Ok attributeModifications, Ok featureModifications ) ->
succeed <| attributeModifications ++ featureModifications
( Err reason, _ ) ->
fail reason
( _, Err reason ) ->
fail reason
-- MODIFIED ATTRIBUTES
EventEnvelope (ModifiedEvent thing) headers AttributesRoot (PayloadValue payloadValue) revision ->
let
attributesDecodeResult =
payloadValue
|> decodeValue attributeModificationsDecoder
|> Result.map
(List.map
(\attributeModification ->
Modified thing attributeModification headers revision
)
)
in
case attributesDecodeResult of
Ok attributeModifications ->
succeed <| attributeModifications
Err reason ->
fail reason
EventEnvelope (ModifiedEvent thing) headers (TopLevelAttribute attributeId) (PayloadValue payloadValue) revision ->
succeed <| [ Modified thing (Attribute (RootAttribute attributeId) (AttributeProperties payloadValue)) headers revision ]
EventEnvelope (ModifiedEvent thing) headers (AttributeProperty attributeId propertyPath) (PayloadValue payloadValue) revision ->
succeed <| [ Modified thing (Attribute (DeepAttribute attributeId propertyPath) (AttributeProperties payloadValue)) headers revision ]
-- MODIFIED FEATURES
EventEnvelope (ModifiedEvent thing) headers FeaturesRoot (PayloadValue payloadValue) revision ->
let
featuresDecodeResult =
payloadValue
|> decodeValue (featureModificationsDecoder (field "properties" value))
|> Result.map
(List.map
(\featureModification ->
Modified thing featureModification headers revision
)
)
in
case featuresDecodeResult of
Ok featureModifications ->
succeed <| featureModifications
Err reason ->
fail reason
EventEnvelope (ModifiedEvent thing) headers (TopLevelFeature featureId) (PayloadValue payloadValue) revision ->
let
propertiesFieldDecodeResult =
payloadValue
|> decodeValue (field "properties" value)
in
case propertiesFieldDecodeResult of
Ok featurePayload ->
succeed <| [ Modified thing (Feature (RootFeature featureId) (FeatureProperties featurePayload)) headers revision ]
Err reason ->
fail reason
EventEnvelope (ModifiedEvent thing) headers (TopLevelFeatureProperties featureId) (PayloadValue payloadValue) revision ->
let
propertiesFieldDecodeResult =
payloadValue
|> decodeValue value
in
case propertiesFieldDecodeResult of
Ok featurePayload ->
succeed <| [ Modified thing (Feature (RootFeature featureId) (FeatureProperties featurePayload)) headers revision ]
Err reason ->
fail reason
EventEnvelope (ModifiedEvent thing) headers (FeatureProperty featureId propertyPath) (PayloadValue payloadValue) revision ->
let
propertiesFieldDecodeResult =
payloadValue
|> decodeValue value
in
case propertiesFieldDecodeResult of
Ok featurePayload ->
succeed <| [ Modified thing (Feature (DeepFeature featureId propertyPath) (FeatureProperties featurePayload)) headers revision ]
Err reason ->
fail reason
-- DELETED ATTRIBUTES
EventEnvelope (DeletedEvent thing) headers AttributesRoot _ revision ->
succeed <| [ Deleted thing AllAttributes headers revision ]
EventEnvelope (DeletedEvent thing) headers (TopLevelAttribute attributeId) _ revision ->
succeed <| [ Deleted thing (SingleAttribute (RootAttribute attributeId)) headers revision ]
EventEnvelope (DeletedEvent thing) headers (AttributeProperty attributeId propertyPath) _ revision ->
succeed <| [ Deleted thing (SingleAttribute (DeepAttribute attributeId propertyPath)) headers revision ]
-- DELETED FEATURES
EventEnvelope (DeletedEvent thing) headers FeaturesRoot _ revision ->
succeed <| [ Deleted thing AllFeatures headers revision ]
EventEnvelope (DeletedEvent thing) headers (TopLevelFeature featureId) _ revision ->
succeed <| [ Deleted thing (SingleFeature (RootFeature featureId)) headers revision ]
EventEnvelope (DeletedEvent thing) headers (TopLevelFeatureProperties featureId) _ revision ->
succeed <| [ Deleted thing (SingleFeature (RootFeature featureId)) headers revision ]
EventEnvelope (DeletedEvent thing) headers (FeatureProperty featureId propertyPath) _ revision ->
succeed <| [ Deleted thing (SingleFeature (DeepFeature featureId propertyPath)) headers revision ]
-- ERRORS
ErrorEnvelope Error headers Root (PayloadValue payloadValue) status ->
succeed <| [ DittoError headers (ErrorProperties payloadValue) status ]
other ->
fail <| ("Unknown scenario: " ++ toString other)
topicDecoder : String -> Decoder Topic
topicDecoder topicStr =
case topicStr |> String.split "/" of
[ namespace, thingId, "things", channel, "events", "created" ] ->
succeed <| CreatedEvent (Thing (ThingNamespace namespace) (ThingId thingId))
[ namespace, thingId, "things", channel, "events", "modified" ] ->
succeed <| ModifiedEvent (Thing (ThingNamespace namespace) (ThingId thingId))
[ namespace, thingId, "things", channel, "events", "deleted" ] ->
succeed <| DeletedEvent (Thing (ThingNamespace namespace) (ThingId thingId))
[ "unknown", "unknown", "things", channel, "errors" ] ->
succeed <| Error
other ->
fail <| ("Unable to parse topic [" ++ topicStr ++ "]")
pathDecoder : String -> Decoder Path
pathDecoder pathStr =
case pathStr |> String.dropLeft 1 |> String.split "/" of
[ "" ] ->
succeed <| Root
[ "attributes" ] ->
succeed <| AttributesRoot
[ "attributes", attributeId ] ->
succeed <| TopLevelAttribute (AttributeId attributeId)
"attributes" :: attributeId :: rest ->
succeed <| AttributeProperty (AttributeId attributeId) (PropertyPath (rest |> String.join "/"))
[ "features" ] ->
succeed <| FeaturesRoot
[ "features", featureId ] ->
succeed <| TopLevelFeature (FeatureId featureId)
[ "features", featureId, "properties" ] ->
succeed <| TopLevelFeatureProperties (FeatureId featureId)
"features" :: featureId :: "properties" :: rest ->
succeed <| FeatureProperty (FeatureId featureId) (PropertyPath (rest |> String.join "/"))
other ->
fail ("Unable to parse path [" ++ pathStr ++ "]")
attributeModificationsDecoder : Decoder (List What)
attributeModificationsDecoder =
Json.Decode.dict value
|> andThen (Dict.toList >> List.map toAttributeModified >> succeed)
toAttributeModified : ( String, Value ) -> What
toAttributeModified ( attributeId, attributeProperties ) =
Attribute (RootAttribute (AttributeId attributeId)) (AttributeProperties attributeProperties)
featureModificationsDecoder : Decoder Value -> Decoder (List What)
featureModificationsDecoder payloadValueDecoder =
Json.Decode.dict value
|> andThen (Dict.toList >> succeed)
|> andThen (featuresDecoder payloadValueDecoder >> succeed)
featuresDecoder : Decoder Value -> List ( String, Value ) -> List What
featuresDecoder payloadValueDecoder =
List.filterMap (toFeatureModified payloadValueDecoder)
toFeatureModified : Decoder Value -> ( String, Value ) -> Maybe What
toFeatureModified payloadValueDecoder ( featureId, featurePayload ) =
featurePayload
|> decodeValue (featurePropertiesDecoder payloadValueDecoder)
|> Result.map (\featureProperties -> Feature (RootFeature (FeatureId featureId)) featureProperties)
|> Result.toMaybe
featurePropertiesDecoder : Decoder Value -> Decoder FeatureProperties
featurePropertiesDecoder =
andThen (FeatureProperties >> succeed)