now setting etags

This commit is contained in:
nek0 2015-09-16 20:28:30 +02:00
parent f7656110ae
commit 647167dd0d
3 changed files with 15 additions and 10 deletions

View file

@ -17,9 +17,11 @@ module Handler.Avatar where
import Import import Import
import Data.Conduit.Binary import Data.Conduit.Binary
import qualified Data.Text as T
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import Graphics.ImageMagick.MagickWand import Graphics.ImageMagick.MagickWand
import qualified Crypto.Hash.SHA3 as SHA3
getAvatarR :: Handler Html getAvatarR :: Handler Html
getAvatarR = do getAvatarR = do
@ -39,9 +41,8 @@ postNewAvatarR = do
case res of case res of
FormSuccess na -> do FormSuccess na -> do
raw <- runResourceT $ fileSource (avatarNewFile na) $$ sinkLbs raw <- runResourceT $ fileSource (avatarNewFile na) $$ sinkLbs
thumb <- generateThumb $ B.concat $ L.toChunks raw (thumb, hash) <- generateThumb $ B.concat $ L.toChunks raw
now <- liftIO getCurrentTime runDB $ insert_ $ Avatar (avatarNewIdent na) thumb hash
runDB $ insert_ $ Avatar (avatarNewIdent na) thumb now
setMessageI MsgAvatarUploadSuccessfull setMessageI MsgAvatarUploadSuccessfull
redirect HomeR redirect HomeR
_ -> do _ -> do
@ -103,15 +104,16 @@ updateAvatar aId (AvatarMod ident Nothing) =
runDB $ update aId [AvatarIdent =. ident] runDB $ update aId [AvatarIdent =. ident]
updateAvatar aId (AvatarMod ident (Just fi)) = do updateAvatar aId (AvatarMod ident (Just fi)) = do
raw <- runResourceT $ fileSource fi $$ sinkLbs raw <- runResourceT $ fileSource fi $$ sinkLbs
thumb <- generateThumb $ B.concat $ L.toChunks raw (thumb, hash) <- generateThumb $ B.concat $ L.toChunks raw
runDB $ update aId runDB $ update aId
[ AvatarIdent =. ident [ AvatarIdent =. ident
, AvatarData =. thumb , AvatarData =. thumb
, AvatarHash =. hash
] ]
generateThumb :: ByteString -> Handler ByteString generateThumb :: ByteString -> Handler (ByteString, ByteString)
generateThumb raw = generateThumb raw = do
liftIO $ withMagickWandGenesis $ do thumb <- liftIO $ withMagickWandGenesis $ do
(_, w) <- magickWand (_, w) <- magickWand
readImageBlob w raw readImageBlob w raw
w1 <- getImageWidth w w1 <- getImageWidth w
@ -122,11 +124,13 @@ generateThumb raw =
setImageCompressionQuality w 95 setImageCompressionQuality w 95
setImageFormat w "png" setImageFormat w "png"
getImageBlob w getImageBlob w
let h = SHA3.hash 16 thumb
return (thumb, h)
getGetAvatarR :: AvatarId -> Handler TypedContent getGetAvatarR :: AvatarId -> Handler TypedContent
getGetAvatarR aId = do getGetAvatarR aId = do
neverExpires
avatar <- runDB $ get404 aId avatar <- runDB $ get404 aId
setEtag $ decodeUtf8 $ avatarHash avatar
return $ TypedContent typePng $ toContent $ avatarData avatar return $ TypedContent typePng $ toContent $ avatarData avatar
getAvatarDeleteR :: AvatarId -> Handler Html getAvatarDeleteR :: AvatarId -> Handler Html

View file

@ -32,7 +32,7 @@ CashCheck
Avatar Avatar
ident Text ident Text
data ByteString data ByteString
altTime UTCTime default=now() hash ByteString default='fill_me!'
deriving Typeable Show deriving Typeable Show
Barcode Barcode
code Text code Text

View file

@ -1,5 +1,5 @@
name: yammat name: yammat
version: 0.0.0 version: 0.0.1
cabal-version: >= 1.8 cabal-version: >= 1.8
build-type: Simple build-type: Simple
@ -100,6 +100,7 @@ library
, split , split
, conduit-extra , conduit-extra
, imagemagick , imagemagick
, cryptohash
executable yammat executable yammat
if flag(library-only) if flag(library-only)