Merge branch 'dev'

2023-03-16 10:29:55 -05:00 · 2023-03-16 10:29:55 -05:00 · b2d58ca035
commit b2d58ca035
parent 9564e9fa18 42f77060b7
13 changed files with 431 additions and 52 deletions
--- a/CHANGELOG.md
+++ b/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
--- a/app/Server.hs
+++ b/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 75 (scanZcash loadedConfig pipe))
-  _ <- forkIO (setInterval 90 (scanPayments loadedConfig pipe))
-  _ <- forkIO (setInterval 60 (checkPayments pipe (c_dbName loadedConfig)))
-  _ <- forkIO (setInterval 60 (expireOwners pipe (c_dbName loadedConfig)))
-  _ <- forkIO (setInterval 60 (updateLogins pipe loadedConfig))
+  {-_ <- forkIO (setInterval 60 (checkZcashPrices pipe (c_dbName loadedConfig)))-}
+  {-_ <- forkIO (setInterval 75 (scanZcash loadedConfig pipe))-}
+  {-_ <- forkIO (setInterval 90 (scanPayments loadedConfig pipe))-}
+  {-_ <- forkIO (setInterval 60 (checkPayments pipe (c_dbName loadedConfig)))-}
+  {-_ <- forkIO (setInterval 60 (expireOwners pipe (c_dbName loadedConfig)))-}
+  {-_ <- forkIO (setInterval 60 (updateLogins pipe loadedConfig))-}
  let appRoutes = routes pipe loadedConfig
  case myTlsSettings of
    Nothing -> scotty (c_port loadedConfig) appRoutes
--- a/app/Tasks.hs
+++ b/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!"
--- a/app/TokenRefresh.hs
+++ b/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"
--- a/package.yaml
+++ b/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:
--- a/src/LangComponent.hs
+++ b/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"
--- a/src/User.hs
+++ b/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
--- a/src/Xero.hs
+++ b/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 pipe dbName cred code token = do
+refreshToken ::
+     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 pipe dbName inv address amt = do
+payXeroInvoice ::
+     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" $
--- a/src/ZGoBackend.hs
+++ b/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 <-
--- a/src/ZGoTx.hs
+++ b/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
--- a/test/Spec.hs
+++ b/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")
-                , ("pin", Just "8227514")
+                [ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
+                , ("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 =
-        WooToken
-          Nothing
-          (read "627ad3492b05a76be3000001")
-          "89bd9d8d69a674e0f467cc8796ed151a"
-          Nothing
-  let wooTest = val myWooToken
-  case wooTest of
-    Doc wT -> access pipe master "test" (insert_ "wootokens" wT)
-    _ -> fail "Couldn't save test WooToken in DB"
+  --let myWooToken =
+        --WooToken
+          --Nothing
+          --(read "627ad3492b05a76be3000001")
+          --"89bd9d8d69a674e0f467cc8796ed151a"
+          --Nothing
+  --let wooTest = val myWooToken
+  --case wooTest of
+    --Doc wT -> access pipe master "test" (insert_ "wootokens" wT)
+    --_ -> fail "Couldn't save test WooToken in DB"
  threadDelay 1000000
  putStrLn "Test server is up!"

--- a/zgo-backend.cabal
+++ b/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
--- a/zgo.cfg
+++ b/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"
-mailPort = 1025
-mailUser = "contact@zgo.cash"
-mailPwd = "uib3K8BkCPexl_wr5bYfrg"
+smtpHost = "127.0.0.1"
+smtpPort = 1025
+smtpUser = "contact@zgo.cash"
+smtpPwd = "uib3K8BkCPexl_wr5bYfrg"