Vergara_Tech/zgo-backend
Vergara_Tech/zgo-backend
2
1
Fork 0
Code Issues Pull requests Projects Releases 4 Packages Wiki Activity

Add language endpoints

Browse source
This commit is contained in:
Rene Vergara 2023-02-02 15:14:28 -06:00
parent 9564e9fa18
commit fb82923949
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
7 changed files with 171 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
CHANGELOG.md
View file

@ -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

86
src/LangComponent.hs Normal file
View file

@ -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"

6
src/User.hs
View file

@ -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

16
src/ZGoBackend.hs
View file

@ -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 ::

72
test/Spec.hs
View file

@ -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!"

1
zgo-backend.cabal
View file

@ -28,6 +28,7 @@ library
exposed-modules:
Config
Item
LangComponent
Order
Owner
Payment

8
zgo.cfg
View file

@ -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"