src/ZGoBackend.hs

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