From 59988f46a19981a6615d4475e38b702b3414049a Mon Sep 17 00:00:00 2001
From: Jezen Thomas <jezen@jezenthomas.com>
Date: Fri, 23 Aug 2019 13:49:33 +0200
Subject: [PATCH 1/3] Add jsAttributesHandler

This adds `jsAttributesHandler` to run arbitrary Handler code before
building the attributes map for the script tag generated by `widgetFile`.
This is useful if you need to add a randomised nonce value to that tag.

Closes https://github.com/yesodweb/yesod/issues/1621
---
 yesod-core/ChangeLog.md                  |  5 +++++
 yesod-core/src/Yesod/Core/Class/Yesod.hs | 21 +++++++++++++++++++--
 yesod-core/yesod-core.cabal              |  2 +-
 3 files changed, 25 insertions(+), 3 deletions(-)

diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md
index 2d1a6e75..3108ec47 100644
--- a/yesod-core/ChangeLog.md
+++ b/yesod-core/ChangeLog.md
@@ -1,5 +1,10 @@
 # ChangeLog for yesod-core
 
+## 1.6.16
+
+* Add `jsAttributesHandler` to run arbitrary Handler code before building the
+  attributes map for the script tag generated by `widgetFile` [#1622](https://github.com/yesodweb/yesod/pull/1622)
+
 ## 1.6.15
 
 * Move `redirectToPost` JavaScript form submission from HTML element to
diff --git a/yesod-core/src/Yesod/Core/Class/Yesod.hs b/yesod-core/src/Yesod/Core/Class/Yesod.hs
index df8d195b..b6886c70 100644
--- a/yesod-core/src/Yesod/Core/Class/Yesod.hs
+++ b/yesod-core/src/Yesod/Core/Class/Yesod.hs
@@ -249,6 +249,17 @@ class RenderRoute site => Yesod site where
     jsAttributes :: site -> [(Text, Text)]
     jsAttributes _ = []
 
+    -- | Same as @jsAttributes@ but allows you to run arbitrary Handler code
+    --
+    -- This is useful if you need to add a randomised nonce value to the script
+    -- tag generated by @widgetFile@. If you use both this function and
+    -- @jsAttributes@, the two attribute maps will be merged, favouring the
+    -- keys from @jsAttributes@ in case of a collision.
+    --
+    -- @since 1.6.16
+    jsAttributesHandler :: HandlerFor site [(Text, Text)]
+    jsAttributesHandler = pure []
+
     -- | Create a session backend. Returning 'Nothing' disables
     -- sessions. If you'd like to change the way that the session
     -- cookies are created, take a look at
@@ -520,7 +531,9 @@ defaultCsrfMiddleware = defaultCsrfSetCookieMiddleware . defaultCsrfCheckMiddlew
 widgetToPageContent :: Yesod site
                     => WidgetFor site ()
                     -> HandlerFor site (PageContent (Route site))
-widgetToPageContent w = HandlerFor $ \hd -> do
+widgetToPageContent w = do
+  jsAttrsFromHandler <- jsAttributesHandler
+  HandlerFor $ \hd -> do
   master <- unHandlerFor getYesod hd
   ref <- newIORef mempty
   unWidgetFor w WidgetData
@@ -531,6 +544,10 @@ widgetToPageContent w = HandlerFor $ \hd -> do
   let title = maybe mempty unTitle mTitle
       scripts = runUniqueList scripts'
       stylesheets = runUniqueList stylesheets'
+      jsAttrs =
+        let jsAttrsStatic = Map.fromList (jsAttributes master)
+            jsAttrsDynamic = Map.fromList jsAttrsFromHandler
+         in Map.toList $ Map.union jsAttrsStatic jsAttrsDynamic
 
   flip unHandlerFor hd $ do
     render <- getUrlRenderParams
@@ -564,7 +581,7 @@ widgetToPageContent w = HandlerFor $ \hd -> do
                 ^{mkScriptTag s}
             $maybe j <- jscript
                 $maybe s <- jsLoc
-                    <script src="#{s}" *{jsAttributes master}>
+                    <script src="#{s}" *{jsAttrs}>
                 $nothing
                     <script>^{jelper j}
         |]
diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal
index cf67b818..0a6ee54e 100644
--- a/yesod-core/yesod-core.cabal
+++ b/yesod-core/yesod-core.cabal
@@ -1,5 +1,5 @@
 name:            yesod-core
-version:         1.6.15
+version:         1.6.16
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>

From d1e4fd485ba1dd4d97c2b02f59d2732100486ce8 Mon Sep 17 00:00:00 2001
From: Jezen Thomas <jezen@jezenthomas.com>
Date: Mon, 26 Aug 2019 12:03:53 +0200
Subject: [PATCH 2/3] Make `jsAttributesHandler` use `jsAttributes`

This addresses this comment:

https://github.com/yesodweb/yesod/pull/1622#discussion_r317467498
---
 yesod-core/src/Yesod/Core/Class/Yesod.hs | 13 ++++---------
 1 file changed, 4 insertions(+), 9 deletions(-)

diff --git a/yesod-core/src/Yesod/Core/Class/Yesod.hs b/yesod-core/src/Yesod/Core/Class/Yesod.hs
index b6886c70..fde5d476 100644
--- a/yesod-core/src/Yesod/Core/Class/Yesod.hs
+++ b/yesod-core/src/Yesod/Core/Class/Yesod.hs
@@ -252,13 +252,12 @@ class RenderRoute site => Yesod site where
     -- | Same as @jsAttributes@ but allows you to run arbitrary Handler code
     --
     -- This is useful if you need to add a randomised nonce value to the script
-    -- tag generated by @widgetFile@. If you use both this function and
-    -- @jsAttributes@, the two attribute maps will be merged, favouring the
-    -- keys from @jsAttributes@ in case of a collision.
+    -- tag generated by @widgetFile@. If this function is overridden then
+    -- @jsAttributes@ is ignored.
     --
     -- @since 1.6.16
     jsAttributesHandler :: HandlerFor site [(Text, Text)]
-    jsAttributesHandler = pure []
+    jsAttributesHandler = getYesod >>= return . jsAttributes
 
     -- | Create a session backend. Returning 'Nothing' disables
     -- sessions. If you'd like to change the way that the session
@@ -532,7 +531,7 @@ widgetToPageContent :: Yesod site
                     => WidgetFor site ()
                     -> HandlerFor site (PageContent (Route site))
 widgetToPageContent w = do
-  jsAttrsFromHandler <- jsAttributesHandler
+  jsAttrs <- jsAttributesHandler
   HandlerFor $ \hd -> do
   master <- unHandlerFor getYesod hd
   ref <- newIORef mempty
@@ -544,10 +543,6 @@ widgetToPageContent w = do
   let title = maybe mempty unTitle mTitle
       scripts = runUniqueList scripts'
       stylesheets = runUniqueList stylesheets'
-      jsAttrs =
-        let jsAttrsStatic = Map.fromList (jsAttributes master)
-            jsAttrsDynamic = Map.fromList jsAttrsFromHandler
-         in Map.toList $ Map.union jsAttrsStatic jsAttrsDynamic
 
   flip unHandlerFor hd $ do
     render <- getUrlRenderParams

From 46af7bfb76883f4ca10b0ad20944fbd1c49cea7d Mon Sep 17 00:00:00 2001
From: Jezen Thomas <jezen@jezenthomas.com>
Date: Mon, 26 Aug 2019 13:49:57 +0200
Subject: [PATCH 3/3] Cleanup

---
 yesod-core/src/Yesod/Core/Class/Yesod.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/yesod-core/src/Yesod/Core/Class/Yesod.hs b/yesod-core/src/Yesod/Core/Class/Yesod.hs
index fde5d476..85a9d10c 100644
--- a/yesod-core/src/Yesod/Core/Class/Yesod.hs
+++ b/yesod-core/src/Yesod/Core/Class/Yesod.hs
@@ -257,7 +257,7 @@ class RenderRoute site => Yesod site where
     --
     -- @since 1.6.16
     jsAttributesHandler :: HandlerFor site [(Text, Text)]
-    jsAttributesHandler = getYesod >>= return . jsAttributes
+    jsAttributesHandler = jsAttributes <$> getYesod
 
     -- | Create a session backend. Returning 'Nothing' disables
     -- sessions. If you'd like to change the way that the session
@@ -639,7 +639,7 @@ defaultErrorHandler NotFound = selectRep $ do
         let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
         defaultMessageWidget "Not Found" [hamlet|<p>#{path'}|]
     provideRep $ return $ object ["message" .= ("Not Found" :: Text)]
-    provideRep $ return $ ("Not Found" :: Text)
+    provideRep $ return ("Not Found" :: Text)
 
 -- For API requests.
 -- For a user with a browser,
@@ -663,7 +663,7 @@ defaultErrorHandler NotAuthenticated = selectRep $ do
         let apair u = ["authentication_url" .= rend u]
             content = maybe [] apair (authRoute site)
         return $ object $ ("message" .= ("Not logged in"::Text)):content
-    provideRep $ return $ ("Not logged in" :: Text)
+    provideRep $ return ("Not logged in" :: Text)
 
 defaultErrorHandler (PermissionDenied msg) = selectRep $ do
     provideRep $ defaultLayout $ defaultMessageWidget
@@ -682,7 +682,7 @@ defaultErrorHandler (InvalidArgs ia) = selectRep $ do
                     <li>#{msg}
         |]
     provideRep $ return $ object ["message" .= ("Invalid Arguments" :: Text), "errors" .= ia]
-    provideRep $ return $ ("Invalid Arguments: " <> T.intercalate " " ia)
+    provideRep $ return ("Invalid Arguments: " <> T.intercalate " " ia)
 
 defaultErrorHandler (InternalError e) = do
     $logErrorS "yesod-core" e