{-# LANGUAGE OverloadedStrings #-} module Control.Avatar where import Control.Monad (void) import Control.Monad.Reader (asks) import Control.Monad.Trans (liftIO) import Crypto.Hash import qualified Data.ByteString as BS import Data.ByteString.Builder (byteString) import Data.ByteString.Base64 import Data.String (fromString) import Data.Text.Encoding (encodeUtf8) import Servant import Network.Wai import Network.HTTP.Types.Status (status200, status404) import Network.HTTP.Types.Header (hETag) -- internal imports import Types import Model import Util (throwMissingAuth) avatarGet :: Int -> MateHandler Application avatarGet aid = do conn <- asks rsConnection as <- liftIO $ avatarSelectById aid conn if null as then return ((\_ response -> response $ responseStream status404 [] $ \write flush -> do write "No avatar found." flush ) :: Application) else return ((\_ response -> response $ responseStream status200 [(hETag, encodeUtf8 (avatarHash (head as)))] $ \write flush -> do write $ byteString $ BS.pack $ avatarData $ head as flush ) :: Application) avatarInsert :: Maybe (Int, AuthMethod) -> AvatarData -> MateHandler Int avatarInsert (Just _) ad = do conn <- asks rsConnection insertAvatar ad (md5 $ BS.pack $ avatarDataData ad) conn avatarInsert Nothing _ = throwMissingAuth avatarUpdate :: Maybe (Int, AuthMethod) -> Int -> AvatarData -> MateHandler NoContent avatarUpdate (Just _) aid ad = do conn <- asks rsConnection void $ updateAvatar aid ad (md5 $ BS.pack $ avatarDataData ad) conn return NoContent avatarUpdate Nothing _ _ = throwMissingAuth avatarList :: MateHandler [Avatar] avatarList = do conn <- asks rsConnection liftIO $ avatarSelect conn md5 :: BS.ByteString -> BS.ByteString md5 bs = encode $ fromString (show ( hash bs :: Digest MD5))