From 76aa7da3ab7878a7fd49926b9f3fe89834c8f1fd Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 4 Oct 2017 14:33:59 +0200
Subject: [PATCH] =?UTF-8?q?Fix=20generation=20of=20temporary=20files=C2=B4?=
 =?UTF-8?q?=20names?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 package.yaml      |  4 ++++
 src/Foundation.hs | 31 +++++++++++++++++++++++++++++--
 2 files changed, 33 insertions(+), 2 deletions(-)

diff --git a/package.yaml b/package.yaml
index 3830186c9..13da5a6b4 100644
--- a/package.yaml
+++ b/package.yaml
@@ -45,6 +45,10 @@ dependencies:
 - time
 - case-insensitive
 - wai
+- cryptonite
+- cryptonite-conduit
+- base64-bytestring
+- memory
 
 # The library contains all of our application code. The executable
 # defined below is just a thin wrapper.
diff --git a/src/Foundation.hs b/src/Foundation.hs
index 2bd8a86b3..cfdceedea 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE DataKinds #-}
 
 module Foundation where
 
@@ -22,6 +23,21 @@ import qualified Yesod.Core.Unsafe as Unsafe
 import qualified Data.CaseInsensitive as CI
 import qualified Data.Text.Encoding as TE
 
+import Data.ByteArray (convert)
+import Crypto.Hash (Digest, SHAKE256)
+import Crypto.Hash.Conduit (sinkHash)
+
+import qualified Data.ByteString.Base64.URL as Base64 (encode)
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Lazy as Lazy.ByteString
+
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Text
+
+import Data.Conduit (($$))
+import Data.Conduit.List (sourceList)
+
 -- | The foundation datatype for your application. This can be a good place to
 -- keep settings and values requiring initialization before your application
 -- starts running, such as database connections. Every handler will have
@@ -165,8 +181,19 @@ instance Yesod UniWorX where
             mime
             content
       where
-        -- Generate a unique filename based on the content itself
-        genFileName lbs = "autogen-" ++ base64md5 lbs
+        -- 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
+        genFileName lbs = Text.unpack
+                        . Text.decodeUtf8
+                        . Base64.encode
+                        . (convert :: Digest (SHAKE256 144) -> ByteString)
+                        . runIdentity
+                        $ sourceList (Lazy.ByteString.toChunks lbs) $$ sinkHash
 
     -- What messages should be logged. The following includes all messages when
     -- in development, and warnings and errors in production.