Skip to content

Commit

Permalink
Merge pull request #142 from hvr/pr/canonical-json
Browse files Browse the repository at this point in the history
Fix 'JSNum' to 'Int32' and document idiosyncracies
  • Loading branch information
edsko committed Jan 6, 2016
2 parents 6191b90 + 867f2e5 commit 9d8a3ce
Show file tree
Hide file tree
Showing 2 changed files with 27 additions and 5 deletions.
5 changes: 3 additions & 2 deletions hackage-security/src/Hackage/Security/Util/JSON.hs
Original file line number Diff line number Diff line change
Expand Up @@ -110,10 +110,11 @@ instance ReportSchemaErrors m => FromJSON m String where
fromJSON val = expected' "string" val

instance Monad m => ToJSON m Int where
toJSON = return . JSNum
-- TODO: runtime-check that 'Int' fits into 'Int32'
toJSON = return . JSNum . fromIntegral

instance ReportSchemaErrors m => FromJSON m Int where
fromJSON (JSNum i) = return i
fromJSON (JSNum i) = return (fromIntegral i)
fromJSON val = expected' "int" val

instance
Expand Down
27 changes: 24 additions & 3 deletions hackage-security/src/Text/JSON/Canonical.hs
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,10 @@
-- This implementation is derived from the json parser from the json package,
-- with simplifications to meet the Canonical JSON grammar.
--

-- Known bugs/limitations:
--
-- * Decoding/encoding Unicode code-points beyond @U+00ff@ is currently broken
--
module Text.JSON.Canonical
( JSValue(..)
, parseCanonicalJSON
Expand All @@ -31,20 +34,38 @@ import Text.ParserCombinators.Parsec
import Data.Char (isDigit, digitToInt)
import Data.List (foldl', sortBy)
import Data.Function (on)
import Data.Int (Int32)
import qualified Data.ByteString.Lazy.Char8 as BS


data JSValue
= JSNull
| JSBool !Bool
| JSNum !Int
| JSNum !Int32
| JSString String
| JSArray [JSValue]
| JSObject [(String, JSValue)]
deriving (Show, Read, Eq, Ord)

------------------------------------------------------------------------------

-- | Encode as \"Canonical\" JSON.
--
-- NB: Canonical JSON's string escaping rules deviate from RFC 7159
-- JSON which requires
--
-- "All Unicode characters may be placed within the quotation
-- marks, except for the characters that must be escaped: quotation
-- mark, reverse solidus, and the control characters (@U+0000@
-- through @U+001F@)."
--
-- Whereas the current specification of Canonical JSON explicitly
-- requires to violate this by only escaping the quotation mark and
-- the reverse solidus. This, however, contradicts Canonical JSON's
-- statement that "Canonical JSON is parsable with any full JSON
-- parser"
--
-- Consequently, Canonical JSON is not a proper subset of RFC 7159.
renderCanonicalJSON :: JSValue -> BS.ByteString
renderCanonicalJSON v = BS.pack (s_value v [])

Expand Down Expand Up @@ -111,7 +132,7 @@ p_jvalue = (JSNull <$ p_null)
<|> (JSArray <$> p_array)
<|> (JSString <$> p_string)
<|> (JSObject <$> p_object)
<|> (JSNum <$> p_number)
<|> (JSNum . fromIntegral <$> p_number)
<?> "JSON value"

p_null :: CharParser () ()
Expand Down

0 comments on commit 9d8a3ce

Please sign in to comment.