diff --git a/config/routes.yesodroutes b/config/routes.yesodroutes
index 059a759..275be8a 100644
--- a/config/routes.yesodroutes
+++ b/config/routes.yesodroutes
@@ -203,4 +203,5 @@
/favicon.ico FaviconR GET
/robots.txt RobotsR GET
-/sitemap.xml SitemapR GET
\ No newline at end of file
+/manifest.json WebAppManifestR GET
+/sitemap.xml SitemapR GET
\ No newline at end of file
diff --git a/src/Admin/Billing.hs b/src/Admin/Billing.hs
index 975ebbd..d8667a0 100644
--- a/src/Admin/Billing.hs
+++ b/src/Admin/Billing.hs
@@ -39,7 +39,7 @@ import qualified Control.Lens as L ((^.), (^?))
import Control.Monad (join, forM)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (object, (.=))
-import Data.Aeson.Lens (AsValue(_String), key, AsNumber (_Integer))
+import Data.Aeson.Lens (AsValue(_String), key)
import Data.Bifunctor (Bifunctor(first, second))
import Data.ByteString (toStrict)
import qualified Data.ByteString.Lazy as BSL (ByteString)
@@ -81,6 +81,7 @@ import Network.Wreq
( post, FormParam ((:=)), responseBody, responseStatus, statusCode
, postWith, defaults, auth, oauth2Bearer
)
+import System.Directory (doesFileExist)
import Text.Blaze.Html (preEscapedToHtml, toHtml)
import Text.Blaze.Html.Renderer.Text (renderHtml)
import Text.Printf (printf)
@@ -217,13 +218,8 @@ getBillingMailHookR = do
, "grant_type" := ("authorization_code" :: Text)
]
- let _status = r L.^. responseStatus . statusCode
-
let accessToken = r L.^. responseBody . key "access_token" . _String
let refreshToken = r L.^. responseBody . key "refresh_token" . _String
- let _tokenType = r L.^. responseBody . key "token_type" . _String
- let _scope = r L.^. responseBody . key "scope" . _String
- let _expiresIn = r L.^? responseBody . key "expires_in" . _Integer
setSession gmailAccessToken accessToken
setSession gmailRefreshToken refreshToken
@@ -379,12 +375,19 @@ postAdmInvoiceSendmailR iid = do
x <- from $ table @Token
where_ $ x ^. TokenApi ==. val gmail
return x
+
+ let at = "/at/gmail_access_token"
+ rt = "/rt/gmail_refresh_token"
+
+ secrets <- liftIO $ and <$> forM [at,rt] doesFileExist
- accessToken <- case store of
- Just (Entity _ (Token _ StoreTypeGoogleSecretManager)) -> do
- Just . pack <$> liftIO ( readFile "/at/gmail_access_token" )
+ accessToken <- case (store,secrets) of
+ (Nothing,True) -> Just . pack <$> liftIO ( readFile at )
+
+ (Just (Entity _ (Token _ StoreTypeGoogleSecretManager)),True) -> do
+ Just . pack <$> liftIO ( readFile at )
- Just (Entity tid (Token _ StoreTypeDatabase)) -> (unValue <$>) <$> runDB ( selectOne $ do
+ (Just (Entity tid (Token _ StoreTypeDatabase)),_) -> (unValue <$>) <$> runDB ( selectOne $ do
x <- from $ table @Store
where_ $ x ^. StoreToken ==. val tid
where_ $ x ^. StoreKey ==. val gmailAccessToken
@@ -392,11 +395,12 @@ postAdmInvoiceSendmailR iid = do
_otherwise -> lookupSession gmailAccessToken
- refreshToken <- case store of
- Just (Entity _ (Token _ StoreTypeGoogleSecretManager)) -> do
- Just . pack <$> liftIO ( readFile "/rt/gmail_refresh_token" )
+ refreshToken <- case (store,secrets) of
+ (Nothing,True) -> Just . pack <$> liftIO ( readFile rt )
+ (Just (Entity _ (Token _ StoreTypeGoogleSecretManager)),True) -> do
+ Just . pack <$> liftIO ( readFile rt )
- Just (Entity tid (Token _ StoreTypeDatabase)) -> (unValue <$>) <$> runDB ( selectOne $ do
+ (Just (Entity tid (Token _ StoreTypeDatabase)),_) -> (unValue <$>) <$> runDB ( selectOne $ do
x <- from $ table @Store
where_ $ x ^. StoreToken ==. val tid
where_ $ x ^. StoreKey ==. val gmailRefreshToken
diff --git a/src/Admin/Tokens.hs b/src/Admin/Tokens.hs
index 3cec039..450f0b6 100644
--- a/src/Admin/Tokens.hs
+++ b/src/Admin/Tokens.hs
@@ -45,7 +45,7 @@ import Foundation
import Network.Wreq
( FormParam ((:=)), post, responseStatus, statusCode, responseBody, defaults
- , auth, oauth2Bearer, postWith
+ , auth, oauth2Bearer, postWith, deleteWith
)
import Text.Blaze.Html (preEscapedToHtml)
@@ -81,6 +81,8 @@ import Model
import Menu (menu)
import Settings (widgetFile, AppSettings (appGoogleClientId, appGoogleClientSecret))
+import Text.Printf (printf)
+import Data.Bifunctor (Bifunctor(first))
getGMailApiHookR :: Handler Html
@@ -123,18 +125,27 @@ getGMailApiHookR = do
addMessageI info MsgRecordEdited
redirect $ AdminR TokensR
Just x@StoreTypeGoogleSecretManager -> do
-
- let apis = [ ( "https://secretmanager.googleapis.com/v1/projects/salon-395815/secrets/gmail_access_token:addVersion"
- , accessToken
- )
- , ( "https://secretmanager.googleapis.com/v1/projects/salon-395815/secrets/gmail_refresh_token:addVersion"
- , refreshToken
- )
- ]
let opts = defaults & auth L.?~ oauth2Bearer (encodeUtf8 accessToken)
- forM_ apis $ \(api,secret) -> do
+ let apic :: [String]
+ apic = printf "https://secretmanager.googleapis.com/v1/projects/salon-395815/secrets?secretId=%s"
+ <$> [ "gmail_access_token" :: String
+ , "gmail_refresh_token" :: String
+ ]
+
+ forM_ apic $ \api -> do
+ liftIO $ tryAny $ postWith opts api
+ (object [ "replication" .= object [ "automatic" .= object []] ])
+
+
+ let apiv :: [(String,Text)]
+ apiv = first (printf "https://secretmanager.googleapis.com/v1/projects/salon-395815/secrets/%s:addVersion")
+ <$> [ ("gmail_access_token",accessToken) :: (String,Text)
+ , ("gmail_refresh_token",refreshToken) :: (String,Text)
+ ]
+
+ forM_ apiv $ \(api,secret) -> do
liftIO $ tryAny $ postWith opts api
(object [ "payload" .= object [ "data" .= decodeUtf8 (B64.encode (encodeUtf8 secret)) ]])
@@ -167,7 +178,18 @@ postTokensGMailClearR = do
addMessageI info MsgRecordDeleted
redirect $ AdminR TokensR
(FormSuccess (),Just (Entity tid (Token _ StoreTypeGoogleSecretManager))) -> do
- undefined
+ let accessToken = undefined
+ let opts = defaults & auth L.?~ oauth2Bearer (encodeUtf8 accessToken)
+
+ let apic :: [String]
+ apic = printf "https://secretmanager.googleapis.com/v1/projects/salon-395815/secrets/%s"
+ <$> [ "gmail_access_token" :: String
+ , "gmail_refresh_token" :: String
+ ]
+
+ forM_ apic $ \api -> do
+ liftIO $ tryAny $ deleteWith opts api
+
runDB $ delete tid
addMessageI info MsgRecordDeleted
redirect $ AdminR TokensR
diff --git a/src/Application.hs b/src/Application.hs
index 037728a..4f3d4fe 100644
--- a/src/Application.hs
+++ b/src/Application.hs
@@ -58,7 +58,6 @@ import Demo.DemoDataEN (populateEN)
-- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file!
-import Handler.Sitemap (getSitemapR)
import Handler.Scratch
( getScratchInitR
@@ -212,6 +211,7 @@ import Admin.Services
)
import Handler.Common
( getFaviconR, getRobotsR, getPhotoPlaceholderR
+ , getSitemapR, getWebAppManifestR
)
diff --git a/src/Demo/DemoDataEN.hs b/src/Demo/DemoDataEN.hs
index 460140b..d03aec6 100644
--- a/src/Demo/DemoDataEN.hs
+++ b/src/Demo/DemoDataEN.hs
@@ -104,7 +104,7 @@ populateEN = do
, businessTz = "Europe/London"
, businessPhone = Just "020-7736-6600"
, businessMobile = Just "567-274-7469"
- , businessEmail = Just "salon@mail.uk"
+ , businessEmail = Just "ciukstar@gmail.com"
}
b <- insert business
diff --git a/src/Demo/DemoDataFR.hs b/src/Demo/DemoDataFR.hs
index 0db2b79..e245b87 100644
--- a/src/Demo/DemoDataFR.hs
+++ b/src/Demo/DemoDataFR.hs
@@ -104,7 +104,7 @@ populateFR = do
, businessTz = "Europe/Paris"
, businessPhone = Just "+33-775-552-652"
, businessMobile = Just "+33-655-537-079"
- , businessEmail = Just "salon@mail.fr"
+ , businessEmail = Just "ciukstar@gmail.com"
}
b <- insert business
diff --git a/src/Demo/DemoDataRO.hs b/src/Demo/DemoDataRO.hs
index 78d5c4c..7e4e4a7 100644
--- a/src/Demo/DemoDataRO.hs
+++ b/src/Demo/DemoDataRO.hs
@@ -102,7 +102,7 @@ populateRO = do
, businessTz = "Europe/Bucharest"
, businessPhone = Just "+40768469474"
, businessMobile = Just "+40769859190"
- , businessEmail = Just "salon@mail.ro"
+ , businessEmail = Just "ciukstar@gmail.com"
}
b <- insert business
diff --git a/src/Demo/DemoDataRU.hs b/src/Demo/DemoDataRU.hs
index f205f07..540bd71 100644
--- a/src/Demo/DemoDataRU.hs
+++ b/src/Demo/DemoDataRU.hs
@@ -96,7 +96,7 @@ populateRU = do
, businessTz = "Europe/Moscow"
, businessPhone = Just "+7 (958) 759-52-25"
, businessMobile = Just "940(8537)418-74-67"
- , businessEmail = Just "salon@mail.ru"
+ , businessEmail = Just "ciukstar@gmail.com"
}
b <- insert business
diff --git a/src/Foundation.hs b/src/Foundation.hs
index 0fdc317..23827c2 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -130,7 +130,8 @@ instance Yesod App where
isAuthorized (StaticR _) _ = return Authorized
isAuthorized (AuthR _) _ = return Authorized
-
+
+ isAuthorized WebAppManifestR _ = return Authorized
isAuthorized SitemapR _ = return Authorized
isAuthorized HomeR _ = return Authorized
isAuthorized FaviconR _ = return Authorized
@@ -145,7 +146,6 @@ instance Yesod App where
isAuthorized r@(StatsR (AovDetailsR {})) _ = setUltDest r >> isAnalyst
-
isAuthorized BillingMailHookR _ = return Authorized
isAuthorized (AdminR GMailApiHookR) _ = return Authorized
diff --git a/src/Handler/Common.hs b/src/Handler/Common.hs
index 6dffc83..2946c91 100644
--- a/src/Handler/Common.hs
+++ b/src/Handler/Common.hs
@@ -2,15 +2,83 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PatternSynonyms #-}
-module Handler.Common where
+module Handler.Common
+ ( getWebAppManifestR
+ , getSitemapR
+ , getPhotoPlaceholderR
+ , getFaviconR
+ , getRobotsR
+ ) where
+import Control.Monad.IO.Class (liftIO)
+import Data.Aeson (object, (.=), Value (String))
+import Data.Conduit (yield)
import Data.FileEmbed (embedFile)
-import Foundation ( Handler )
+import Data.Time.Clock (getCurrentTime, UTCTime (utctDay))
+import Data.Time.Calendar (toGregorian)
+import Data.Time.Calendar.Month (pattern YearMonth)
+import Foundation
+ ( Handler
+ , Route
+ ( HomeR, ServicesR, BookOffersR, BookingsCalendarR, AboutUsR
+ , ContactR, ResourcesR, StaticR
+ )
+ , ResourcesR (DocsR), AppMessage (MsgAppName, MsgMetaDescription)
+ )
+import Settings.StaticFiles
+ (img_salon_512_png, img_salon_1024_png, img_salon_512_maskable_png)
import Yesod.Core
( TypedContent (TypedContent), ToContent (toContent)
, typePlain, cacheSeconds, typeSvg
)
+import Yesod.Core.Handler (selectRep, getUrlRender, getMessageRender)
+import Yesod.Core.Json (provideJson, array)
+import Yesod.Sitemap
+ (sitemap, SitemapUrl (SitemapUrl), SitemapChangeFreq (Monthly))
+
+
+getWebAppManifestR :: Handler TypedContent
+getWebAppManifestR = do
+ urlRender <- getUrlRender
+ msgRender <- getMessageRender
+ selectRep $ provideJson $ object
+ [ "name" .= msgRender MsgAppName
+ , "short_name" .= msgRender MsgAppName
+ , "description" .= msgRender MsgMetaDescription
+ , "categories" .= array [String "beauty"]
+ , "start_url" .= urlRender HomeR
+ , "theme_color" .= String "#FFFFFF"
+ , "background_color" .= String "#FFFFFF"
+ , "display" .= String "standalone"
+ , "icons" .= array [ object [ "src" .= urlRender (StaticR img_salon_512_png)
+ , "type" .= String "image/png"
+ , "sizes" .= String "512x512"
+ ]
+ , object [ "src" .= urlRender (StaticR img_salon_512_maskable_png)
+ , "type" .= String "image/png"
+ , "sizes" .= String "512x512"
+ , "purpose" .= String "maskable"
+ ]
+ ]
+ ]
+
+
+getSitemapR :: Handler TypedContent
+getSitemapR = sitemap $ do
+ yield $ SitemapUrl (ResourcesR DocsR) Nothing (Just Monthly) (Just 1.0)
+ yield $ SitemapUrl HomeR Nothing (Just Monthly) (Just 1.0)
+ yield $ SitemapUrl ServicesR Nothing (Just Monthly) (Just 0.9)
+ yield $ SitemapUrl BookOffersR Nothing (Just Monthly) (Just 0.8)
+
+ today <- utctDay <$> liftIO getCurrentTime
+ let (y,m,_) = toGregorian today
+ month = YearMonth y m
+
+ yield $ SitemapUrl (BookingsCalendarR month) Nothing (Just Monthly) (Just 0.7)
+ yield $ SitemapUrl AboutUsR Nothing (Just Monthly) (Just 0.6)
+ yield $ SitemapUrl ContactR Nothing (Just Monthly) (Just 0.6)
getPhotoPlaceholderR :: Handler TypedContent
diff --git a/src/Handler/Sitemap.hs b/src/Handler/Sitemap.hs
deleted file mode 100644
index 1407f63..0000000
--- a/src/Handler/Sitemap.hs
+++ /dev/null
@@ -1,37 +0,0 @@
-{-# LANGUAGE PatternSynonyms #-}
-
-module Handler.Sitemap (getSitemapR) where
-
-import Control.Monad.IO.Class (liftIO)
-import Foundation
- ( Handler
- , Route
- ( HomeR, ServicesR, BookOffersR, BookingsCalendarR, AboutUsR
- , ContactR, ResourcesR
- )
- , ResourcesR (DocsR)
- )
-import Yesod.Core.Types (TypedContent)
-import Yesod.Sitemap
- (sitemap, SitemapUrl (SitemapUrl), SitemapChangeFreq (Monthly))
-import Data.Conduit (yield)
-import Data.Time.Clock (getCurrentTime, UTCTime (utctDay))
-import Data.Time.Calendar (toGregorian)
-import Data.Time.Calendar.Month (pattern YearMonth)
-
-
-getSitemapR :: Handler TypedContent
-getSitemapR = sitemap $ do
- yield $ SitemapUrl (ResourcesR DocsR) Nothing (Just Monthly) (Just 1.0)
- yield $ SitemapUrl HomeR Nothing (Just Monthly) (Just 1.0)
- yield $ SitemapUrl ServicesR Nothing (Just Monthly) (Just 0.9)
- yield $ SitemapUrl BookOffersR Nothing (Just Monthly) (Just 0.8)
-
- today <- utctDay <$> liftIO getCurrentTime
- let (y,m,_) = toGregorian today
- month = YearMonth y m
-
- yield $ SitemapUrl (BookingsCalendarR month) Nothing (Just Monthly) (Just 0.7)
- yield $ SitemapUrl AboutUsR Nothing (Just Monthly) (Just 0.6)
- yield $ SitemapUrl ContactR Nothing (Just Monthly) (Just 0.6)
-
diff --git a/static/img/Salon-ERD.svg b/static/img/Salon-ERD.svg
index 6b923cb..1d4955b 100644
--- a/static/img/Salon-ERD.svg
+++ b/static/img/Salon-ERD.svg
@@ -123,34 +123,34 @@
>offertimeaddrtzotzpay_methodstatusbookinvoice_mailstore_typestoretokenkeyvalstorecustomergroup
+
+
+
diff --git a/static/img/salon_512.png b/static/img/salon_512.png
new file mode 100644
index 0000000..8286ca1
Binary files /dev/null and b/static/img/salon_512.png differ
diff --git a/static/img/salon_512.svg b/static/img/salon_512.svg
new file mode 100644
index 0000000..cbffbdf
--- /dev/null
+++ b/static/img/salon_512.svg
@@ -0,0 +1,47 @@
+
+
+
+
diff --git a/static/img/salon_512_maskable.png b/static/img/salon_512_maskable.png
new file mode 100644
index 0000000..8286ca1
Binary files /dev/null and b/static/img/salon_512_maskable.png differ
diff --git a/templates/default-layout-wrapper.hamlet b/templates/default-layout-wrapper.hamlet
index 24be6c0..d4b06af 100644
--- a/templates/default-layout-wrapper.hamlet
+++ b/templates/default-layout-wrapper.hamlet
@@ -11,6 +11,7 @@ $doctype 5
+
$maybe Entity rid (Brand bid _ _ _ _ _ _ ico mime _) <- brand
$maybe _ <- ico
$maybe mime <- mime