Vergara_Tech/zgo-backend
Vergara_Tech/zgo-backend
2
1
Fork 0
Code Issues Pull requests Projects Releases 4 Packages Wiki Activity

Fix issue 56

Browse source
This commit is contained in:
Rene Vergara 2023-08-12 20:41:27 -05:00
parent bacb2369e0
commit eda0f9336c
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
1 changed files with 69 additions and 86 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

85
src/ZGoBackend.hs
View file

@ -72,39 +72,33 @@ import ZcashHaskell.Utils (decodeBech32)
-- Models for API objects -- Models for API objects
-- | A type to model Zcash RPC calls -- | 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 instance ToJSON RpcCall where
toJSON (RpcCall j c m p) = toJSON (RpcCall j c m p) =
object ["jsonrpc" .= j, "id" .= c, "method" .= m, "params" .= p] object ["jsonrpc" .= j, "id" .= c, "method" .= m, "params" .= p]
-- | A type to model the response of the Zcash RPC -- | 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 instance (FromJSON r) => FromJSON (RpcResponse r) where
parseJSON (Object obj) = parseJSON (Object obj) =
MakeRpcResponse <$> obj .: "error" <*> obj .: "id" <*> obj .: "result" MakeRpcResponse <$> obj .: "error" <*> obj .: "id" <*> obj .: "result"
parseJSON _ = mzero 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 instance FromJSON RpcError where
parseJSON = parseJSON =
@ -113,31 +107,26 @@ instance FromJSON RpcError where
m <- obj .: "message" m <- obj .: "message"
pure $ RpcError c m 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 instance (FromJSON r) => FromJSON (Payload r) where
parseJSON (Object obj) = Payload <$> obj .: "payload" parseJSON (Object obj) = Payload <$> obj .: "payload"
parseJSON _ = mzero parseJSON _ = mzero
-- | Type to model a (simplified) block of Zcash blockchain -- | 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 instance FromJSON Block where
parseJSON (Object obj) = Block <$> obj .: "height" <*> obj .: "size" parseJSON (Object obj) = Block <$> obj .: "height" <*> obj .: "size"
parseJSON _ = mzero parseJSON _ = mzero
-- | Type to model a Zcash shielded transaction -- | 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
@ -146,8 +135,7 @@ data ZcashTx =
, zchange :: Bool , zchange :: Bool
, zconfirmations :: Integer , zconfirmations :: Integer
, zmemo :: T.Text , zmemo :: T.Text
} } deriving (Show, Generic)
deriving (Show, Generic)
instance FromJSON ZcashTx where instance FromJSON ZcashTx where
parseJSON = parseJSON =
@ -196,14 +184,12 @@ instance Arbitrary ZcashTx where
ZcashTx a aZ t bh bt c cm <$> arbitrary ZcashTx a aZ t bh bt c cm <$> arbitrary
-- | A type to model an address group -- | 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 instance FromJSON AddressGroup where
parseJSON = parseJSON =
@ -284,14 +270,12 @@ instance FromJSON ZcashPool where
"orchard" -> return Orchard "orchard" -> return Orchard
_ -> fail "Not a known Zcash pool" _ -> 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 instance Show ZcashAddress where
show (ZcashAddress s p i a) = 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 -- Types for the ZGo database documents
-- | Type to model a country for the database's country list -- | 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 :: B.Document -> Maybe Country
parseCountryBson d = do 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 Left e -> print $ "Failed to parse ZGo memo: " ++ show e
-- |Type to model a price in the ZGo database -- |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 :: B.Document -> Maybe ZGoPrice
parseZGoPrice d = do parseZGoPrice d = do
@ -718,9 +698,11 @@ routes pipe config = do
[ "reportType" .= [ "reportType" .=
(7 :: Integer) (7 :: Integer)
, "order" .= , "order" .=
(Nothing :: Maybe ZGoOrder) (Nothing :: Maybe
ZGoOrder)
, "shop" .= , "shop" .=
(Nothing :: Maybe String) (Nothing :: Maybe
String)
]) ])
Just cp -> do Just cp -> do
let newOrder = let newOrder =
@ -790,7 +772,8 @@ routes pipe config = do
[ "reportType" .= [ "reportType" .=
(8 :: Integer) (8 :: Integer)
, "order" .= , "order" .=
(Nothing :: Maybe ZGoOrder) (Nothing :: Maybe
ZGoOrder)
, "shop" .= , "shop" .=
(Nothing :: Maybe String) (Nothing :: Maybe String)
]) ])
@ -960,7 +943,8 @@ routes pipe config = do
where blk3Hash :: String -> String where blk3Hash :: String -> String
blk3Hash s = blk3Hash s =
show 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 get "/woopayment" $ do
oid <- param "ownerid" oid <- param "ownerid"
t <- param "token" t <- param "token"
@ -1303,15 +1287,12 @@ routes pipe config = do
get "/price" $ do get "/price" $ do
curr <- param "currency" curr <- param "currency"
pr <- liftAndCatchIO $ run (findPrice curr) pr <- liftAndCatchIO $ run (findPrice curr)
case pr of case parseZGoPrice =<< pr of
Nothing -> do Nothing -> do
status noContent204 status noContent204
Just p -> do Just p -> do
Web.Scotty.json 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 all closed orders for the address
get "/api/allorders" $ do get "/api/allorders" $ do
session <- param "session" session <- param "session"
@ -1546,7 +1527,8 @@ listTxs user pwd a confs = do
user user
pwd pwd
"z_listreceivedbyaddress" "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 case res of
Right txList -> do Right txList -> do
let content = getResponseBody txList :: RpcResponse [ZcashTx] let content = getResponseBody txList :: RpcResponse [ZcashTx]
@ -1679,7 +1661,8 @@ scanPayments config pipe = do
listAddresses :: BS.ByteString -> BS.ByteString -> IO [ZcashAddress] listAddresses :: BS.ByteString -> BS.ByteString -> IO [ZcashAddress]
listAddresses user pwd = do listAddresses user pwd = do
response <- 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 case response of
Right addrList -> do Right addrList -> do
let rpcResp = getResponseBody addrList let rpcResp = getResponseBody addrList