now setting etags
This commit is contained in:
parent
f7656110ae
commit
647167dd0d
3 changed files with 15 additions and 10 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in a new issue