Add Entity Token

config/models.persistentmodels

@@ -1,6 +1,17 @@
 
+Store
+  token TokenId OnDeleteCascade
+  key Text
+  val Text
+  UniqueStore token key
+
+Token
+  api Text
+  store StoreType
+  UniqueToken api
+
 InvoiceMail
-  invoice InvoiceId OnDeleteCascade
+  invoice InvoiceId OnDeleteCascade 
   status MailStatus
   timemark UTCTime
   recipient Text

config/routes.yesodroutes

@@ -84,7 +84,7 @@
 
 /admin AdminR:
 
-    /tokens TokensR GET
+    /tokens TokensR GET POST
 
     /invoices/#InvoiceId/mail/#InvoiceMailId/delete AdmInvoiceMailDeleteR POST
     /invoices/#InvoiceId/mail/#InvoiceMailId 	    AdmInvoiceMailR       GET

messages/en.msg

@@ -1,5 +1,8 @@
-StoreWithSecretManager: Store with Google Secret Manager
-StoreInDatabase: Store in database
+Initialization: Initialization
+StoreType: Store type
+UserSession: User session
+GoogleSecretManager: Google Secret Manager
+Database: Database
 ClearSettings: Clear
 Initialize: Initialize
 Tokens: Tokens

messages/fr.msg

@@ -1,5 +1,8 @@
-StoreWithSecretManager: Stocker avec Google Secret Manager
-StoreInDatabase: Stocker dans la base de données
+Initialization: Initialisation
+StoreType: Type de stockage
+UserSession: Session utilisateur
+GoogleSecretManager: Google Secret Manager
+Database: Base de données
 ClearSettings: Effacer
 Initialize: Initialiser
 Tokens: Jetons

messages/ro.msg

@@ -1,5 +1,8 @@
-StoreWithSecretManager: Stocați cu Google Secret Manager
-StoreInDatabase: Stocați în baza de date
+Initialization: Inițializare
+StoreType: Tipul de stocare
+UserSession: Sesiunea de utilizator
+GoogleSecretManager: Google Secret Manager
+Database: Baza de date
 ClearSettings: Ștergeți
 Initialize: Inițializează
 Tokens: Jetoane

messages/ru.msg

@@ -1,5 +1,8 @@
-StoreWithSecretManager: Хранить с помощью Google Secret Manager
-StoreInDatabase: Хранить в базе данных
+Initialization: Инициализация
+StoreType: Тип хранилища
+UserSession: Пользовательская сессия
+GoogleSecretManager: Google Secret Manager
+Database: База данных
 ClearSettings: Сбросить
 Initialize: Инициализировать
 Tokens: Токены

src/Admin/Tokens.hs

@@ -1,32 +1,118 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
 
-module Admin.Tokens (getTokensR) where
+module Admin.Tokens
+  ( getTokensR
+  , postTokensR
+  ) where
 
+import Data.Text (Text)
+import Database.Persist (Entity(Entity))
 import Foundation
-    ( Handler
+    ( Handler, Widget
+    , Route
+      ( AuthR, PhotoPlaceholderR, AccountPhotoR, ProfileR, AdminR
+      )
+    , AdminR (TokensR)
     , AppMessage
       ( MsgTokens, MsgNavigationMenu, MsgUserProfile, MsgPhoto, MsgLogin
-      , MsgInitialize, MsgClearSettings, MsgStoreInDatabase
-      , MsgStoreWithSecretManager
-      )
-    , Route
-      ( AuthR, PhotoPlaceholderR, AccountPhotoR, ProfileR
+      , MsgInitialize, MsgClearSettings, MsgDatabase, MsgUserSession
+      , MsgGoogleSecretManager, MsgStoreType, MsgInitialization
+      , MsgInvalidFormData
       )
     )
 import Text.Hamlet (Html)
-import Database.Persist (Entity(Entity))
+import Text.Cassius (cassius)
 
 import Yesod.Auth (maybeAuth, Route (LoginR))
-import Yesod.Core (Yesod(defaultLayout))
+import Yesod.Core
+    ( Yesod(defaultLayout), SomeMessage (SomeMessage), getMessages, whamlet
+    , newIdent, toWidget, addMessageI
+    )
 import Yesod.Core.Widget (setTitleI)
+import Yesod.Form.Fields (OptionList, optionsPairs, withRadioField)
+import Yesod.Form.Functions (generateFormPost, mreq, runFormPost)
+import Yesod.Form.Types
+    ( MForm, FormResult (FormSuccess), Field, FieldView (fvInput, fvId)
+    , FieldSettings (FieldSettings, fsLabel, fsTooltip, fsId, fsName, fsAttrs)
+    )
+
+import Model
+    ( StoreType (StoreTypeSession, StoreTypeDatabase, StoreTypeGoogleSecretManager)
+    )
 
-import Settings (widgetFile)
 import Menu (menu)
+import Settings (widgetFile)
+
+
+postTokensR :: Handler Html
+postTokensR = do
+    user <- maybeAuth
+    ((fr,fw),et) <- runFormPost formGmailApi
+
+    formStoreType <- newIdent
+    case fr of
+      FormSuccess StoreTypeDatabase -> undefined
+      FormSuccess StoreTypeGoogleSecretManager -> undefined
+      _otherwize -> do
+          addMessageI warn MsgInvalidFormData
+          msgs <- getMessages          
+          defaultLayout $ do
+              setTitleI MsgTokens
+              $(widgetFile "admin/tokens/tokens")
 
 
 getTokensR :: Handler Html
-getTokensR = do
+getTokensR = do    
     user <- maybeAuth
+
+    (fw,et) <- generateFormPost formGmailApi
+
+    formStoreType <- newIdent
+    msgs <- getMessages
     defaultLayout $ do
         setTitleI MsgTokens
         $(widgetFile "admin/tokens/tokens")
+
+
+formGmailApi :: Html -> MForm Handler (FormResult StoreType,Widget)
+formGmailApi extra = do
+    let storeTypes = [ (MsgGoogleSecretManager,StoreTypeGoogleSecretManager)
+                     , (MsgDatabase,StoreTypeDatabase)
+                     , (MsgUserSession,StoreTypeSession)
+                     ]
+    (r,v) <- mreq (mdcStoreTypeField (optionsPairs storeTypes)) FieldSettings
+        { fsLabel = SomeMessage MsgStoreType
+        , fsTooltip = Nothing, fsId = Nothing, fsName = Nothing
+        , fsAttrs = [("class","mdc-radio__native-control")]
+        } (Just StoreTypeSession)
+    return (r, do
+                 toWidget [cassius|
+##{fvId v}
+  display: flex
+  flex-direction: column
+|]
+                 [whamlet|
+#{extra}
+^{fvInput v}
+|])
+  where
+      mdcStoreTypeField :: Handler (OptionList StoreType) -> Field Handler StoreType
+      mdcStoreTypeField = withRadioField
+          (\_ _ -> [whamlet||])
+          (\theId value _isSel text optionW -> [whamlet|
+<div.mdc-form-field.mdc-touch-target-wrapper>
+  <div.mdc-radio.mdc-radio--touch>
+    ^{optionW}
+    <div.mdc-radio__background>
+      <div.mdc-radio__outer-circle>
+      <div.mdc-radio__inner-circle>
+    <div.mdc-radio__ripple>
+    <div.mdc-radio__focus-ring>
+  <label for=#{theId}-#{value}>#{text}
+|])
+
+
+warn :: Text
+warn = "warn"

src/Application.hs

@@ -113,7 +113,7 @@ import Handler.Stats
     , getStatsAovR, getAovDetailsR
     )
 
-import Admin.Tokens (getTokensR)
+import Admin.Tokens (getTokensR, postTokensR)
 
 import Admin.Billing
     ( getAdmInvoicesR

src/Foundation.hs

@@ -146,7 +146,7 @@ instance Yesod App where
 
     isAuthorized BillingMailHookR _ = return Authorized
 
-    isAuthorized (AdminR TokensR) _ = isAdmin
+    isAuthorized r@(AdminR TokensR) _ = setUltDest r >> isAdmin
 
     isAuthorized (AdminR (AdmInvoiceMailDeleteR _ _)) _ = isAdmin
     isAuthorized (AdminR (AdmInvoiceMailR _ _)) _ = isAdmin

src/Model.hs

@@ -71,6 +71,13 @@ import Database.Persist.Types
     )
 import Database.Persist.Sql (fromSqlKey, toSqlKey, PersistFieldSql, sqlType)
 import Control.Lens (makeLensesFor)
+
+
+data StoreType = StoreTypeGoogleSecretManager
+               | StoreTypeDatabase
+               | StoreTypeSession
+    deriving (Show, Read, Eq, Ord)
+derivePersistField "StoreType"
 
 
 data PayMethod = PayAtVenue | PayNow