fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Revert "Include preload hints about static content"

Browse Source 
This reverts commit c757bf9a00.
This commit is contained in:
Gregor Kleen 2018-12-05 15:30:51 +01:00
parent e94173acb1
commit 3f60f6391c
3 changed files with 6 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
src/Foundation.hs
View File

@ -721,19 +721,11 @@ instance Yesod UniWorX where
UniWorX{appWidgetMemcached, appSettings} <- getYesod UniWorX{appWidgetMemcached, appSettings} <- getYesod
for ((,) <$> appWidgetMemcached <*> appWidgetMemcachedConf appSettings) $ \(mConn, WidgetMemcachedConf{ widgetMemcachedConnectInfo = _, .. }) -> do for ((,) <$> appWidgetMemcached <*> appWidgetMemcachedConf appSettings) $ \(mConn, WidgetMemcachedConf{ widgetMemcachedConnectInfo = _, .. }) -> do
let expiry = (maybe 0 ceiling widgetMemcachedExpiry) let expiry = (maybe 0 ceiling widgetMemcachedExpiry)
touch = liftIO $ Memcached.touch expiry (encodeUtf8 $ pack fileName) mConn touch = liftIO $ Memcached.touch expiry fileName mConn
add = liftIO $ Memcached.add zeroBits expiry (encodeUtf8 $ pack fileName) content mConn add = liftIO $ Memcached.add zeroBits expiry fileName content mConn
link = pack $ unpack widgetMemcachedBaseUrl </> fileName
linkAs :: Maybe Text
linkAs
| ext == "js" = Just "script"
| ext == "css" = Just "style"
| otherwise = Nothing
C.catchIf Memcached.isKeyNotFound touch $ \_ -> C.catchIf Memcached.isKeyNotFound touch $ \_ ->
C.handleIf Memcached.isKeyExists (\_ -> return ()) add C.handleIf Memcached.isKeyExists (\_ -> return ()) add
whenIsJust linkAs $ \linkAs' -> return . Left $ widgetMemcachedBaseUrl <> "/" <> decodeUtf8 fileName
addHeader "Link" [st|<#{link}>; as=#{linkAs'}; rel=preload|]
return $ Left link
where where
-- Generate a unique filename based on the content itself, this is used -- Generate a unique filename based on the content itself, this is used
-- for deduplication so a collision resistant hash function is required -- for deduplication so a collision resistant hash function is required
@ -742,9 +734,7 @@ instance Yesod UniWorX where
-- --
-- Length of hash is 144 bits instead of MD5's 128, so as to avoid -- Length of hash is 144 bits instead of MD5's 128, so as to avoid
-- padding after base64-conversion -- padding after base64-conversion
fileName = (<.> unpack ext) fileName = (<> ("." <> encodeUtf8 ext))
. unpack
. decodeUtf8
. Base64.encode . Base64.encode
. (convert :: Digest (SHAKE256 144) -> ByteString) . (convert :: Digest (SHAKE256 144) -> ByteString)
. runIdentity . runIdentity

2
src/Handler/Utils/Rating.hs
View File

@ -41,7 +41,7 @@ import qualified Database.Esqueleto as E
import qualified Data.Conduit.List as Conduit import qualified Data.Conduit.List as Conduit
import Utils.Lens import Utils.Lens hiding ((<.>))
instance HasResolution prec => Pretty (Fixed prec) where instance HasResolution prec => Pretty (Fixed prec) where

2
src/Utils/Lens.hs
View File

@ -1,7 +1,7 @@
module Utils.Lens ( module Utils.Lens ) where module Utils.Lens ( module Utils.Lens ) where
import Import.NoFoundation import Import.NoFoundation
import Control.Lens as Utils.Lens hiding ((<.>)) import Control.Lens as Utils.Lens
import Control.Lens.Extras as Utils.Lens (is) import Control.Lens.Extras as Utils.Lens (is)
import Utils.Lens.TH as Utils.Lens (makeLenses_) import Utils.Lens.TH as Utils.Lens (makeLenses_)