diff --git a/src/Foundation/Instances.hs b/src/Foundation/Instances.hs index 02de76927..7620d6cdc 100644 --- a/src/Foundation/Instances.hs +++ b/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 diff --git a/src/Foundation/Yesod/StaticContent.hs b/src/Foundation/Yesod/StaticContent.hs new file mode 100644 index 000000000..79fbf726d --- /dev/null +++ b/src/Foundation/Yesod/StaticContent.hs @@ -0,0 +1,53 @@ +-- SPDX-FileCopyrightText: 2022-2025 Sarah Vaupel , 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 compatibility + fileName = (<.> unpack ext) + . unpack + . decodeUtf8 + . Base64.encodeUnpadded + . (convert :: Digest (SHAKE256 144) -> ByteString) + . runConduitPure + $ C.sourceLazy content .| sinkHash