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
-    { jsonrpc :: T.Text
+  , callId :: T.Text
-    , callId :: T.Text
+  , method :: T.Text
-    , method :: T.Text
+  , parameters :: [Data.Aeson.Value]
-    , 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
-    { err :: Maybe RpcError
+  , respId :: T.Text
-    , respId :: T.Text
+  , result :: Maybe r
-    , 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
-    { ecode :: Double
+  , emessage :: T.Text
-    , emessage :: T.Text
+  } deriving (Show, Generic, ToJSON)
-    }
-  deriving (Show, Generic, ToJSON)
 
 instance FromJSON RpcError where
   parseJSON =
@@ -113,41 +107,35 @@ instance FromJSON RpcError where
       m <- obj .: "message"
       pure $ RpcError c m
 
-data Payload r =
+data Payload r = Payload
-  Payload
+  { payload :: r
-    { 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
-    { height :: Integer
+  , size :: 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
-    { ztxid :: T.Text
+  , zamount :: Double
-    , zamount :: Double
+  , zamountZat :: Integer
-    , zamountZat :: Integer
+  , zblockheight :: Integer
-    , zblockheight :: Integer
+  , zblocktime :: Integer
-    , zblocktime :: Integer
+  , zchange :: Bool
-    , zchange :: Bool
+  , zconfirmations :: Integer
-    , zconfirmations :: Integer
+  , zmemo :: T.Text
-    , 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
-    { agsource :: AddressSource
+  , agtransparent :: [ZcashAddress]
-    , agtransparent :: [ZcashAddress]
+  , agsapling :: [ZcashAddress]
-    , agsapling :: [ZcashAddress]
+  , agunified :: [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
-    { source :: AddressSource
+  , pool :: [ZcashPool]
-    , pool :: [ZcashPool]
+  , account :: Maybe Integer
-    , account :: Maybe Integer
+  , addy :: T.Text
-    , 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
-    { _id :: String
+  , name :: T.Text
-    , name :: T.Text
+  , code :: 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
-    { _id :: String
+  , currency :: T.Text
-    , currency :: T.Text
+  , price :: Double
-    , price :: Double
+  , timestamp :: UTCTime
-    , 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