From d4f264dc18979e01b93614a8d91bca63b24eb059 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Fri, 25 Oct 2024 04:40:24 +0200 Subject: [PATCH] refactor: revisit static file embedding remove memcached-based static caching, serve static files directly from binary embedding, remove frontend bundler entrypoint and widget generation (directly add js/css in siteLayout) --- src/Foundation/Instances.hs | 6 +- src/Foundation/SiteLayout.hs | 8 +-- src/Foundation/Yesod/StaticContent.hs | 53 --------------- src/Settings/StaticFiles.hs | 11 ++-- src/Settings/StaticFiles/Bundler.hs | 92 --------------------------- src/Settings/StaticFiles/Generator.hs | 73 --------------------- 6 files changed, 10 insertions(+), 233 deletions(-) delete mode 100644 src/Foundation/Yesod/StaticContent.hs delete mode 100644 src/Settings/StaticFiles/Bundler.hs delete mode 100644 src/Settings/StaticFiles/Generator.hs diff --git a/src/Foundation/Instances.hs b/src/Foundation/Instances.hs index cf684b5bc..02de76927 100644 --- a/src/Foundation/Instances.hs +++ b/src/Foundation/Instances.hs @@ -27,7 +27,6 @@ import Auth.Dummy import qualified Foundation.Yesod.Session as UniWorX import qualified Foundation.Yesod.Middleware as UniWorX import qualified Foundation.Yesod.ErrorHandler as UniWorX -import qualified Foundation.Yesod.StaticContent as UniWorX import qualified Foundation.Yesod.Persist as UniWorX import qualified Foundation.Yesod.Auth as UniWorX @@ -91,9 +90,8 @@ instance Yesod UniWorX where isAuthorized :: HasCallStack => Route UniWorX -> Bool -> HandlerFor UniWorX AuthResult isAuthorized r w = runDBRead $ evalAccess r w - -- TODO: replace memcached-based static-content caching with basic addStaticContent - addStaticContent = UniWorX.addStaticContent - -- addStaticContent = embedStaticContent appStatic StaticR Right -- TODO: minify on production builds + -- TODO: minify on production builds using ifdef DEVELOP instead of bundler-based minify + addStaticContent = embedStaticContent appStatic StaticR Right fileUpload _site _length = FileUploadMemory lbsBackEnd diff --git a/src/Foundation/SiteLayout.hs b/src/Foundation/SiteLayout.hs index 2b5fbec51..de88d07f7 100644 --- a/src/Foundation/SiteLayout.hs +++ b/src/Foundation/SiteLayout.hs @@ -487,9 +487,10 @@ siteLayout' overrideHeading widget = do frontendI18n = toJSON (mr :: FrontendMessage -> Text) frontendDatetimeLocale <- toJSON <$> selectLanguage frontendDatetimeLocales - pc' <- widgetToPageContent $ do - bundlerLinks_main StaticR - bundlerLinks_polyfill StaticR + pc <- widgetToPageContent $ do + addScript $ StaticR main_js + addStylesheet $ StaticR main_css + addScript $ StaticR polyfill_js toWidget $(juliusFile "templates/i18n.julius") whenIsJust currentApproot' $ \currentApproot -> toWidget $(juliusFile "templates/approot.julius") @@ -505,7 +506,6 @@ siteLayout' overrideHeading widget = do | otherwise -> CssBuilder . LTB.fromLazyText $ "[data-uw-field-display=\"" <> fromStrict hpSecret <> "\"]{/*display:none!important*/}" $(widgetFile "default-layout") - let pc = pc'{ pageHead = pageHead pc' <> [hamlet||] } -- TODO replace href withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") diff --git a/src/Foundation/Yesod/StaticContent.hs b/src/Foundation/Yesod/StaticContent.hs deleted file mode 100644 index 5ab5b04be..000000000 --- a/src/Foundation/Yesod/StaticContent.hs +++ /dev/null @@ -1,53 +0,0 @@ --- SPDX-FileCopyrightText: 2022 Gregor Kleen ,Sarah Vaupel --- --- SPDX-License-Identifier: AGPL-3.0-or-later - -module Foundation.Yesod.StaticContent - ( addStaticContent - ) where - -import Import.NoFoundation hiding (addStaticContent) - -import Foundation.Type - -import qualified Database.Memcached.Binary.IO as Memcached - -import qualified Data.ByteString.Lazy as Lazy -import qualified Data.ByteString.Base64.URL as Base64 (encodeUnpadded) -import Data.ByteArray (convert) -import Crypto.Hash (SHAKE256) -import Crypto.Hash.Conduit (sinkHash) -import Data.Bits (Bits(zeroBits)) - -import qualified Data.Conduit.Combinators as C - - -addStaticContent :: Text - -> Text - -> Lazy.ByteString - -> HandlerFor UniWorX (Maybe (Either Text (Route UniWorX, [(Text, Text)]))) -addStaticContent ext _mime content = do - UniWorX{appWidgetMemcached, appSettings'} <- getYesod - for ((,) <$> appWidgetMemcached <*> appWidgetMemcachedConf appSettings') $ \(mConn, WidgetMemcachedConf{ widgetMemcachedConf = MemcachedConf { memcachedExpiry }, widgetMemcachedBaseUrl }) -> do - let expiry = maybe 0 ceiling memcachedExpiry - touch = liftIO $ Memcached.touch expiry (encodeUtf8 $ pack fileName) mConn - addItem = liftIO $ Memcached.add zeroBits expiry (encodeUtf8 $ pack fileName) content mConn - absoluteLink = unpack widgetMemcachedBaseUrl fileName - catchIf Memcached.isKeyNotFound touch . const $ - handleIf Memcached.isKeyExists (const $ return ()) addItem - return . Left $ pack absoluteLink - where - -- Generate a unique filename based on the content itself, this is used - -- for deduplication so a collision resistant hash function is required - -- - -- SHA-3 (SHAKE256) seemed to be a future-proof choice - -- - -- Length of hash is 144 bits ~~instead of MD5's 128, so as to avoid - -- padding after base64-conversion~~ for backwards compatability - fileName = (<.> unpack ext) - . unpack - . decodeUtf8 - . Base64.encodeUnpadded - . (convert :: Digest (SHAKE256 144) -> ByteString) - . runConduitPure - $ C.sourceLazy content .| sinkHash diff --git a/src/Settings/StaticFiles.hs b/src/Settings/StaticFiles.hs index 3f483f227..98ee31ee6 100644 --- a/src/Settings/StaticFiles.hs +++ b/src/Settings/StaticFiles.hs @@ -7,16 +7,14 @@ -- prevents rebuilds if files change, that are not directly used (like -- webpack bundles) module Settings.StaticFiles - ( bundlerLinks_main, bundlerLinks_polyfill - , embeddedStatic + ( embeddedStatic + , main_js, main_css, polyfill_js , module Yesod.EmbeddedStatic ) where import ClassyPrelude.Yesod -import Settings (appStaticDir, appBundlerEntrypoints, compileTimeAppSettings) -import Settings.StaticFiles.Generator -import Settings.StaticFiles.Bundler +import Settings (appStaticDir, compileTimeAppSettings) import Yesod.EmbeddedStatic -- This generates easy references to files in the static directory at compile time, @@ -34,5 +32,4 @@ import Yesod.EmbeddedStatic #define DEV_BOOL False #endif -mkEmbeddedStatic DEV_BOOL "embeddedStatic" . pure . staticGenerator $ appStaticDir compileTimeAppSettings -mkBundlerEntrypoints (appBundlerEntrypoints compileTimeAppSettings) (pure staticGenerator) $ appStaticDir compileTimeAppSettings \ No newline at end of file +mkEmbeddedStatic DEV_BOOL "embeddedStatic" . pure . embedDir $ appStaticDir compileTimeAppSettings \ No newline at end of file diff --git a/src/Settings/StaticFiles/Bundler.hs b/src/Settings/StaticFiles/Bundler.hs deleted file mode 100644 index 4c82b50ff..000000000 --- a/src/Settings/StaticFiles/Bundler.hs +++ /dev/null @@ -1,92 +0,0 @@ --- SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel , Gregor Kleen --- --- SPDX-License-Identifier: AGPL-3.0-or-later - -module Settings.StaticFiles.Bundler - ( mkBundlerEntrypoints - ) where - -import ClassyPrelude - -import Language.Haskell.TH -import Language.Haskell.TH.Syntax hiding (Lift(..)) -import qualified Language.Haskell.TH.Syntax as TH (Lift(..)) - -import qualified Data.Aeson as Aeson - -import qualified Data.Map as Map - -import Yesod.Core (Route, MonadLogger, MonadWidget, HandlerSite, logDebugS, logErrorS) -import Yesod.EmbeddedStatic (EmbeddedStatic) -import Yesod.EmbeddedStatic.Types -import Network.Mime (MimeType) - -import Control.Lens.Indexed (iforM) - -import Control.Monad.Writer.Class (MonadWriter(..)) -import Control.Monad.Trans.Writer.Lazy (execWriterT) - -import System.FilePath (makeRelative) - -import Text.Shakespeare.Text (st) - -import Utils () -import Data.Containers.ListUtils - - -mkBundlerEntrypoints :: FilePath -- ^ Path to manifest (json) - -> [FilePath -> Generator] - -> FilePath -- ^ Path to static dir - -> DecsQ -mkBundlerEntrypoints manifest mkGen stDir = do - addDependentFile manifest - entrypoints <- decodeManifest manifest - - staticEntries <- concat <$> mapM ($ stDir) mkGen - - fmap (concat . Map.elems) . iforM entrypoints $ \entrypoint files -> do - entries <- execWriterT . forM_ files $ \file -> do - let fileEntries = filter (\entry -> makeRelative stDir (ebLocation entry) == file) staticEntries - forM_ fileEntries $ \entry -> case ebHaskellName entry of - Nothing -> lift . reportWarning $ concat - [ "Entry “" - , ebLocation entry - , "” of file “" - , file - , "” of bundler entrypoint “" - , entrypoint - , "” has no haskellName" - ] - Just n -> tell $ pure (n, ebMimeType entry) - - let entryName = mkName $ "bundlerEntrypoint_" <> entrypoint - widgetName = mkName $ "bundlerLinks_" <> entrypoint - - staticR <- newName "staticR" - sequence - [ sigD entryName [t|[(Route EmbeddedStatic, MimeType)]|] - , funD entryName - [ clause [] (normalB . listE . map (\(n, mime) -> tupE [varE n, TH.lift mime]) $ nubOrdOn fst entries) [] - ] - , sigD widgetName [t|forall m. (MonadLogger m, MonadWidget m) => (Route EmbeddedStatic -> Route (HandlerSite m)) -> m ()|] - , funD widgetName - [ clause [varP staticR] (normalB [e| - do - $logDebugS "siteLayout" $ tshow $(varE entryName) - forM_ $(varE entryName) $ \(sRoute, mime) -> - let ctEq = (==) `on` simpleContentType - in if - | mime `ctEq` "text/css" - -> addStylesheet $ $(varE staticR) sRoute - | mime `ctEq` "application/javascript" - -> addScript $ $(varE staticR) sRoute - | otherwise - -> $logErrorS "siteLayout" [st|Unknown mime type in bundle: #{tshow mime}|] - |]) [] - ] - ] - -decodeManifest :: FilePath -> Q (Map String (Map String FilePath)) -decodeManifest manifest' = liftIO (Aeson.eitherDecodeFileStrict manifest') >>= \case - Left exc -> error $ "Encountered error while decoding manifest: " ++ exc - Right res -> return res \ No newline at end of file diff --git a/src/Settings/StaticFiles/Generator.hs b/src/Settings/StaticFiles/Generator.hs deleted file mode 100644 index f7b8eab15..000000000 --- a/src/Settings/StaticFiles/Generator.hs +++ /dev/null @@ -1,73 +0,0 @@ --- SPDX-FileCopyrightText: 2022 Gregor Kleen --- --- SPDX-License-Identifier: AGPL-3.0-or-later - -module Settings.StaticFiles.Generator - ( staticGenerator - ) where - -import ClassyPrelude -import Yesod.EmbeddedStatic.Types -import Yesod.EmbeddedStatic - -import System.FilePath -import System.Directory.Tree -import Network.Mime - -import Language.Haskell.TH -import Language.Haskell.TH.Syntax - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as LBS - -import qualified Text.Sass.Compilation as Sass -import Text.Sass.Options - -import Data.Default - -import qualified Data.Foldable as Fold - -import Settings.Mime - -import Control.Monad.Fail - - -staticGenerator :: FilePath -> Generator -staticGenerator staticDir = do - dirTree' <- runIO $ readDirectoryWith toEntries staticDir - Fold.forM_ (fst <$> zipPaths dirTree') addDependentFile - return . Fold.fold $ dirTree dirTree' - where - toEntries :: FilePath -- ^ Absolute path - -> IO [Entry] - toEntries loc = compile (mimeLookup $ pack loc) (makeRelative staticDir loc) loc - -compile :: MimeType - -> Location -- ^ Relative location - -> FilePath -- ^ Absolute filepath - -> IO [Entry] -compile "text/x-scss" sassLoc fp = return . pure $ def - { ebHaskellName = Just $ pathToName sassLoc - , ebLocation - , ebMimeType = "text/css" - , ebProductionContent = either (fail <=< Sass.errorMessage) (return . LBS.fromStrict) =<< Sass.compileFile fp def - , ebDevelReload = [| either (fail <=< Sass.errorMessage) (return . LBS.fromStrict) =<< Sass.compileFile $(litE $ stringL fp) def |] - } - where - ebLocation = sassLoc -<.> "css" -compile "text/x-sass" sassLoc fp = return . pure $ def - { ebHaskellName = Just $ pathToName sassLoc - , ebLocation - , ebMimeType = "text/css" - , ebProductionContent = either (fail <=< Sass.errorMessage) (return . LBS.fromStrict) =<< Sass.compileFile fp (def { sassIsIndentedSyntax = True }) - , ebDevelReload = [| either (fail <=< Sass.errorMessage) (return . LBS.fromStrict) =<< Sass.compileFile $(litE $ stringL fp) (def { sassIsIndentedSyntax = True }) |] - } - where - ebLocation = sassLoc -<.> "css" -compile ebMimeType ebLocation fp = return . pure $ def - { ebHaskellName = Just $ pathToName ebLocation - , ebLocation - , ebMimeType - , ebProductionContent = LBS.fromStrict <$> BS.readFile fp - , ebDevelReload = [| LBS.fromStrict <$> BS.readFile $(litE $ stringL fp) |] - }