CHANGELOG.md

@@ -4,39 +4,7 @@ All notable changes to this project will be documented in this file.
 The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
 and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
-## [1.7.0]
+## [1.5.0]
-
-### Added
-
-- Parameter to config for number of confirmations for scan
-- Endpoint for language for invoices
-
-### Changed
-
-- Modified payment confirmation to use new WooCommerce plugin API endpoint.
-- Consolidated the `invdata`, `orderid` and `orderx` endpoints
-- The `xerotoken` endpoint uses `session` for authentication
-- The order by ID/token endpoint includes shop name
-
-### Fixed
-
-- The viewing key obfuscation of blank viewing keys
-
-## [1.6.0]
-
-### Added
-
-- New JSON serialization for WooTokens.
-- New `/api/ownervk` endpoint to save viewing keys
-- Use of `zcash-haskell` library to validate Sapling viewing keys
-
-### Changed
-
-- Modified the process of scanning for payments to only scan addresses that have an active ZGo session and have enabled payment confirmations
-- Modified the process to mark paid orders to ensure only payments to the shop's wallet get marked as paid
-- Modified the `items` endpoint to use the login session to identify records
-
-## [1.5.0] - 2023-05-15
 
 ### Added
 

README.md

@@ -6,8 +6,7 @@ The API server behind the [ZGo.cash](https://zgo.cash) app.
 
 ## Dependencies
 
-- Zcash Full node (`zcashd`)
+- Zcash Full node
-- [Zcash Haskell](https://git.vergara.tech/Vergara_Tech/zcash-haskell)
 - MongoDB
 
 ## Configuration

package.yaml

@@ -1,5 +1,5 @@
 name:                zgo-backend
-version:             1.7.0
+version:             1.5.0
 git:                 "https://git.vergara.tech/Vergara_Tech/zgo-backend"
 license:             BOSL
 author:              "Rene Vergara"
@@ -62,7 +62,6 @@ library:
   - crypto-rng
   - megaparsec
   - uuid
-  - zcash-haskell
 
 executables:
   zgo-backend-exe:
@@ -162,6 +161,3 @@ tests:
     - time
     - configurator
     - scotty
-    - megaparsec
-    - uuid
-    - zcash-haskell

src/Config.hs

@@ -26,7 +26,6 @@ data Config =
     , c_smtpPort :: Integer
     , c_smtpUser :: String
     , c_smtpPwd :: String
-    , c_confirmations :: Integer
     }
   deriving (Eq, Show)
 
@@ -49,7 +48,6 @@ loadZGoConfig path = do
   mailPort <- require config "smtpPort"
   mailUser <- require config "smtpUser"
   mailPwd <- require config "smtpPwd"
-  conf <- require config "confirmations"
   return $
     Config
       dbHost
@@ -68,4 +66,3 @@ loadZGoConfig path = do
       mailPort
       mailUser
       mailPwd
-      conf

src/Item.hs

@@ -12,7 +12,6 @@ import Data.Time.Clock
 import Database.MongoDB
 import GHC.Generics
 import Test.QuickCheck
-import User
 
 -- | Type to represent a ZGo item
 data Item =
@@ -88,9 +87,6 @@ findItems :: T.Text -> Action IO [Document]
 findItems a =
   rest =<< find (select ["owner" =: a] "items") {sort = ["name" =: (1 :: Int)]}
 
-findItemById :: String -> Action IO (Maybe Document)
-findItemById i = findOne (select ["_id" =: (read i :: ObjectId)] "items")
-
 upsertItem :: Item -> Action IO ()
 upsertItem i = do
   let item = val i

src/Order.hs

@@ -29,12 +29,11 @@ data ZGoOrder =
     , qpaid :: Bool
     , qexternalInvoice :: T.Text
     , qshortCode :: T.Text
-    , qtoken :: T.Text
     }
   deriving (Eq, Show, Generic)
 
 instance ToJSON ZGoOrder where
-  toJSON (ZGoOrder i a s ts c cur p t tZ l paid eI sC tk) =
+  toJSON (ZGoOrder i a s ts c cur p t tZ l paid eI sC) =
     case i of
       Just oid ->
         object
@@ -51,7 +50,6 @@ instance ToJSON ZGoOrder where
           , "paid" .= paid
           , "externalInvoice" .= eI
           , "shortCode" .= sC
-          , "token" .= tk
           ]
       Nothing ->
         object
@@ -68,7 +66,6 @@ instance ToJSON ZGoOrder where
           , "paid" .= paid
           , "externalInvoice" .= eI
           , "shortCode" .= sC
-          , "token" .= tk
           ]
 
 instance FromJSON ZGoOrder where
@@ -87,7 +84,6 @@ instance FromJSON ZGoOrder where
       pd <- obj .: "paid"
       eI <- obj .: "externalInvoice"
       sC <- obj .: "shortCode"
-      tk <- obj .: "token"
       pure $
         ZGoOrder
           (if not (null i)
@@ -105,10 +101,9 @@ instance FromJSON ZGoOrder where
           pd
           eI
           sC
-          tk
 
 instance Val ZGoOrder where
-  val (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk) =
+  val (ZGoOrder i a s ts c cur p t tZ l pd eI sC) =
     if isJust i
       then Doc
              [ "_id" =: i
@@ -124,7 +119,6 @@ instance Val ZGoOrder where
              , "paid" =: pd
              , "externalInvoice" =: eI
              , "shortCode" =: sC
-             , "token" =: tk
              ]
       else Doc
              [ "address" =: a
@@ -139,7 +133,6 @@ instance Val ZGoOrder where
              , "paid" =: pd
              , "externalInvoice" =: eI
              , "shortCode" =: sC
-             , "token" =: tk
              ]
   cast' (Doc d) = do
     i <- B.lookup "_id" d
@@ -155,8 +148,7 @@ instance Val ZGoOrder where
     pd <- B.lookup "paid" d
     eI <- B.lookup "externalInvoice" d
     sC <- B.lookup "shortCode" d
-    tk <- B.lookup "token" d
+    Just (ZGoOrder i a s ts c cur p t tZ l pd eI sC)
-    Just (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk)
   cast' _ = Nothing
 
 -- Type to represent an order line item
@@ -232,17 +224,12 @@ updateOrderTotals o =
     (qpaid o)
     (qexternalInvoice o)
     (qshortCode o)
-    (qtoken o)
   where
     newTotal :: ZGoOrder -> Double
     newTotal x = foldr tallyItems 0 (qlines x)
     tallyItems :: LineItem -> Double -> Double
     tallyItems y z = (lqty y * lcost y) + z
 
-setOrderToken :: T.Text -> ZGoOrder -> ZGoOrder
-setOrderToken token (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk) =
-  ZGoOrder i a s ts c cur p t tZ l pd eI sC token
-
 findOrder :: T.Text -> Action IO (Maybe Document)
 findOrder s = findOne (select ["session" =: s, "closed" =: False] "orders")
 

src/Owner.hs

@@ -366,12 +366,8 @@ instance ToJSON OwnerSettings where
       , "expiration" .= e
       , "payconf" .= pc
       , "crmToken" .= cT
-      , "viewkey" .= keyObfuscate vK
+      , "viewkey" .= (T.take 8 vK <> "...." <> T.takeEnd 8 vK)
       ]
-    where
-      keyObfuscate s
-        | s == "" = ""
-        | otherwise = T.take 8 s <> "...." <> T.takeEnd 8 s
 
 -- Helper Functions
 getOwnerSettings :: Owner -> OwnerSettings
@@ -411,10 +407,6 @@ findOwnerById :: T.Text -> Action IO (Maybe Document)
 findOwnerById i =
   findOne (select ["_id" =: (read (T.unpack i) :: ObjectId)] "owners")
 
-findActiveOwners :: Action IO [Document]
-findActiveOwners =
-  rest =<< find (select ["paid" =: True, "payconf" =: True] "owners")
-
 -- | Function to find Owners about to expire
 findExpiringOwners :: UTCTime -> Action IO [Document]
 findExpiringOwners now =
@@ -445,10 +437,6 @@ updateOwnerSettings os =
       ]
     ]
 
-upsertViewingKey :: Owner -> String -> Action IO ()
-upsertViewingKey o vk =
-  modify (select ["_id" =: o_id o] "owners") ["$set" =: ["viewKey" =: vk]]
-
 -- | Type for a pro session
 data ZGoProSession =
   ZGoProSession

src/User.hs

@@ -69,36 +69,6 @@ instance FromJSON User where
           ""
           v
 
-instance Val User where
-  cast' (Doc d) = do
-    i <- B.lookup "_id" d
-    a <- B.lookup "address" d
-    s <- B.lookup "session" d
-    b <- B.lookup "blocktime" d
-    p <- B.lookup "pin" d
-    v <- B.lookup "validated" d
-    Just $ User i a s b p v
-  cast' _ = Nothing
-  val (User i a s b p v) =
-    case i of
-      Just oid ->
-        Doc
-          [ "_id" =: oid
-          , "address" =: a
-          , "session" =: s
-          , "blocktime" =: b
-          , "pin" =: p
-          , "validated" =: v
-          ]
-      Nothing ->
-        Doc
-          [ "address" =: a
-          , "session" =: s
-          , "blocktime" =: b
-          , "pin" =: p
-          , "validated" =: v
-          ]
-
 parseUserBson :: B.Document -> Maybe User
 parseUserBson d = do
   i <- B.lookup "_id" d
@@ -114,9 +84,6 @@ parseUserBson d = do
 findUser :: T.Text -> Action IO (Maybe Document)
 findUser s = findOne (select ["session" =: s] "users")
 
-findUserById :: String -> Action IO (Maybe Document)
-findUserById i = findOne (select ["_id" =: (read i :: B.ObjectId)] "users")
-
 -- | Function to delete user by ID
 deleteUser :: String -> Action IO ()
 deleteUser i = deleteOne (select ["_id" =: (read i :: B.ObjectId)] "users")

src/WooCommerce.hs

@@ -28,29 +28,6 @@ data WooToken =
     }
   deriving (Eq, Show)
 
-instance FromJSON WooToken where
-  parseJSON =
-    withObject "WooToken" $ \obj -> do
-      i <- obj .:? "_id"
-      o <- obj .: "ownerid"
-      t <- obj .: "token"
-      u <- obj .: "siteurl"
-      pure $ WooToken (read <$> i) (read o) t u
-
-instance ToJSON WooToken where
-  toJSON (WooToken i o t u) =
-    case i of
-      Just oid ->
-        object
-          ["_id" .= show oid, "ownerid" .= show o, "token" .= t, "siteurl" .= u]
-      Nothing ->
-        object
-          [ "_id" .= ("" :: String)
-          , "ownerid" .= show o
-          , "token" .= t
-          , "siteurl" .= u
-          ]
-
 instance Val WooToken where
   val (WooToken i o t u) =
     if isJust i
@@ -70,11 +47,8 @@ instance Val WooToken where
   cast' _ = Nothing
 
 -- Database actions
-findWooToken :: Maybe ObjectId -> Action IO (Maybe Document)
+findWooToken :: ObjectId -> Action IO (Maybe Document)
-findWooToken oid =
+findWooToken oid = findOne (select ["owner" =: oid] "wootokens")
-  case oid of
-    Nothing -> return Nothing
-    Just o -> findOne (select ["owner" =: o] "wootokens")
 
 addUrl :: WooToken -> T.Text -> Action IO ()
 addUrl t u =
@@ -89,9 +63,8 @@ payWooOrder ::
   -> BS.ByteString -- Total ZEC for order
   -> IO ()
 payWooOrder u i o t p z = do
-  wooReq <- parseRequest u
+  wooReq <- parseRequest $ u ++ "/wc-api/zpmtcallback"
   let req =
-        setRequestPath "/wp-json/wc/v3/zgocallback" $
         setRequestQueryString
           [ ("token", Just t)
           , ("orderid", Just o)
@@ -104,15 +77,23 @@ payWooOrder u i o t p z = do
   res <- httpLBS req
   if getResponseStatus res == ok200
     then return ()
-    else do
+    else error "Failed to report payment to WooCommerce"
-      print $ getResponseStatus res
-      error "Failed to report payment to WooCommerce"
 
-generateWooToken :: Owner -> String -> Action IO ()
+generateWooToken :: Owner -> Action IO ()
-generateWooToken o s =
+generateWooToken o =
   case o_id o of
     Just ownerid -> do
-      let wooToken = val $ WooToken Nothing ownerid (T.pack s) Nothing
+      let tokenHash =
+            BLK.hash
+              [ BA.pack . BS.unpack . C.pack . T.unpack $ oname o <> oaddress o :: BA.Bytes
+              ]
+      let wooToken =
+            val $
+            WooToken
+              Nothing
+              ownerid
+              (T.pack . show $ (tokenHash :: BLK.Digest BLK.DEFAULT_DIGEST_LEN))
+              Nothing
       case wooToken of
         Doc wT -> insert_ "wootokens" wT
         _ -> error "Couldn't create the WooCommerce token"

src/Xero.hs

@@ -171,26 +171,6 @@ instance FromJSON XeroTenant where
       --u <- obj .: "updatedDateUtc"
       pure $ XeroTenant i aei tI tT tN
 
-data XeroInvoiceRequest =
-  XeroInvoiceRequest
-    { xr_owner :: T.Text
-    , xr_invNo :: T.Text
-    , xr_amount :: Double
-    , xr_currency :: T.Text
-    , xr_shortCode :: T.Text
-    }
-  deriving (Show, Eq)
-
-instance FromJSON XeroInvoiceRequest where
-  parseJSON =
-    withObject "XeroInvoiceRequest" $ \obj -> do
-      o <- obj .: "ownerId"
-      i <- obj .: "invoice"
-      a <- obj .: "amount"
-      c <- obj .: "currency"
-      s <- obj .: "shortcode"
-      pure $ XeroInvoiceRequest o i a c s
-
 data XeroInvoice =
   XeroInvoice
     { xi_id :: Maybe ObjectId
@@ -463,6 +443,5 @@ payXeroInvoice pipe dbName inv address amt zec = do
             setRequestHost "api.xero.com" $
             setRequestMethod "PUT" defaultRequest
       res <- httpJSON req :: IO (Response Object)
-      print res
       return ()
     else error "Invalid parameters"

src/ZGoBackend.hs

@@ -12,8 +12,6 @@ import Control.Concurrent (forkIO, threadDelay)
 import Control.Exception (try)
 import Control.Monad
 import Control.Monad.IO.Class
-import Crypto.RNG (newCryptoRNGState, runCryptoRNGT)
-import Crypto.RNG.Utils (randomString)
 import Data.Aeson
 import Data.Array
 import qualified Data.Bson as B
@@ -39,7 +37,7 @@ import qualified Data.UUID as U
 import qualified Data.Vector as V
 import Data.Vector.Internal.Check (doChecks)
 import Data.Word
-import Database.MongoDB hiding (Order)
+import Database.MongoDB
 import Debug.Trace
 import GHC.Generics
 import Item
@@ -66,9 +64,6 @@ import Web.Scotty
 import WooCommerce
 import Xero
 import ZGoTx
-import ZcashHaskell.Sapling
-import ZcashHaskell.Types (RawData(..))
-import ZcashHaskell.Utils (decodeBech32)
 
 -- Models for API objects
 -- | A type to model Zcash RPC calls
@@ -591,7 +586,7 @@ routes pipe config = do
       simpleCorsResourcePolicy
         { corsRequestHeaders = ["Authorization", "Content-Type"]
         , corsMethods = "DELETE" : simpleMethods
-        , corsOrigins = Nothing
+        --, corsOrigins = Nothing
         }
   middleware $
     basicAuth
@@ -628,221 +623,56 @@ routes pipe config = do
                  ])
   get "/api/xerotoken" $ do
     code <- param "code"
-    session <- param "session"
+    address <- param "address"
-    user <- liftAndCatchIO $ run (findUser session)
     xeroConfig <- liftAndCatchIO $ run findXero
-    case cast' . Doc =<< xeroConfig of
+    case xeroConfig of
+      Nothing -> status noContent204
+      Just x -> do
+        let xConfig = cast' (Doc x)
+        case xConfig of
           Nothing -> status noContent204
           Just c -> do
-        case cast' . Doc =<< user of
-          Nothing -> status unauthorized401
-          Just u -> do
             res <-
               liftAndCatchIO $
-              requestXeroToken pipe (c_dbName config) c code $ uaddress u
+              requestXeroToken pipe (c_dbName config) c code address
             if res
               then status ok200
               else status noContent204
-  post "/invdata" $ do
+  get "/api/invdata" $ do
-    invData <- jsonData
+    inv <- param "inv"
+    oAddress <- param "address"
     xeroConfig <- liftAndCatchIO $ run findXero
-    let invReq = payload (invData :: Payload XeroInvoiceRequest)
+    case xeroConfig of
-    case cast' . Doc =<< xeroConfig of
       Nothing -> do
-        status ok200
+        status noContent204
-        Web.Scotty.json
+        text "Xero App credentials not found"
-          (object
+      Just x -> do
-             [ "reportType" .= (1 :: Integer)
+        let xConfig = cast' (Doc x)
-             , "order" .= (Nothing :: Maybe ZGoOrder)
+        case xConfig of
-             , "shop" .= (Nothing :: Maybe String)
+          Nothing -> do
-             ])
+            status noContent204
+            text "Xero App credentials corrupted"
           Just c -> do
-        o <- liftAndCatchIO $ run $ findOwnerById $ xr_owner invReq
-        case cast' . Doc =<< o of
-          Nothing -> do
-            status ok200
-            Web.Scotty.json
-              (object
-                 [ "reportType" .= (2 :: Integer)
-                 , "order" .= (Nothing :: Maybe ZGoOrder)
-                 , "shop" .= (Nothing :: Maybe String)
-                 ])
-          Just o' -> do
-            existingOrder <-
-              liftAndCatchIO $
-              run $
-              findXeroOrder
-                (oaddress o')
-                (xr_invNo invReq)
-                (xr_shortCode invReq)
-            case cast' . Doc =<< existingOrder of
-              Nothing -> do
             res <-
               liftAndCatchIO $
-                  requestXeroToken pipe (c_dbName config) c "none" $ oaddress o'
+              requestXeroToken pipe (c_dbName config) c "none" oAddress
             if res
               then do
                 resInv <-
                   liftAndCatchIO $
-                      getXeroInvoice pipe (c_dbName config) (xr_invNo invReq) $
+                  getXeroInvoice pipe (c_dbName config) inv oAddress
-                      oaddress o'
                 case resInv of
                   Nothing -> do
-                        status ok200
+                    status noContent204
-                        Web.Scotty.json
+                    text "Xero invoice not found"
-                          (object
-                             [ "reportType" .= (2 :: Integer)
-                             , "order" .= (Nothing :: Maybe ZGoOrder)
-                             , "shop" .= (Nothing :: Maybe String)
-                             ])
                   Just xI -> do
-                        if xi_type xI == "ACCREC"
-                          then if xi_status xI == "AUTHORISED"
-                                 then if xi_currency xI ==
-                                         T.toUpper (ocurrency o')
-                                        then if xi_total xI == xr_amount invReq
-                                               then do
-                                                 now <- liftIO getCurrentTime
-                                                 tk <- liftIO generateToken
-                                                 pr <-
-                                                   liftAndCatchIO $
-                                                   run
-                                                     (findPrice $
-                                                      T.unpack . ocurrency $ o')
-                                                 case parseZGoPrice =<< pr of
-                                                   Nothing -> do
                     status ok200
-                                                     Web.Scotty.json
+                    Web.Scotty.json (object ["invdata" .= toJSON xI])
-                                                       (object
+              else status noContent204
-                                                          [ "reportType" .=
-                                                            (7 :: Integer)
-                                                          , "order" .=
-                                                            (Nothing :: Maybe ZGoOrder)
-                                                          , "shop" .=
-                                                            (Nothing :: Maybe String)
-                                                          ])
-                                                   Just cp -> do
-                                                     let newOrder =
-                                                           ZGoOrder
-                                                             Nothing
-                                                             (oaddress o')
-                                                             ("Xero-" <>
-                                                              maybe
-                                                                ""
-                                                                (T.pack . show)
-                                                                (o_id o'))
-                                                             now
-                                                             True
-                                                             (ocurrency o')
-                                                             (price cp)
-                                                             (xi_total xI)
-                                                             (xi_total xI /
-                                                              price cp)
-                                                             [ LineItem
-                                                                 1
-                                                                 ("Invoice from " <>
-                                                                  oname o' <>
-                                                                  " [" <>
-                                                                  xi_number xI <>
-                                                                  "]")
-                                                                 (xi_total xI)
-                                                             ]
-                                                             False
-                                                             (xi_number xI)
-                                                             (xr_shortCode
-                                                                invReq)
-                                                             (T.pack tk)
-                                                     _ <-
-                                                       liftAndCatchIO $
-                                                       run $
-                                                       upsertOrder newOrder
-                                                     finalOrder <-
-                                                       liftAndCatchIO $
-                                                       run $
-                                                       findXeroOrder
-                                                         (oaddress o')
-                                                         (xi_number xI)
-                                                         (xr_shortCode invReq)
-                                                     case cast' . Doc =<<
-                                                          finalOrder of
-                                                       Nothing -> do
-                                                         status
-                                                           internalServerError500
-                                                         text
-                                                           "Unable to save order to DB"
-                                                       Just fO -> do
-                                                         status created201
-                                                         Web.Scotty.json
-                                                           (object
-                                                              [ "reportType" .=
-                                                                (0 :: Integer)
-                                                              , "order" .=
-                                                                toJSON
-                                                                  (fO :: ZGoOrder)
-                                                              , "shop" .=
-                                                                oname o'
-                                                              ])
-                                               else do
-                                                 status ok200
-                                                 Web.Scotty.json
-                                                   (object
-                                                      [ "reportType" .=
-                                                        (8 :: Integer)
-                                                      , "order" .=
-                                                        (Nothing :: Maybe ZGoOrder)
-                                                      , "shop" .=
-                                                        (Nothing :: Maybe String)
-                                                      ])
-                                        else do
-                                          status ok200
-                                          Web.Scotty.json
-                                            (object
-                                               [ "reportType" .= (7 :: Integer)
-                                               , "order" .=
-                                                 (Nothing :: Maybe ZGoOrder)
-                                               , "shop" .=
-                                                 (Nothing :: Maybe String)
-                                               ])
-                                 else do
-                                   status ok200
-                                   Web.Scotty.json
-                                     (object
-                                        [ "reportType" .= (6 :: Integer)
-                                        , "order" .= (Nothing :: Maybe ZGoOrder)
-                                        , "shop" .= (Nothing :: Maybe String)
-                                        ])
-                          else do
-                            status ok200
-                            Web.Scotty.json
-                              (object
-                                 [ "reportType" .= (5 :: Integer)
-                                 , "order" .= (Nothing :: Maybe ZGoOrder)
-                                 , "shop" .= (Nothing :: Maybe String)
-                                 ])
-                  else do
-                    status ok200
-                    Web.Scotty.json
-                      (object
-                         [ "reportType" .= (1 :: Integer)
-                         , "order" .= (Nothing :: Maybe ZGoOrder)
-                         , "shop" .= (Nothing :: Maybe String)
-                         ])
-              Just eO -> do
-                status created201
-                Web.Scotty.json
-                  (object
-                     [ "reportType" .= (0 :: Integer)
-                     , "order" .= toJSON (eO :: ZGoOrder)
-                     , "shop" .= oname o'
-                     ])
   -- Get the xeroaccount code
   get "/api/xeroaccount" $ do
-    session <- param "session"
+    oAdd <- param "address"
-    user <- liftAndCatchIO $ run (findUser session)
+    res <- liftAndCatchIO $ run (findToken oAdd)
-    case cast' . Doc =<< user of
-      Nothing -> status unauthorized401
-      Just u -> do
-        res <- liftAndCatchIO $ run (findToken $ uaddress u)
     let c = cast' . Doc =<< res
     case c of
       Nothing -> status noContent204
@@ -855,27 +685,14 @@ routes pipe config = do
              ])
   -- Save the xeroaccount code
   post "/api/xeroaccount" $ do
-    session <- param "session"
+    oAdd <- param "address"
     c <- param "code"
-    user <- liftAndCatchIO $ run (findUser session)
-    case cast' . Doc =<< user of
-      Nothing -> status unauthorized401
-      Just u -> do
-        let oAdd = uaddress u
     liftAndCatchIO $ run (addAccCode oAdd c)
     status accepted202
   -- Get the WooCommerce token
   get "/api/wootoken" $ do
-    session <- param "session"
+    oid <- param "ownerid"
-    user <- liftAndCatchIO $ run (findUser session)
+    res <- liftAndCatchIO $ run (findWooToken (read oid))
-    case cast' . Doc =<< user of
-      Nothing -> status unauthorized401
-      Just u -> do
-        owner <- liftAndCatchIO $ run (findOwner $ uaddress u)
-        case cast' . Doc =<< owner of
-          Nothing -> status internalServerError500
-          Just o -> do
-            res <- liftAndCatchIO $ run (findWooToken $ o_id o)
     let t1 = cast' . Doc =<< res
     case t1 of
       Nothing -> status noContent204
@@ -889,27 +706,19 @@ routes pipe config = do
              ])
   post "/api/wootoken" $ do
     oid <- param "ownerid"
-    session <- param "session"
-    user <- liftAndCatchIO $ run (findUser session)
-    case cast' . Doc =<< user of
-      Nothing -> status unauthorized401
-      Just u -> do
     res <- liftAndCatchIO $ run (findOwnerById oid)
-        case cast' . Doc =<< res of
+    let o1 = cast' . Doc =<< res
-          Nothing -> status badRequest400
+    case o1 of
+      Nothing -> status noContent204
       Just o -> do
-            if oaddress o == uaddress u
+        liftAndCatchIO $ run (generateWooToken o)
-              then do
-                tk <- liftIO generateToken
-                liftAndCatchIO $ run (generateWooToken o tk)
         status accepted202
-              else status forbidden403
   -- Authenticate the WooCommerce plugin
   get "/auth" $ do
     oid <- param "ownerid"
     t <- param "token"
     siteurl <- param "siteurl"
-    res <- liftAndCatchIO $ run (findWooToken $ Just (read oid))
+    res <- liftAndCatchIO $ run (findWooToken (read oid))
     let c1 = cast' . Doc =<< res
     case c1 of
       Nothing -> do
@@ -918,7 +727,7 @@ routes pipe config = do
           (object
              ["authorized" .= False, "message" .= ("Owner not found" :: String)])
       Just c ->
-        if blk3Hash t == blk3Hash (T.unpack $ w_token c)
+        if t == w_token c
           then if isNothing (w_url c)
                  then do
                    liftAndCatchIO $ run (addUrl c siteurl)
@@ -956,10 +765,6 @@ routes pipe config = do
                  [ "authorized" .= False
                  , "message" .= ("Token mismatch" :: String)
                  ])
-        where blk3Hash :: String -> String
-              blk3Hash s =
-                show
-                  (BLK.hash [BA.pack . BS.unpack . C.pack $ s :: BA.Bytes] :: BLK.Digest BLK.DEFAULT_DIGEST_LEN)
   get "/woopayment" $ do
     oid <- param "ownerid"
     t <- param "token"
@@ -969,7 +774,7 @@ routes pipe config = do
     amount <- param "amount"
     sUrl <- param "siteurl"
     orderKey <- param "orderkey"
-    res <- liftAndCatchIO $ run (findWooToken $ Just (read oid))
+    res <- liftAndCatchIO $ run (findWooToken (read oid))
     let c = cast' . Doc =<< res
     case c of
       Nothing -> do
@@ -1001,7 +806,6 @@ routes pipe config = do
                   Just o ->
                     if opaid o
                       then do
-                        tk <- liftIO generateToken
                         let newOrder =
                               ZGoOrder
                                 Nothing
@@ -1028,11 +832,9 @@ routes pipe config = do
                                 (T.concat
                                    [T.pack sUrl, "-", ordId, "-", orderKey])
                                 ""
-                                (T.pack tk)
                         newId <- liftAndCatchIO $ run (insertWooOrder newOrder)
                         status ok200
-                        Web.Scotty.json
+                        Web.Scotty.json (object ["order" .= show newId])
-                          (object ["order" .= show newId, "token" .= tk])
                       else do
                         status accepted202
                         Web.Scotty.json
@@ -1091,20 +893,12 @@ routes pipe config = do
     --Delete user
   Web.Scotty.delete "/api/user/:id" $ do
     userId <- param "id"
-    session <- param "session"
     let r = mkRegex "^[a-f0-9]{24}$"
     if matchTest r userId
-      then do
-        u <- liftAndCatchIO $ run (findUserById userId)
-        case cast' . Doc =<< u of
-          Nothing -> status badRequest400
-          Just u' ->
-            if session == usession u'
       then do
         liftAndCatchIO $ run (deleteUser userId)
         status ok200
-              else status forbidden403
+      else status noContent204
-      else status badRequest400
   --Get current blockheight from Zcash node
   get "/blockheight" $ do
     blockInfo <-
@@ -1135,7 +929,7 @@ routes pipe config = do
                  [ "message" .= ("Owner found!" :: String)
                  , "owner" .= getOwnerSettings o
                  ])
-  get "/ownerid" $ do
+  get "/api/ownerid" $ do
     id <- param "id"
     owner <- liftAndCatchIO $ run (findOwnerById id)
     case owner of
@@ -1149,7 +943,23 @@ routes pipe config = do
             Web.Scotty.json
               (object
                  [ "message" .= ("Owner found!" :: String)
-                 , "owner" .= getOwnerSettings q
+                 , "owner" .=
+                   object
+                     [ "_id" .= (maybe "" show $ o_id q :: String)
+                     , "address" .= oaddress q
+                     , "name" .= oname q
+                     , "currency" .= ocurrency q
+                     , "tax" .= otax q
+                     , "taxValue" .= otaxValue q
+                     , "vat" .= ovat q
+                     , "vatValue" .= ovatValue q
+                     , "paid" .= opaid q
+                     , "zats" .= ozats q
+                     , "invoices" .= oinvoices q
+                     , "expiration" .= oexpiration q
+                     , "payconf" .= opayconf q
+                     , "crmToken" .= ocrmToken q
+                     ]
                  ])
   --Upsert owner to DB
   post "/api/owner" $ do
@@ -1205,58 +1015,10 @@ routes pipe config = do
             liftAndCatchIO $ run $ updateOwnerSettings q
             status accepted202
           else status noContent204
-  post "/api/ownervk" $ do
-    s <- param "session"
-    u <- liftAndCatchIO $ run (findUser s)
-    o <- jsonData
-    let q = payload (o :: Payload String)
-    let qRaw = decodeBech32 $ C.pack q
-    if hrp qRaw == "fail"
-      then status badRequest400
-      else do
-        let qBytes = bytes qRaw
-        case cast' . Doc =<< u of
-          Nothing -> status unauthorized401
-          Just u' -> do
-            if isValidSaplingViewingKey qBytes
-              then if matchSaplingAddress
-                        qBytes
-                        (bytes . decodeBech32 . C.pack . T.unpack $ uaddress u')
-                     then do
-                       owner <- liftAndCatchIO $ run (findOwner $ uaddress u')
-                       case cast' . Doc =<< owner of
-                         Nothing -> status badRequest400
-                         Just o' -> do
-                           unless (oviewkey o' /= "") $ do
-                             vkInfo <-
-                               liftAndCatchIO $
-                               makeZcashCall
-                                 nodeUser
-                                 nodePwd
-                                 "z_importviewingkey"
-                                 [ Data.Aeson.String (T.strip . T.pack $ q)
-                                 , "no"
-                                 ]
-                             let content =
-                                   getResponseBody vkInfo :: RpcResponse Object
-                             if isNothing (err content)
-                               then do
-                                 _ <-
-                                   liftAndCatchIO $ run (upsertViewingKey o' q)
-                                 status created201
-                               else do
-                                 text $ L.pack . show $ err content
-                                 status badRequest400
-                     else status forbidden403
-              else status badRequest400
     --Get items associated with the given address
   get "/api/items" $ do
-    session <- param "session"
+    addr <- param "address"
-    user <- liftAndCatchIO $ run (findUser session)
+    items <- liftAndCatchIO $ run (findItems addr)
-    case cast' . Doc =<< user of
-      Nothing -> status forbidden403
-      Just u -> do
-        items <- liftAndCatchIO $ run (findItems $ uaddress u)
     case items of
       [] -> status noContent204
       _ -> do
@@ -1264,40 +1026,22 @@ routes pipe config = do
         status ok200
         Web.Scotty.json
           (object
-                 [ "message" .= ("Items found!" :: String)
+             ["message" .= ("Items found!" :: String), "items" .= toJSON pItems])
-                 , "items" .= toJSON pItems
-                 ])
     --Upsert item
   post "/api/item" $ do
     i <- jsonData
-    session <- param "session"
-    user <- liftAndCatchIO $ run (findUser session)
-    case cast' . Doc =<< user of
-      Nothing -> status forbidden403
-      Just u -> do
     let q = payload (i :: Payload Item)
-        if uaddress u == iowner q
-          then do
     _ <- liftAndCatchIO $ run (upsertItem q)
     status created201
-          else status forbidden403
     --Delete item
   Web.Scotty.delete "/api/item/:id" $ do
-    session <- param "session"
     oId <- param "id"
-    u' <- liftAndCatchIO $ checkUser run session
+    let r = mkRegex "^[a-f0-9]{24}$"
-    case u' of
+    if matchTest r oId
-      Nothing -> status forbidden403
-      Just u -> do
-        i <- liftAndCatchIO $ run (findItemById oId)
-        case cast' . Doc =<< i of
-          Nothing -> status badRequest400
-          Just i' -> do
-            if iowner i' == uaddress u
       then do
         liftAndCatchIO $ run (deleteItem oId)
         status ok200
-              else status forbidden403
+      else status noContent204
     --Get price for Zcash
   get "/price" $ do
     curr <- param "currency"
@@ -1313,12 +1057,8 @@ routes pipe config = do
              ])
     --Get all closed orders for the address
   get "/api/allorders" $ do
-    session <- param "session"
+    addr <- param "address"
-    user <- liftAndCatchIO $ run (findUser session)
+    myOrders <- liftAndCatchIO $ run (findAllOrders addr)
-    case cast' . Doc =<< user of
-      Nothing -> status unauthorized401
-      Just u -> do
-        myOrders <- liftAndCatchIO $ run (findAllOrders $ uaddress u)
     case myOrders of
       [] -> status noContent204
       _ -> do
@@ -1330,31 +1070,26 @@ routes pipe config = do
              , "orders" .= toJSON pOrders
              ])
     --Get order by id for receipts
-  get "/order/:id" $ do
+  get "/api/order/:id" $ do
     oId <- param "id"
-    token <- param "token"
     let r = mkRegex "^[a-f0-9]{24}$"
     if matchTest r oId
       then do
         myOrder <- liftAndCatchIO $ run (findOrderById oId)
-        case cast' . Doc =<< myOrder of
+        case myOrder of
           Nothing -> status noContent204
+          Just o -> do
+            let o' = cast' (Doc o)
+            case o' of
+              Nothing -> status internalServerError500
               Just pOrder -> do
-            if qtoken pOrder == token
-              then do
-                shop <- liftAndCatchIO $ run (findOwner $ qaddress pOrder)
-                case cast' . Doc =<< shop of
-                  Nothing -> status badRequest400
-                  Just s -> do
                 status ok200
                 Web.Scotty.json
                   (object
                      [ "message" .= ("Order found!" :: String)
                      , "order" .= toJSON (pOrder :: ZGoOrder)
-                         , "shop" .= (oname s :: T.Text)
                      ])
-              else status forbidden403
+      else status noContent204
-      else status badRequest400
     --Get order by session
   get "/api/order" $ do
     sess <- param "session"
@@ -1397,37 +1132,13 @@ routes pipe config = do
   post "/api/order" $ do
     newOrder <- jsonData
     let q = payload (newOrder :: Payload ZGoOrder)
-    session <- param "session"
-    user <- liftAndCatchIO $ run (findUser session)
-    case cast' . Doc =<< user of
-      Nothing -> status unauthorized401
-      Just u -> do
-        if uaddress u == qaddress q
-          then do
-            if qtoken q == ""
-              then do
-                t <- liftIO generateToken
-                _ <-
-                  liftAndCatchIO $
-                  run (upsertOrder $ setOrderToken (T.pack t) q)
-                status created201
-              else do
     _ <- liftAndCatchIO $ run (upsertOrder q)
     status created201
-          else status forbidden403
     --Delete order
   Web.Scotty.delete "/api/order/:id" $ do
     oId <- param "id"
-    session <- param "session"
-    o <- liftAndCatchIO $ run (findOrderById oId)
-    case cast' . Doc =<< o of
-      Nothing -> status badRequest400
-      Just order -> do
-        if qsession order == session
-          then do
     liftAndCatchIO $ run (deleteOrder oId)
     status ok200
-          else status forbidden403
   -- Get language for component
   get "/getmainlang" $ do
     lang <- param "lang"
@@ -1453,22 +1164,6 @@ routes pipe config = do
       Just textPack -> do
         status ok200
         Web.Scotty.json $ toJSON (textPack :: LangComponent)
-  get "/getinvoicelang" $ do
-    lang <- param "lang"
-    txtPack' <- liftAndCatchIO $ run (findLangComponent lang "invoice")
-    case cast' . Doc =<< txtPack' of
-      Nothing -> status noContent204
-      Just textPack -> do
-        status ok200
-        Web.Scotty.json $ toJSON (textPack :: LangComponent)
-  get "/getpmtservicelang" $ do
-    lang <- param "lang"
-    txtPack' <- liftAndCatchIO $ run (findLangComponent lang "pmtservice")
-    case cast' . Doc =<< txtPack' of
-      Nothing -> status noContent204
-      Just textPack -> do
-        status ok200
-        Web.Scotty.json $ toJSON (textPack :: LangComponent)
   get "/api/getlang" $ do
     component <- param "component"
     lang <- param "lang"
@@ -1556,10 +1251,36 @@ listTxs user pwd a confs = do
         Just e -> return $ Left $ "Error reading transactions: " <> emessage e
     Left ex -> return $ Left $ (T.pack . show) ex
 
+-- | Function to check the ZGo full node for new txs
+scanZcash :: Config -> Pipe -> IO ()
+scanZcash config pipe = do
+  myTxs <-
+    listTxs (c_nodeUser config) (c_nodePwd config) (c_nodeAddress config) 1
+  case myTxs of
+    Right txs -> 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 y =
+            mkRegex
+              ".*MSG\\s(zs[a-z0-9]{76})\\s+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}).*"
+      let k = map zToZGoTx (filter (isRelevant r) txs)
+      mapM_ (access pipe master (c_dbName config) . upsertZGoTx "txs") k
+      let j = map zToZGoTx (filter (isRelevant p) txs)
+      mapM_ (upsertPayment pipe (c_dbName config)) j
+      let l = map zToZGoTx (filter (isRelevant y) txs)
+      mapM_ (access pipe master (c_dbName config) . upsertZGoTx "txs") l
+    Left e -> do
+      putStrLn $ "Error scanning node transactions: " ++ T.unpack e
+      return ()
+
 -- | Function to filter transactions
-isRelevant :: Integer -> Text.Regex.Regex -> ZcashTx -> Bool
+isRelevant :: Text.Regex.Regex -> ZcashTx -> Bool
-isRelevant conf re t
+isRelevant re t
-  | zconfirmations t < conf && (matchTest re . T.unpack . zmemo) t = True
+  | zconfirmations t < 100 && (matchTest re . T.unpack . zmemo) t = True
   | otherwise = False
 
 -- | New function to scan transactions with parser
@@ -1575,24 +1296,19 @@ scanZcash' config pipe = do
 -- | Function to scan loaded viewing keys for payments
 scanPayments :: Config -> Pipe -> IO ()
 scanPayments config pipe = do
-  shopRecords <- access pipe master (c_dbName config) findActiveOwners
+  shops <- listAddresses (c_nodeUser config) (c_nodePwd config)
-  case shopRecords of
+  mapM_ (findPaidOrders config pipe) shops
-    [] -> return ()
+  where
-    _ -> do
+    findPaidOrders :: Config -> Pipe -> ZcashAddress -> IO ()
-      let shops = cast' . Doc <$> shopRecords :: [Maybe Owner]
-      let validShopAddresses = map (maybe "" oaddress) $ filter isJust shops
-      mapM_ (findPaidOrders config pipe) validShopAddresses
-      where findPaidOrders :: Config -> Pipe -> T.Text -> IO ()
     findPaidOrders c p z = do
-              print z
+      paidTxs <- listTxs (c_nodeUser c) (c_nodePwd c) (addy z) 5
-              paidTxs <- listTxs (c_nodeUser c) (c_nodePwd c) z 5
       case paidTxs of
         Right txs -> do
           let r = mkRegex ".*ZGo Order::([0-9a-fA-F]{24}).*"
-                  let k = filter (isRelevant (c_confirmations c) r) txs
+          let k = filter (isRelevant r) txs
-                  print k
           let j = map (getOrderId r) k
-                  mapM_ (recordPayment p (c_dbName config) z) j
+          mapM_ (recordPayment p (c_dbName config)) j
+          mapM_ (access p master (c_dbName config) . markOrderPaid) j
         Left e -> print e
     getOrderId :: Text.Regex.Regex -> ZcashTx -> (String, Double)
     getOrderId re t = do
@@ -1600,17 +1316,16 @@ scanPayments config pipe = do
       if not (null reg)
         then (fst $ head reg ! 1, zamount t)
         else ("", 0)
-            recordPayment ::
+    recordPayment :: Pipe -> T.Text -> (String, Double) -> IO ()
-                 Pipe -> T.Text -> T.Text -> (String, Double) -> IO ()
+    recordPayment p dbName x = do
-            recordPayment p dbName z x = do
-              print x
       o <- access p master dbName $ findOrderById (fst x)
       let xOrder = o >>= (cast' . Doc)
       case xOrder of
         Nothing -> error "Failed to retrieve order from database"
         Just xO ->
           when
-                    (not (qpaid xO) && qtotalZec xO == snd x && z == qaddress xO) $ do
+            (not (qpaid xO) &&
+             qexternalInvoice xO /= "" && qtotalZec xO == snd x) $ do
             let sReg = mkRegex "(.*)-([a-fA-f0-9]{24})"
             let sResult = matchAllText sReg (T.unpack $ qsession xO)
             if not (null sResult)
@@ -1621,12 +1336,7 @@ scanPayments config pipe = do
                        case xC of
                          Nothing -> error "Failed to read Xero config"
                          Just xConf -> do
-                                   requestXeroToken
+                           requestXeroToken p dbName xConf "" (qaddress xO)
-                                     p
-                                     dbName
-                                     xConf
-                                     ""
-                                     (qaddress xO)
                            payXeroInvoice
                              p
                              dbName
@@ -1634,17 +1344,13 @@ scanPayments config pipe = do
                              (qaddress xO)
                              (qtotal xO)
                              (qtotalZec xO)
-                                   liftIO $
-                                     access p master dbName $ markOrderPaid x
                      "WC" -> do
                        let wOwner = fst $ head sResult ! 2
                        wooT <-
-                                 access p master dbName $
+                         access p master dbName $ findWooToken (read wOwner)
-                                 findWooToken $ Just (read wOwner)
                        let wT = wooT >>= (cast' . Doc)
                        case wT of
-                                 Nothing ->
+                         Nothing -> error "Failed to read WooCommerce token"
-                                   error "Failed to read WooCommerce token"
                          Just wt -> do
                            let iReg = mkRegex "(.*)-(.*)-.*"
                            let iResult =
@@ -1665,13 +1371,10 @@ scanPayments config pipe = do
                                  (C.pack . T.unpack $ w_token wt)
                                  (C.pack . show $ qprice xO)
                                  (C.pack . show $ qtotalZec xO)
-                                       liftIO $
-                                         access p master dbName $
-                                         markOrderPaid x
                              else error
                                     "Couldn't parse externalInvoice for WooCommerce"
                      _ -> putStrLn "Not an integration order"
-                      else liftIO $ access p master dbName $ markOrderPaid x
+              else putStrLn "Not an integration order"
 
 -- | RPC methods
 -- | List addresses with viewing keys loaded
@@ -1834,17 +1537,4 @@ expireProSessions pipe db = do
           access pipe master db $ removePro (psaddress z)
           access pipe master db $ closeProSession z
 
-checkUser ::
-     (Action IO (Maybe Document) -> IO (Maybe Document))
-  -> T.Text
-  -> IO (Maybe User)
-checkUser run s = do
-  user <- run (findUser s)
-  return $ cast' . Doc =<< user
-
-generateToken :: IO String
-generateToken = do
-  rngState <- newCryptoRNGState
-  runCryptoRNGT rngState $ randomString 24 "abcdef0123456789"
-
 debug = flip trace

src/ZGoTx.hs

@@ -119,6 +119,7 @@ type Parser = Parsec Void T.Text
 
 pSession :: Parser MemoToken
 pSession = do
+  optional spaceChar
   string "ZGO"
   pay <- optional $ char 'p'
   string "::"
@@ -141,18 +142,13 @@ pSaplingAddress = do
 
 pMsg :: Parser MemoToken
 pMsg = do
-  msg <-
+  Msg . T.pack <$>
-    some
+    some (alphaNumChar <|> punctuationChar <|> charCategory OtherSymbol)
-      (alphaNumChar <|> punctuationChar <|> symbolChar <|>
-       charCategory OtherSymbol)
-  pure $ Msg . T.pack $ msg
 
 pMemo :: Parser MemoToken
 pMemo = do
-  optional $ some spaceChar
+  optional spaceChar
-  t <- pSession <|> pSaplingAddress <|> pMsg
+  pSession <|> pSaplingAddress <|> pMsg
-  optional $ some spaceChar
-  return t
 
 isMemoToken :: T.Text -> MemoToken -> Bool
 isMemoToken kind t =

stack.yaml

@@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-20.23
+resolver: lts-20.19
   #url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/4.yaml
 
 # User packages to be built.
@@ -44,16 +44,6 @@ packages:
 extra-deps:
   - git: https://github.com/reach-sh/haskell-hexstring.git
     commit: 085c16fb21b9f856a435a3faab980e7e0b319341
-  - git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
-    commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
-  - git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
-    commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
-  - git: https://github.com/well-typed/borsh.git
-    commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
-  - aeson-2.1.2.1@sha256:5b8d62a60963a925c4d123a46e42a8e235a32188522c9f119f64ac228c2612a7,6359
-  - vector-0.13.0.0@sha256:fa5cac81a17a5af388716792e8b99c24b3b66770086756d0d8b23f8272a0244c,9112
-  - generically-0.1.1
-  - vector-algorithms-0.9.0.1
   - blake3-0.2@sha256:d1146b9a51ccfbb0532780778b6d016a614e3d44c05d8c1923dde9a8be869045,2448
   - crypto-rng-0.3.0.1@sha256:04f4ae75943ecad8b794950985054130f272d65a588b6b6528f56df0bfedc4dc,1565
 # Override default flag values for local packages and extra-deps

stack.yaml.lock

@@ -15,67 +15,6 @@ packages:
   original:
     commit: 085c16fb21b9f856a435a3faab980e7e0b319341
     git: https://github.com/reach-sh/haskell-hexstring.git
-- completed:
-    commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
-    git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
-    name: zcash-haskell
-    pantry-tree:
-      sha256: ec7782cf2646da17548d59af0ea98dcbaac1b6c2176258c696a7f508db6dbc21
-      size: 1126
-    version: 0.1.0
-  original:
-    commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
-    git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
-- completed:
-    commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
-    git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
-    name: foreign-rust
-    pantry-tree:
-      sha256: be2f6fc0fab58a90fec657bdb6bd0ccf0810c7dccfe95c78b85e174fae227e42
-      size: 2315
-    version: 0.1.0
-  original:
-    commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
-    git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
-- completed:
-    commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
-    git: https://github.com/well-typed/borsh.git
-    name: borsh
-    pantry-tree:
-      sha256: 8335925f495a5a653fcb74b6b8bb18cd0b6b7fe7099a1686108704e6ab82f47b
-      size: 2268
-    version: 0.3.0
-  original:
-    commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
-    git: https://github.com/well-typed/borsh.git
-- completed:
-    hackage: aeson-2.1.2.1@sha256:5b8d62a60963a925c4d123a46e42a8e235a32188522c9f119f64ac228c2612a7,6359
-    pantry-tree:
-      sha256: 58d33beedd6e0ff79920c636d8a4295deb684b6e97c9b1ca94d3c780958d6302
-      size: 82465
-  original:
-    hackage: aeson-2.1.2.1@sha256:5b8d62a60963a925c4d123a46e42a8e235a32188522c9f119f64ac228c2612a7,6359
-- completed:
-    hackage: vector-0.13.0.0@sha256:fa5cac81a17a5af388716792e8b99c24b3b66770086756d0d8b23f8272a0244c,9112
-    pantry-tree:
-      sha256: d2461d28022c8c0a91da08b579b1bff478f617102d2f5ef596cc5b28d14b8b6a
-      size: 4092
-  original:
-    hackage: vector-0.13.0.0@sha256:fa5cac81a17a5af388716792e8b99c24b3b66770086756d0d8b23f8272a0244c,9112
-- completed:
-    hackage: generically-0.1.1@sha256:2b9b5efb6eea2fb65377565d53d85b0ccc5b37404fba4bef1d60277caa877e5e,1155
-    pantry-tree:
-      sha256: 98a8fe89d516d3752a9cc0af22cfa652f098cc6613da080762b63aa1d596e56d
-      size: 233
-  original:
-    hackage: generically-0.1.1
-- completed:
-    hackage: vector-algorithms-0.9.0.1@sha256:f3e5c6695529a94edf762117cafd91c989cb642ad3f8ca4014dbb13c8f6c2a20,3826
-    pantry-tree:
-      sha256: aef389e57ae6020e5da719bee40aaf6cccf1c4d1e7743a85d30c9d8c25d170a0
-      size: 1510
-  original:
-    hackage: vector-algorithms-0.9.0.1
 - completed:
     hackage: blake3-0.2@sha256:d1146b9a51ccfbb0532780778b6d016a614e3d44c05d8c1923dde9a8be869045,2448
     pantry-tree:
@@ -92,7 +31,7 @@ packages:
     hackage: crypto-rng-0.3.0.1@sha256:04f4ae75943ecad8b794950985054130f272d65a588b6b6528f56df0bfedc4dc,1565
 snapshots:
 - completed:
-    sha256: 4c972e067bae16b95961dbfdd12e07f1ee6c8fffabbfa05c3d65100b03f548b7
+    sha256: 42f77c84b34f68c30c2cd0bf8c349f617a0f428264362426290847a6a2019b64
-    size: 650253
+    size: 649618
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/23.yaml
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/19.yaml
-  original: lts-20.23
+  original: lts-20.19

test/Spec.hs

@@ -13,12 +13,10 @@ import Data.Either
 import Data.Maybe
 import Data.SecureMem
 import qualified Data.Text as T
-import qualified Data.Text.Encoding as E
 import Data.Time
 import Data.Time.Calendar
 import Data.Time.Clock
 import Data.Time.Clock.POSIX
-import qualified Data.UUID as U
 import Database.MongoDB
 import Item
 import LangComponent
@@ -34,7 +32,6 @@ import Test.Hspec.QuickCheck
 import Test.QuickCheck
 import Test.QuickCheck.Gen
 import Test.QuickCheck.Monadic
-import Text.Megaparsec
 import User
 import Web.Scotty
 import WooCommerce
@@ -56,31 +53,7 @@ main = do
       describe "hex strings" $ do
         prop "encoding and decoding are inverse" $ \x ->
           (decodeHexText . encodeHexText) x == x
-      describe "zToZGoTx" $
+      describe "zToZGoTx" $ do
-        --prop "memo parsing" testMemoParser
-       do
-        it "parse ZecWallet memo" $ do
-          let m =
-                runParser
-                  pZGoMemo
-                  "Zecwalllet memo"
-                  "ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
-          case m of
-            Left e -> putStrLn $ errorBundlePretty e
-            Right m' ->
-              m_session m' `shouldBe`
-              U.fromString "5d3d4494-51c0-432d-8495-050419957aea"
-        it "parse YWallet memo" $ do
-          let m =
-                runParser
-                  pZGoMemo
-                  "Ywallet memo"
-                  "\128737MSG\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e\n\nZGO::ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
-          case m of
-            Left e -> putStrLn $ errorBundlePretty e
-            Right m' ->
-              m_session m' `shouldBe`
-              U.fromString "ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
         it "converts ZecWallet tx to ZGo tx" $ do
           let t =
                 ZcashTx
@@ -183,13 +156,32 @@ main = do
             getResponseStatus res `shouldBe` accepted202
         describe "Price endpoint" $ do
           it "returns a price for an existing currency" $ do
-            req <- testGet "/price" [("currency", Just "usd")]
+            req <-
+              testGet
+                "/api/price"
+                [ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
+                , ("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 "/price" [("currency", Just "jpy")]
+            req <-
+              testGet
+                "/api/price"
+                [ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
+                , ("currency", Just "jpy")
+                ]
             res <- httpLBS req
             getResponseStatus res `shouldBe` noContent204
+          it "returs 401 when the session is not valid" $ do
+            req <-
+              testGet
+                "/api/price"
+                [ ("session", Just "th7s1sa-fake-6u1d-7h47-1m4deuph3r3")
+                , ("currency", Just "usd")
+                ]
+            res <- httpLBS req
+            getResponseStatus res `shouldBe` unauthorized401
         describe "Countries endpoint" $ do
           it "returns a list of countries" $ do
             req <-
@@ -209,7 +201,7 @@ main = do
           it "returns a block number" $ do
             req <-
               testGet
-                "/blockheight"
+                "/api/blockheight"
                 [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
             res <- httpJSON req
             height (getResponseBody (res :: Response Block)) `shouldSatisfy` \x ->
@@ -233,32 +225,18 @@ main = do
               req <-
                 testGet
                   "/api/xeroaccount"
-                  [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
+                  [ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
+                  , ("address", Just "Zaddy")
+                  ]
               res <- httpJSON req
               getResponseStatus (res :: Response A.Value) `shouldBe` ok200
-            it "reading returns 401 with invalid session" $ do
+            it "returns 401 with invalid session" $ do
               req <-
                 testGet
                   "/api/xeroaccount"
                   [("session", Just "fnelrkgnlyebrlvns82949")]
               res <- httpLBS req
               getResponseStatus res `shouldBe` unauthorized401
-            it "setting returns 401 with invalid session" $ do
-              req <-
-                testPost
-                  "/api/xeroaccount"
-                  [("session", Just "fnelrkgnlyebrlvns82949")]
-              res <- httpLBS req
-              getResponseStatus res `shouldBe` unauthorized401
-            it "setting succeeds with valid session" $ do
-              req <-
-                testPost
-                  "/api/xeroaccount"
-                  [ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
-                  , ("code", Just "ZEC")
-                  ]
-              res <- httpLBS req
-              getResponseStatus res `shouldBe` accepted202
         describe "User endpoint" $ do
           it "returns a user for a session" $ do
             req <-
@@ -274,37 +252,12 @@ main = do
                 [("session", Just "suchafak-euui-dican-eve-nbelieveitca")]
             res <- httpLBS req
             getResponseStatus res `shouldBe` unauthorized401
-          describe "delete" $ do
-            it "returns 401 when session is invalid" $ do
-              req <-
-                testDelete
-                  "/api/user/"
-                  "6272a90f2b05a74cf1000005"
-                  [("session", Just "suchafak-euui-dican-eve-nbelieveitca")]
-              res <- httpLBS req
-              getResponseStatus res `shouldBe` unauthorized401
-            it "returns 403 when user and session don't match" $ do
-              req <-
-                testDelete
-                  "/api/user/"
-                  "6272a90f2b05a74cf1000005"
-                  [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
-              res <- httpLBS req
-              getResponseStatus res `shouldBe` forbidden403
-            it "returns 400 when user is invalid" $ do
-              req <-
-                testDelete
-                  "/api/user/"
-                  "000000000000000000000000"
-                  [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
-              res <- httpLBS req
-              getResponseStatus res `shouldBe` badRequest400
           it "deletes user by id" $ do
             req <-
               testDelete
                 "/api/user/"
                 "6272a90f2b05a74cf1000003"
-                  [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdaa")]
+                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
             res <- httpLBS req
             getResponseStatus res `shouldBe` ok200
         describe "Owner endpoint" $
@@ -341,90 +294,8 @@ main = do
                 ]
             res <- httpLBS req
             getResponseStatus res `shouldBe` ok200
-        describe "Order endpoints" $
+        describe "Order endpoints" $ do
-          --prop "upsert order" testOrderAdd
+          prop "upsert order" testOrderAdd
-         do
-          it "adding order with bad session fails with 401" $ do
-            myTs <- liftIO getCurrentTime
-            let testOrder =
-                  ZGoOrder
-                    (Just (read "627ab3ea2b05a76be3000011"))
-                    "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
-                    "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
-                    myTs
-                    False
-                    "usd"
-                    102.0
-                    0
-                    0
-                    []
-                    False
-                    ""
-                    ""
-                    "testToken4321"
-            req <-
-              testPostJson "/api/order" $
-              A.object ["payload" A..= A.toJSON testOrder]
-            res <-
-              httpLBS $
-              setRequestQueryString
-                [("session", Just "35bfb9c2-9ad2-fake-adda-99d63b8dcdcd")]
-                req
-            getResponseStatus res `shouldBe` unauthorized401
-          it "adding order with mismatched session fails with 403" $ do
-            myTs <- liftIO getCurrentTime
-            let testOrder =
-                  ZGoOrder
-                    (Just (read "627ab3ea2b05a76be3000011"))
-                    "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
-                    "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
-                    myTs
-                    False
-                    "usd"
-                    102.0
-                    0
-                    0
-                    []
-                    False
-                    ""
-                    ""
-                    "testToken4321"
-            req <-
-              testPostJson "/api/order" $
-              A.object ["payload" A..= A.toJSON testOrder]
-            res <-
-              httpLBS $
-              setRequestQueryString
-                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dfake")]
-                req
-            getResponseStatus res `shouldBe` forbidden403
-          it "adding order with correct session succeeds" $ do
-            myTs <- liftIO getCurrentTime
-            let testOrder =
-                  ZGoOrder
-                    (Just (read "627ab3ea2b05a76be3000011"))
-                    "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
-                    "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
-                    myTs
-                    False
-                    "usd"
-                    102.0
-                    0
-                    0
-                    []
-                    False
-                    ""
-                    ""
-                    "testToken4321"
-            req <-
-              testPostJson "/api/order" $
-              A.object ["payload" A..= A.toJSON testOrder]
-            res <-
-              httpLBS $
-              setRequestQueryString
-                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
-                req
-            getResponseStatus res `shouldBe` created201
           it "get order by session" $ do
             req <-
               testGet
@@ -432,7 +303,7 @@ main = do
                 [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` ok200
-          it "get order by session fails with bad session" $ do
+          it "get order by session fails when invalid" $ do
             req <-
               testGet
                 "/api/order"
@@ -442,49 +313,40 @@ main = do
           it "get order by id" $ do
             req <-
               testGet
-                "/order/627ab3ea2b05a76be3000000"
+                "/api/order/627ab3ea2b05a76be3000000"
-                [("token", Just "testToken1234")]
+                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` ok200
-          it "get order with invalid id fails with 400" $ do
+          it "get order with wrong id" $ do
-            req <- testGet "/order/6273hrb" [("token", Just "testToken1234")]
-            res <- httpLBS req
-            getResponseStatus res `shouldBe` badRequest400
-          it "get order by id fails with bad token" $ do
             req <-
               testGet
-                "/order/627ab3ea2b05a76be3000000"
+                "/api/order/6273hrb"
-                [("token", Just "wrongToken1234")]
+                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
             res <- httpLBS req
-            getResponseStatus res `shouldBe` forbidden403
+            getResponseStatus res `shouldBe` noContent204
+          it "get order by id fails with bad session" $ do
+            req <-
+              testGet
+                "/api/order/627ab3ea2b05a76be3000000"
+                [("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
+            res <- httpLBS req
+            getResponseStatus res `shouldBe` unauthorized401
           it "get all orders for owner" $ do
             req <-
               testGet
                 "/api/allorders"
-                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
+                [ ("address", Just "Zaddy")
+                , ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
+                ]
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` ok200
           it "get all orders for owner fails with bad session" $ do
             req <-
               testGet
                 "/api/allorders"
-                [("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
+                [ ("address", Just "Zaddy")
-            res <- httpLBS req
+                , ("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")
-            getResponseStatus res `shouldBe` unauthorized401
+                ]
-          it "delete order by id fails with mismatched session" $ do
-            req <-
-              testDelete
-                "/api/order/"
-                "627ab3ea2b05a76be3000000"
-                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dfake")]
-            res <- httpLBS req
-            getResponseStatus res `shouldBe` forbidden403
-          it "delete order by id fails with bad session" $ do
-            req <-
-              testDelete
-                "/api/order/"
-                "627ab3ea2b05a76be3000000"
-                [("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
             res <- httpLBS req
             getResponseStatus res `shouldBe` unauthorized401
           it "delete order by id" $ do
@@ -495,98 +357,35 @@ main = do
                 [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
             res <- httpLBS req
             getResponseStatus res `shouldBe` ok200
-        describe "Item endpoint" $ do
+          it "delete order by id fails with bad session" $ do
-          it "adding item with bad session fails" $ do
-            let item =
-                  Item
-                    Nothing
-                    "Table"
-                    "Oak"
-                    "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
-                    499.99
             req <-
-              testPostJson "/api/item" $ A.object ["payload" A..= A.toJSON item]
+              testDelete
-            res <-
+                "/api/order/"
-              httpLBS $
+                "627ab3ea2b05a76be3000000"
-              setRequestQueryString
-                [("session", Just "35bfb9c2-9ad2-fake-adda-99d63b8dcdcd")]
-                req
-            getResponseStatus res `shouldBe` unauthorized401
-          it "adding item with good session succeeds" $ do
-            let item =
-                  Item
-                    (Just (read "627d7ba92b05a76be3000013"))
-                    "Table"
-                    "Oak"
-                    "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
-                    499.99
-            req <-
-              testPostJson "/api/item" $ A.object ["payload" A..= A.toJSON item]
-            res <-
-              httpLBS $
-              setRequestQueryString
-                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
-                req
-            getResponseStatus res `shouldBe` created201
-          it "get items with valid session succeeds" $ do
-            req <-
-              testGet
-                "/api/items"
-                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
-            res <- httpJSON req
-            getResponseStatus (res :: Response A.Value) `shouldBe` ok200
-          it "get items with invalid session returns 401" $ do
-            req <-
-              testGet
-                "/api/items"
                 [("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
             res <- httpLBS req
             getResponseStatus res `shouldBe` unauthorized401
-          describe "delete item" $ do
+        describe "Item endpoint" $ do
-            it "returns 401 with invalid session and item ID" $ do
+          prop "add item" testItemAdd
+          it "get items" $ do
+            req <-
+              testGet
+                "/api/items"
+                [ ("address", Just "Zaddy")
+                , ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
+                ]
+            res <- httpJSON req
+            getResponseStatus (res :: Response A.Value) `shouldBe` ok200
+          it "delete item" $ do
             req <-
               testDelete
                 "/api/item/"
                 "627d7ba92b05a76be3000003"
-                  [("session", Just "35bfb9c2-9ad2-fake-adda-99d63b8dcdcd")]
-              res <- httpLBS req
-              getResponseStatus res `shouldBe` unauthorized401
-            it "returns 403 when item ID doesn't belong to session" $ do
-              req <-
-                testDelete
-                  "/api/item/"
-                  "627d7ba92b05a76be3000003"
-                  [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
-              res <- httpLBS req
-              getResponseStatus res `shouldBe` forbidden403
-            it "succeeds with valid session and item ID" $ do
-              req <-
-                testDelete
-                  "/api/item/"
-                  "627d7ba92b05a76be3000013"
                 [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
             res <- httpLBS req
             getResponseStatus res `shouldBe` ok200
         describe "WooCommerce endpoints" $ do
-          it "generate token with invalid session gives 401" $ do
+          it "generate token" $ do
-            req <-
-              testPost
-                "/api/wootoken"
-                [ ("ownerid", Just "627ad3492b05a76be3000001")
-                , ("session", Just "35bfb9c2-9ad2-fake-adda-99d63b8dcdcd")
-                ]
-            res <- httpLBS req
-            getResponseStatus res `shouldBe` unauthorized401
-          it "generate token with mismatched session gives 403" $ do
-            req <-
-              testPost
-                "/api/wootoken"
-                [ ("ownerid", Just "627ad3492b05a76be3000001")
-                , ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dfake")
-                ]
-            res <- httpLBS req
-            getResponseStatus res `shouldBe` forbidden403
-          it "generate token with valid session succeeds" $ do
             req <-
               testPost
                 "/api/wootoken"
@@ -595,20 +394,6 @@ main = do
                 ]
             res <- httpLBS req
             getResponseStatus res `shouldBe` accepted202
-          it "read token gives 401 with bad session" $ do
-            req <-
-              testGet
-                "/api/wootoken"
-                [("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
-            res <- httpLBS req
-            getResponseStatus res `shouldBe` unauthorized401
-          it "read token succeeds with valid session" $ do
-            req <-
-              testGet
-                "/api/wootoken"
-                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
-            res <- httpJSON req
-            getResponseStatus (res :: Response A.Value) `shouldBe` ok200
           it "authenticate with incorrect owner" $ do
             req <-
               testPublicGet
@@ -632,17 +417,13 @@ main = do
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
           it "authenticate with correct token" $ do
-            req1 <-
-              testGet
-                "/api/wootoken"
-                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
-            res1 <- httpJSON req1
-            let tk = getResponseBody (res1 :: Response WooToken)
             req <-
               testPublicGet
                 "/auth"
                 [ ("ownerid", Just "627ad3492b05a76be3000001")
-                , ("token", Just $ (E.encodeUtf8 . w_token) tk)
+                , ( "token"
+                  , Just
+                      "0c1702c16c7bd7e075b8bb129b24888a5cc2181fa1eb4ce9190cfcb625ecf0ee")
                 , ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
                 ]
             res <- httpJSON req
@@ -660,17 +441,13 @@ main = do
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
           it "request order creation" $ do
-            req1 <-
-              testGet
-                "/api/wootoken"
-                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
-            res1 <- httpJSON req1
-            let tk = getResponseBody (res1 :: Response WooToken)
             req <-
               testPublicGet
                 "/woopayment"
                 [ ("ownerid", Just "627ad3492b05a76be3000001")
-                , ("token", Just $ (E.encodeUtf8 . w_token) tk)
+                , ( "token"
+                  , Just
+                      "0c1702c16c7bd7e075b8bb129b24888a5cc2181fa1eb4ce9190cfcb625ecf0ee")
                 , ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
                 , ("order_id", Just "1234")
                 , ("currency", Just "usd")
@@ -721,63 +498,6 @@ main = do
                 ]
             res <- httpLBS req
             getResponseStatus res `shouldBe` noContent204
-        describe "Viewing Key endpoint" $ do
-          let vk0 =
-                "zxviews1qwrw0jlxqqqqpqr9faepwqpgj09f0ee55mfwl60eumv6duk5pwncntweah0xdlhqrwre2fgmgersah9atx92z6pmxec8t32mpz59t47yuplkcdcaw3873aalv7e59xhwv846g9q9qjy0ypc68ceypg6pux490dr4snsc4m482l57rvnzj2lsh4f3dv6mltc75z72pypkx0dchwpumdwfuajstfhwulv30kjt5l0x7juwe523ufwz2xleplxf37gk2pfh59gmdjr4zsql4ga9p"
-          let vk1 =
-                "zxviews1qdjagrrpqqqqpq8es75mlu6rref0qyrstchf8dxzeygtsejwfqu8ckhwl2qj5m8am7lmupxk3vkvdjm8pawjpmesjfapvsqw96pa46c2z0kk7letrxf7mkltwz54fwpxc7kc79mm5kce3rwn5ssl009zwsra2spppwgrx25s9k5hq65f69l4jz2tjmqgy0pl49qmtaj3nudk6wglwe2hpa327hydlchtyq9av6wjd6hu68e04ahwk9a9n2kt0kj3nj99nue65awtu5cwwcpjs"
-          let vk2 =
-                "zxviews1qdjagrrpqqqqpq8es75mlufakef0qyrstchf8dxzeygtsejwfqu8ckhwl2qj5m8am7lmupxk3vkvdjm8pawjpmesjfapvsqw96pa46c2z0kk7letrxf7mkltwz54fwpxc7kc79mm5kce3rwn5ssl009zwsra2spppwgrx25s9k5hq65f69l4jz2tjmqgy0pl49qmtaj3nudk6wglwe2hpa327hydlchtyq9av6wjd6hu68e04ahwk9a9n2kt0kj3nj99nue65awtu5cwwcpjs"
-          it "returns 401 with bad session" $ do
-            req <-
-              testPostJson "/api/ownervk" $
-              A.object ["payload" A..= (vk0 :: String)]
-            res <-
-              httpLBS $
-              setRequestQueryString
-                [("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
-                req
-            getResponseStatus res `shouldBe` unauthorized401
-          it "returns 403 with mismatched session" $ do
-            req <-
-              testPostJson "/api/ownervk" $
-              A.object ["payload" A..= (vk0 :: String)]
-            res <-
-              httpLBS $
-              setRequestQueryString
-                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
-                req
-            getResponseStatus res `shouldBe` forbidden403
-          it "returns 400 with malformed key" $ do
-            req <-
-              testPostJson "/api/ownervk" $
-              A.object ["payload" A..= (vk2 :: String)]
-            res <-
-              httpLBS $
-              setRequestQueryString
-                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
-                req
-            getResponseStatus res `shouldBe` badRequest400
-          it "returns 400 with non-key valid bech32" $ do
-            req <-
-              testPostJson "/api/ownervk" $
-              A.object ["payload" A..= ("bech321qqqsyrhqy2a" :: String)]
-            res <-
-              httpLBS $
-              setRequestQueryString
-                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
-                req
-            getResponseStatus res `shouldBe` badRequest400
-          it "succeeds with correct key" $ do
-            req <-
-              testPostJson "/api/ownervk" $
-              A.object ["payload" A..= (vk1 :: String)]
-            res <-
-              httpLBS $
-              setRequestQueryString
-                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
-                req
-            getResponseStatus res `shouldBe` created201
     around handleDb $
       describe "Database actions" $ do
         describe "authentication" $ do
@@ -792,7 +512,7 @@ main = do
             doc <-
               access p master "test" $
               findProSession
-                "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
+                "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
             doc `shouldNotBe` Nothing
           it "upsert to DB" $ const pending
         describe "Zcash prices" $ do
@@ -853,7 +573,7 @@ main = do
             let myOrder =
                   ZGoOrder
                     (Just (read "627ab3ea2b05a76be3000001"))
-                    "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
+                    "Zaddy"
                     "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
                     myTs
                     False
@@ -865,7 +585,6 @@ main = do
                     False
                     ""
                     ""
-                    "testToken1234"
             let ordTest = val myOrder
             case ordTest of
               Doc oT -> access p master "test" (insert_ "orders" oT)
@@ -881,26 +600,25 @@ main = do
               Just o2 -> qpaid o2 `shouldBe` True
         describe "Xero data" $ do
           it "token is saved" $ \p -> do
-            t <-
+            let myToken =
-              access p master "test" $
+                  XeroToken
-              findToken
+                    Nothing
-                "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
+                    "Zaddy"
+                    "superFakeToken123"
+                    1800
+                    "anotherSuperFakeToken"
+                    (UTCTime (fromGregorian 2022 9 16) (secondsToDiffTime 0))
+                    (UTCTime (fromGregorian 2022 9 16) (secondsToDiffTime 0))
+                    ""
+            _ <- access p master "test" $ upsertToken myToken
+            t <- access p master "test" $ findToken "Zaddy"
             let t1 = (cast' . Doc) =<< t
             case t1 of
               Nothing -> True `shouldBe` False
-              Just t2 ->
+              Just t2 -> t_address t2 `shouldBe` "Zaddy"
-                t_address t2 `shouldBe`
-                "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
           it "code is saved" $ \p -> do
-            _ <-
+            _ <- access p master "test" $ addAccCode "Zaddy" "ZEC"
-              access p master "test" $
+            t <- access p master "test" $ findToken "Zaddy"
-              addAccCode
-                "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
-                "ZEC"
-            t <-
-              access p master "test" $
-              findToken
-                "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
             let t1 = (cast' . Doc) =<< t
             case t1 of
               Nothing -> True `shouldBe` False
@@ -932,7 +650,7 @@ main = do
             let myUser =
                   User
                     (Just (read "6272a90f2b05a74cf1000002" :: ObjectId))
-                    "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
+                    "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
                     "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcb"
                     1613487
                     "1234567"
@@ -974,13 +692,13 @@ main = do
                   findOne
                     (select
                        [ "address" =:
-                         ("zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4" :: T.Text)
+                         ("zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" :: T.Text)
                        ]
                        "owners")
                 let s = (cast' . Doc) =<< t
                 let ownerPaid = maybe False opaid s
                 ownerPaid `shouldBe` True
-              _ -> True `shouldBe` False --`debug` "Failed parsing payment"
+              _ -> True `shouldBe` False `debug` "Failed parsing payment"
           xit "owners are expired" $ \p -> do
             _ <- expireOwners p "test"
             now <- getCurrentTime
@@ -999,7 +717,7 @@ main = do
             let myTx =
                   ZGoTx
                     Nothing
-                    "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
+                    "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
                     "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdca"
                     3
                     1613487
@@ -1082,23 +800,6 @@ testDelete endpoint par body = do
         setRequestPath (B.append endpoint par) defaultRequest
   return testRequest
 
-testMemoParser :: T.Text -> T.Text -> T.Text -> Property
-testMemoParser t1 t2 t3 =
-  monadicIO $ do
-    let res =
-          runParser pZGoMemo "Parser test" $
-          t1 <>
-          " zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e " <>
-          t2 <> " ZGO::5d3d4494-51c0-432d-8495-050419957aea " <> t3
-    case res of
-      Left e -> assert False `debug` errorBundlePretty e
-      Right zm ->
-        assert $
-        U.fromString "5d3d4494-51c0-432d-8495-050419957aea" == m_session zm &&
-        Just
-          "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" ==
-        m_address zm
-
 testOwnerAdd :: Owner -> Property
 testOwnerAdd o =
   monadicIO $ do
@@ -1147,14 +848,6 @@ closeDbConnection = close
 handleDb :: (Pipe -> Expectation) -> IO ()
 handleDb = bracket openDbConnection closeDbConnection
 
-filterDocs :: Value -> Bool
-filterDocs (Doc v) = True
-filterDocs _ = False
-
-unwrapDoc :: Value -> Document
-unwrapDoc (Doc v) = v
-unwrapDoc _ = []
-
 startAPI :: Config -> IO ()
 startAPI config = do
   putStrLn "Starting test server ..."
@@ -1167,39 +860,54 @@ startAPI config = do
   _ <- access pipe master "test" (Database.MongoDB.delete (select [] "users"))
   _ <- access pipe master "test" (Database.MongoDB.delete (select [] "items"))
   _ <- access pipe master "test" (Database.MongoDB.delete (select [] "orders"))
-  _ <-
-    access pipe master "test" (Database.MongoDB.delete (select [] "xerotokens"))
   let myUser =
         User
           (Just (read "6272a90f2b05a74cf1000001" :: ObjectId))
-          "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
+          "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
           "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
           1613487
           "8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
           False
+  _ <-
+    access
+      pipe
+      master
+      "test"
+      (insert_
+         "users"
+         [ "address" =: uaddress myUser
+         , "_id" =: u_id myUser
+         , "session" =: usession myUser
+         , "blocktime" =: ublocktime myUser
+         , "pin" =: upin myUser
+         , "validated" =: uvalidated myUser
+         ])
   let myUser1 =
         User
           (Just (read "6272a90f2b05a74cf1000003" :: ObjectId))
-          "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
+          "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
-          "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdaa"
+          "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
           1613487
           "8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
           True
-  let myUser2 =
+  _ <-
-        User
+    access
-          (Just (read "6272a90f2b05a74cf1000005" :: ObjectId))
+      pipe
-          "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3fake"
+      master
-          "35bfb9c2-9ad2-4fe5-adda-99d63b8dfake"
+      "test"
-          1613487
+      (insert_
-          "8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
+         "users"
-          True
+         [ "address" =: uaddress myUser1
-  let userList =
+         , "_id" =: u_id myUser1
-        map unwrapDoc $ filter filterDocs $ val <$> [myUser, myUser1, myUser2]
+         , "session" =: usession myUser1
-  _ <- access pipe master "test" (insertAll_ "users" userList)
+         , "blocktime" =: ublocktime myUser1
+         , "pin" =: upin myUser1
+         , "validated" =: uvalidated myUser1
+         ])
   let myOwner =
         Owner
           (Just (read "627ad3492b05a76be3000001"))
-          "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
+          "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
           "Test shop"
           "usd"
           False
@@ -1223,48 +931,17 @@ startAPI config = do
           False
           ""
           ""
-  let myOwner1 =
-        Owner
-          (Just (read "627ad3492b05a76be3000008"))
-          "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3fake"
-          "Test shop 2"
-          "usd"
-          False
-          0
-          False
-          0
-          "Roxy"
-          "Foo"
-          "roxy@zgo.cash"
-          "1 Main St"
-          "Mpls"
-          "Minnesota"
-          "55401"
-          ""
-          "missyfoo.io"
-          "United States"
-          True
-          False
-          False
-          (UTCTime (fromGregorian 2023 8 6) (secondsToDiffTime 0))
-          False
-          ""
-          ""
   _ <- access pipe master "test" (Database.MongoDB.delete (select [] "owners"))
   let o = val myOwner
   case o of
     Doc d -> access pipe master "test" (insert_ "owners" d)
     _ -> fail "Couldn't save Owner in DB"
-  let o1 = val myOwner1
-  case o1 of
-    Doc d1 -> access pipe master "test" (insert_ "owners" d1)
-    _ -> fail "Couldn't save Owner1 in DB"
   _ <- access pipe master "test" (Database.MongoDB.delete (select [] "orders"))
   myTs <- liftIO getCurrentTime
   let myOrder =
         ZGoOrder
           (Just (read "627ab3ea2b05a76be3000000"))
-          "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
+          "Zaddy"
           "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
           myTs
           False
@@ -1276,7 +953,6 @@ startAPI config = do
           False
           ""
           ""
-          "testToken1234"
   let ordTest = val myOrder
   case ordTest of
     Doc oT -> access pipe master "test" (insert_ "orders" oT)
@@ -1295,24 +971,13 @@ startAPI config = do
   let proSession1 =
         ZGoProSession
           Nothing
-          "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
+          "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
           myTs
           False
   let proSessionTest = val proSession1
   case proSessionTest of
     Doc pS1 -> access pipe master "test" (insert_ "prosessions" pS1)
     _ -> fail "Couldn't save test ZGoProSession in DB"
-  let myToken =
-        XeroToken
-          Nothing
-          "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
-          "superFakeToken123"
-          1800
-          "anotherSuperFakeToken"
-          (UTCTime (fromGregorian 2022 9 16) (secondsToDiffTime 0))
-          (UTCTime (fromGregorian 2022 9 16) (secondsToDiffTime 0))
-          ""
-  _ <- access pipe master "test" $ upsertToken myToken
   --let myWooToken =
         --WooToken
           --Nothing
@@ -1341,8 +1006,7 @@ instance Arbitrary ZGoOrder where
     l <- arbitrary
     pd <- arbitrary
     eI <- arbitrary
-    sc <- arbitrary
+    ZGoOrder i a s ts c cur p t tZ l pd eI <$> arbitrary
-    ZGoOrder i a s ts c cur p t tZ l pd eI sc <$> arbitrary
 
 instance Arbitrary LineItem where
   arbitrary = do

zgo-backend.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           zgo-backend
-version:        1.6.0
+version:        1.5.0
 synopsis:       Haskell Back-end for the ZGo point-of-sale application
 description:    Please see the README at <https://git.vergara.tech/Vergara_Tech//zgo-backend#readme>
 category:       Web
@@ -78,7 +78,6 @@ library
     , wai-cors
     , wai-extra
     , warp-tls
-    , zcash-haskell
   default-language: Haskell2010
 
 executable zgo-backend-exe
@@ -176,13 +175,10 @@ test-suite zgo-backend-test
     , hspec-wai
     , http-conduit
     , http-types
-    , megaparsec
     , mongoDB
     , scotty
     , securemem
     , text
     , time
-    , uuid
-    , zcash-haskell
     , zgo-backend
   default-language: Haskell2010

zgo.cfg

@@ -6,7 +6,6 @@ dbUser = "zgo"
 dbPassword = "zcashrules"
 nodeUser = "zecwallet"
 nodePassword = "rdsxlun6v4a"
-confirmations = 100
 port = 3000
 tls = false
 certificate = "/path/to/cert.pem"

zgotest.cfg

@@ -6,7 +6,6 @@ dbUser = "zgo"
 dbPassword = "zcashrules"
 nodeUser = "zecwallet"
 nodePassword = "rdsxlun6v4a"
-confirmations = 100
 port = 3000
 tls = false
 certificate = "/path/to/cert.pem"