Minor cleanup

This commit is contained in:
Gregor Kleen 2018-12-05 17:57:13 +01:00
parent 3f60f6391c
commit 7fc705730d
3 changed files with 9 additions and 6 deletions

View File

@ -721,11 +721,12 @@ instance Yesod UniWorX where
UniWorX{appWidgetMemcached, appSettings} <- getYesod UniWorX{appWidgetMemcached, appSettings} <- getYesod
for ((,) <$> appWidgetMemcached <*> appWidgetMemcachedConf appSettings) $ \(mConn, WidgetMemcachedConf{ widgetMemcachedConnectInfo = _, .. }) -> do for ((,) <$> appWidgetMemcached <*> appWidgetMemcachedConf appSettings) $ \(mConn, WidgetMemcachedConf{ widgetMemcachedConnectInfo = _, .. }) -> do
let expiry = (maybe 0 ceiling widgetMemcachedExpiry) let expiry = (maybe 0 ceiling widgetMemcachedExpiry)
touch = liftIO $ Memcached.touch expiry fileName mConn touch = liftIO $ Memcached.touch expiry (encodeUtf8 $ pack fileName) mConn
add = liftIO $ Memcached.add zeroBits expiry fileName content mConn add = liftIO $ Memcached.add zeroBits expiry (encodeUtf8 $ pack fileName) content mConn
absoluteLink = unpack widgetMemcachedBaseUrl </> fileName
C.catchIf Memcached.isKeyNotFound touch $ \_ -> C.catchIf Memcached.isKeyNotFound touch $ \_ ->
C.handleIf Memcached.isKeyExists (\_ -> return ()) add C.handleIf Memcached.isKeyExists (\_ -> return ()) add
return . Left $ widgetMemcachedBaseUrl <> "/" <> decodeUtf8 fileName return . Left $ pack absoluteLink
where where
-- Generate a unique filename based on the content itself, this is used -- Generate a unique filename based on the content itself, this is used
-- for deduplication so a collision resistant hash function is required -- for deduplication so a collision resistant hash function is required
@ -734,7 +735,9 @@ instance Yesod UniWorX where
-- --
-- Length of hash is 144 bits instead of MD5's 128, so as to avoid -- Length of hash is 144 bits instead of MD5's 128, so as to avoid
-- padding after base64-conversion -- padding after base64-conversion
fileName = (<> ("." <> encodeUtf8 ext)) fileName = (<.> unpack ext)
. unpack
. decodeUtf8
. Base64.encode . Base64.encode
. (convert :: Digest (SHAKE256 144) -> ByteString) . (convert :: Digest (SHAKE256 144) -> ByteString)
. runIdentity . runIdentity

View File

@ -41,7 +41,7 @@ import qualified Database.Esqueleto as E
import qualified Data.Conduit.List as Conduit import qualified Data.Conduit.List as Conduit
import Utils.Lens hiding ((<.>)) import Utils.Lens
instance HasResolution prec => Pretty (Fixed prec) where instance HasResolution prec => Pretty (Fixed prec) where

View File

@ -1,7 +1,7 @@
module Utils.Lens ( module Utils.Lens ) where module Utils.Lens ( module Utils.Lens ) where
import Import.NoFoundation 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 Control.Lens.Extras as Utils.Lens (is)
import Utils.Lens.TH as Utils.Lens (makeLenses_) import Utils.Lens.TH as Utils.Lens (makeLenses_)