From fb82923949d07e5512776a7bc258da45a6ec21e0 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Thu, 2 Feb 2023 15:14:28 -0600 Subject: [PATCH] Add language endpoints --- CHANGELOG.md | 12 +++++++ src/LangComponent.hs | 86 ++++++++++++++++++++++++++++++++++++++++++++ src/User.hs | 6 ---- src/ZGoBackend.hs | 16 +++++++++ test/Spec.hs | 72 ++++++++++++++++++++++++++----------- zgo-backend.cabal | 1 + zgo.cfg | 8 ++--- 7 files changed, 171 insertions(+), 30 deletions(-) create mode 100644 src/LangComponent.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index 06f7a55..199c303 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,18 @@ 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). +## [Unreleased] + +## Added + +- New type to handle UI translation objects +- New endpoints for API to get/set translation +- Tests for translation endpoints + +## Changed + +- Remove old code for PIN generation + ## [1.2.5] - 2023-02-01 ### Fixed diff --git a/src/LangComponent.hs b/src/LangComponent.hs new file mode 100644 index 0000000..dd17638 --- /dev/null +++ b/src/LangComponent.hs @@ -0,0 +1,86 @@ +{-# 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 -> insert_ "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/ZGoBackend.hs b/src/ZGoBackend.hs index 10db309..502beef 100644 --- a/src/ZGoBackend.hs +++ b/src/ZGoBackend.hs @@ -40,6 +40,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) @@ -1025,6 +1026,21 @@ 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 $ run (loadLangComponent langComp) + status created201 -- | Make a Zcash RPC call makeZcashCall :: diff --git a/test/Spec.hs b/test/Spec.hs index 18ad17f..4255bd8 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 @@ -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..c797e56 100644 --- a/zgo-backend.cabal +++ b/zgo-backend.cabal @@ -28,6 +28,7 @@ library exposed-modules: Config Item + LangComponent Order Owner Payment 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"