fix(static): fix addStaticContent by using memcached again to supply static files

src/Foundation/Instances.hs

@@ -29,6 +29,7 @@ import qualified Foundation.Yesod.Middleware as UniWorX
 import qualified Foundation.Yesod.ErrorHandler as UniWorX
 import qualified Foundation.Yesod.Persist as UniWorX
 import qualified Foundation.Yesod.Auth as UniWorX
+import qualified Foundation.Yesod.StaticContent as UniWorX
 
 import Foundation.Instances.ButtonClass
 import Foundation.SiteLayout
@@ -90,8 +91,7 @@ instance Yesod UniWorX where
     isAuthorized :: HasCallStack => Route UniWorX -> Bool -> HandlerFor UniWorX AuthResult
     isAuthorized r w = runDBRead $ evalAccess r w
 
-    -- TODO: minify on production builds using ifdef DEVELOP instead of bundler-based minify
-    addStaticContent = embedStaticContent appStatic StaticR Right
+    addStaticContent = UniWorX.addStaticContent
 
     fileUpload _site _length = FileUploadMemory lbsBackEnd
 

src/Foundation/Yesod/StaticContent.hs

@@ -0,0 +1,53 @@
+-- SPDX-FileCopyrightText: 2022-2025 Sarah Vaupel <sarah.vaupel@uniworx.systems>, Gregor Kleen <gregor.kleen@ifi.lmu.de>, Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
+--
+-- 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 compatibility
+    fileName = (<.> unpack ext)
+             . unpack
+             . decodeUtf8
+             . Base64.encodeUnpadded
+             . (convert :: Digest (SHAKE256 144) -> ByteString)
+             . runConduitPure
+             $ C.sourceLazy content .| sinkHash