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

Update license to BOSL

Browse source
This commit is contained in:
Rene Vergara 2022-04-30 07:59:49 -05:00
parent 5279f5c739
commit 3acaa7e487
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
6 changed files with 735 additions and 184 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

191
LICENSE
View file

@ -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 <insert your license name here>" or with
a notice of your own that is not confusingly similar to the notice in this
License.

144
app/Main.hs
View file

@ -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

24
package.yaml
View file

@ -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

336
src/ZGoBackend.hs
View file

@ -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

199
test/Spec.hs
View file

@ -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!"

25
zgo-backend.cabal
View file

@ -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