diff --git a/LICENSE b/LICENSE index 2caba40..099f1aa 100644 --- a/LICENSE +++ b/LICENSE @@ -1,23 +1,178 @@ -[The MIT License (MIT)][] +Copyright (c) 2022 Vergara Technologies -Copyright (c) 2022 Rene Vergara +======================================================= +Bootstrap Open Source Licence ("BOSL") v. 1.0 +======================================================= +This Bootstrap Open Source Licence (the "License") applies to any original work +of authorship (the "Original Work") whose owner (the "Licensor") has placed the +following licensing notice adjacent to the copyright notice for the Original +Work: -Permission is hereby granted, free of charge, to any person obtaining a copy of -this software and associated documentation files (the "Software"), to deal in -the Software without restriction, including without limitation the rights to -use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies -of the Software, and to permit persons to whom the Software is furnished to do -so, subject to the following conditions: +*Licensed under the Bootstrap Open Source Licence version 1.0* -The above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. +1. **Grant of Copyright License.** Licensor grants You a worldwide, + royalty-free, non-exclusive, sublicensable license, for the duration of the + copyright in the Original Work, to do the following: -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. + a. to reproduce the Original Work in copies, either alone or as part of + a collective work; -[The MIT License (MIT)]: https://opensource.org/licenses/MIT + b. to translate, adapt, alter, transform, modify, or arrange the + Original Work, thereby creating derivative works ("Derivative Works") + based upon the Original Work; + + c. to distribute or communicate copies of the Original Work and + Derivative Works to the public, provided that prior to any such + distribution or communication You first place a machine-readable copy + of the Source Code of the Original Work and such Derivative Works that + You intend to distribute or communicate in an information repository + reasonably calculated to permit inexpensive and convenient access + thereto by the public (“Information Repository”) for as long as You + continue to distribute or communicate said copies, accompanied by an + irrevocable offer to license said copies to the public free of charge + under this License, said offer valid starting no later than 12 months + after You first distribute or communicate said copies; + + d. to perform the Original Work publicly; and + + e. to display the Original Work publicly. + +2. **Grant of Patent License.** Licensor grants You a worldwide, royalty-free, +non-exclusive, sublicensable license, under patent claims owned or controlled +by the Licensor that are embodied in the Original Work as furnished by the +Licensor, for the duration of the patents, to make, use, sell, offer for sale, +have made, and import the Original Work and Derivative Works. + +3. **Grant of Source Code License.** The "Source Code" for a work means the +preferred form of the work for making modifications to it and all available +documentation describing how to modify the work. Licensor agrees to provide a +machine-readable copy of the Source Code of the Original Work along with each +copy of the Original Work that Licensor distributes. Licensor reserves the +right to satisfy this obligation by placing a machine-readable copy of said +Source Code in an Information Repository for as long as Licensor continues to +distribute the Original Work. + +4. **Exclusions From License Grant.** Neither the names of Licensor, nor the +names of any contributors to the Original Work, nor any of their trademarks or +service marks, may be used to endorse or promote products derived from this +Original Work without express prior permission of the Licensor. Except as +expressly stated herein, nothing in this License grants any license to +Licensor's trademarks, copyrights, patents, trade secrets or any other +intellectual property. No patent license is granted to make, use, sell, offer +for sale, have made, or import embodiments of any patent claims other than the +licensed claims defined in Section 2. No license is granted to the trademarks +of Licensor even if such marks are included in the Original Work. Nothing in +this License shall be interpreted to prohibit Licensor from licensing under +terms different from this License any Original Work that Licensor otherwise +would have a right to license. + +5. **External Deployment.** The term "External Deployment" means the use, +distribution, or communication of the Original Work or Derivative Works in any +way such that the Original Work or Derivative Works may be used by anyone other +than You, whether those works are distributed or communicated to those persons +or made available as an application intended for use over a network. As an +express condition for the grants of license hereunder, You must treat any +External Deployment by You of the Original Work or a Derivative Work as a +distribution under section 1(c). + +6. **Attribution Rights.** You must retain, in the Source Code of any +Derivative Works that You create, all copyright, patent, or trademark notices +from the Source Code of the Original Work, as well as any notices of licensing +and any descriptive text identified therein as an "Attribution Notice." You +must cause the Source Code for any Derivative Works that You create to carry a +prominent Attribution Notice reasonably calculated to inform recipients that +You have modified the Original Work. + +7. **Warranty of Provenance and Disclaimer of Warranty.** Licensor warrants +that the copyright in and to the Original Work and the patent rights granted +herein by Licensor are owned by the Licensor or are sublicensed to You under +the terms of this License with the permission of the contributor(s) of those +copyrights and patent rights. Except as expressly stated in the immediately +preceding sentence, the Original Work is provided under this License on an "AS +IS" BASIS and WITHOUT WARRANTY, either express or implied, including, without +limitation, the warranties of non-infringement, merchantability or fitness for +a particular purpose. THE ENTIRE RISK AS TO THE QUALITY OF THE ORIGINAL WORK IS +WITH YOU. This DISCLAIMER OF WARRANTY constitutes an essential part of this +License. No license to the Original Work is granted by this License except +under this disclaimer. + +8. **Limitation of Liability.** Under no circumstances and under no legal +theory, whether in tort (including negligence), contract, or otherwise, shall +the Licensor be liable to anyone for any indirect, special, incidental, or +consequential damages of any character arising as a result of this License or +the use of the Original Work including, without limitation, damages for loss of +goodwill, work stoppage, computer failure or malfunction, or any and all other +commercial damages or losses. This limitation of liability shall not apply to +the extent applicable law prohibits such limitation. + +9. **Acceptance and Termination.** If, at any time, You expressly assented to +this License, that assent indicates your clear and irrevocable acceptance of +this License and all of its terms and conditions. If You distribute or +communicate copies of the Original Work or a Derivative Work, You must make a +reasonable effort under the circumstances to obtain the express assent of +recipients to the terms of this License. This License conditions your rights to +undertake the activities listed in Section 1, including your right to create +Derivative Works based upon the Original Work, and doing so without honoring +these terms and conditions is prohibited by copyright law and international +treaty. Nothing in this License is intended to affect copyright exceptions and +limitations (including 'fair use' or 'fair dealing'). This License shall +terminate immediately and You may no longer exercise any of the rights granted +to You by this License upon your failure to honor the conditions in Section +1(c). + +10. **Termination for Patent Action.** This License shall terminate +automatically and You may no longer exercise any of the rights granted to You +by this License as of the date You commence an action, including a cross-claim +or counterclaim, against Licensor or any licensee alleging that the Original +Work infringes a patent. This termination provision shall not apply for an +action alleging patent infringement by combinations of the Original Work with +other software or hardware. + +11. **Jurisdiction, Venue and Governing Law.** Any action or suit relating to +this License may be brought only in the courts of a jurisdiction wherein the +Licensor resides or in which Licensor conducts its primary business, and under +the laws of that jurisdiction excluding its conflict-of-law provisions. The +application of the United Nations Convention on Contracts for the International +Sale of Goods is expressly excluded. Any use of the Original Work outside the +scope of this License or after its termination shall be subject to the +requirements and penalties of copyright or patent law in the appropriate +jurisdiction. This section shall survive the termination of this License. + +12. **Attorneys' Fees.** In any action to enforce the terms of this License or +seeking damages relating thereto, the prevailing party shall be entitled to +recover its costs and expenses, including, without limitation, reasonable +attorneys' fees and costs incurred in connection with such action, including +any appeal of such action. This section shall survive the termination of this +License. + +13. **Miscellaneous.** If any provision of this License is held to be +unenforceable, such provision shall be reformed only to the extent necessary to +make it enforceable. + +14. **Definition of "You" in This License.** "You" throughout this License, +whether in upper or lower case, means an individual or a legal entity +exercising rights under, and complying with all of the terms of, this License. +For legal entities, "You" includes any entity that controls, is controlled by, +or is under common control with you. For purposes of this definition, "control" +means (i) the power, direct or indirect, to cause the direction or management +of such entity, whether by contract or otherwise, or (ii) ownership of fifty +percent (50%) or more of the outstanding shares, or (iii) beneficial ownership +of such entity. + +15. **Right to Use.** You may use the Original Work in all ways not otherwise +restricted or conditioned by this License or by law, and Licensor promises not +to interfere with or be responsible for such uses by You. + +16. **Modification of This License.** This License is Copyright © 2007 Zooko +Wilcox-O'Hearn. Permission is granted to copy, distribute, or communicate this +License without modification. Nothing in this License permits You to modify +this License as applied to the Original Work or to Derivative Works. However, +You may modify the text of this License and copy, distribute or communicate +your modified version (the "Modified License") and apply it to other original +works of authorship subject to the following conditions: (i) You may not +indicate in any way that your Modified License is the "Bootstrap Open Source +Licence" or "BOSL" and you may not use those names in the name of your Modified +License; and (ii) You must replace the notice specified in the first paragraph +above with the notice "Licensed under " or with +a notice of your own that is not confusingly similar to the notice in this +License. diff --git a/app/Main.hs b/app/Main.hs index 07353f4..e26fa6a 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -6,6 +6,7 @@ import Control.Concurrent (forkIO, threadDelay) import Control.Monad import Control.Monad.IO.Class import Data.Aeson +import qualified Data.ByteString as B import Data.SecureMem import qualified Data.Text as T import qualified Data.Text.Lazy as L @@ -34,146 +35,9 @@ main :: IO () main = do putStrLn "Starting Server..." pipe <- connect $ host "127.0.0.1" - let run = access pipe master "zgo" - j <- run (auth dbUser dbPassword) - _ <- forkIO (setInterval 60 (checkZcashPrices pipe)) + j <- access pipe master "zgo" (auth dbUser dbPassword) + {-_ <- forkIO (setInterval 60 (checkZcashPrices pipe))-} if j then putStrLn "Connected to MongoDB!" else fail "MongoDB connection failed!" - scotty 4000 $ do - middleware $ - basicAuth - (\u p -> return $ u == "user" && secureMemFromByteString p == passkey) - "ZGo Backend" - --Get list of countries for UI - get "/api/countries" $ do - countries <- liftIO $ run listCountries - case countries of - [] -> do - status noContent204 - Web.Scotty.json - (object ["message" .= ("No countries available" :: String)]) - _ -> do - Web.Scotty.json - (object - [ "message" .= ("Country data found" :: String) - , "countries" .= toJSON (map parseCountryBson countries) - ]) - --Get user associated with session - get "/api/user" $ do - session <- param "session" - user <- liftIO $ run (findUser session) - case user of - Nothing -> status noContent204 - Just u -> - Web.Scotty.json - (object - [ "message" .= ("User found" :: String) - , "user" .= toJSON (parseUserBson u) - ]) - --Delete user - Web.Scotty.delete "/api/user/:id" $ do text "Deleted that guy!" - --Get txs from DB that have less than 10 confirmations - get "/api/pending" $ do - session <- param "session" - pending <- liftIO $ run (findPending session) - case pending of - [] -> do - status noContent204 - Web.Scotty.json - (object ["message" .= ("No pending transactions" :: String)]) - _ -> do - Web.Scotty.json - (object - [ "message" .= ("Found pending transactions" :: String) - , "txs" .= toJSON (map parseZGoTxBson pending) - ]) - --Get current blockheight from Zcash node - get "/api/blockheight" $ do - blockInfo <- makeZcashCall "getblock" ["-1"] - Web.Scotty.json (result (getResponseBody blockInfo :: RpcResponse Block)) - --Get transactions associated with ZGo node - get "/api/txs" $ do - txs <- makeZcashCall "z_listreceivedbyaddress" [nodeAddress] - Web.Scotty.json (result (getResponseBody txs :: RpcResponse [ZcashTx])) - --Get the ZGo node's shielded address - get "/api/getaddr" $ do Web.Scotty.json (object ["addr" .= nodeAddress]) - --Get owner by address - get "/api/owner" $ do text "Here's an owner for you" - --Upsert owner to DB - post "/api/owner" $ do text "I added an owner for you" - --Validate user, updating record - post "/api/validateuser" $ do text "Marked user as validated" - --Get items associated with the given address - get "/api/items" $ do text "Here are your items" - --Upsert item - post "/api/item" $ do text "I upserted the item for you" - --Delete item - Web.Scotty.delete "/api/item/:id" $ do text "Deleted that pesky item" - --Get price for Zcash - get "/api/price" $ do - currency <- param "currency" - price <- liftIO $ run (findPrice currency) - case price of - Nothing -> do - status noContent204 - Web.Scotty.json (object ["message" .= ("No price" :: String)]) - Just p -> do - Web.Scotty.json - (object - [ "message" .= ("Price found!" :: String) - , "price" .= toJSON (parseZGoPrice p) - ]) - --Get all closed orders for the address - get "/api/allorders" $ do text "Here are the orders" - --Get order by id for receipts - get "/api/order/:id" $ do - oId <- param "id" - text (L.pack ("Here's the order" <> oId)) - --Get order by session - get "/api/order" $ do - diff <- param "diff" - text (L.pack ("This is a diff order" <> diff)) - --Upsert order - post "/api/order" $ do text "Upserted your order" - get "/api/test" $ do - q <- liftIO getZcashPrices - a <- liftIO $ mapM_ run (updatePrices (getResponseBody q)) - text "Updated the DB!" - --- |Make a Zcash RPC call -makeZcashCall :: (MonadIO m, FromJSON a) => T.Text -> [T.Text] -> m (Response a) -makeZcashCall m p = do - let username = "zecwallet" - let password = "rdsxlun6v4a" - let payload = - RpcCall {jsonrpc = "1.0", callId = "test", method = m, parameters = p} - let myRequest = - setRequestBodyJSON payload $ - setRequestPort 8232 $ - setRequestBasicAuth username password $ - setRequestMethod "POST" defaultRequest - httpJSON myRequest - --- |Timer for repeating actions -setInterval :: Int -> IO () -> IO () -setInterval secs func = do - forever $ threadDelay (secs * 1000000) >> func - --- |Function to query the CoinGecko API for the price of Zcash -getZcashPrices :: IO (Response CoinGeckoPrices) -getZcashPrices = do - let priceRequest = - setRequestQueryString - [("ids", Just "zcash"), ("vs_currencies", Just "usd,gbp,eur,cad,aud")] $ - setRequestPort 443 $ - setRequestSecure True $ - setRequestHost "api.coingecko.com" $ - setRequestPath "/api/v3/simple/price" defaultRequest - httpJSON priceRequest - -checkZcashPrices :: Pipe -> IO () -checkZcashPrices p = do - q <- getZcashPrices - mapM_ (access p master "zgo") (updatePrices (getResponseBody q)) - putStrLn "Got new prices" + app pipe "zgo" passkey nodeAddress diff --git a/package.yaml b/package.yaml index 1dd8650..29b155c 100644 --- a/package.yaml +++ b/package.yaml @@ -31,6 +31,20 @@ library: - unordered-containers - bson - aeson + - QuickCheck + - quickcheck-instances + - scotty + - http-conduit + - wai-extra + - http-types + - time + - securemem + - bytestring + - regex-base + - regex-compat + - array + - random + - vector executables: zgo-backend-exe: @@ -52,6 +66,7 @@ executables: - http-types - http-conduit - time + - bytestring tests: zgo-backend-test: @@ -66,3 +81,12 @@ tests: - zgo-backend - hspec - QuickCheck + - text + - aeson + - http-conduit + - http-types + - hspec-expectations-json + - bytestring + - mongoDB + - hspec-wai + - securemem diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs index 0a9dc9e..6b834b1 100644 --- a/src/ZGoBackend.hs +++ b/src/ZGoBackend.hs @@ -5,16 +5,33 @@ module ZGoBackend where +import Control.Concurrent (forkIO, threadDelay) import Control.Monad import Control.Monad.IO.Class import Data.Aeson +import Data.Array import qualified Data.Bson as B +import qualified Data.ByteString as BS import Data.Char import qualified Data.HashMap.Strict as HM +import Data.SecureMem import qualified Data.Text as T +import qualified Data.Text.Lazy as L import Data.Time.Clock +import qualified Data.Vector as V import Database.MongoDB import GHC.Generics +import Network.HTTP.Simple +import Network.HTTP.Types.Status +import Network.Wai.Middleware.HttpAuth +import Numeric +import System.IO.Unsafe +import System.Random +import Test.QuickCheck +import Test.QuickCheck.Instances +import Text.Regex +import Text.Regex.Base +import Web.Scotty -- Models for API objects -- | A type to model Zcash RPC calls @@ -23,7 +40,7 @@ data RpcCall = { jsonrpc :: T.Text , callId :: T.Text , method :: T.Text - , parameters :: [T.Text] + , parameters :: [Data.Aeson.Value] } deriving (Show, Generic) @@ -60,14 +77,14 @@ instance FromJSON Block where -- | Type to model a Zcash shielded transaction data ZcashTx = ZcashTx - { txid :: T.Text - , amount :: Double - , amountZat :: Integer - , blockheight :: Integer - , blocktime :: Integer - , change :: Bool - , confirmations :: Integer - , memo :: String + { ztxid :: T.Text + , zamount :: Double + , zamountZat :: Integer + , zblockheight :: Integer + , zblocktime :: Integer + , zchange :: Bool + , zconfirmations :: Integer + , zmemo :: T.Text } deriving (Show, Generic) @@ -82,7 +99,16 @@ instance FromJSON ZcashTx where c <- obj .: "change" conf <- obj .: "confirmations" m <- obj .: "memo" - pure $ ZcashTx t a aZ bh bt c conf (decodeHexText m) + pure $ + ZcashTx + t + a + aZ + bh + bt + c + conf + (T.pack (filter (/= '\NUL') $ decodeHexText m)) instance ToJSON ZcashTx where toJSON (ZcashTx t a aZ bh bt c conf m) = @@ -97,15 +123,50 @@ instance ToJSON ZcashTx where , "memo" .= m ] +instance Arbitrary ZcashTx where + arbitrary = do + a <- arbitrary + aZ <- arbitrary + t <- arbitrary + bh <- arbitrary + bt <- arbitrary + c <- arbitrary + cm <- arbitrary + m <- arbitrary + return $ ZcashTx a aZ t bh bt c cm m + -- | Helper function to turn a hex-encoded memo strings to readable text decodeHexText :: String -> String decodeHexText hexText - | chunk == "00" = decodeHexText (drop 2 hexText) + -- | chunk == "00" = decodeHexText (drop 2 hexText) | null chunk = "" | otherwise = chr (read ("0x" <> chunk)) : decodeHexText (drop 2 hexText) where chunk = take 2 hexText +-- | Helper function to turn a string into a hex-encoded string +encodeHexText :: String -> String +encodeHexText t = mconcat (map padHex t) + where + padHex x = + if ord x < 16 + then "0" ++ (showHex . ord) x "" + else showHex (ord x) "" + +-- | Helper function to pad a string to a given length +padLeft :: String -> Char -> Int -> String +padLeft s c m = + let isBaseLarger = length s > m + padder s c m False = [c | _ <- [1 .. (m - length s)]] ++ s + padder s _ _ True = s + in padder s c m isBaseLarger + +generatePin :: IO T.Text +generatePin = do + g <- newStdGen + pure $ + T.pack (padLeft (show . head $ randomRs (1 :: Integer, 10000000) g) '0' 7) + -- Types for the ZGo database documents -- | Type to model a country for the database's country list data Country = @@ -123,6 +184,7 @@ parseCountryBson d = do c <- B.lookup "code" d pure $ Country (show (i :: B.ObjectId)) n c +-- | Type to represent a ZGo User, i.e.: a specific device data User = User { _id :: String @@ -131,7 +193,6 @@ data User = , blocktime :: Integer , pin :: T.Text , validated :: Bool - , expired :: Bool } deriving (Eq, Show, Generic, ToJSON) @@ -143,8 +204,7 @@ parseUserBson d = do b <- B.lookup "blocktime" d p <- B.lookup "pin" d v <- B.lookup "validated" d - e <- B.lookup "expired" d - pure $ User (show (i :: B.ObjectId)) a s b p v e + pure $ User (show (i :: B.ObjectId)) a s b p v -- | Type to model a ZGo transaction data ZGoTx = @@ -153,6 +213,7 @@ data ZGoTx = , address :: T.Text , session :: T.Text , confirmations :: Integer + , blocktime :: Integer , amount :: Double , txid :: T.Text , memo :: T.Text @@ -168,7 +229,51 @@ parseZGoTxBson d = do am <- B.lookup "amount" d t <- B.lookup "txid" d m <- B.lookup "memo" d - pure $ ZGoTx (show (i :: B.ObjectId)) a s c am t m + bt <- B.lookup "blocktime" d + pure $ ZGoTx (show (i :: B.ObjectId)) a s c bt am t m + +encodeZGoTxBson :: ZGoTx -> B.Document +encodeZGoTxBson (ZGoTx i a s c bt am t m) = + if not (null i) + then [ "_id" =: i + , "address" =: a + , "session" =: s + , "confirmations" =: c + , "blocktime" =: bt + , "amount" =: am + , "txid" =: t + , "memo" =: m + ] + else [ "address" =: a + , "session" =: s + , "confirmations" =: c + , "blocktime" =: bt + , "amount" =: am + , "txid" =: t + , "memo" =: m + ] + +zToZGoTx :: ZcashTx -> ZGoTx +zToZGoTx (ZcashTx t a aZ bh bt c conf m) = do + let r = + mkRegex + ".*ZGO::([0-9a-fA-F]{8}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{12})\\sReply-To:\\s(zs[a-z0-9]{76}).*" + let p = + mkRegex + ".*ZGOp::([0-9a-fA-F]{8}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{12}).*" + let reg = matchAllText r (T.unpack m) + let reg2 = matchAllText p (T.unpack m) + if not (null reg) + then do + let session = T.pack (fst $ head reg ! 1) + let addy = T.pack (fst $ head reg ! 2) + ZGoTx "" addy session conf bt a t m + else do + if not (null reg2) + then do + let session = T.pack (fst $ head reg2 ! 1) + ZGoTx "" "" session conf bt a t m + else ZGoTx "" "" "" conf bt a t m -- |Type to model a price in the ZGo database data ZGoPrice = @@ -205,17 +310,48 @@ listCountries :: Action IO [Document] listCountries = rest =<< find (select [] "countries") -- | Function to query DB for unexpired user by session ID -findUser :: String -> Action IO (Maybe Document) -findUser s = findOne (select ["session" =: s, "expired" =: False] "users") +findUser :: T.Text -> Action IO (Maybe Document) +findUser s = findOne (select ["session" =: s] "users") + +-- | Function to create user from ZGoTx +addUser :: T.Text -> ZGoTx -> Action IO () +addUser node (ZGoTx i a s c bt am t m) = do + let newPin = unsafePerformIO generatePin + let msg = sendPin node a newPin + insert_ + "users" + [ "address" =: a + , "session" =: s + , "blocktime" =: bt + , "pin" =: newPin + , "validated" =: False + ] + +sendPin :: T.Text -> T.Text -> T.Text -> IO () +sendPin nodeAddress addr pin = do + let payload = + [ Data.Aeson.String nodeAddress + , Data.Aeson.Array + (V.fromList + [ object + [ "address" .= addr + , "amount" .= (0.00000001 :: Double) + , "memo" .= pin + ] + ]) + ] + r <- makeZcashCall "z_sendmany" payload + let sCode = getResponseStatus (r :: Response Object) + if sCode == ok200 + then putStrLn "Pin sent!" + else putStrLn "Pin sending failed :(" -- | Function to query DB for transactions with less than 10 confirmations findPending :: String -> Action IO [Document] findPending s = rest =<< find - (select - ["session" =: s, "confirmations" =: ["$lt" =: (10 :: Integer)]] - "txs") + (select ["session" =: s, "confirmations" =: ["$lt" =: (3 :: Integer)]] "txs") -- | Function to query DB for price by currency findPrice :: String -> Action IO (Maybe Document) @@ -234,3 +370,163 @@ updateOnePrice (c, v) = do upsert (select ["currency" =: c] "prices") ["currency" =: c, "price" =: v, "timestamp" =: t] + +-- | Function to upsert ZGoTxs into the given collection +upsertZGoTx :: T.Text -> ZGoTx -> Action IO () +upsertZGoTx coll t = do + upsert (select ["txid" =: txid t] coll) (encodeZGoTxBson t) + +-- | Main API function +app :: Pipe -> T.Text -> SecureMem -> T.Text -> IO () +app pipe db passkey nodeAddress = do + let run = access pipe master db + scotty 4000 $ do + middleware $ + basicAuth + (\u p -> return $ u == "user" && secureMemFromByteString p == passkey) + "ZGo Backend" + --Get list of countries for UI + get "/api/countries" $ do + countries <- liftIO $ run listCountries + case countries of + [] -> do + status noContent204 + Web.Scotty.json + (object ["message" .= ("No countries available" :: String)]) + _ -> do + Web.Scotty.json + (object + [ "message" .= ("Country data found" :: String) + , "countries" .= toJSON (map parseCountryBson countries) + ]) + --Get user associated with session + get "/api/user" $ do + session <- param "session" + user <- liftIO $ run (findUser session) + case user of + Nothing -> status noContent204 + Just u -> + Web.Scotty.json + (object + [ "message" .= ("User found" :: String) + , "user" .= toJSON (parseUserBson u) + ]) + --Add user + post "/api/user" $ do text "Added that guy" + --Delete user + Web.Scotty.delete "/api/user/:id" $ do text "Deleted that guy!" + --Get txs from DB that have less than 10 confirmations + get "/api/pending" $ do + session <- param "session" + pending <- liftIO $ run (findPending session) + case pending of + [] -> do + status noContent204 + _ -> do + Web.Scotty.json + (object + [ "message" .= ("Found pending transactions" :: String) + , "txs" .= toJSON (map parseZGoTxBson pending) + ]) + --Get current blockheight from Zcash node + get "/api/blockheight" $ do + blockInfo <- makeZcashCall "getblock" ["-1"] + Web.Scotty.json (result (getResponseBody blockInfo :: RpcResponse Block)) + --Get transactions associated with ZGo node + --get "/api/txs" $ do + --txs <- makeZcashCall "z_listreceivedbyaddress" [nodeAddress] + --Web.Scotty.json (result (getResponseBody txs :: RpcResponse [ZcashTx])) + --Get the ZGo node's shielded address + get "/api/getaddr" $ do Web.Scotty.json (object ["addr" .= nodeAddress]) + --Get owner by address + get "/api/owner" $ do text "Here's an owner for you" + --Upsert owner to DB + post "/api/owner" $ do text "I added an owner for you" + --Validate user, updating record + post "/api/validateuser" $ do text "Marked user as validated" + --Get items associated with the given address + get "/api/items" $ do text "Here are your items" + --Upsert item + post "/api/item" $ do text "I upserted the item for you" + --Delete item + Web.Scotty.delete "/api/item/:id" $ do text "Deleted that pesky item" + --Get price for Zcash + get "/api/price" $ do + currency <- param "currency" + price <- liftIO $ run (findPrice currency) + case price of + Nothing -> do + status noContent204 + --Web.Scotty.json (object ["message" .= ("No price" :: T.Text)]) + Just p -> do + Web.Scotty.json + (object + [ "message" .= ("Price found!" :: String) + , "price" .= toJSON (parseZGoPrice p) + ]) + --Get all closed orders for the address + get "/api/allorders" $ do text "Here are the orders" + --Get order by id for receipts + get "/api/order/:id" $ do + oId <- param "id" + text (L.pack ("Here's the order" <> oId)) + --Get order by session + get "/api/order" $ do + diff <- param "diff" + text (L.pack ("This is a diff order" <> diff)) + --Upsert order + post "/api/order" $ do text "Upserted your order" + +-- |Make a Zcash RPC call +makeZcashCall :: + (MonadIO m, FromJSON a) => T.Text -> [Data.Aeson.Value] -> m (Response a) +makeZcashCall m p = do + let username = "zecwallet" + let password = "rdsxlun6v4a" + let payload = + RpcCall {jsonrpc = "1.0", callId = "test", method = m, parameters = p} + let myRequest = + setRequestBodyJSON payload $ + setRequestPort 8232 $ + setRequestBasicAuth username password $ + setRequestMethod "POST" defaultRequest + httpJSON myRequest + +-- |Timer for repeating actions +setInterval :: Int -> IO () -> IO () +setInterval secs func = do + forever $ threadDelay (secs * 1000000) >> func + +-- |Function to query the CoinGecko API for the price of Zcash +getZcashPrices :: IO (Response CoinGeckoPrices) +getZcashPrices = do + let priceRequest = + setRequestQueryString + [("ids", Just "zcash"), ("vs_currencies", Just "usd,gbp,eur,cad,aud")] $ + setRequestPort 443 $ + setRequestSecure True $ + setRequestHost "api.coingecko.com" $ + setRequestPath "/api/v3/simple/price" defaultRequest + httpJSON priceRequest + +checkZcashPrices :: Pipe -> T.Text -> IO () +checkZcashPrices p db = do + q <- getZcashPrices + mapM_ (access p master db) (updatePrices (getResponseBody q)) + +scanZcash :: T.Text -> Pipe -> T.Text -> IO () +scanZcash addr pipe db = do + r <- makeZcashCall "z_listreceivedbyaddress" [Data.Aeson.String addr] + let txs = + filter (not . zchange) $ + result (getResponseBody r :: RpcResponse [ZcashTx]) + let r = + mkRegex + ".*ZGO::([0-9a-fA-F]{8}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{12})\\sReply-To:\\s(zs[a-z0-9]{76}).*" + let p = + mkRegex + ".*ZGOp::([0-9a-fA-F]{8}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{12}).*" + let k = map zToZGoTx (filter (matchTest r . T.unpack . zmemo) txs) + mapM_ (access pipe master db . upsertZGoTx "txs") k + let j = map zToZGoTx (filter (matchTest p . T.unpack . zmemo) txs) + mapM_ (access pipe master db . upsertZGoTx "payments") j diff --git a/test/Spec.hs b/test/Spec.hs index 35feb16..9422dc4 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,14 +1,203 @@ +{-# LANGUAGE OverloadedStrings #-} + module Spec where +import Control.Concurrent (forkIO, threadDelay) +import Control.Exception (bracket) +import Control.Monad.IO.Class +import qualified Data.Aeson as A +import qualified Data.ByteString as B +import Data.Char (isAscii) +import Data.Either +import Data.SecureMem +import qualified Data.Text as T +import Database.MongoDB +import Network.HTTP.Simple +import Network.HTTP.Types.Status +import System.IO.Unsafe import Test.Hspec +import Test.Hspec.Expectations.Json +import Test.Hspec.QuickCheck import Test.QuickCheck +import Test.QuickCheck.Gen import ZGoBackend +passkey :: SecureMem +passkey = secureMemFromByteString "superSecret" + +nodeAddress :: T.Text +nodeAddress = + "zs1xnpqd2tae9d95f8fhe4l0q7j44a5vf993m0pcnnvr56uqr4lgqlamesk5v4c5rhtvywc6lvlduy" + +dbUser :: T.Text +dbUser = "zgo" + +dbPassword :: T.Text +dbPassword = "zcashrules" + main :: IO () main = hspec $ do - describe "Decode Memo" $ do - it "converts to readable text" $ do - decodeHexText - "5a474f3a3a35643364343439342d353163302d343332642d383439352d3035303431393935376165610a5265706c792d546f3a0a7a733177366e6b616d65617a633567756a6d363933353073796c35773874677679617068756d73337077386579747a7935796d303878376476736b6d796b6b61746d777275636d67763365723865" `shouldBe` - "ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" + describe "Helper functions" $ do + describe "decodeHexText" $ do + it "converts to readable text" $ do + decodeHexText + "5a474f3a3a35643364343439342d353163302d343332642d383439352d3035303431393935376165610a5265706c792d546f3a0a7a733177366e6b616d65617a633567756a6d363933353073796c35773874677679617068756d73337077386579747a7935796d303878376476736b6d796b6b61746d777275636d67763365723865" `shouldBe` + "ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" + describe "hex strings" $ do + prop "encoding and decoding are inverse" $ \x -> + (decodeHexText . encodeHexText) (filter isAscii x) == filter isAscii x + describe "zToZGoTx" $ do + it "converts zcash tx to ZGo tx" $ do + let t = + ZcashTx + "someId" + 0.5 + 50000000 + 1602000 + 18732456 + False + 20 + "ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" + zToZGoTx t `shouldBe` + ZGoTx + "" + "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" + "5d3d4494-51c0-432d-8495-050419957aea" + 20 + 18732456 + 0.5 + "someId" + "ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" + describe "PIN generator" $ do + it "should give a 7 digit" $ do + length (T.unpack (unsafePerformIO generatePin)) `shouldBe` 7 + describe "API endpoints" $ do + beforeAll_ startAPI $ do + describe "Price endpoint" $ do + it "returns a price for an existing currency" $ do + req <- testGet "/api/price" [("currency", Just "usd")] + res <- httpJSON req + getResponseStatus (res :: Response A.Value) `shouldBe` ok200 + it "returns 204 when the currency is not supported" $ do + req <- testGet "/api/price" [("currency", Just "jpy")] + res <- httpLBS req + getResponseStatus res `shouldBe` noContent204 + describe "Countries endpoint" $ do + it "returns a list of countries" $ do + req <- testGet "/api/countries" [] + res <- httpJSON req + getResponseStatus (res :: Response A.Value) `shouldBe` ok200 + describe "blockheight endpoint" $ do + it "returns a block number" $ do + req <- testGet "/api/blockheight" [] + res <- httpJSON req + height (getResponseBody (res :: Response Block)) `shouldSatisfy` \x -> + x > 1600000 + describe "unconfirmed Zcash txs" $ do + it "returns txs with less than 2 confirmations" $ do pending + describe "User endpoint" $ do + it "adds a user" $ do pending + it "returns a user for a session" $ do pending + it "returns 204 when no user" $ do pending + it "marks user as validated" $ do pending + it "deletes user by id" $ do pending + describe "Owner endpoint" $ do + it "add owner" $ do pending + it "return owner" $ do pending + describe "Order endpoint" $ do + it "upsert order" $ do pending + it "get order by session" $ do pending + it "get order by id" $ do pending + it "get all orders for owner" $ do pending + around handleDb $ + describe "Database actions" $ do + describe "authentication" $ do + it "should succeed with good creds" $ \p -> do + r <- liftIO $ access p master "zgo" (auth "zgo" "zcashrules") + r `shouldBe` True + it "should fail with bad creds" $ \p -> do + r <- liftIO $ access p master "zgo" (auth "user" "pwd") + r `shouldBe` False + describe "Zcash prices" $ do + it "should update" $ \p -> do + doc <- access p master "test" $ findPrice "usd" + case doc of + Nothing -> True `shouldBe` False + Just d -> do + let q = parseZGoPrice d + case q of + Nothing -> True `shouldBe` False + Just r -> do + let t1 = ZGoBackend.timestamp r + _ <- checkZcashPrices p "test" + doc2 <- access p master "test" $ findPrice "usd" + case doc2 of + Nothing -> True `shouldBe` False + Just d2 -> do + let q2 = parseZGoPrice d2 + case q2 of + Nothing -> True `shouldBe` False + Just r2 -> do + let t2 = ZGoBackend.timestamp r2 + t2 `shouldSatisfy` (t1 <) + describe "Zcash transactions" $ do + it "logins are added to db" $ \p -> do + _ <- access p master "test" (delete (select [] "txs")) + _ <- scanZcash nodeAddress p "test" + threadDelay 1000000 + t <- access p master "test" $ findOne (select [] "txs") + case t of + Nothing -> True `shouldBe` False + Just r -> do + let s = parseZGoTxBson r + case s of + Nothing -> True `shouldBe` False + Just z -> confirmations z `shouldSatisfy` (> 0) + it "payments are added to db" $ \p -> do + _ <- access p master "test" (delete (select [] "payments")) + _ <- scanZcash nodeAddress p "test" + threadDelay 1000000 + t <- access p master "test" $ findOne (select [] "payments") + case t of + Nothing -> True `shouldBe` False + Just r -> do + let s = parseZGoTxBson r + case s of + Nothing -> True `shouldBe` False + Just z -> confirmations z `shouldSatisfy` (> 0) + +testGet :: B.ByteString -> [(B.ByteString, Maybe B.ByteString)] -> IO Request +testGet endpoint body = do + let user = "user" + let pwd = "superSecret" + let testRequest = + setRequestQueryString body $ + setRequestPort 4000 $ + setRequestBasicAuth user pwd $ + setRequestMethod "GET" $ setRequestPath endpoint defaultRequest + return testRequest + +-- | Open the MongoDB connection +openDbConnection :: IO Pipe +openDbConnection = do + pipe <- connect $ host "127.0.0.1" + access pipe master "zgo" (auth "zgo" "zcashrules") + return pipe + +-- | Close the MongoDB pipe +closeDbConnection :: Pipe -> IO () +closeDbConnection = close + +-- | DB handling function +handleDb :: (Pipe -> Expectation) -> IO () +handleDb = bracket openDbConnection closeDbConnection + +startAPI :: IO () +startAPI = do + putStrLn "Starting test server ..." + pipe <- connect $ host "127.0.0.1" + c <- access pipe master "zgo" (auth "zgo" "zcashrules") + _ <- forkIO (app pipe "test" passkey nodeAddress) + threadDelay 1000000 + putStrLn "Test server is up!" diff --git a/zgo-backend.cabal b/zgo-backend.cabal index 2892109..6cb5d6c 100644 --- a/zgo-backend.cabal +++ b/zgo-backend.cabal @@ -31,13 +31,26 @@ library hs-source-dirs: src build-depends: - aeson + QuickCheck + , aeson + , array , base >=4.7 && <5 , bson + , bytestring + , http-conduit + , http-types , mongoDB + , quickcheck-instances + , random + , regex-base + , regex-compat + , scotty + , securemem , text , time , unordered-containers + , vector + , wai-extra default-language: Haskell2010 executable zgo-backend-exe @@ -50,6 +63,7 @@ executable zgo-backend-exe build-depends: aeson , base + , bytestring , http-conduit , http-types , mongoDB @@ -71,7 +85,16 @@ test-suite zgo-backend-test ghc-options: -threaded -rtsopts -with-rtsopts=-N -main-is Spec build-depends: QuickCheck + , aeson , base >=4.7 && <5 + , bytestring , hspec + , hspec-expectations-json + , hspec-wai + , http-conduit + , http-types + , mongoDB + , securemem + , text , zgo-backend default-language: Haskell2010