Fix generation of temporary files´ names

This commit is contained in:
Gregor Kleen 2017-10-04 14:33:59 +02:00
parent ef3be262aa
commit 76aa7da3ab
2 changed files with 33 additions and 2 deletions

View File

@ -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.

View File

@ -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.