From c757bf9a005e1f343c46052025350c5de1aa42e4 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Wed, 5 Dec 2018 15:07:24 +0100
Subject: [PATCH] Include preload hints about static content

---
 src/Foundation.hs           | 18 ++++++++++++++----
 src/Handler/Utils/Rating.hs |  2 +-
 src/Utils/Lens.hs           |  2 +-
 3 files changed, 16 insertions(+), 6 deletions(-)

diff --git a/src/Foundation.hs b/src/Foundation.hs
index 0dc658312..80f979ff3 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -710,11 +710,19 @@ instance Yesod UniWorX where
       UniWorX{appWidgetMemcached, appSettings} <- getYesod
       for ((,) <$> appWidgetMemcached <*> appWidgetMemcachedConf appSettings) $ \(mConn, WidgetMemcachedConf{ widgetMemcachedConnectInfo = _, .. }) -> do
         let expiry = (maybe 0 ceiling widgetMemcachedExpiry)
-            touch = liftIO $ Memcached.touch expiry fileName mConn
-            add = liftIO $ Memcached.add zeroBits expiry fileName content mConn
+            touch = liftIO $ Memcached.touch expiry (encodeUtf8 $ pack fileName) mConn
+            add = liftIO $ Memcached.add zeroBits expiry (encodeUtf8 $ pack 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.handleIf Memcached.isKeyExists (\_ -> return ()) add
-        return . Left $ widgetMemcachedBaseUrl <> "/" <> decodeUtf8 fileName
+        whenIsJust linkAs $ \linkAs' -> 
+          addHeader "Link" [st|<#{link}>; as=#{linkAs'}; rel=preload|]
+        return $ Left link
       where
         -- Generate a unique filename based on the content itself, this is used
         -- for deduplication so a collision resistant hash function is required
@@ -723,7 +731,9 @@ instance Yesod UniWorX where
         --
         -- Length of hash is 144 bits instead of MD5's 128, so as to avoid
         -- padding after base64-conversion
-        fileName = (<> ("." <> encodeUtf8 ext))
+        fileName = (<.> unpack ext)
+                 . unpack
+                 . decodeUtf8
                  . Base64.encode
                  . (convert :: Digest (SHAKE256 144) -> ByteString)
                  . runIdentity
diff --git a/src/Handler/Utils/Rating.hs b/src/Handler/Utils/Rating.hs
index be259344f..624b6cea4 100644
--- a/src/Handler/Utils/Rating.hs
+++ b/src/Handler/Utils/Rating.hs
@@ -41,7 +41,7 @@ import qualified Database.Esqueleto as E
 
 import qualified Data.Conduit.List as Conduit
 
-import Utils.Lens hiding ((<.>))
+import Utils.Lens
 
 
 instance HasResolution prec => Pretty (Fixed prec) where
diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs
index 7d7df4350..7d71d63ef 100644
--- a/src/Utils/Lens.hs
+++ b/src/Utils/Lens.hs
@@ -1,7 +1,7 @@
 module Utils.Lens ( module Utils.Lens ) where
 
 import Import.NoFoundation
-import Control.Lens as Utils.Lens
+import Control.Lens as Utils.Lens hiding ((<.>))
 import Control.Lens.Extras as Utils.Lens (is)
 import Utils.Lens.TH as Utils.Lens (makeLenses_)