Fix issue 56
This commit is contained in:
parent
bacb2369e0
commit
eda0f9336c
GPG key ID:
65122AD495A7F5B2
1 changed files with 69 additions and 86 deletions
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue