Fail with an error when encountering a 'reflection' key in a JSON/WSP request.
Fixes #217.
Fixes #217.
# Changelog
## [1.3.1] -- 2022-05-21
- `gWSPFromJSON` will now fail with a user-friendly error when encountering a key `reflection` in the body of a **request**. See [#217](https://github.com/CardanoSolutions/ogmios/issues/217)
## [1.3.0] -- 2022-02-15
### Added
-- see: https://github.com/sol/hpack
name: json-wsp
version: 1.3.0
version: 1.3.1
synopsis: An implementation of JSON-WSP in Haskell
description: Please see the README on GitHub at <https://github.com/cardanosolutions/ogmios/tree/master/server/modules/json-wsp>
category: Web
, bytestring
, text
default-language: Haskell2010
test-suite unit
type: exitcode-stdio-1.0
main-is: Spec.hs
other-modules:
Codec.Json.WspSpec
Paths_json_wsp
hs-source-dirs:
test/unit
default-extensions:
BangPatterns
BinaryLiterals
ConstraintKinds
DataKinds
DefaultSignatures
DeriveDataTypeable
DeriveFoldable
DeriveFunctor
DeriveGeneric
DeriveTraversable
EmptyDataDecls
ExistentialQuantification
FlexibleContexts
FlexibleInstances
FunctionalDependencies
GADTs
InstanceSigs
KindSignatures
LambdaCase
MultiParamTypeClasses
MultiWayIf
NamedFieldPuns
NoImplicitPrelude
NumericUnderscores
OverloadedStrings
PartialTypeSignatures
PatternGuards
RankNTypes
ScopedTypeVariables
StandaloneDeriving
TupleSections
TypeFamilies
TypeSynonymInstances
ViewPatterns
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -Wunused-packages -threaded -rtsopts -with-rtsopts=-N
build-tool-depends:
hspec-discover:hspec-discover
build-depends:
aeson
, base >=4.7 && <5
, hspec
, json-wsp
default-language: Haskell2010
_config: !include "../../.hpack.config.yaml"
name: json-wsp
version: 1.3.0
version: 1.3.1
github: "cardanosolutions/ogmios"
license: MPL-2.0
author: "KtorZ <[email protected]>"
- aeson
- bytestring
- text
tests:
unit:
main: Spec.hs
source-dirs: test/unit
ghc-options: *ghc-options-test
dependencies:
- aeson
- hspec
- json-wsp
build-tools:
- hspec-discover
import Control.Arrow
( second )
import Control.Monad
( guard )
( guard, when )
import Data.Aeson
( FromJSON (..), ToJSON (..), (.:), (.:?), (.=) )
import Data.Char
( toLower )
import Data.Kind
( Type )
import Data.Maybe
( isJust )
import Data.Proxy
( Proxy (..) )
import Data.Text
_ <- parseKey obj "version" V1_0
_ <- parseKey obj "methodname" methodName
refl <- obj .:? "mirror"
wrong <- obj .:? "reflection"
when (isJust @(Maybe Json.Value) wrong)
(fail "invalid key 'reflection'; should be 'mirror' on requests.")
(_, f) <- gWSPFromJSON opts value
pure (refl, M1 f)
where
-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at http://mozilla.org/MPL/2.0/.
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeApplications #-}
module Codec.Json.WspSpec
( spec,
)
where
import Prelude
import Data.Aeson
( FromJSON (..), Result (..), ToJSON (..), fromJSON )
import Data.Aeson.QQ.Simple
( aesonQQ )
import GHC.Generics
( Generic )
import Test.Hspec
( Spec, context, shouldBe, specify )
import qualified Codec.Json.Wsp as Wsp
import qualified Codec.Json.Wsp.Handler as Wsp
spec :: Spec
spec = context "gWSPFromJSON" $ do
specify "can parse WSP envelope" $ do
let
json = [aesonQQ|
{ "type": "jsonwsp/request"
, "version": "1.0"
, "servicename": "any"
, "methodname": "Foo"
, "args":
{ "foo": 14
, "bar": true
}
}
|]
in
fromJSON json `shouldBe` Success (Wsp.Request Nothing (Foo 14 True))
specify "can parse WSP envelope with mirror" $ do
let
json = [aesonQQ|
{ "type": "jsonwsp/request"
, "version": "1.0"
, "servicename": "any"
, "methodname": "Foo"
, "args":
{ "foo": 14
, "bar": true
}
, "mirror": "whatever"
}
|]
mirror = Just (toJSON ("whatever" :: String))
in
fromJSON json `shouldBe` Success (Wsp.Request mirror (Foo 14 True))
specify "fails when given a 'reflection' key" $ do
let
json = [aesonQQ|
{ "type": "jsonwsp/request"
, "version": "1.0"
, "servicename": "any"
, "methodname": "Foo"
, "args":
{ "foo": 14
, "bar": true
}
, "reflection": "whatever"
}
|]
in
fromJSON @(Wsp.Request Foo) json `shouldBe` Error "invalid key 'reflection'; should be 'mirror' on requests."
data Foo = Foo
{ foo :: Int
, bar :: Bool
} deriving (Eq, Show, Generic)
instance FromJSON (Wsp.Request Foo) where
parseJSON = Wsp.genericFromJSON Wsp.defaultOptions
-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at http://mozilla.org/MPL/2.0/.
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
resolver: resolver.yaml
compiler: ghc-8.10.4 # Simply for reference, already inferred from the resolver.
compiler: ghc-8.10.7 # Simply for reference, already inferred from the resolver.
packages:
- .
Docs for running SMASH against docker.
Fixup prose in configuration docs.
Co-authored-by: Ubuntu <[email protected]>
Adding Coin
XFAIL on node issue #3859