diff --git a/CHANGELOG.md b/CHANGELOG.md index 06f7a55..06645e8 100644 --- 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 diff --git a/app/Server.hs b/app/Server.hs index 5c6ee4f..229ebc6 100644 --- 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 diff --git a/app/Tasks.hs b/app/Tasks.hs new file mode 100644 index 0000000..c3360a8 --- /dev/null +++ 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!" diff --git a/app/TokenRefresh.hs b/app/TokenRefresh.hs index 81b5168..83e2ac4 100644 --- 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" diff --git a/package.yaml b/package.yaml index e1d9519..631b58e 100644 --- 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: diff --git a/src/LangComponent.hs b/src/LangComponent.hs new file mode 100644 index 0000000..7c01839 --- /dev/null +++ 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" diff --git a/src/User.hs b/src/User.hs index 8d2817a..f455f1c 100644 --- 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 diff --git a/src/Xero.hs b/src/Xero.hs index 14091ce..52fe641 100644 --- 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" $ diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs index 10db309..17bb653 100644 --- 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 <- diff --git a/src/ZGoTx.hs b/src/ZGoTx.hs index 0abbe96..95278f8 100644 --- 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 diff --git a/test/Spec.hs b/test/Spec.hs index 18ad17f..b549218 100644 --- 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!" diff --git a/zgo-backend.cabal b/zgo-backend.cabal index 6178642..270d63d 100644 --- 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 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 diff --git a/zgo.cfg b/zgo.cfg index aa2bbf8..1502706 100644 --- 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"