From 867f2e5dcf8519be1f10e553304baf46c7e0bf11 Mon Sep 17 00:00:00 2001
From: Herbert Valerio Riedel <hvr@gnu.org>
Date: Wed, 6 Jan 2016 12:12:29 +0100
Subject: [PATCH] Fix 'JSNum' to 'Int32' and document idiosyncracies

---
 .../src/Hackage/Security/Util/JSON.hs         |  5 ++--
 hackage-security/src/Text/JSON/Canonical.hs   | 27 ++++++++++++++++---
 2 files changed, 27 insertions(+), 5 deletions(-)

diff --git a/hackage-security/src/Hackage/Security/Util/JSON.hs b/hackage-security/src/Hackage/Security/Util/JSON.hs
index 950324ce..84f4752d 100644
--- a/hackage-security/src/Hackage/Security/Util/JSON.hs
+++ b/hackage-security/src/Hackage/Security/Util/JSON.hs
@@ -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
diff --git a/hackage-security/src/Text/JSON/Canonical.hs b/hackage-security/src/Text/JSON/Canonical.hs
index f764bdfb..ee220f5c 100644
--- a/hackage-security/src/Text/JSON/Canonical.hs
+++ b/hackage-security/src/Text/JSON/Canonical.hs
@@ -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
@@ -31,13 +34,14 @@ 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)]
@@ -45,6 +49,23 @@ data JSValue
 
 ------------------------------------------------------------------------------
 
+-- | 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 [])
 
@@ -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 () ()