From eda0f9336c64ef34334ef56c2a2e07b992b50e73 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Sat, 12 Aug 2023 20:41:27 -0500 Subject: [PATCH] Fix issue 56 --- src/ZGoBackend.hs | 155 +++++++++++++++++++++------------------------- 1 file changed, 69 insertions(+), 86 deletions(-) diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs index c67fe69..85d1ac8 100644 --- a/src/ZGoBackend.hs +++ b/src/ZGoBackend.hs @@ -72,39 +72,33 @@ import ZcashHaskell.Utils (decodeBech32) -- Models for API objects -- | A type to model Zcash RPC calls -data RpcCall = - RpcCall - { jsonrpc :: T.Text - , callId :: T.Text - , method :: T.Text - , parameters :: [Data.Aeson.Value] - } - deriving (Show, Generic) +data RpcCall = RpcCall + { jsonrpc :: T.Text + , callId :: T.Text + , method :: T.Text + , parameters :: [Data.Aeson.Value] + } 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 = - MakeRpcResponse - { err :: Maybe RpcError - , respId :: T.Text - , result :: Maybe r - } - deriving (Show, Generic, ToJSON) +data RpcResponse r = MakeRpcResponse + { err :: Maybe RpcError + , respId :: T.Text + , result :: Maybe r + } 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 = - RpcError - { ecode :: Double - , emessage :: T.Text - } - deriving (Show, Generic, ToJSON) +data RpcError = RpcError + { ecode :: Double + , emessage :: T.Text + } 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 = - Payload - { payload :: r - } - deriving (Show, Generic, ToJSON) +data Payload r = Payload + { payload :: r + } 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 = - Block - { height :: Integer - , size :: Integer - } - deriving (Show, Generic, ToJSON) +data Block = Block + { height :: Integer + , size :: Integer + } 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 = - ZcashTx - { ztxid :: T.Text - , zamount :: Double - , zamountZat :: Integer - , zblockheight :: Integer - , zblocktime :: Integer - , zchange :: Bool - , zconfirmations :: Integer - , zmemo :: T.Text - } - deriving (Show, Generic) +data ZcashTx = ZcashTx + { ztxid :: T.Text + , zamount :: Double + , zamountZat :: Integer + , zblockheight :: Integer + , zblocktime :: Integer + , zchange :: Bool + , zconfirmations :: Integer + , zmemo :: T.Text + } 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 = - AddressGroup - { agsource :: AddressSource - , agtransparent :: [ZcashAddress] - , agsapling :: [ZcashAddress] - , agunified :: [ZcashAddress] - } - deriving (Show, Generic) +data AddressGroup = AddressGroup + { agsource :: AddressSource + , agtransparent :: [ZcashAddress] + , agsapling :: [ZcashAddress] + , agunified :: [ZcashAddress] + } 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 = - ZcashAddress - { source :: AddressSource - , pool :: [ZcashPool] - , account :: Maybe Integer - , addy :: T.Text - } - deriving (Eq) +data ZcashAddress = ZcashAddress + { source :: AddressSource + , pool :: [ZcashPool] + , account :: Maybe Integer + , addy :: T.Text + } 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 = - Country - { _id :: String - , name :: T.Text - , code :: T.Text - } - deriving (Eq, Show, Generic, ToJSON) +data Country = Country + { _id :: String + , name :: T.Text + , code :: T.Text + } 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 = - ZGoPrice - { _id :: String - , currency :: T.Text - , price :: Double - , timestamp :: UTCTime - } - deriving (Eq, Show, Generic, ToJSON) +data ZGoPrice = ZGoPrice + { _id :: String + , currency :: T.Text + , price :: Double + , timestamp :: UTCTime + } 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 - [ "message" .= ("Price found!" :: String) - , "price" .= toJSON (parseZGoPrice p) - ]) + (object ["message" .= ("Price found!" :: String), "price" .= toJSON 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