Update license to BOSL

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
+*Licensed under the Bootstrap Open Source Licence version 1.0*
-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:
 
-The above copyright notice and this permission notice shall be included in all
+1.  **Grant of Copyright License.** Licensor grants You a worldwide,
-copies or substantial portions of the Software.
+    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
+        a. to reproduce the Original Work in copies, either alone or as part of
-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+        a collective work;
-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.
 
-[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.

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 <- access pipe master "zgo" (auth dbUser dbPassword)
-  j <- run (auth dbUser dbPassword)
+  {-_ <- forkIO (setInterval 60 (checkZcashPrices pipe))-}
-  _ <- forkIO (setInterval 60 (checkZcashPrices pipe))
   if j
     then putStrLn "Connected to MongoDB!"
     else fail "MongoDB connection failed!"
-  scotty 4000 $ do
+  app pipe "zgo" passkey nodeAddress
-    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"

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

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
+    { ztxid :: T.Text
-    , amount :: Double
+    , zamount :: Double
-    , amountZat :: Integer
+    , zamountZat :: Integer
-    , blockheight :: Integer
+    , zblockheight :: Integer
-    , blocktime :: Integer
+    , zblocktime :: Integer
-    , change :: Bool
+    , zchange :: Bool
-    , confirmations :: Integer
+    , zconfirmations :: Integer
-    , memo :: String
+    , 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
-  pure $ User (show (i :: B.ObjectId)) a s b p v e
 
 -- | 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 :: T.Text -> Action IO (Maybe Document)
-findUser s = findOne (select ["session" =: s, "expired" =: False] "users")
+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
+    (select ["session" =: s, "confirmations" =: ["$lt" =: (3 :: Integer)]] "txs")
-       ["session" =: s, "confirmations" =: ["$lt" =: (10 :: 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

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
+    describe "Helper functions" $ do
-      it "converts to readable text" $ do
+      describe "decodeHexText" $ do
-        decodeHexText
+        it "converts to readable text" $ do
-          "5a474f3a3a35643364343439342d353163302d343332642d383439352d3035303431393935376165610a5265706c792d546f3a0a7a733177366e6b616d65617a633567756a6d363933353073796c35773874677679617068756d73337077386579747a7935796d303878376476736b6d796b6b61746d777275636d67763365723865" `shouldBe`
+          decodeHexText
-          "ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+            "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!"

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