diff --git a/.gitignore b/.gitignore index f5d1591..fa62f90 100644 --- a/.gitignore +++ b/.gitignore @@ -23,6 +23,10 @@ salon.cabal node_modules/ package-lock.json package.json +build-demo-en.sh +build-demo-fr.sh +build-demo-ro.sh +build-demo-ru.sh deploy-demo-en.sh deploy-demo-fr.sh deploy-demo-ro.sh diff --git a/config/models.persistentmodels b/config/models.persistentmodels index d7a0967..c4c9822 100644 --- a/config/models.persistentmodels +++ b/config/models.persistentmodels @@ -144,9 +144,16 @@ UserPhoto mime Text UniqueUserPhoto user +UserCred + user UserId OnDeleteCascade + name Text + val Text + UniqueUserCred user name + User name Text - password Text + authType AuthenticationType + password Text Maybe admin Bool analyst Bool blocked Bool @@ -156,6 +163,7 @@ User UniqueUser name deriving Typeable + Brand business BusinessId OnDeleteCascade mark ByteString Maybe diff --git a/config/routes.yesodroutes b/config/routes.yesodroutes index 275be8a..c95942e 100644 --- a/config/routes.yesodroutes +++ b/config/routes.yesodroutes @@ -200,8 +200,8 @@ /auth AuthR Auth getAuth /photo-placeholder PhotoPlaceholderR GET -/favicon.ico FaviconR GET -/robots.txt RobotsR GET +/favicon.ico FaviconR GET +/robots.txt RobotsR GET /manifest.json WebAppManifestR GET /sitemap.xml SitemapR GET \ No newline at end of file diff --git a/messages/en.msg b/messages/en.msg index 08f1e19..31c3eab 100644 --- a/messages/en.msg +++ b/messages/en.msg @@ -1,3 +1,4 @@ +SignInWithGoogle: Sign in with Google Cleared: Cleared InvalidStoreType: Invalid store type Initialization: Initialization diff --git a/messages/fr.msg b/messages/fr.msg index 208b784..7f90b8a 100644 --- a/messages/fr.msg +++ b/messages/fr.msg @@ -1,3 +1,4 @@ +SignInWithGoogle: Connectez-vous avec Google Cleared: Effacé InvalidStoreType: Type de stockage invalide Initialization: Initialisation diff --git a/messages/ro.msg b/messages/ro.msg index cfd21b7..52e24af 100644 --- a/messages/ro.msg +++ b/messages/ro.msg @@ -1,3 +1,4 @@ +SignInWithGoogle: Conectați-vă cu Google Cleared: S-a șters InvalidStoreType: Tip de stocare nevalid Initialization: Inițializare diff --git a/messages/ru.msg b/messages/ru.msg index e3bd089..4c9258b 100644 --- a/messages/ru.msg +++ b/messages/ru.msg @@ -1,3 +1,4 @@ +SignInWithGoogle: Войти через Google Cleared: Очищено InvalidStoreType: Неверный тип хранилища Initialization: Инициализация diff --git a/package.yaml b/package.yaml index 9b54107..1b04f55 100644 --- a/package.yaml +++ b/package.yaml @@ -64,6 +64,7 @@ dependencies: - http-client - safe-exceptions - HPDF +- yesod-auth-oauth2 # The library contains all of our application code. The executable diff --git a/src/Admin/Billing.hs b/src/Admin/Billing.hs index d8667a0..40611e3 100644 --- a/src/Admin/Billing.hs +++ b/src/Admin/Billing.hs @@ -853,7 +853,7 @@ renderIvoiceHtml :: Maybe (Entity User) renderIvoiceHtml customer employee invoice items = [ihamlet|

_{MsgAppName}

_{MsgInvoice} -$maybe Entity _ (User uname _ _ _ _ _ cname cemail) <- customer +$maybe Entity _ (User uname _ _ _ _ _ _ cname cemail) <- customer $maybe Entity _ (Staff ename _ _ _ eemail _) <- employee $maybe Entity _ (Invoice _ _ no status day due) <- invoice diff --git a/src/Admin/Staff.hs b/src/Admin/Staff.hs index ad46871..f7aaec6 100644 --- a/src/Admin/Staff.hs +++ b/src/Admin/Staff.hs @@ -163,7 +163,7 @@ import Model , ServiceId, Service (Service) , UserId, User (User), UserPhoto (UserPhoto) , EmplStatus (EmplStatusUnavailable, EmplStatusAvailable) - , SortOrder (SortOrderAsc, SortOrderDesc) + , SortOrder (SortOrderAsc, SortOrderDesc), AuthenticationType (UserAuthTypePassword) ) import Settings.StaticFiles (img_add_photo_alternate_FILL0_wght400_GRAD0_opsz48_svg) @@ -663,7 +663,10 @@ formUser empl extra = do , fsTooltip = Nothing, fsId = Nothing, fsName = Nothing , fsAttrs = [("class","mdc-text-field__input")] } (staffEmail . entityVal <$> empl) - let r = User <$> nameR <*> passR <*> adminR <*> analystR <*> blockedR <*> deletedR <*> fnameR <*> emailR + + let r = User <$> nameR <*> pure UserAuthTypePassword <*> (pure <$> passR) <*> adminR + <*> analystR <*> blockedR <*> deletedR <*> fnameR <*> emailR + let w = [whamlet| #{extra} $forall v <- [nameV,passV] diff --git a/src/Admin/Users.hs b/src/Admin/Users.hs index a3b3735..4fc2ed3 100644 --- a/src/Admin/Users.hs +++ b/src/Admin/Users.hs @@ -82,16 +82,16 @@ import Foundation import Model ( UserId , User - ( User, userName, userPassword, userFullName, userEmail, userAdmin + ( User, userName, userFullName, userEmail, userAdmin , userAnalyst, userBlocked, userRemoved ) , UserPhoto (UserPhoto) , EntityField ( UserId, UserName, UserFullName, UserEmail, UserPhotoPhoto , UserPhotoMime, UserPassword, UserAdmin, StaffUser, UserAnalyst - , UserBlocked, UserRemoved + , UserBlocked, UserRemoved, UserAuthType ) - , Staff + , Staff, AuthenticationType (UserAuthTypePassword) ) import Settings.StaticFiles (img_add_photo_alternate_FILL0_wght400_GRAD0_opsz48_svg) @@ -177,7 +177,7 @@ postUserPwdResetR uid = do FormSuccess (r,_) -> do pwd <- liftIO $ decodeUtf8 <$> makePassword (encodeUtf8 r) 17 runDB $ update $ \x -> do - set x [UserPassword =. val pwd] + set x [UserPassword =. val (pure pwd)] where_ $ x ^. UserId ==. val uid addMessageI "info" MsgPasswordChanged redirect $ AdminR $ UserR uid @@ -233,7 +233,7 @@ $case r close $of _ -$maybe Entity uid (User name _ _ _ _ _ _ _) <- user +$maybe Entity uid (User name _ _ _ _ _ _ _ _) <- user
_{MsgPhoto}
@@ -286,9 +286,10 @@ postUserR uid = do return x ((fr,fw),et) <- runFormPost $ formUserEdit user case fr of - FormSuccess (User name _ admin analyst blocked removed fname email,mfi) -> do + FormSuccess (User name auth _ admin analyst blocked removed fname email,mfi) -> do runDB $ update $ \x -> do set x [ UserName =. val name + , UserAuthType =. val auth , UserAdmin =. val admin , UserAnalyst =. val analyst , UserBlocked =. val blocked @@ -328,8 +329,8 @@ postUsersR :: Handler Html postUsersR = do ((fr,fw),et) <- runFormPost formUserCreate case fr of - FormSuccess (r,mfi) -> do - uid <- setPassword (userPassword r) r >>= \u -> runDB $ insert u + FormSuccess (r@(User _ _ (Just pass) _ _ _ _ _ _),mfi) -> do + uid <- setPassword pass r >>= \u -> runDB $ insert u addMessageI "info" MsgRecordAdded case mfi of Just fi -> do @@ -413,7 +414,7 @@ formUserCreate extra = do } Nothing let r = (,) - <$> ( User <$> nameR <*> passR + <$> ( User <$> nameR <*> pure UserAuthTypePassword <*> (pure <$> passR) <*> adminR <*> analystR <*> blockedR <*> removedR <*> fnameR <*> emailR ) <*> photoR @@ -539,7 +540,7 @@ formUserEdit user extra = do } Nothing let r = (,) - <$> ( User <$> nameR <*> FormSuccess "Nothing" + <$> ( User <$> nameR <*> pure UserAuthTypePassword <*> pure (pure "NOTHING") <*> adminR <*> analystR <*> blockedR <*> removedR <*> fnameR <*> emailR ) diff --git a/src/Demo/DemoDataEN.hs b/src/Demo/DemoDataEN.hs index d03aec6..d7c7719 100644 --- a/src/Demo/DemoDataEN.hs +++ b/src/Demo/DemoDataEN.hs @@ -29,7 +29,7 @@ import Database.Persist ( PersistStoreWrite(insert_, insert) ) import Model ( User ( User, userName, userPassword, userAdmin, userAnalyst, userBlocked - , userRemoved, userEmail, userFullName + , userRemoved, userEmail, userFullName, userAuthType ) , UserPhoto (UserPhoto, userPhotoUser, userPhotoPhoto, userPhotoMime) , Service @@ -75,7 +75,7 @@ import Model ( ContactUs, contactUsBusiness, contactUsShowSchedule, contactUsShowMap , contactUsLongitude, contactUsLatitude, contactUsHtml, contactUsShowAddress ) - , DayType (Weekday), PayMethod (PayAtVenue) + , DayType (Weekday), PayMethod (PayAtVenue), AuthenticationType (UserAuthTypePassword) ) import Data.FileEmbed (embedFile) @@ -169,7 +169,8 @@ populateEN = do pass0 <- liftIO $ makePassword "root" 17 insert_ $ User { userName = "root" - , userPassword = decodeUtf8 pass0 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass0 , userAdmin = True , userAnalyst = True , userBlocked = False @@ -180,7 +181,8 @@ populateEN = do pass1 <- liftIO $ makePassword "johnnysmith" 17 let user1 = User { userName = "johnnysmith" - , userPassword = decodeUtf8 pass1 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass1 , userAdmin = False , userAnalyst = True , userBlocked = False @@ -239,7 +241,8 @@ populateEN = do pass2 <- liftIO $ makePassword "marylopez" 17 let user2 = User { userName = "marylopez" - , userPassword = decodeUtf8 pass2 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass2 , userAdmin = True , userAnalyst = False , userBlocked = False @@ -271,7 +274,8 @@ populateEN = do pass3 <- liftIO $ makePassword "johnjohnson" 17 let user3 = User { userName = "johnjohnson" - , userPassword = decodeUtf8 pass3 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass3 , userAdmin = False , userAnalyst = False , userBlocked = False @@ -304,7 +308,8 @@ populateEN = do pass4 <- liftIO $ makePassword "patriciabrown" 17 let user4 = User { userName = "patriciabrown" - , userPassword = decodeUtf8 pass4 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass4 , userAdmin = False , userAnalyst = False , userBlocked = False @@ -337,7 +342,8 @@ populateEN = do pass5 <- liftIO $ makePassword "chriswilson" 17 let user5 = User { userName = "chriswilson" - , userPassword = decodeUtf8 pass5 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass5 , userAdmin = False , userAnalyst = False , userBlocked = False @@ -399,7 +405,8 @@ populateEN = do pass8 <- liftIO $ makePassword "byoung" 17 let user8 = User { userName = "byoung" - , userPassword = decodeUtf8 pass8 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass8 , userAdmin = True , userAnalyst = True , userBlocked = False @@ -501,7 +508,8 @@ populateEN = do pass11 <- liftIO $ makePassword "ihughes" 17 let user11 = User { userName = "ihughes" - , userPassword = decodeUtf8 pass11 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass11 , userAdmin = False , userAnalyst = False , userBlocked = False @@ -3021,7 +3029,8 @@ Body Shaping: Abdomen & waist, hips & thighs, legs & arms pass6 <- liftIO $ makePassword "pattyofurniture" 17 c1 <- insert $ User { userName = "pattyofurniture" - , userPassword = decodeUtf8 pass6 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass6 , userAdmin = False , userAnalyst = False , userBlocked = False @@ -3065,7 +3074,8 @@ Body Shaping: Abdomen & waist, hips & thighs, legs & arms pass7 <- liftIO $ makePassword "raysin" 17 c2 <- insert $ User { userName = "raysin" - , userPassword = decodeUtf8 pass7 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass7 , userAdmin = False , userAnalyst = False , userBlocked = False diff --git a/src/Demo/DemoDataFR.hs b/src/Demo/DemoDataFR.hs index e245b87..5272ada 100644 --- a/src/Demo/DemoDataFR.hs +++ b/src/Demo/DemoDataFR.hs @@ -31,7 +31,7 @@ import Database.Persist ( PersistStoreWrite(insert_, insert) ) import Model ( User ( User, userName, userPassword, userAdmin, userAnalyst, userBlocked - , userRemoved, userEmail, userFullName + , userRemoved, userEmail, userFullName, userAuthType ) , UserPhoto (UserPhoto, userPhotoUser, userPhotoPhoto, userPhotoMime) , Service @@ -77,7 +77,7 @@ import Model ( ContactUs, contactUsBusiness, contactUsShowSchedule, contactUsHtml , contactUsShowMap, contactUsLongitude, contactUsLatitude, contactUsShowAddress ) - , DayType (Weekday), PayMethod (PayAtVenue) + , DayType (Weekday), PayMethod (PayAtVenue), AuthenticationType (UserAuthTypePassword) ) import Data.FileEmbed (embedFile) import Demo.DemoPhotos @@ -169,7 +169,8 @@ populateFR = do pass <- liftIO $ makePassword "root" 17 insert_ $ User { userName = "root" - , userPassword = decodeUtf8 pass + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass , userAdmin = True , userAnalyst = True , userBlocked = False @@ -180,7 +181,8 @@ populateFR = do pass1 <- liftIO $ makePassword "martinl" 17 let user1 = User { userName = "martinl" - , userPassword = decodeUtf8 pass1 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass1 , userAdmin = False , userAnalyst = True , userBlocked = False @@ -239,7 +241,8 @@ populateFR = do pass2 <- liftIO $ makePassword "bernardj" 17 let user2 = User { userName = "bernardj" - , userPassword = decodeUtf8 pass2 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass2 , userAdmin = True , userAnalyst = False , userBlocked = False @@ -271,7 +274,8 @@ populateFR = do pass3 <- liftIO $ makePassword "thomasgr" 17 let user3 = User { userName = "thomasgr" - , userPassword = decodeUtf8 pass3 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass3 , userAdmin = False , userAnalyst = False , userBlocked = False @@ -304,7 +308,8 @@ populateFR = do pass4 <- liftIO $ makePassword "robertle" 17 let user4 = User { userName = "robertle" - , userPassword = decodeUtf8 pass4 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass4 , userAdmin = False , userAnalyst = False , userBlocked = False @@ -337,7 +342,8 @@ populateFR = do pass5 <- liftIO $ makePassword "richardal" 17 let user5 = User { userName = "richardal" - , userPassword = decodeUtf8 pass5 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass5 , userAdmin = False , userAnalyst = False , userBlocked = False @@ -399,7 +405,8 @@ populateFR = do pass8 <- liftIO $ makePassword "moreaul" 17 let user8 = User { userName = "moreaul" - , userPassword = decodeUtf8 pass8 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass8 , userAdmin = True , userAnalyst = True , userBlocked = False @@ -501,7 +508,8 @@ populateFR = do pass11 <- liftIO $ makePassword "michelrc" 17 let user11 = User { userName = "michelrc" - , userPassword = decodeUtf8 pass11 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass11 , userAdmin = False , userAnalyst = False , userBlocked = False @@ -3015,7 +3023,8 @@ Mise en forme du corps : Abdomen et taille, hanches et cuisses, jambes et bras pass6 <- liftIO $ makePassword "bernardl" 17 c1 <- insert $ User { userName = "bernardl" - , userPassword = decodeUtf8 pass6 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass6 , userAdmin = False , userAnalyst = False , userBlocked = False @@ -3059,7 +3068,8 @@ Mise en forme du corps : Abdomen et taille, hanches et cuisses, jambes et bras pass7 <- liftIO $ makePassword "bardota" 17 c2 <- insert $ User { userName = "bardota" - , userPassword = decodeUtf8 pass7 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass7 , userAdmin = False , userAnalyst = False , userBlocked = False diff --git a/src/Demo/DemoDataRO.hs b/src/Demo/DemoDataRO.hs index 7e4e4a7..2a0bd86 100644 --- a/src/Demo/DemoDataRO.hs +++ b/src/Demo/DemoDataRO.hs @@ -29,7 +29,7 @@ import Database.Persist ( PersistStoreWrite(insert_, insert) ) import Model ( User ( User, userName, userPassword, userAdmin, userAnalyst, userBlocked - , userRemoved, userEmail, userFullName + , userRemoved, userEmail, userFullName, userAuthType ) , UserPhoto (UserPhoto, userPhotoUser, userPhotoPhoto, userPhotoMime) , Service @@ -75,7 +75,7 @@ import Model ( ContactUs, contactUsBusiness, contactUsShowSchedule, contactUsHtml , contactUsShowMap, contactUsLongitude, contactUsLatitude, contactUsShowAddress ) - , DayType (Weekday), PayMethod (PayAtVenue) + , DayType (Weekday), PayMethod (PayAtVenue), AuthenticationType (UserAuthTypePassword) ) import Data.FileEmbed (embedFile) import Demo.DemoPhotos @@ -167,7 +167,8 @@ populateRO = do pass <- liftIO $ makePassword "root" 17 insert_ $ User { userName = "root" - , userPassword = decodeUtf8 pass + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass , userAdmin = True , userAnalyst = True , userBlocked = False @@ -178,7 +179,8 @@ populateRO = do pass1 <- liftIO $ makePassword "popaa" 17 let user1 = User { userName = "popaa" - , userPassword = decodeUtf8 pass1 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass1 , userAdmin = False , userAnalyst = True , userBlocked = False @@ -237,7 +239,8 @@ populateRO = do pass2 <- liftIO $ makePassword "raduam" 17 let user2 = User { userName = "raduam" - , userPassword = decodeUtf8 pass2 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass2 , userAdmin = True , userAnalyst = False , userBlocked = False @@ -269,7 +272,8 @@ populateRO = do pass3 <- liftIO $ makePassword "johnjohnson" 17 let user3 = User { userName = "johnjohnson" - , userPassword = decodeUtf8 pass3 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass3 , userAdmin = False , userAnalyst = False , userBlocked = False @@ -302,7 +306,8 @@ populateRO = do pass4 <- liftIO $ makePassword "stoicama" 17 let user4 = User { userName = "stoicama" - , userPassword = decodeUtf8 pass4 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass4 , userAdmin = False , userAnalyst = False , userBlocked = False @@ -335,7 +340,8 @@ populateRO = do pass5 <- liftIO $ makePassword "rususa" 17 let user5 = User { userName = "rususa" - , userPassword = decodeUtf8 pass5 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass5 , userAdmin = False , userAnalyst = False , userBlocked = False @@ -397,7 +403,8 @@ populateRO = do pass8 <- liftIO $ makePassword "marini" 17 let user8 = User { userName = "marini" - , userPassword = decodeUtf8 pass8 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass8 , userAdmin = True , userAnalyst = True , userBlocked = False @@ -499,7 +506,8 @@ populateRO = do pass11 <- liftIO $ makePassword "floreaim" 17 let user11 = User { userName = "floreaim" - , userPassword = decodeUtf8 pass11 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass11 , userAdmin = False , userAnalyst = False , userBlocked = False @@ -3015,7 +3023,8 @@ Pachetul include: machiaj de mireasă, up-do, tratament facial și manichiură pass6 <- liftIO $ makePassword "grigorescudg" 17 c1 <- insert $ User { userName = "grigorescudg" - , userPassword = decodeUtf8 pass6 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass6 , userAdmin = False , userAnalyst = False , userBlocked = False @@ -3059,7 +3068,8 @@ Pachetul include: machiaj de mireasă, up-do, tratament facial și manichiură pass7 <- liftIO $ makePassword "vasilescuam" 17 c2 <- insert $ User { userName = "vasilescuam" - , userPassword = decodeUtf8 pass7 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass7 , userAdmin = False , userAnalyst = False , userBlocked = False diff --git a/src/Demo/DemoDataRU.hs b/src/Demo/DemoDataRU.hs index 540bd71..b20fc81 100644 --- a/src/Demo/DemoDataRU.hs +++ b/src/Demo/DemoDataRU.hs @@ -28,7 +28,7 @@ import Database.Persist ( PersistStoreWrite(insert_, insert) ) import Model ( User ( User, userName, userPassword, userAdmin, userAnalyst, userBlocked - , userRemoved, userEmail, userFullName + , userRemoved, userEmail, userFullName, userAuthType ) , UserPhoto (UserPhoto, userPhotoUser, userPhotoPhoto, userPhotoMime) , Service @@ -68,7 +68,7 @@ import Model ( ContactUs, contactUsBusiness, contactUsShowSchedule, contactUsHtml , contactUsShowMap, contactUsLongitude, contactUsLatitude, contactUsShowAddress ) - , DayType (Weekday), PayMethod (PayAtVenue) + , DayType (Weekday), PayMethod (PayAtVenue), AuthenticationType (UserAuthTypePassword) ) import Data.FileEmbed (embedFile) import Demo.DemoPhotos @@ -161,7 +161,8 @@ populateRU = do pass <- liftIO $ makePassword "root" 17 insert_ $ User { userName = "root" - , userPassword = decodeUtf8 pass + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass , userAdmin = True , userAnalyst = True , userBlocked = False @@ -172,7 +173,8 @@ populateRU = do pass1 <- liftIO $ makePassword "ivanoviv" 17 let user1 = User { userName = "ivanoviv" - , userPassword = decodeUtf8 pass1 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass1 , userAdmin = False , userAnalyst = True , userBlocked = False @@ -230,7 +232,8 @@ populateRU = do pass2 <- liftIO $ makePassword "bulanovalm" 17 let user2 = User { userName = "bulanovalm" - , userPassword = decodeUtf8 pass2 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass2 , userAdmin = True , userAnalyst = False , userBlocked = False @@ -263,7 +266,8 @@ populateRU = do pass3 <- liftIO $ makePassword "petrovia" 17 let user3 = User { userName = "petrovia" - , userPassword = decodeUtf8 pass3 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass3 , userAdmin = False , userAnalyst = False , userBlocked = False @@ -296,7 +300,8 @@ populateRU = do pass4 <- liftIO $ makePassword "lebedevamv" 17 let user4 = User { userName = "lebedevamv" - , userPassword = decodeUtf8 pass4 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass4 , userAdmin = False , userAnalyst = False , userBlocked = False @@ -329,7 +334,8 @@ populateRU = do pass5 <- liftIO $ makePassword "smirnovav" 17 let user5 = User { userName = "smirnovav" - , userPassword = decodeUtf8 pass5 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass5 , userAdmin = False , userAnalyst = False , userBlocked = False @@ -392,7 +398,8 @@ populateRU = do pass8 <- liftIO $ makePassword "stepanovatn" 17 let user8 = User { userName = "stepanovatn" - , userPassword = decodeUtf8 pass8 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass8 , userAdmin = True , userAnalyst = True , userBlocked = False @@ -494,7 +501,8 @@ populateRU = do pass11 <- liftIO $ makePassword "baranovaag" 17 let user11 = User { userName = "baranovaag" - , userPassword = decodeUtf8 pass11 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass11 , userAdmin = False , userAnalyst = False , userBlocked = False @@ -3013,7 +3021,8 @@ Collagen 90-II — это уважаемое и востребованное а pass6 <- liftIO $ makePassword "ivanovata" 17 c1 <- insert $ User { userName = "ivanovata" - , userPassword = decodeUtf8 pass6 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass6 , userAdmin = False , userAnalyst = False , userBlocked = False @@ -3057,7 +3066,8 @@ Collagen 90-II — это уважаемое и востребованное а pass7 <- liftIO $ makePassword "danilovip" 17 c2 <- insert $ User { userName = "danilovip" - , userPassword = decodeUtf8 pass7 + , userAuthType = UserAuthTypePassword + , userPassword = pure $ decodeUtf8 pass7 , userAdmin = False , userAnalyst = False , userBlocked = False diff --git a/src/Foundation.hs b/src/Foundation.hs index 23827c2..74dced0 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -12,14 +12,20 @@ module Foundation where +import Control.Lens (filtered, folded, _2, (^?), to) +import Control.Monad.Logger (LogSource) import Import.NoFoundation +import Data.Aeson.Lens (key, AsValue (_String)) +import qualified Data.ByteString.Lazy as BSL (toStrict) +import qualified Data.List.Safe as LS (head) import Data.Kind (Type) import qualified Data.Text as T (pack) import Data.Time.Calendar.Month (Month) +import qualified Network.Wreq as W (get, responseHeader, responseBody) import Text.Hamlet (hamletFile) import Text.Jasmine (minifym) -import Control.Monad.Logger (LogSource) +import Yesod.Auth.OAuth2.Google (oauth2GoogleScopedWidget) import Yesod.Default.Util (addStaticContentExternal) import Yesod.Core.Types (Logger) import qualified Yesod.Core.Unsafe as Unsafe @@ -33,7 +39,6 @@ import Yesod.Auth.Message import Yesod.Form.I18n.English (englishFormMessage) import Yesod.Form.I18n.French (frenchFormMessage) import Yesod.Form.I18n.Russian (russianFormMessage) -import qualified Data.List.Safe as LS import Database.Persist.Sql (ConnectionPool, runSqlPool, fromSqlKey) import qualified Database.Esqueleto.Experimental as E ((==.), exists) import Database.Esqueleto.Experimental @@ -42,6 +47,7 @@ import Database.Esqueleto.Experimental , just, orderBy, asc, unionAll_, not_, val, isNothing_ ) + -- | The foundation datatype for your application. This can be a good place to -- keep settings and values requiring initialization before your application -- starts running, such as database connections. Every handler will have @@ -126,11 +132,11 @@ instance Yesod App where isAuthorized (ScratchR ScratchTwoR) _ = return Authorized isAuthorized (ScratchR ScratchOneR) _ = return Authorized isAuthorized (ScratchR ScratchInitR) _ = return Authorized - + isAuthorized (StaticR _) _ = return Authorized - + isAuthorized (AuthR _) _ = return Authorized - + isAuthorized WebAppManifestR _ = return Authorized isAuthorized SitemapR _ = return Authorized isAuthorized HomeR _ = return Authorized @@ -143,16 +149,16 @@ instance Yesod App where isAuthorized r@(StatsR (WorkloadEmplMonthR _ _)) _ = setUltDest r >> isAnalyst isAuthorized r@(StatsR (WorkloadEmplDayR _ _)) _ = setUltDest r >> isAnalyst isAuthorized r@(StatsR StatsAovR) _ = setUltDest r >> isAnalyst - isAuthorized r@(StatsR (AovDetailsR {})) _ = setUltDest r >> isAnalyst - + isAuthorized r@(StatsR (AovDetailsR {})) _ = setUltDest r >> isAnalyst - isAuthorized BillingMailHookR _ = return Authorized + + isAuthorized BillingMailHookR _ = return Authorized isAuthorized (AdminR GMailApiHookR) _ = return Authorized - + isAuthorized (AdminR TokensGMailClearR) _ = isAdmin isAuthorized (AdminR TokensGMailR) _ = isAdmin isAuthorized r@(AdminR TokensR) _ = setUltDest r >> isAdmin - + isAuthorized (AdminR (AdmInvoiceMailDeleteR _ _)) _ = isAdmin isAuthorized (AdminR (AdmInvoiceMailR _ _)) _ = isAdmin isAuthorized (AdminR (AdmInvoiceSendmailR _)) _ = isAdmin @@ -249,7 +255,7 @@ instance Yesod App where isAuthorized r@(AdminR (BusinessContactCreateR _)) _ = setUltDest r >> isAdmin isAuthorized r@(AdminR (BusinessContactEditR _ _)) _ = setUltDest r >> isAdmin isAuthorized (AdminR (BusinessContactDeleteR _ _)) _ = isAdmin - + isAuthorized ContactR _ = return Authorized isAuthorized BookEndR _ = return Authorized @@ -274,7 +280,7 @@ instance Yesod App where isAuthorized r@(BookingsCalendarR _) _ = setUltDest r >> isAuthenticated isAuthorized r@(BookingsDayListR _ _) _ = setUltDest r >> isAuthenticated isAuthorized r@(BookingItemR {}) _ = setUltDest r >> isAuthenticated - + isAuthorized r@(RequestsR {}) _ = setUltDest r >> isEmployee isAuthorized r@(RequestR {}) _ = setUltDest r >> isEmployee @@ -288,12 +294,12 @@ instance Yesod App where isAuthorized r@(TasksDayListR {}) _ = setUltDest r >> isEmployee isAuthorized r@(TaskItemR {}) _ = setUltDest r >> isEmployee isAuthorized r@(TaskHistR {}) _ = setUltDest r >> isEmployee - + isAuthorized (ProfileR _) _ = isAuthenticated isAuthorized (ProfileEditR _) _ = isAuthenticated isAuthorized (ProfileRemoveR _) _ = isAuthenticated - - + + isAuthorized AccountR _ = return Authorized isAuthorized (AccountPhotoR _) _ = return Authorized @@ -355,13 +361,24 @@ instance YesodPersist App where master <- getYesod runSqlPool action $ appConnPool master + instance YesodPersistRunner App where getDBRunner :: Handler (DBRunner App, Handler ()) getDBRunner = defaultGetDBRunner appConnPool + instance YesodAuth App where type AuthId App = UserId + authLayout :: (MonadHandler m, HandlerSite m ~ App) => WidgetFor App () -> m Html + authLayout w = liftHandler $ defaultLayout $ do + ult <- getUrlRender >>= \rndr -> fromMaybe (rndr HomeR) <$> lookupSession ultDestKey + setTitleI MsgAuthentication + let anError = "error" + msgs <- getMessages + $(widgetFile "auth/layout") + + -- Where to send a user after successful login loginDest :: App -> Route App loginDest _ = HomeR @@ -375,20 +392,76 @@ instance YesodAuth App where redirectToReferer _ = True authenticate :: (MonadHandler m, HandlerSite m ~ App) => Creds App -> m (AuthenticationResult App) - authenticate creds = liftHandler $ do - user <- runDB $ selectOne $ do - x <- from $ table @User - where_ $ x ^. UserName E.==. val (credsIdent creds) - where_ $ not_ $ x ^. UserBlocked - where_ $ not_ $ x ^. UserRemoved - return x - return $ case user of - Just (Entity uid _) -> Authenticated uid - Nothing -> UserError InvalidLogin - - -- You can add other plugins like Google Email, email or OAuth here + authenticate (Creds plugin ident extra) = liftHandler $ do + case plugin of + "google" -> do + let atoken :: Maybe Text + atoken = extra ^? folded . filtered ((== "accessToken") . fst) . _2 + let name :: Maybe Text + name = extra ^? folded . filtered ((== "userResponse") . fst) . _2 . key "name" . _String + let sub :: Maybe Text + sub = extra ^? folded . filtered ((== "userResponse") . fst) . _2 . key "sub" . _String + let picture :: Maybe Text + picture = extra ^? folded . filtered ((== "userResponse") . fst) . _2 . key "picture" . _String + let email :: Maybe Text + email = extra ^? folded . filtered ((== "userResponse") . fst) . _2 . key "email" . _String + + case (atoken,sub) of + (Just at,Just gid) -> do + Entity uid _ <- runDB $ upsert User { userName = gid + , userAuthType = UserAuthTypeGoogle + , userPassword = Nothing + , userAdmin = False + , userAnalyst = False + , userBlocked = False + , userRemoved = False + , userFullName = name + , userEmail = email + } + [UserEmail =. email] + _ <- runDB $ upsert UserCred { userCredUser = uid + , userCredName = "google_access_token" + , userCredVal = at + } + [UserCredVal =. at] + + case picture of + Just src -> do + r <- liftIO $ W.get (unpack src) + case (r ^? W.responseHeader "Content-Type" . to decodeUtf8, BSL.toStrict <$> r ^? W.responseBody) of + (Just mime, Just bs) -> do + liftIO $ print mime + liftIO $ print bs + _ <- runDB $ upsert UserPhoto { userPhotoUser = uid + , userPhotoMime = mime + , userPhotoPhoto = bs + } + [UserPhotoMime =. mime, UserPhotoPhoto =. bs] + return () + _otherwise -> return () + return () + Nothing -> return () + return $ Authenticated uid + _otherwise -> return $ UserError InvalidLogin + + "hashdb" -> do + user <- runDB $ selectOne $ do + x <- from $ table @User + where_ $ x ^. UserName E.==. val ident + where_ $ not_ $ x ^. UserBlocked + where_ $ not_ $ x ^. UserRemoved + return x + return $ case user of + Just (Entity uid _) -> Authenticated uid + Nothing -> UserError InvalidLogin + _ -> return $ UserError InvalidLogin + authPlugins :: App -> [AuthPlugin App] - authPlugins _ = [authHashDBWithForm formLogin (Just . UniqueUser)] + authPlugins app = [ authHashDBWithForm formLogin (Just . UniqueUser) + , oauth2GoogleScopedWidget googleButton ["email","openid","profile"] + (appGoogleClientId . appSettings $ app) + (appGoogleClientSecret . appSettings $ app) + ] renderAuthMessage :: App -> [Text] -> AuthMessage -> Text renderAuthMessage _ [] = defaultMessage @@ -421,7 +494,7 @@ isAdmin = do msgs <- getMessages $(widgetFile "auth/403") sendResponseStatus status403 r - Just (Entity _ (User _ _ True _ False False _ _)) -> return Authorized + Just (Entity _ (User _ _ _ True _ False False _ _)) -> return Authorized _ -> do r <- defaultLayout $ do setTitleI MsgAuthorizationRequired @@ -440,7 +513,7 @@ isAnalyst = do msgs <- getMessages $(widgetFile "auth/403") sendResponseStatus status403 r - Just (Entity _ (User _ _ _ True False False _ _)) -> return Authorized + Just (Entity _ (User _ _ _ _ True False False _ _)) -> return Authorized _ -> do r <- defaultLayout $ do setTitleI MsgAuthorizationRequired @@ -475,10 +548,121 @@ isEmployee = do Just _ -> return Authorized +googleButton :: Widget +googleButton = do + toWidget [cassius| +.gsi-material-button + -moz-user-select: none + -webkit-user-select: none + -ms-user-select: none + -webkit-appearance: none + background-color: WHITE + background-image: none + border: 1px solid #747775 + -webkit-border-radius: 4px + border-radius: 4px + -webkit-box-sizing: border-box + box-sizing: border-box + color: #1f1f1f + cursor: pointer + font-family: 'Roboto', arial, sans-serif + font-size: 14px + height: 40px + letter-spacing: 0.25px + outline: none + overflow: hidden + padding: 0 12px + position: relative + text-align: center + -webkit-transition: background-color .218s, border-color .218s, box-shadow .218s + transition: background-color .218s, border-color .218s, box-shadow .218s + vertical-align: middle + white-space: nowrap + width: auto + max-width: 400px + min-width: min-content + +.gsi-material-button .gsi-material-button-icon + height: 20px + margin-right: 12px + min-width: 20px + width: 20px + +.gsi-material-button .gsi-material-button-content-wrapper + -webkit-align-items: center + align-items: center + display: flex + -webkit-flex-direction: row + flex-direction: row + -webkit-flex-wrap: nowrap + flex-wrap: nowrap + height: 100% + justify-content: center + position: relative + width: 100% + +.gsi-material-button .gsi-material-button-contents + -webkit-flex-grow: 0 + flex-grow: 0 + font-family: 'Roboto', arial, sans-serif + font-weight: 500 + overflow: hidden + text-overflow: ellipsis + vertical-align: top + +.gsi-material-button .gsi-material-button-state + -webkit-transition: opacity .218s + transition: opacity .218s + bottom: 0 + left: 0 + opacity: 0 + position: absolute + right: 0 + top: 0 + +.gsi-material-button:disabled + cursor: default + background-color: #ffffff61 + border-color: #1f1f1f1f + +.gsi-material-button:disabled .gsi-material-button-contents + opacity: 38% + +.gsi-material-button:disabled .gsi-material-button-icon + opacity: 38% + +.gsi-material-button:not(:disabled):active .gsi-material-button-state, +.gsi-material-button:not(:disabled):focus .gsi-material-button-state + background-color: #303030 + opacity: 12% + +.gsi-material-button:not(:disabled):hover + -webkit-box-shadow: 0 1px 2px 0 rgba(60, 64, 67, .30), 0 1px 3px 1px rgba(60, 64, 67, .15) + box-shadow: 0 1px 2px 0 rgba(60, 64, 67, .30), 0 1px 3px 1px rgba(60, 64, 67, .15) + +.gsi-material-button:not(:disabled):hover .gsi-material-button-state + background-color: #303030 + opacity: 8% + +|] + [whamlet| + + + + + + + + + + + _{MsgSignInWithGoogle} + _{MsgSignInWithGoogle} +|] + + formLogin :: Route App -> Widget formLogin route = do - ult <- getUrlRender >>= \rndr -> fromMaybe (rndr HomeR) <$> lookupSession ultDestKey - msgs <- getMessages users <- liftHandler $ unval <$> runDB (select $ do x :& y <- from $ do x <- from $ table @User @@ -506,12 +690,10 @@ formLogin route = do loginFormWrapper <- newIdent loginForm <- newIdent pCreateAccount <- newIdent - dlgSampleCreds <- newIdent $(widgetFile "auth/form") where unval = (bimap (bimap (bimap (bimap unValue unValue) unValue) unValue) unValue <$>) - anError = "error" instance YesodAuthPersist App diff --git a/src/Handler/Account.hs b/src/Handler/Account.hs index 06e1bbd..2ba3eb5 100644 --- a/src/Handler/Account.hs +++ b/src/Handler/Account.hs @@ -73,7 +73,7 @@ import Model ( UserPhotoUser, StaffUser, RoleStaff, RoleName, UserId, UserFullName , UserEmail, UserPhotoPhoto, UserPhotoMime, UserRemoved ) - , Staff (Staff), Role + , Staff (Staff), Role, AuthenticationType (UserAuthTypePassword) ) import Database.Esqueleto.Experimental @@ -208,8 +208,8 @@ postAccountR :: Handler Html postAccountR = do ((fr,widget),enctype) <- runFormPost $ formAccount Nothing case fr of - FormSuccess (user,mfi) -> do - uid <- setPassword (userPassword user) user >>= \u -> runDB $ insert u + FormSuccess (user@(User _ _ (Just pass) _ _ _ _ _ _),mfi) -> do + uid <- setPassword pass user >>= \u -> runDB $ insert u case mfi of Just fi -> do bs <- fileSourceByteString fi @@ -246,7 +246,7 @@ formAccount user extra = do { fsLabel = SomeMessage MsgPassword , fsTooltip = Nothing, fsId = Nothing, fsName = Nothing , fsAttrs = [("class","mdc-text-field__input")] - } (userPassword <$> user) + } (userPassword =<< user) (fnameR,fnameV) <- mopt textField FieldSettings { fsLabel = SomeMessage MsgFullName , fsTooltip = Nothing, fsId = Nothing, fsName = Nothing @@ -264,8 +264,8 @@ formAccount user extra = do } Nothing let r = (,) - <$> ( User <$> nameR <*> passR - <*> FormSuccess False <*> FormSuccess False <*> FormSuccess False <*> FormSuccess False + <$> ( User <$> nameR <*> pure UserAuthTypePassword <*> (pure <$> passR) + <*> pure False <*> pure False <*> pure False <*> pure False <*> fnameR <*> emailR ) <*> photoR diff --git a/src/Handler/Book.hs b/src/Handler/Book.hs index cec335f..e45d17a 100644 --- a/src/Handler/Book.hs +++ b/src/Handler/Book.hs @@ -256,7 +256,7 @@ getBookPayNowR uid = do rndr <- getUrlRenderParams let confirmParams = encodeToLazyText $ object $ case user of - Just (Entity _ (User _ _ _ _ _ _ _ (Just email))) -> + Just (Entity _ (User _ _ _ _ _ _ _ _ (Just email))) -> [ "return_url" .= rndr (BookPayCompletionR uid) stati , "receipt_email" .= email ] diff --git a/src/Handler/Common.hs b/src/Handler/Common.hs index 2946c91..9ad4d2e 100644 --- a/src/Handler/Common.hs +++ b/src/Handler/Common.hs @@ -28,7 +28,7 @@ import Foundation , ResourcesR (DocsR), AppMessage (MsgAppName, MsgMetaDescription) ) import Settings.StaticFiles - (img_salon_512_png, img_salon_1024_png, img_salon_512_maskable_png) + (img_salon_512_png, img_salon_512_maskable_png) import Yesod.Core ( TypedContent (TypedContent), ToContent (toContent) , typePlain, cacheSeconds, typeSvg diff --git a/src/Model.hs b/src/Model.hs index 02bbc8f..93cca70 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -71,6 +71,11 @@ import Database.Persist.Types ) import Database.Persist.Sql (fromSqlKey, toSqlKey, PersistFieldSql, sqlType) import Control.Lens (makeLensesFor) + + +data AuthenticationType = UserAuthTypePassword | UserAuthTypeGoogle + deriving (Show, Read, Eq, Ord) +derivePersistField "AuthenticationType" data StoreType = StoreTypeGoogleSecretManager @@ -272,10 +277,10 @@ instance PathMultiPiece Services where instance HashDBUser User where userPasswordHash :: User -> Maybe Text - userPasswordHash = Just . userPassword + userPasswordHash = userPassword setPasswordHash :: Text -> User -> User - setPasswordHash h u = u { userPassword = h } + setPasswordHash h u = u { userPassword = Just h } data SortOrder = SortOrderAsc | SortOrderDesc diff --git a/templates/admin/billing/form.hamlet b/templates/admin/billing/form.hamlet index e52a120..891b2f1 100644 --- a/templates/admin/billing/form.hamlet +++ b/templates/admin/billing/form.hamlet @@ -18,7 +18,7 @@ - $forall Entity cid (User uname _ _ _ _ _ fname _) <- customers + $forall Entity cid (User uname _ _ _ _ _ _ fname _) <- customers diff --git a/templates/admin/staff/empl/details.hamlet b/templates/admin/staff/empl/details.hamlet index 8c6c0c2..f4c44a4 100644 --- a/templates/admin/staff/empl/details.hamlet +++ b/templates/admin/staff/empl/details.hamlet @@ -140,7 +140,7 @@ _{MsgUser} - $maybe Entity _ (User uname _ _ _ _ _ _ _) <- user + $maybe Entity _ (User uname _ _ _ _ _ _ _ _) <- user #{uname} $forall (_,msg) <- msgs diff --git a/templates/admin/users/search.hamlet b/templates/admin/users/search.hamlet index fffaeaa..515c041 100644 --- a/templates/admin/users/search.hamlet +++ b/templates/admin/users/search.hamlet @@ -59,7 +59,7 @@ _{MsgNoUsersFound}. $else - $forall Entity uid (User uname _ admin analyst blocked removed fname email) <- users + $forall Entity uid (User uname _ _ admin analyst blocked removed fname email) <- users diff --git a/templates/admin/users/user.hamlet b/templates/admin/users/user.hamlet index cd4de8e..3612b24 100644 --- a/templates/admin/users/user.hamlet +++ b/templates/admin/users/user.hamlet @@ -40,7 +40,7 @@ - $maybe Entity uid (User uname _ admin analyst blocked deleted fname email) <- user + $maybe Entity uid (User uname _ _ admin analyst blocked deleted fname email) <- user
_{MsgPhoto}
diff --git a/templates/admin/users/users.hamlet b/templates/admin/users/users.hamlet index 73f7e12..f1fdc88 100644 --- a/templates/admin/users/users.hamlet +++ b/templates/admin/users/users.hamlet @@ -33,7 +33,7 @@ _{MsgNoUsersYet}. $else - $forall Entity uid (User uname _ admin analyst blocked removed fname email) <- users + $forall Entity uid (User uname _ _ admin analyst blocked removed fname email) <- users diff --git a/templates/appointments/appointment.hamlet b/templates/appointments/appointment.hamlet index 5fd5756..6a685bb 100644 --- a/templates/appointments/appointment.hamlet +++ b/templates/appointments/appointment.hamlet @@ -117,7 +117,7 @@ expand_more
- $maybe Entity uid (User uname _ _ _ _ _ fname _) <- user + $maybe Entity uid (User uname _ _ _ _ _ _ fname _) <- user
_{MsgPhoto} diff --git a/templates/appointments/calendar/item.hamlet b/templates/appointments/calendar/item.hamlet index 16759ea..b6f93fc 100644 --- a/templates/appointments/calendar/item.hamlet +++ b/templates/appointments/calendar/item.hamlet @@ -117,7 +117,7 @@ expand_more
- $maybe Entity uid (User uname _ _ _ _ _ fname _) <- user + $maybe Entity uid (User uname _ _ _ _ _ _ fname _) <- user
_{MsgPhoto} diff --git a/templates/appointments/hist.hamlet b/templates/appointments/hist.hamlet index 508b0f6..6b787bc 100644 --- a/templates/appointments/hist.hamlet +++ b/templates/appointments/hist.hamlet @@ -15,7 +15,7 @@
_{MsgNoHistoryYet}. $else - $forall (Entity _ (Hist _ _ logtime day time addr tzo tz status rname ename),Entity _ (User uname _ _ _ _ _ fname _)) <- hist + $forall (Entity _ (Hist _ _ logtime day time addr tzo tz status rname ename),Entity _ (User uname _ _ _ _ _ _ fname _)) <- hist $with (color,icon,label,title) <- resolveBookStatus status diff --git a/templates/auth/form.cassius b/templates/auth/form.cassius index 361aab8..e4a5761 100644 --- a/templates/auth/form.cassius +++ b/templates/auth/form.cassius @@ -1,29 +1,28 @@ -main - ##{loginFormWrapper} +##{loginFormWrapper} + display: flex + flex-direction: column + align-items: center + ##{loginForm} + width: 100% + max-width: 20rem display: flex flex-direction: column - align-items: center - ##{loginForm} - width: 100% - max-width: 20rem - display: flex - flex-direction: column - gap: 1rem - .mdc-text-field - input.mdc-text-field__input - caret-color: var(--theme-accent) - #btnLogin - margin: 1rem 0 + gap: 1rem + .mdc-text-field + input.mdc-text-field__input + caret-color: var(--theme-accent) + #btnLogin + margin: 1rem 0 - ##{pCreateAccount} - margin-top: 2rem - display: flex - flex-direction: column - align-items: center - gap: 0.5rem - small.hint - color: var(--theme-text-small-hint-on-light) + ##{pCreateAccount} + margin-top: 1.5rem + display: flex + flex-direction: column + align-items: center + gap: 0.5rem + small.hint + color: var(--theme-text-small-hint-on-light) div.mdc-dialog div.mdc-dialog__content diff --git a/templates/auth/form.hamlet b/templates/auth/form.hamlet index eefd98f..745013a 100644 --- a/templates/auth/form.hamlet +++ b/templates/auth/form.hamlet @@ -1,66 +1,45 @@ - - - - + +
+ _{MsgSignInToYourAccount} + +
+ + + _{MsgUsername} + + - arrow_back - _{MsgAuthentication} - - - - $forall (_,msg) <- filter (((==) anError) . fst) msgs - - - - - warning - #{msg} - - - - close + demography + -
- _{MsgSignInToYourAccount} - - - - _{MsgUsername} - - - - - demography - - - - - _{MsgPassword} - - - - - demography - + + + _{MsgPassword} + + + + + demography + - - - - _{MsgLogin} + + + + _{MsgLogin} -

- _{MsgDoNotHaveAnAccount} - - - - _{MsgCreateNewAccount} +

+ _{MsgDoNotHaveAnAccount} + + + + _{MsgCreateNewAccount} - + @@ -76,7 +55,8 @@ :not (admin || analyst):.mdc-list-item--with-two-lines> - _{MsgPhoto} #{uname} @@ -118,25 +98,3 @@ _{MsgSelect} - - -$forall (_,msg) <- filter (((/=) anError) . fst) msgs - - - #{msg} - - - - - close - - - - * - _{MsgDemoSampleOne} - - - - demography - _{MsgDemoSampleTwo} diff --git a/templates/auth/form.julius b/templates/auth/form.julius index 125c0d2..936f54d 100644 --- a/templates/auth/form.julius +++ b/templates/auth/form.julius @@ -1,14 +1,6 @@ window.mdc.autoInit(); -Array.from( - document.querySelectorAll('div.mdc-banner') -).forEach(function (x) { x.MDCBanner.open(); }); - -Array.from( - document.querySelectorAll('aside.mdc-snackbar') -).map(x => x.MDCSnackbar).forEach(function (x) { x.open(); }); - document.getElementById('btnFillCreds').addEventListener('click',function (e) { document.getElementById(#{loginForm}).querySelectorAll('.mdc-text-field').forEach(function (x) { x.querySelector('input').value = document.forms.formUserOptions.uname.value; diff --git a/templates/auth/layout.cassius b/templates/auth/layout.cassius new file mode 100644 index 0000000..e2cf216 --- /dev/null +++ b/templates/auth/layout.cassius @@ -0,0 +1,16 @@ + +main + display: flex + flex-direction: column + align-items: center + gap: 1rem + +footer.demo + width: 100% + position: absolute + bottom: 0 + text-align: center + small.hint + line-height: 1 + font-style: italic + color: var(--theme-text-small-hint-on-light) \ No newline at end of file diff --git a/templates/auth/layout.hamlet b/templates/auth/layout.hamlet new file mode 100644 index 0000000..ea6806c --- /dev/null +++ b/templates/auth/layout.hamlet @@ -0,0 +1,44 @@ + + + + + + + arrow_back + _{MsgAuthentication} + + + $forall (_,msg) <- filter (((==) anError) . fst) msgs + + + + + warning + #{msg} + + + + close + + ^{w} + + + + + * + _{MsgDemoSampleOne} + + demography + _{MsgDemoSampleTwo} + + +$forall (_,msg) <- filter (((/=) anError) . fst) msgs + + + #{msg} + + + + + close diff --git a/templates/auth/layout.julius b/templates/auth/layout.julius new file mode 100644 index 0000000..78dbe42 --- /dev/null +++ b/templates/auth/layout.julius @@ -0,0 +1,10 @@ + +window.mdc.autoInit(); + +Array.from( + document.querySelectorAll('div.mdc-banner') +).forEach(function (x) { x.MDCBanner.open(); }); + +Array.from( + document.querySelectorAll('aside.mdc-snackbar') +).map(x => x.MDCSnackbar).forEach(function (x) { x.open(); }); diff --git a/templates/book/customer/banner.hamlet b/templates/book/customer/banner.hamlet index 81c5b97..f1a33a7 100644 --- a/templates/book/customer/banner.hamlet +++ b/templates/book/customer/banner.hamlet @@ -44,7 +44,7 @@ close $of _ - $maybe Entity _ (User name _ _ _ _ _ fname email) <- user + $maybe Entity _ (User name _ _ _ _ _ _ fname email) <- user - $maybe Entity uid (User uname _ _ _ _ _ fname email) <- user + $maybe Entity uid (User uname _ _ _ _ _ _ fname email) <- user diff --git a/templates/book/payment/form.hamlet b/templates/book/payment/form.hamlet index c700796..3a20ee4 100644 --- a/templates/book/payment/form.hamlet +++ b/templates/book/payment/form.hamlet @@ -3,7 +3,7 @@ ^{fvInput pmV} -$maybe Entity uid (User uname _ _ _ _ _ fname email) <- user +$maybe Entity uid (User uname _ _ _ _ _ _ fname email) <- user + + + + $maybe Entity rid (Brand bid _ _ _ _ _ _ ico mime _) <- brand $maybe _ <- ico $maybe mime <- mime diff --git a/templates/profile/profile.hamlet b/templates/profile/profile.hamlet index dfa2674..eab2b4e 100644 --- a/templates/profile/profile.hamlet +++ b/templates/profile/profile.hamlet @@ -53,7 +53,7 @@ close - $maybe Entity uid (User uname _ _ _ _ _ fname email) <- user + $maybe Entity uid (User uname _ _ _ _ _ _ fname email) <- user

_{MsgPhoto} @@ -85,7 +85,7 @@ _{MsgLogin} - $maybe Entity _ (User _ _ admin analyst _ _ _ _) <- user + $maybe Entity _ (User _ _ _ _ admin analyst _ _ _) <- user $if admin || analyst diff --git a/templates/requests/calendar/hist.hamlet b/templates/requests/calendar/hist.hamlet index ed33df5..2ebfe99 100644 --- a/templates/requests/calendar/hist.hamlet +++ b/templates/requests/calendar/hist.hamlet @@ -16,7 +16,7 @@
_{MsgNoHistoryYet}. $else - $forall (Entity _ (Hist _ _ logtime day time addr tzo tz status rname ename),Entity _ (User uname _ _ _ _ _ fname _)) <- hist + $forall (Entity _ (Hist _ _ logtime day time addr tzo tz status rname ename),Entity _ (User uname _ _ _ _ _ _ fname _)) <- hist $with (color,icon,label,title) <- resolveBookStatus status diff --git a/templates/requests/calendar/item.hamlet b/templates/requests/calendar/item.hamlet index 7c94e12..987d023 100644 --- a/templates/requests/calendar/item.hamlet +++ b/templates/requests/calendar/item.hamlet @@ -135,7 +135,7 @@ handshake - $with Entity uid (User uname _ _ _ _ _ fname _) <- customer + $with Entity uid (User uname _ _ _ _ _ _ fname _) <- customer
_{MsgPhoto} diff --git a/templates/requests/hist.hamlet b/templates/requests/hist.hamlet index 6c416d0..1803f6b 100644 --- a/templates/requests/hist.hamlet +++ b/templates/requests/hist.hamlet @@ -16,7 +16,7 @@
_{MsgNoHistoryYet}. $else - $forall (Entity _ (Hist _ _ logtime day time addr tzo tz status rname ename),Entity _ (User uname _ _ _ _ _ fname _)) <- hist + $forall (Entity _ (Hist _ _ logtime day time addr tzo tz status rname ename),Entity _ (User uname _ _ _ _ _ _ fname _)) <- hist $with (color,icon,label,title) <- resolveBookStatus status diff --git a/templates/requests/request.hamlet b/templates/requests/request.hamlet index d717508..4ba35d7 100644 --- a/templates/requests/request.hamlet +++ b/templates/requests/request.hamlet @@ -134,7 +134,7 @@ handshake - $with Entity uid (User uname _ _ _ _ _ fname _) <- customer + $with Entity uid (User uname _ _ _ _ _ _ fname _) <- customer
_{MsgPhoto} diff --git a/templates/resources/docs.hamlet b/templates/resources/docs.hamlet index b3ecf20..c0080b0 100644 --- a/templates/resources/docs.hamlet +++ b/templates/resources/docs.hamlet @@ -9,7 +9,7 @@ _{MsgDocumentation} - + $maybe Entity uid _ <- user