From f2f06e2e763cb735f2e891c23252b766bfdef569 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Mon, 20 Aug 2012 13:53:09 +0200
Subject: [PATCH] Handle better 'null' values in optional fields
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

While testing Haskell⇔Python interoperability for opcode
serialisation, I found this bug: the Haskell code doesn't treat
optional fields with 'null' values as missing, which the Python code
does, leading to differences.

Investigating all uses of 'maybeFromObj' and the single use of
'fromObjWithDefault' shows that these are only used in cases where we
the rules are indeed "null == missing", so let's update the functions
and their docstrings accordingly.

Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Agata Murawska <agatamurawska@google.com>
---
 htools/Ganeti/HTools/JSON.hs | 15 +++++++++++++--
 1 file changed, 13 insertions(+), 2 deletions(-)

diff --git a/htools/Ganeti/HTools/JSON.hs b/htools/Ganeti/HTools/JSON.hs
index b2f40fb45..2667f80a3 100644
--- a/htools/Ganeti/HTools/JSON.hs
+++ b/htools/Ganeti/HTools/JSON.hs
@@ -84,15 +84,26 @@ fromObj o k =
                k (show (map fst o))
     Just val -> fromKeyValue k val
 
--- | Reads the value of an optional key in a JSON object.
+-- | Reads the value of an optional key in a JSON object. Missing
+-- keys, or keys that have a \'null\' value, will be returned as
+-- 'Nothing', otherwise we attempt deserialisation and return a 'Just'
+-- value.
 maybeFromObj :: (J.JSON a, Monad m) =>
                 JSRecord -> String -> m (Maybe a)
 maybeFromObj o k =
   case lookup k o of
     Nothing -> return Nothing
+    -- a optional key with value JSNull is the same as missing, since
+    -- we can't convert it meaningfully anyway to a Haskell type, and
+    -- the Python code can emit 'null' for optional values (depending
+    -- on usage), and finally our encoding rules treat 'null' values
+    -- as 'missing'
+    Just J.JSNull -> return Nothing
     Just val -> liftM Just (fromKeyValue k val)
 
--- | Reads the value of a key in a JSON object with a default if missing.
+-- | Reads the value of a key in a JSON object with a default if
+-- missing. Note that both missing keys and keys with value \'null\'
+-- will case the default value to be returned.
 fromObjWithDefault :: (J.JSON a, Monad m) =>
                       JSRecord -> String -> a -> m a
 fromObjWithDefault o k d = liftM (fromMaybe d) $ maybeFromObj o k
-- 
GitLab