Skip to content
Permalink
Browse files

Bugfix for JSON-encoding of KnownCurrencies.

We could decode them from the server fine, but not encode them to
something that would _then_ decode. That meant they worked if coming
from the backend, but not if we saved them to a gist. :-o

Fixed now, along with some extra roundtrip-JSON-encoding tests (and a
recipe for writing more).
  • Loading branch information...
krisajenkins committed Apr 15, 2019
1 parent 56a4d1c commit 4db1ad29f1aa3c6c019b671d1affb504f56dd651
@@ -7,12 +7,15 @@ import Control.MonadPlus (empty, (=<<))
import Data.Argonaut.Core (Json)
import Data.Argonaut.Generic.Aeson as Aeson
import Data.Argonaut.Generic.Decode (genericDecodeJson)
import Data.Argonaut.Generic.Encode (genericEncodeJson)
import Data.Argonaut.Generic.Options (Options(..))
import Data.Argonaut.Parser (jsonParser)
import Data.Array (intercalate)
import Data.Array as Array
import Data.Either (Either(Right, Left), note)
import Data.Generic (class Generic, GenericSignature(SigProd), GenericSpine(SProd), fromSpine, isValidSpine, toSignature, toSpine)
import Data.List as List
import Data.List.NonEmpty (NonEmptyList)
import Data.List.NonEmpty as NonEmpty
import Data.Maybe (Maybe(..), fromMaybe)
import Gist (GistId)
@@ -31,6 +34,7 @@ ajaxSettings :: SPSettings_ SPParams_
ajaxSettings = SPSettings_ $ settings
{ toURLPiece = SPSettingsToUrlPiece_ gCustomToURLPiece
, decodeJson = SPSettingsDecodeJson_ (genericDecodeJson $ Options $ options {userDecoding = userDecoding})
, encodeJson = SPSettingsEncodeJson_ (genericEncodeJson $ Options $ options {userEncoding = userEncoding})
}
where
SPSettings_ settings = defaultSettings $ SPParams_ { baseURL: "/api/" }
@@ -73,6 +77,19 @@ decodeTokenIdLists opts (SigProd "Data.List.Types.NonEmptyList" [{sigValues: [l]
_ -> empty
decodeTokenIdLists _ _ _ = Nothing

userEncoding :: Options -> GenericSignature -> GenericSpine -> Maybe Json
userEncoding opts sig spine =
encodeTokenIdLists opts sig spine
<|>
Aeson.userEncoding opts sig spine

encodeTokenIdLists :: Options -> GenericSignature -> GenericSpine -> Maybe Json
encodeTokenIdLists opts sig@(SigProd "Data.List.Types.NonEmptyList" [{sigValues: [l]}]) spine =
case fromSpine spine of
Nothing -> Nothing
Just (xs :: NonEmptyList TokenId) -> Just $ encodeJson $ Array.fromFoldable xs
encodeTokenIdLists _ _ _ = Nothing

-- | Generally we want the default parameter encoding behaviour. But
-- sometimes we need to do something special.
gCustomToURLPiece :: forall a. Generic a => a -> URLPiece
@@ -80,14 +80,13 @@ instance atLedgerMap :: Eq k => At (LedgerMap k a) k a where
matching tuple = fst tuple == key
get (LedgerMap xs) = map snd $ Array.find matching xs
set (LedgerMap xs) Nothing = LedgerMap $ Array.filter (not matching) xs
set (LedgerMap []) (Just new) = LedgerMap [ Tuple key new ]
set (LedgerMap xs) (Just new) =
set (LedgerMap xs) (Just new) = LedgerMap $
case Array.findIndex matching xs of
Nothing -> LedgerMap $ Array.snoc xs (Tuple key new)
_ -> LedgerMap $ map (\(Tuple k v) ->
Tuple k (if k == key
then new
else v)) xs
Nothing -> Array.snoc xs (Tuple key new)
_ -> map (\(Tuple k v) ->
Tuple k (if k == key
then new
else v)) xs

collapse ::
forall m n i j a.
@@ -5,29 +5,37 @@ module AjaxUtilsTests
import Prelude

import AjaxUtils (decodeJson, encodeJson)
import AjaxUtils as AjaxUtils
import Control.Monad.Eff.Exception (EXCEPTION)
import Control.Monad.Eff.Random (RANDOM)
import Data.Argonaut.Core as Argonaut
import Data.Either (Either(..))
import Data.Generic (class Generic, gShow)
import Data.List (List)
import Data.List as List
import Data.List.NonEmpty (NonEmptyList(..))
import Data.List.Types (NonEmptyList)
import Data.NonEmpty ((:|))
import Data.Tuple (Tuple(..))
import Language.Haskell.Interpreter (CompilationError, InterpreterError, InterpreterResult)
import Ledger.Extra (LedgerMap(..))
import Ledger.Value.TH (CurrencySymbol(..), TokenName(..), Value(..))
import Node.FS (FS)
import Playground.API (CompilationResult, EvaluationResult, KnownCurrency, TokenId)
import Playground.API (CompilationResult, EvaluationResult, KnownCurrency(..), TokenId(..))
import Test.QuickCheck (arbitrary, withHelp)
import Test.QuickCheck.Gen (Gen, chooseInt, vectorOf)
import Test.Unit (TestSuite, suite, test)
import Test.Unit.QuickCheck (quickCheck)
import TestUtils (assertDecodesTo, assertEncodesTo, equalGShow)
import Type.Proxy (Proxy(..))

all :: forall eff. TestSuite (exception :: EXCEPTION, fs :: FS, random :: RANDOM | eff)
all =
suite "AjaxUtils" do
jsonHandling
jsonHandlingTests

jsonHandling :: forall eff. TestSuite (exception :: EXCEPTION, fs :: FS, random :: RANDOM | eff)
jsonHandling = do
jsonHandlingTests :: forall eff. TestSuite (exception :: EXCEPTION, fs :: FS, random :: RANDOM | eff)
jsonHandlingTests = do
suite "Json handling" do
test "Decode a List." do
assertDecodesTo
@@ -71,3 +79,62 @@ jsonHandling = do
assertEncodesTo
aValue
"test/value1.json"
suite "Roundtrips" do
testRoundTrip "CurrencySymbol" arbitraryCurrencySymbol
testRoundTrip "TokenId" arbitraryTokenId
testRoundTrip "TokenName" arbitraryTokenName
testRoundTrip "Value" arbitraryValue
testRoundTrip "KnownCurrency" arbitraryKnownCurrency

testRoundTrip ::
forall eff a.
Eq a =>
Generic a =>
String ->
Gen a ->
TestSuite (random :: RANDOM | eff)
testRoundTrip title gen = do
test title do
quickCheck do
value <- gen
let expect = Right value
let actual = AjaxUtils.decodeJson (AjaxUtils.encodeJson value)
pure $ withHelp (expect == actual) $ "Expected: " <> gShow expect <> "Got: " <> gShow actual

arbitraryCurrencySymbol :: Gen CurrencySymbol
arbitraryCurrencySymbol = do
str <- arbitrary
pure $ CurrencySymbol { unCurrencySymbol: str }

arbitraryTokenId :: Gen TokenId
arbitraryTokenId = TokenId <$> arbitrary

arbitraryTokenName :: Gen TokenName
arbitraryTokenName = do
str <- arbitrary
pure $ TokenName { unTokenName: str }

arbitraryLedgerMap :: forall k v. Gen k -> Gen v -> Gen (LedgerMap k v)
arbitraryLedgerMap genK genV = do
n <- chooseInt 0 5
xs <- vectorOf n (Tuple <$> genK <*> genV)
pure $ LedgerMap xs

arbitraryValue :: Gen Value
arbitraryValue = do
ledgerMap <- arbitraryLedgerMap arbitraryCurrencySymbol (arbitraryLedgerMap arbitraryTokenName arbitrary)
pure $ Value { getValue: ledgerMap }

arbitraryKnownCurrency :: Gen KnownCurrency
arbitraryKnownCurrency = do
hash <- arbitrary
friendlyName <- arbitrary
knownTokens <- arbitraryNonEmptyList arbitraryTokenId
pure $ KnownCurrency { hash, friendlyName, knownTokens }

arbitraryNonEmptyList :: forall a. Gen a -> Gen (NonEmptyList a)
arbitraryNonEmptyList genX = do
n <- chooseInt 0 5
x <- genX
xs <- List.fromFoldable <$> vectorOf n genX
pure $ NonEmptyList $ x :| xs
@@ -211,6 +211,10 @@ evalTests =
steps

assert "Gist gets loaded." $ isSuccess (view _createGistResult finalState)
equal'
"Simulations gets loaded."
1
(Cursor.length (view _simulations finalState))
let sourceFile = unsafePartial $ fromJust $ Array.head (unwrap gist)._gistFiles >>= (unwrap >>> _._gistFileContent)
equal' "Editor gets update."
(Just sourceFile)
Oops, something went wrong.

0 comments on commit 4db1ad2

Please sign in to comment.
You can’t perform that action at this time.