Merge branch 'fix0056' into dev18

src/ZGoBackend.hs

@@ -72,39 +72,33 @@ import ZcashHaskell.Utils (decodeBech32)
 
 -- Models for API objects
 -- | A type to model Zcash RPC calls
-data RpcCall =
+data RpcCall = RpcCall
-  RpcCall
   { jsonrpc :: T.Text
   , callId :: T.Text
   , method :: T.Text
   , parameters :: [Data.Aeson.Value]
-    }
+  } deriving (Show, Generic)
-  deriving (Show, Generic)
 
 instance ToJSON RpcCall where
   toJSON (RpcCall j c m p) =
     object ["jsonrpc" .= j, "id" .= c, "method" .= m, "params" .= p]
 
 -- | A type to model the response of the Zcash RPC
-data RpcResponse r =
+data RpcResponse r = MakeRpcResponse
-  MakeRpcResponse
   { err :: Maybe RpcError
   , respId :: T.Text
   , result :: Maybe r
-    }
+  } deriving (Show, Generic, ToJSON)
-  deriving (Show, Generic, ToJSON)
 
 instance (FromJSON r) => FromJSON (RpcResponse r) where
   parseJSON (Object obj) =
     MakeRpcResponse <$> obj .: "error" <*> obj .: "id" <*> obj .: "result"
   parseJSON _ = mzero
 
-data RpcError =
+data RpcError = RpcError
-  RpcError
   { ecode :: Double
   , emessage :: T.Text
-    }
+  } deriving (Show, Generic, ToJSON)
-  deriving (Show, Generic, ToJSON)
 
 instance FromJSON RpcError where
   parseJSON =
@@ -113,31 +107,26 @@ instance FromJSON RpcError where
       m <- obj .: "message"
       pure $ RpcError c m
 
-data Payload r =
+data Payload r = Payload
-  Payload
   { payload :: r
-    }
+  } deriving (Show, Generic, ToJSON)
-  deriving (Show, Generic, ToJSON)
 
 instance (FromJSON r) => FromJSON (Payload r) where
   parseJSON (Object obj) = Payload <$> obj .: "payload"
   parseJSON _ = mzero
 
 -- | Type to model a (simplified) block of Zcash blockchain
-data Block =
+data Block = Block
-  Block
   { height :: Integer
   , size :: Integer
-    }
+  } deriving (Show, Generic, ToJSON)
-  deriving (Show, Generic, ToJSON)
 
 instance FromJSON Block where
   parseJSON (Object obj) = Block <$> obj .: "height" <*> obj .: "size"
   parseJSON _ = mzero
 
 -- | Type to model a Zcash shielded transaction
-data ZcashTx =
+data ZcashTx = ZcashTx
-  ZcashTx
   { ztxid :: T.Text
   , zamount :: Double
   , zamountZat :: Integer
@@ -146,8 +135,7 @@ data ZcashTx =
   , zchange :: Bool
   , zconfirmations :: Integer
   , zmemo :: T.Text
-    }
+  } deriving (Show, Generic)
-  deriving (Show, Generic)
 
 instance FromJSON ZcashTx where
   parseJSON =
@@ -196,14 +184,12 @@ instance Arbitrary ZcashTx where
     ZcashTx a aZ t bh bt c cm <$> arbitrary
 
 -- | A type to model an address group
-data AddressGroup =
+data AddressGroup = AddressGroup
-  AddressGroup
   { agsource :: AddressSource
   , agtransparent :: [ZcashAddress]
   , agsapling :: [ZcashAddress]
   , agunified :: [ZcashAddress]
-    }
+  } deriving (Show, Generic)
-  deriving (Show, Generic)
 
 instance FromJSON AddressGroup where
   parseJSON =
@@ -284,14 +270,12 @@ instance FromJSON ZcashPool where
       "orchard" -> return Orchard
       _ -> fail "Not a known Zcash pool"
 
-data ZcashAddress =
+data ZcashAddress = ZcashAddress
-  ZcashAddress
   { source :: AddressSource
   , pool :: [ZcashPool]
   , account :: Maybe Integer
   , addy :: T.Text
-    }
+  } deriving (Eq)
-  deriving (Eq)
 
 instance Show ZcashAddress where
   show (ZcashAddress s p i a) =
@@ -315,13 +299,11 @@ encodeHexText t = T.unpack . toText . fromBytes $ E.encodeUtf8 t
 
 -- Types for the ZGo database documents
 -- | Type to model a country for the database's country list
-data Country =
+data Country = Country
-  Country
   { _id :: String
   , name :: T.Text
   , code :: T.Text
-    }
+  } deriving (Eq, Show, Generic, ToJSON)
-  deriving (Eq, Show, Generic, ToJSON)
 
 parseCountryBson :: B.Document -> Maybe Country
 parseCountryBson d = do
@@ -385,14 +367,12 @@ zToZGoTx' config pipe (ZcashTx t a aZ bh bt c conf m) = do
       Left e -> print $ "Failed to parse ZGo memo: " ++ show e
 
 -- |Type to model a price in the ZGo database
-data ZGoPrice =
+data ZGoPrice = ZGoPrice
-  ZGoPrice
   { _id :: String
   , currency :: T.Text
   , price :: Double
   , timestamp :: UTCTime
-    }
+  } deriving (Eq, Show, Generic, ToJSON)
-  deriving (Eq, Show, Generic, ToJSON)
 
 parseZGoPrice :: B.Document -> Maybe ZGoPrice
 parseZGoPrice d = do
@@ -718,9 +698,11 @@ routes pipe config = do
                                                           [ "reportType" .=
                                                             (7 :: Integer)
                                                           , "order" .=
-                                                            (Nothing :: Maybe ZGoOrder)
+                                                            (Nothing :: Maybe
+                                                               ZGoOrder)
                                                           , "shop" .=
-                                                            (Nothing :: Maybe String)
+                                                            (Nothing :: Maybe
+                                                               String)
                                                           ])
                                                    Just cp -> do
                                                      let newOrder =
@@ -790,7 +772,8 @@ routes pipe config = do
                                                       [ "reportType" .=
                                                         (8 :: Integer)
                                                       , "order" .=
-                                                        (Nothing :: Maybe ZGoOrder)
+                                                        (Nothing :: Maybe
+                                                           ZGoOrder)
                                                       , "shop" .=
                                                         (Nothing :: Maybe String)
                                                       ])
@@ -960,7 +943,8 @@ routes pipe config = do
         where blk3Hash :: String -> String
               blk3Hash s =
                 show
-                  (BLK.hash [BA.pack . BS.unpack . C.pack $ s :: BA.Bytes] :: BLK.Digest BLK.DEFAULT_DIGEST_LEN)
+                  (BLK.hash [BA.pack . BS.unpack . C.pack $ s :: BA.Bytes] :: BLK.Digest
+                     BLK.DEFAULT_DIGEST_LEN)
   get "/woopayment" $ do
     oid <- param "ownerid"
     t <- param "token"
@@ -1303,15 +1287,12 @@ routes pipe config = do
   get "/price" $ do
     curr <- param "currency"
     pr <- liftAndCatchIO $ run (findPrice curr)
-    case pr of
+    case parseZGoPrice =<< pr of
       Nothing -> do
         status noContent204
       Just p -> do
         Web.Scotty.json
-          (object
+          (object ["message" .= ("Price found!" :: String), "price" .= toJSON p])
-             [ "message" .= ("Price found!" :: String)
-             , "price" .= toJSON (parseZGoPrice p)
-             ])
     --Get all closed orders for the address
   get "/api/allorders" $ do
     session <- param "session"
@@ -1546,7 +1527,8 @@ listTxs user pwd a confs = do
       user
       pwd
       "z_listreceivedbyaddress"
-      [Data.Aeson.String a, Data.Aeson.Number $ Scientific.scientific confs 0] :: IO (Either HttpException (Response (RpcResponse [ZcashTx])))
+      [Data.Aeson.String a, Data.Aeson.Number $ Scientific.scientific confs 0] :: IO
+      (Either HttpException (Response (RpcResponse [ZcashTx])))
   case res of
     Right txList -> do
       let content = getResponseBody txList :: RpcResponse [ZcashTx]
@@ -1679,7 +1661,8 @@ scanPayments config pipe = do
 listAddresses :: BS.ByteString -> BS.ByteString -> IO [ZcashAddress]
 listAddresses user pwd = do
   response <-
-    try $ makeZcashCall user pwd "listaddresses" [] :: IO (Either HttpException (Response (RpcResponse [AddressGroup])))
+    try $ makeZcashCall user pwd "listaddresses" [] :: IO
+      (Either HttpException (Response (RpcResponse [AddressGroup])))
   case response of
     Right addrList -> do
       let rpcResp = getResponseBody addrList