From 3e147c0c92573dd3bbc4c9ce37d918a5df9c2e34 Mon Sep 17 00:00:00 2001
From: rnhmjoj <micheleguerinirocco@me.com>
Date: Sun, 14 May 2017 05:53:04 +0200
Subject: [PATCH] fix JSON error handling

---
 Main.hs | 27 ++++++++++++++-------------
 1 file changed, 14 insertions(+), 13 deletions(-)

diff --git a/Main.hs b/Main.hs
index ac03c39..96cb9ed 100644
--- a/Main.hs
+++ b/Main.hs
@@ -75,13 +75,13 @@ data RPCRequest = RPCRequest
 -- | JSON-RPC 1.0 response record
 data RPCResponse = RPCResponse
   { id      :: String          -- ^ the same identificative string 
-  , result  :: Maybe RPCResult -- ^ result if the method call succeded
+  , result  :: Value           -- ^ result if the method call succeded
   , error   :: Maybe RPCError  -- ^ error in case the method call failed
   }
 
 -- | Namecoin API error record
 data RPCError = RPCError
-  { code    :: String  -- ^ a number indicating the kind of error
+  { code    :: Int     -- ^ a number indicating the kind of error
   , message :: String  -- ^ a detailed explanation of the error
   }
 
@@ -90,37 +90,34 @@ data Name = Name
   { name       :: String -- ^ the namecoin name
   , value      :: String -- ^ its value
   , expires_in :: Int    -- ^ number of blocks before the name expires
-  }
-
--- | Namecoin API result type
-type RPCResult = [Name]
+  } deriving (Show)
 
 deriveJSON defaultOptions ''RPCRequest
 deriveJSON defaultOptions ''RPCResponse
 deriveJSON defaultOptions ''RPCError
 deriveJSON defaultOptions ''Name
 
+-- | Turn an Aeson AST object into a 'fromJSON' type
+decodeValue :: FromJSON a => Value -> Error a
+decodeValue = eitherDecode . encode
+
 -- | Execute an RPC method
 rpcRequest
   :: String               -- ^ the URI of the JSON-RPC endpoint
   -> String               -- ^ the method name
   -> [String]             -- ^ the method parameters
-  -> IO (Error RPCResult) -- ^ and error or the wanted result
+  -> IO (Error Value)     -- ^ and error or the wanted result
 rpcRequest uri method params = do
   req <- try (view responseBody <$> (asJSON =<< postWith options uri req))
   return $ case req of
     Left  err -> Left ("RPC error: "++show (err :: SomeException))
     Right res -> case (error res) of
-      Nothing  -> Right (fromJust $ result res)
-      Just err -> Left  ("API error "++code err++": "++message err)
+      Nothing  -> Right (result res)
+      Just err -> Left  ("API error "++show (code err)++": "++message err)
   where
     req = toJSON (RPCRequest "namecoin-update" method params)
     options = set checkResponse (Just $ \_ _ -> return ()) defaults
 
--- | Return the list of currently registered names
-nameList :: String -> IO (Error [Name])
-nameList uri = rpcRequest uri "name_list" []
-
 
 -- * Expiration checking
 
@@ -128,6 +125,10 @@ nameList uri = rpcRequest uri "name_list" []
 isExpiring :: Name -> Bool
 isExpiring name = expires_in name < 100
 
+-- | Return the list of currently registered names
+nameList :: String -> IO (Error [Name])
+nameList uri = fmap (decodeValue =<<) (rpcRequest uri "name_list" [])
+
 -- | Issue an udpate for a name (confirming its current value)
 nameUpdate :: String -> Name -> IO Int
 nameUpdate uri (Name {..}) = do