base64md5

Yesod/Helpers/Static.hs

@@ -31,6 +31,8 @@ module Yesod.Helpers.Static
       -- * Lookup files in filesystem
     , fileLookupDir
     , staticFiles
+      -- * Hashing
+    , base64md5
 #if TEST
     , testSuite
 #endif
@@ -47,6 +49,9 @@ import Web.Routes.Site
 
 import qualified Data.ByteString.Lazy as L
 import Data.Digest.Pure.MD5
+import qualified Codec.Binary.Base64Url
+import qualified Data.ByteString as S
+import qualified Data.Serialize
 
 #if TEST
 import Test.Framework (testGroup, Test)
@@ -147,7 +152,7 @@ staticFiles fp = do
         let name = mkName $ intercalate "_" $ map (map replace') f
         f' <- lift f
         let sr = ConE $ mkName "StaticRoute"
-        hash <- qRunIO $ fmap (show . md5) $ L.readFile $ fp ++ '/' : intercalate "/" f
+        hash <- qRunIO $ fmap base64md5 $ L.readFile $ fp ++ '/' : intercalate "/" f
         let qs = ListE [TupE [LitE $ StringL "hash", LitE $ StringL hash]]
         return
             [ SigD name $ ConT ''Route `AppT` ConT ''Static
@@ -169,3 +174,11 @@ caseGetFileList = do
     x @?= [["foo"], ["bar", "baz"]]
 
 #endif
+
+-- | md5-hashes the given lazy bytestring and returns the hash as
+-- base64url-encoded string.
+base64md5 :: L.ByteString -> String
+base64md5 = Codec.Binary.Base64Url.encode
+          . S.unpack
+          . Data.Serialize.encode
+          . md5

hellowidget.hs

@@ -19,10 +19,10 @@ mkYesod "HW" [$parseRoutes|
 instance Yesod HW where
     approot _ = ""
     addStaticContent ext _ content = do
-        let fn = show (md5 content) ++ '.' : ext
+        let fn = (base64md5 content) ++ '.' : ext
         liftIO $ createDirectoryIfMissing True "static/tmp"
         liftIO $ L.writeFile ("static/tmp/" ++ fn) content
-        return $ Just $ Right (StaticR $ StaticRoute ["tmp", fn], [])
+        return $ Just $ Right (StaticR $ StaticRoute ["tmp", fn] [], [])
 
 instance YesodNic HW
 instance YesodJquery HW
@@ -33,14 +33,14 @@ wrapper h = [$hamlet|
 getRootR = applyLayoutW $ flip wrapWidget wrapper $ do
     i <- newIdent
     setTitle $ string "Hello Widgets"
-    addStyle [$camlet|
+    addStyle [$cassius|
 #$i$
     color:red
 |]
-    addStylesheet $ StaticR $ StaticRoute ["style.css"]
+    addStylesheet $ StaticR $ StaticRoute ["style.css"] []
     addStylesheetRemote "http://localhost:3000/static/style2.css"
     addScriptRemote "http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js"
-    addScript $ StaticR $ StaticRoute ["script.js"]
+    addScript $ StaticR $ StaticRoute ["script.js"] []
     addBody [$hamlet|
 %h1#$i$ Welcome to my first widget!!!
 %p
@@ -74,12 +74,12 @@ handleFormR = do
                     FormSuccess (_, _, _, _, _, _, _, _, x, _) -> Just x
                     _ -> Nothing
     applyLayoutW $ do
-        addStyle [$camlet|
+        addStyle [$cassius|
 .tooltip
     color:#666
     font-style:italic
 |]
-        addStyle [$camlet|
+        addStyle [$cassius|
 textarea.html
     width:300px
     height:150px
@@ -102,7 +102,7 @@ getAutoCompleteR :: Handler HW RepJson
 getAutoCompleteR = do
     term <- runFormGet' $ stringInput "term"
     jsonToRepJson $ jsonList
-        [ jsonScalar $ string $ term ++ "foo"
+        [ jsonScalar $ term ++ "foo"
-        , jsonScalar $ string $ term ++ "bar"
+        , jsonScalar $ term ++ "bar"
-        , jsonScalar $ string $ term ++ "baz"
+        , jsonScalar $ term ++ "baz"
         ]

yesod.cabal

@@ -40,6 +40,7 @@ library
                      random >= 1.0.0.2 && < 1.1,
                      control-monad-attempt >= 0.3 && < 0.4,
                      cereal >= 0.2 && < 0.3,
+                     dataenc >= 0.13.0.2 && < 0.14,
                      old-locale >= 1.0.0.2 && < 1.1,
                      persistent >= 0.2.0 && < 0.3,
                      neither >= 0.0.0 && < 0.1,