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 =
+  RpcCall
     { jsonrpc :: T.Text
     , callId :: T.Text
     , method :: T.Text
     , 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 = MakeRpcResponse
+data RpcResponse r =
+  MakeRpcResponse
     { err :: Maybe RpcError
     , respId :: T.Text
     , 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 = RpcError
+data RpcError =
+  RpcError
     { ecode :: Double
     , emessage :: T.Text
-  } deriving (Show, Generic, ToJSON)
+    }
+  deriving (Show, Generic, ToJSON)
 
 instance FromJSON RpcError where
   parseJSON =
@@ -107,26 +113,31 @@ instance FromJSON RpcError where
       m <- obj .: "message"
       pure $ RpcError c m
 
-data Payload r = Payload
+data Payload r =
+  Payload
     { 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 = Block
+data Block =
+  Block
     { height :: 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 = ZcashTx
+data ZcashTx =
+  ZcashTx
     { ztxid :: T.Text
     , zamount :: Double
     , zamountZat :: Integer
@@ -135,7 +146,8 @@ data ZcashTx = ZcashTx
     , zchange :: Bool
     , zconfirmations :: Integer
     , zmemo :: T.Text
-  } deriving (Show, Generic)
+    }
+  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 =
+  AddressGroup
     { agsource :: AddressSource
     , agtransparent :: [ZcashAddress]
     , agsapling :: [ZcashAddress]
     , agunified :: [ZcashAddress]
-  } deriving (Show, Generic)
+    }
+  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 =
+  ZcashAddress
     { source :: AddressSource
     , pool :: [ZcashPool]
     , account :: Maybe Integer
     , addy :: T.Text
-  } deriving (Eq)
+    }
+  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 =
+  Country
     { _id :: String
     , name :: T.Text
     , code :: T.Text
-  } deriving (Eq, Show, Generic, ToJSON)
+    }
+  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 =
+  ZGoPrice
     { _id :: String
     , currency :: T.Text
     , price :: Double
     , timestamp :: UTCTime
-  } deriving (Eq, Show, Generic, ToJSON)
+    }
+  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