Merge branch 'dev'

CHANGELOG.md

@@ -4,6 +4,26 @@ 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.3.0] - 2023-03-16
+
+### Added
+
+- New type to handle UI translation objects
+- New endpoints for API to get/set translation
+- Tests for translation endpoints
+- Formal parser of ZGo-related tokens in memos
+
+### Changed
+
+- Remove old code for PIN generation
+- Xero reference field to include the amount of ZEC received
+- Separate periodic tasks from API server
+- Zcash transaction monitoring changed to use memo parser
+
+### Fixed
+
+- Xero token generation for brand new users
+
 ## [1.2.5] - 2023-02-01
 
 ### Fixed

app/Server.hs

@@ -3,7 +3,8 @@
 module Server where
 
 import Config
-import Control.Concurrent (forkIO)
+
+--import Control.Concurrent (forkIO)
 import Database.MongoDB
 import Network.Wai.Handler.Warp (defaultSettings, setPort)
 import Network.Wai.Handler.WarpTLS (runTLS, tlsSettings)
@@ -30,12 +31,12 @@ main = do
   if j
     then putStrLn "Connected to MongoDB!"
     else fail "MongoDB connection failed!"
-  _ <- forkIO (setInterval 60 (checkZcashPrices pipe (c_dbName loadedConfig)))
+  {-_ <- forkIO (setInterval 60 (checkZcashPrices pipe (c_dbName loadedConfig)))-}
-  _ <- forkIO (setInterval 75 (scanZcash loadedConfig pipe))
+  {-_ <- forkIO (setInterval 75 (scanZcash loadedConfig pipe))-}
-  _ <- forkIO (setInterval 90 (scanPayments loadedConfig pipe))
+  {-_ <- forkIO (setInterval 90 (scanPayments loadedConfig pipe))-}
-  _ <- forkIO (setInterval 60 (checkPayments pipe (c_dbName loadedConfig)))
+  {-_ <- forkIO (setInterval 60 (checkPayments pipe (c_dbName loadedConfig)))-}
-  _ <- forkIO (setInterval 60 (expireOwners pipe (c_dbName loadedConfig)))
+  {-_ <- forkIO (setInterval 60 (expireOwners pipe (c_dbName loadedConfig)))-}
-  _ <- forkIO (setInterval 60 (updateLogins pipe loadedConfig))
+  {-_ <- forkIO (setInterval 60 (updateLogins pipe loadedConfig))-}
   let appRoutes = routes pipe loadedConfig
   case myTlsSettings of
     Nothing -> scotty (c_port loadedConfig) appRoutes

app/Tasks.hs

@@ -0,0 +1,31 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Tasks where
+
+import Config
+import Database.MongoDB
+import ZGoBackend
+
+main :: IO ()
+main = do
+  putStrLn "ZGo Recurring Tasks"
+  putStrLn "Reading config..."
+  loadedConfig <- loadZGoConfig "zgo.cfg"
+  pipe <- connect $ host (c_dbHost loadedConfig)
+  j <-
+    access
+      pipe
+      master
+      (c_dbName loadedConfig)
+      (auth (c_dbUser loadedConfig) (c_dbPassword loadedConfig))
+  if j
+    then do
+      putStrLn "Connected to MongoDB!"
+      checkZcashPrices pipe (c_dbName loadedConfig)
+      scanZcash' loadedConfig pipe
+      scanPayments loadedConfig pipe
+      checkPayments pipe (c_dbName loadedConfig)
+      expireOwners pipe (c_dbName loadedConfig)
+      updateLogins pipe loadedConfig
+      close pipe
+    else fail "MongoDB connection failed!"

app/TokenRefresh.hs

@@ -30,6 +30,6 @@ main = do
     then do
       let t = map (cast' . Doc) tokens
       case creds of
-        Just c -> mapM_ (refreshToken pipe db c "") t
+        Just c -> mapM_ (refreshToken pipe db c "" "") t
         Nothing -> fail "No credentials"
     else putStrLn "No tokens to refresh1"

package.yaml

@@ -1,10 +1,10 @@
 name:                zgo-backend
-version:             1.2.5
+version:             1.3.0
 git:                 "https://git.vergara.tech/Vergara_Tech/zgo-backend"
 license:             BOSL
 author:              "Rene Vergara"
 maintainer:          "rene@vergara.network"
-copyright:           "Copyright (c) 2022 Vergara Technologies LLC"
+copyright:           "Copyright (c) 2023 Vergara Technologies LLC"
 
 extra-source-files:
 - README.md
@@ -60,6 +60,8 @@ library:
   - ghc-prim
   - network
   - crypto-rng
+  - megaparsec
+  - uuid
 
 executables:
   zgo-backend-exe:
@@ -87,6 +89,7 @@ executables:
             - configurator
             - warp-tls
             - warp
+            - megaparsec
   zgo-token-refresh:
     main:                TokenRefresh.hs
     source-dirs:         app
@@ -113,6 +116,25 @@ executables:
             - configurator
             - warp-tls
             - warp
+            - megaparsec
+  zgo-tasks:
+    main:                Tasks.hs
+    source-dirs:         app
+    ghc-options:
+            - -main-is Tasks
+            - -threaded
+            - -rtsopts
+            - -with-rtsopts=-N
+            - -Wall
+    dependencies:
+            - base
+            - mongoDB
+            - zgo-backend
+            - scotty
+            - warp-tls
+            - warp
+            - time
+            - megaparsec
 
 tests:
   zgo-backend-test:

src/LangComponent.hs

@@ -0,0 +1,91 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module LangComponent where
+
+import Data.Aeson
+import Data.Aeson.KeyMap
+import qualified Data.Bson as B
+import Data.ByteString.Builder.Extra (AllocationStrategy)
+import Data.Maybe
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TLE
+import Database.MongoDB
+import Xero (Xero(x_clientId))
+
+-- | Type to represent a UI components text variables in different languages
+data LangComponent =
+  LangComponent
+    { lc_id :: Maybe ObjectId
+    , lc_lang :: T.Text
+    , lc_component :: T.Text
+    , lc_data :: Data.Aeson.Object
+    }
+  deriving (Show, Eq)
+
+instance ToJSON LangComponent where
+  toJSON (LangComponent i l c d) =
+    case i of
+      Just oid ->
+        object
+          ["_id" .= show oid, "language" .= l, "component" .= c, "data" .= d]
+      Nothing ->
+        object
+          [ "_id" .= ("" :: String)
+          , "language" .= l
+          , "component" .= c
+          , "data" .= d
+          ]
+
+instance FromJSON LangComponent where
+  parseJSON =
+    withObject "LangComponent" $ \obj -> do
+      l <- obj .: "language"
+      c <- obj .: "component"
+      d <- obj .: "data"
+      pure $ LangComponent Nothing l c d
+
+instance Val LangComponent where
+  val (LangComponent i l c d) =
+    if isJust i
+      then Doc
+             [ "_id" =: i
+             , "language" =: l
+             , "component" =: c
+             , "data" =: (TL.toStrict . TLE.decodeUtf8 . encode) d
+             ]
+      else Doc
+             [ "language" =: l
+             , "component" =: c
+             , "data" =: (TL.toStrict . TLE.decodeUtf8 . encode) d
+             ]
+  cast' (Doc d) = do
+    i <- B.lookup "_id" d
+    l <- B.lookup "language" d
+    c <- B.lookup "component" d
+    dt <- B.lookup "data" d
+    pure $
+      LangComponent
+        i
+        l
+        c
+        (fromMaybe
+           Data.Aeson.KeyMap.empty
+           ((decode . TLE.encodeUtf8 . TL.fromStrict) dt))
+
+-- Database Actions
+findLangComponent :: T.Text -> T.Text -> Action IO (Maybe Document)
+findLangComponent lang component =
+  findOne (select ["language" =: lang, "component" =: component] "langcomps")
+
+loadLangComponent :: LangComponent -> Action IO ()
+loadLangComponent lc = do
+  let langComp = val lc
+  case langComp of
+    Doc x ->
+      upsert
+        (select
+           ["language" =: lc_lang lc, "component" =: lc_component lc]
+           "langcomps")
+        x
+    _ -> error "Couldn't parse language JSON"

src/User.hs

@@ -101,12 +101,6 @@ validateUser session =
     (select ["session" =: session] "users")
     ["$set" =: ["validated" =: True]]
 
-generatePin' :: Int -> IO T.Text
-generatePin' s = do
-  let g = mkStdGen s
-  pure $
-    T.pack (padLeft (show . head $ randomRs (1 :: Integer, 10000000) g) '0' 7)
-
 generatePin :: IO String
 generatePin = do
   rngState <- newCryptoRNGState

src/Xero.hs

@@ -290,10 +290,11 @@ requestXeroToken :: Pipe -> T.Text -> Xero -> T.Text -> T.Text -> IO Bool
 requestXeroToken pipe dbName cred code address = do
   token <- access pipe master dbName $ findToken address
   let oToken = token >>= cast' . Doc
-  refreshToken pipe dbName cred code oToken
+  refreshToken pipe dbName cred code address oToken
 
-refreshToken :: Pipe -> T.Text -> Xero -> T.Text -> Maybe XeroToken -> IO Bool
+refreshToken ::
-refreshToken pipe dbName cred code token = do
+     Pipe -> T.Text -> Xero -> T.Text -> T.Text -> Maybe XeroToken -> IO Bool
+refreshToken pipe dbName cred code address token = do
   let pars =
         case token of
           Just x -> "grant_type=refresh_token&refresh_token=" <> t_refresh x
@@ -316,9 +317,12 @@ refreshToken pipe dbName cred code token = do
     200 -> do
       let newToken = getResponseBody (res :: Response XeroToken)
       let accCode = t_code <$> token
-      let address = t_address <$> token
+      {-let address = t_address <$> token-}
       pToken <-
-        processToken newToken (fromMaybe "" address) (fromMaybe "" accCode)
+        processToken
+          newToken
+          (maybe address t_address token)
+          (fromMaybe "" accCode)
       --print pToken
       _ <- access pipe master dbName $ upsertToken pToken
       _ <- getTenantId pipe dbName pToken
@@ -410,8 +414,9 @@ getXeroInvoice pipe dbName inv address = do
                 Right iData -> return $ Just (head $ xir_invs iData)
             _ -> return Nothing
 
-payXeroInvoice :: Pipe -> T.Text -> T.Text -> T.Text -> Double -> IO ()
+payXeroInvoice ::
-payXeroInvoice pipe dbName inv address amt = do
+     Pipe -> T.Text -> T.Text -> T.Text -> Double -> Double -> IO ()
+payXeroInvoice pipe dbName inv address amt zec = do
   token <- access pipe master dbName $ findToken address
   let aToken = t_access <$> (token >>= cast' . Doc)
   let aCode = t_code <$> (token >>= cast' . Doc)
@@ -426,7 +431,8 @@ payXeroInvoice pipe dbName inv address amt = do
                  [ "Invoice" .= object ["InvoiceNumber" .= inv]
                  , "Account" .= object ["Code" .= fromMaybe "" aCode]
                  , "Date" .= utctDay today
-                 , "Reference" .= ("Paid in Zcash through ZGo" :: String)
+                 , "Reference" .=
+                   ("Paid in Zcash through ZGo: " ++ show zec ++ " ZEC" :: String)
                  , "Amount" .= amt
                  ]) $
             addRequestHeader "Accept" "application/json" $

src/ZGoBackend.hs

@@ -33,6 +33,7 @@ import Data.Time.Clock
 import Data.Time.Clock.POSIX
 import Data.Time.Format
 import Data.Typeable
+import qualified Data.UUID as U
 import qualified Data.Vector as V
 import Data.Vector.Internal.Check (doChecks)
 import Data.Word
@@ -40,6 +41,7 @@ import Database.MongoDB
 import Debug.Trace
 import GHC.Generics
 import Item
+import LangComponent
 import Network.HTTP.Simple
 import Network.HTTP.Types.Status
 import Network.Wai (Request, pathInfo)
@@ -54,6 +56,7 @@ import System.Random
 import Test.QuickCheck
 import Test.QuickCheck.Instances
 import Test.QuickCheck.Property (Result(ok))
+import Text.Megaparsec (runParser)
 import Text.Regex
 import Text.Regex.Base
 import User
@@ -354,6 +357,27 @@ zToZGoTx (ZcashTx t a aZ bh bt c conf m) = do
               ZGoTx Nothing nAddy sess conf bt a t m
             else ZGoTx Nothing "" "" conf bt a t m
 
+zToZGoTx' :: Config -> Pipe -> ZcashTx -> IO ()
+zToZGoTx' config pipe (ZcashTx t a aZ bh bt c conf m) = do
+  when (conf < 100) $ do
+    let zM = runParser pZGoMemo (T.unpack t) m
+    case zM of
+      Right zM' -> do
+        let tx =
+              ZGoTx
+                Nothing
+                (fromMaybe "" $ m_address zM')
+                (maybe "" U.toText $ m_session zM')
+                conf
+                bt
+                a
+                t
+                m
+        if m_payment zM'
+          then upsertPayment pipe (c_dbName config) tx
+          else access pipe master (c_dbName config) $ upsertZGoTx "txs" tx
+      Left e -> error "Failed to parse ZGo memo"
+
 -- |Type to model a price in the ZGo database
 data ZGoPrice =
   ZGoPrice
@@ -1025,6 +1049,23 @@ routes pipe config = do
     oId <- param "id"
     liftAndCatchIO $ run (deleteOrder oId)
     status ok200
+  -- Get language for component
+  get "/api/getlang" $ do
+    component <- param "component"
+    lang <- param "lang"
+    txtPack' <- liftAndCatchIO $ run (findLangComponent lang component)
+    let txtPack = cast' . Doc =<< txtPack'
+    case txtPack of
+      Nothing -> status noContent204
+      Just tP -> do
+        status ok200
+        Web.Scotty.json $ toJSON (tP :: LangComponent)
+  post "/api/setlang" $ do
+    langComp <- jsonData
+    _ <-
+      liftAndCatchIO $
+      mapM (run . loadLangComponent) (langComp :: [LangComponent])
+    status created201
 
 -- | Make a Zcash RPC call
 makeZcashCall ::
@@ -1121,9 +1162,19 @@ scanZcash config pipe = do
 -- | Function to filter transactions
 isRelevant :: Text.Regex.Regex -> ZcashTx -> Bool
 isRelevant re t
-  | zconfirmations t < 10 && (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
+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 -> mapM_ (zToZGoTx' config pipe) txs
+    Left e -> do
+      putStrLn $ "Error scanning node transactions: " ++ T.unpack e
+
 -- | Function to scan loaded viewing keys for payments
 scanPayments :: Config -> Pipe -> IO ()
 scanPayments config pipe = do
@@ -1174,6 +1225,7 @@ scanPayments config pipe = do
                              (qexternalInvoice xO)
                              (qaddress xO)
                              (qtotal xO)
+                             (qtotalZec xO)
                      "WC" -> do
                        let wOwner = fst $ head sResult ! 2
                        wooT <-

src/ZGoTx.hs

@@ -6,9 +6,15 @@ module ZGoTx where
 
 import Data.Aeson
 import qualified Data.Bson as B
+import Data.Char
+import Data.Maybe
 import qualified Data.Text as T
+import qualified Data.UUID as U
+import Data.Void
 import Database.MongoDB
 import GHC.Generics
+import Text.Megaparsec hiding (State)
+import Text.Megaparsec.Char
 
 -- | Type to model a ZGo transaction
 data ZGoTx =
@@ -92,3 +98,100 @@ instance Val ZGoTx where
           , "txid" =: t
           , "memo" =: m
           ]
+
+-- | Type to represent and parse ZGo memos
+data ZGoMemo =
+  ZGoMemo
+    { m_session :: Maybe U.UUID
+    , m_address :: Maybe T.Text
+    , m_payment :: Bool
+    }
+  deriving (Eq, Show)
+
+data MemoToken
+  = Login !U.UUID
+  | PayMsg !U.UUID
+  | Address !T.Text
+  | Msg !T.Text
+  deriving (Show, Eq)
+
+type Parser = Parsec Void T.Text
+
+pSession :: Parser MemoToken
+pSession = do
+  string "ZGO"
+  pay <- optional $ char 'p'
+  string "::"
+  s <- some $ hexDigitChar <|> char '-'
+  let u = U.fromString s
+  case u of
+    Nothing -> fail "Invalid UUID"
+    Just u' -> do
+      if isJust pay
+        then pure $ PayMsg u'
+        else pure $ Login u'
+
+pSaplingAddress :: Parser MemoToken
+pSaplingAddress = do
+  string "zs"
+  a <- some alphaNumChar
+  if length a /= 76
+    then fail "Failed to parse Sapling address"
+    else pure $ Address $ T.pack ("zs" <> a)
+
+pMsg :: Parser MemoToken
+pMsg = do
+  Msg . T.pack <$>
+    some
+      (alphaNumChar <|> punctuationChar <|> symbolChar <|>
+       charCategory OtherSymbol)
+
+pMemo :: Parser MemoToken
+pMemo = do
+  optional spaceChar
+  pSession <|> pSaplingAddress <|> pMsg
+
+isMemoToken :: T.Text -> MemoToken -> Bool
+isMemoToken kind t =
+  case kind of
+    "session" ->
+      case t of
+        PayMsg i -> True
+        Login j -> True
+        _ -> False
+    "address" ->
+      case t of
+        Address a -> True
+        _ -> False
+    "payment" ->
+      case t of
+        PayMsg i -> True
+        _ -> False
+    _ -> False
+
+pZGoMemo :: Parser ZGoMemo
+pZGoMemo = do
+  tks <- some pMemo
+  pure $ ZGoMemo (isSession tks) (isAddress tks) (isPayment tks)
+  where
+    isPayment [] = False
+    isPayment tks =
+      not (null tks) &&
+      case head tks of
+        PayMsg x -> True
+        _ -> isPayment $ tail tks
+    isAddress [] = Nothing
+    isAddress tks =
+      if not (null tks)
+        then case head tks of
+               Address x -> Just x
+               _ -> isAddress $ tail tks
+        else Nothing
+    isSession [] = Nothing
+    isSession tks =
+      if not (null tks)
+        then case head tks of
+               Login x -> Just x
+               PayMsg y -> Just y
+               _ -> isSession $ tail tks
+        else Nothing

test/Spec.hs

@@ -19,6 +19,7 @@ import Data.Time.Clock
 import Data.Time.Clock.POSIX
 import Database.MongoDB
 import Item
+import LangComponent
 import Network.HTTP.Simple
 import Network.HTTP.Types.Status
 import Order
@@ -139,7 +140,8 @@ main = do
               "\128737MSG\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e\n\nZGOp::ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
       describe "PIN generator" $ do
         it "should give a 7 digit" $ do
-          length (T.unpack (unsafePerformIO (generatePin 1010))) `shouldBe` 7
+          pin <- generatePin
+          length pin `shouldBe` 7
     describe "API endpoints" $ do
       beforeAll_ (startAPI loadedConfig) $ do
         describe "Price endpoint" $ do
@@ -176,7 +178,7 @@ main = do
             req <-
               testGet
                 "/api/user"
-                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdca")]
+                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` ok200
           it "returns 204 when no user" $ do
@@ -190,8 +192,8 @@ main = do
             req <-
               testPost
                 "/api/validateuser"
-                [ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdca")
+                [ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
-                , ("pin", Just "8227514")
+                , ("pin", Just "1234567")
                 ]
             res <- httpLBS req
             getResponseStatus res `shouldBe` accepted202
@@ -256,7 +258,7 @@ main = do
             req <-
               testPost
                 "/api/wootoken"
-                [("ownerid", Just "627ad3492b05a76be5000001")]
+                [("ownerid", Just "627ad3492b05a76be3000001")]
             res <- httpLBS req
             getResponseStatus res `shouldBe` accepted202
           it "authenticate with incorrect owner" $ do
@@ -264,7 +266,9 @@ main = do
               testPublicGet
                 "/auth"
                 [ ("ownerid", Just "62cca13f5530331e2a900001")
-                , ("token", Just "89bd9d8d69a674e0f467cc8796ed151a")
+                , ( "token"
+                  , Just
+                      "0c1702c16c7bd7e075b8bb129b24888a5cc2181fa1eb4ce9190cfcb625ecf0ee")
                 , ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
                 ]
             res <- httpJSON req
@@ -284,7 +288,9 @@ main = do
               testPublicGet
                 "/auth"
                 [ ("ownerid", Just "627ad3492b05a76be3000001")
-                , ("token", Just "89bd9d8d69a674e0f467cc8796ed151a")
+                , ( "token"
+                  , Just
+                      "0c1702c16c7bd7e075b8bb129b24888a5cc2181fa1eb4ce9190cfcb625ecf0ee")
                 , ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
                 ]
             res <- httpJSON req
@@ -294,7 +300,9 @@ main = do
               testPublicGet
                 "/auth"
                 [ ("ownerid", Just "627ad3492b05a76be3000001")
-                , ("token", Just "89bd9d8d69a674e0f467cc8796ed151a")
+                , ( "token"
+                  , Just
+                      "0c1702c16c7bd7e075b8bb129b24888a5cc2181fa1eb4ce9190cfcb625ecf0ee")
                 , ("siteurl", Just "aHR0cHM6Ly93d3cuZ29vZ2xlLmNvbS8")
                 ]
             res <- httpJSON req
@@ -304,7 +312,9 @@ main = do
               testPublicGet
                 "/woopayment"
                 [ ("ownerid", Just "627ad3492b05a76be3000001")
-                , ("token", Just "89bd9d8d69a674e0f467cc8796ed151a")
+                , ( "token"
+                  , Just
+                      "0c1702c16c7bd7e075b8bb129b24888a5cc2181fa1eb4ce9190cfcb625ecf0ee")
                 , ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
                 , ("order_id", Just "1234")
                 , ("currency", Just "usd")
@@ -314,6 +324,28 @@ main = do
                 ]
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` ok200
+        describe "Language endpoint" $ do
+          it "existing component" $ do
+            req <-
+              testGet
+                "/api/getlang"
+                [("lang", Just "en-US"), ("component", Just "login")]
+            res <- httpJSON req
+            getResponseStatus (res :: Response A.Value) `shouldBe` ok200
+          it "wrong component" $ do
+            req <-
+              testGet
+                "/api/getlang"
+                [("lang", Just "en-US"), ("component", Just "test")]
+            res <- httpLBS req
+            getResponseStatus res `shouldBe` noContent204
+          it "wrong language" $ do
+            req <-
+              testGet
+                "/api/getlang"
+                [("lang", Just "fr-FR"), ("component", Just "login")]
+            res <- httpLBS req
+            getResponseStatus res `shouldBe` noContent204
     around handleDb $
       describe "Database actions" $ do
         describe "authentication" $ do
@@ -441,7 +473,7 @@ main = do
             let s = parseZGoTxBson =<< t
             let conf = maybe 0 confirmations s
             conf `shouldSatisfy` (> 0)
-          xit "payments are added to db" $ \p -> do
+          it "payments are added to db" $ \p -> do
             _ <-
               access
                 p
@@ -658,7 +690,7 @@ startAPI config = do
           "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
           "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
           1613487
-          "1234567"
+          "8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
           False
   _ <-
     access
@@ -738,16 +770,16 @@ startAPI config = do
   case itemTest of
     Doc iT -> access pipe master "test" (insert_ "items" iT)
     _ -> fail "Couldn't save test Item in DB"
-  let myWooToken =
+  --let myWooToken =
-        WooToken
+        --WooToken
-          Nothing
+          --Nothing
-          (read "627ad3492b05a76be3000001")
+          --(read "627ad3492b05a76be3000001")
-          "89bd9d8d69a674e0f467cc8796ed151a"
+          --"89bd9d8d69a674e0f467cc8796ed151a"
-          Nothing
+          --Nothing
-  let wooTest = val myWooToken
+  --let wooTest = val myWooToken
-  case wooTest of
+  --case wooTest of
-    Doc wT -> access pipe master "test" (insert_ "wootokens" wT)
+    --Doc wT -> access pipe master "test" (insert_ "wootokens" wT)
-    _ -> fail "Couldn't save test WooToken in DB"
+    --_ -> fail "Couldn't save test WooToken in DB"
   threadDelay 1000000
   putStrLn "Test server is up!"
 

zgo-backend.cabal

@@ -5,13 +5,13 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           zgo-backend
-version:        1.2.5
+version:        1.3.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
 author:         Rene Vergara
 maintainer:     rene@vergara.network
-copyright:      Copyright (c) 2022 Vergara Technologies LLC
+copyright:      Copyright (c) 2023 Vergara Technologies LLC
 license:        BOSL
 license-file:   LICENSE
 build-type:     Simple
@@ -28,6 +28,7 @@ library
   exposed-modules:
       Config
       Item
+      LangComponent
       Order
       Owner
       Payment
@@ -57,6 +58,7 @@ library
     , http-conduit
     , http-types
     , jwt
+    , megaparsec
     , memory
     , mongoDB
     , network
@@ -70,6 +72,7 @@ library
     , text
     , time
     , unordered-containers
+    , uuid
     , vector
     , wai
     , wai-cors
@@ -80,6 +83,7 @@ library
 executable zgo-backend-exe
   main-is: Server.hs
   other-modules:
+      Tasks
       TokenRefresh
       Paths_zgo_backend
   hs-source-dirs:
@@ -92,6 +96,7 @@ executable zgo-backend-exe
     , configurator
     , http-conduit
     , http-types
+    , megaparsec
     , mongoDB
     , scotty
     , securemem
@@ -103,10 +108,31 @@ executable zgo-backend-exe
     , zgo-backend
   default-language: Haskell2010
 
+executable zgo-tasks
+  main-is: Tasks.hs
+  other-modules:
+      Server
+      TokenRefresh
+      Paths_zgo_backend
+  hs-source-dirs:
+      app
+  ghc-options: -main-is Tasks -threaded -rtsopts -with-rtsopts=-N -Wall
+  build-depends:
+      base
+    , megaparsec
+    , mongoDB
+    , scotty
+    , time
+    , warp
+    , warp-tls
+    , zgo-backend
+  default-language: Haskell2010
+
 executable zgo-token-refresh
   main-is: TokenRefresh.hs
   other-modules:
       Server
+      Tasks
       Paths_zgo_backend
   hs-source-dirs:
       app
@@ -118,6 +144,7 @@ executable zgo-token-refresh
     , configurator
     , http-conduit
     , http-types
+    , megaparsec
     , mongoDB
     , scotty
     , securemem

zgo.cfg

@@ -10,7 +10,7 @@ port = 3000
 tls = false
 certificate = "/path/to/cert.pem"
 key = "/path/to/key.pem"
-mailHost = "127.0.0.1"
+smtpHost = "127.0.0.1"
-mailPort = 1025
+smtpPort = 1025
-mailUser = "contact@zgo.cash"
+smtpUser = "contact@zgo.cash"
-mailPwd = "uib3K8BkCPexl_wr5bYfrg"
+smtpPwd = "uib3K8BkCPexl_wr5bYfrg"