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) |]
- }