Skip to content

Commit

Permalink
Fix tests, based on the patch by @ezzieyguywuf in #247 and advice from
Browse files Browse the repository at this point in the history
  • Loading branch information
Mikolaj committed Jan 12, 2022
1 parent eae375f commit cf8f1da
Show file tree
Hide file tree
Showing 2 changed files with 9 additions and 2 deletions.
1 change: 1 addition & 0 deletions hackage-security/hackage-security.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -255,6 +255,7 @@ test-suite TestSuite
bytestring,
network-uri,
tar,
text,
time,
zlib

Expand Down
10 changes: 8 additions & 2 deletions hackage-security/tests/TestSuite/JSON.hs
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,9 @@ import Data.String (fromString)
import qualified Data.Vector as V
import qualified Data.HashMap.Strict as HM

-- text
import qualified Data.Text as Text

prop_aeson_canonical, prop_roundtrip_canonical, prop_roundtrip_pretty, prop_canonical_pretty
:: JSValue -> Bool

Expand All @@ -48,16 +51,19 @@ canonicalise (JSArray vs) = JSArray [ canonicalise v | v <- vs]
canonicalise (JSObject vs) = JSObject [ (k, canonicalise v)
| (k,v) <- sortBy (compare `on` fst) vs ]

sanitizeString :: String -> String
sanitizeString s = Text.unpack (Text.replace (Text.pack "\\") (Text.pack "\\\\") (Text.pack (show s)))

instance Arbitrary JSValue where
arbitrary =
sized $ \sz ->
frequency
[ (1, pure JSNull)
, (1, JSBool <$> arbitrary)
, (2, JSNum <$> arbitrary)
, (2, JSString . getASCIIString <$> arbitrary)
, (2, JSString . sanitizeString . getASCIIString <$> arbitrary)
, (3, JSArray <$> resize (sz `div` 2) arbitrary)
, (3, JSObject . mapFirst getASCIIString . noDupFields <$> resize (sz `div` 2) arbitrary)
, (3, JSObject . mapFirst (sanitizeString . getASCIIString) . noDupFields <$> resize (sz `div` 2) arbitrary)
]
where
noDupFields = nubBy (\(x,_) (y,_) -> x==y)
Expand Down

0 comments on commit cf8f1da

Please sign in to comment.