Add language endpoints

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

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"

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

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

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

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"