{-# 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.String (fromString) import Servant import Network.Wai import Network.HTTP.Types.Status (status200, status404) import Network.HTTP.Types.Header (hETag) -- internal imports import Types import Model 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, BS.pack (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 _ = throwError $ err401 { errBody = "No Authentication present." } avatarUpdate :: Maybe (Int, AuthMethod) -> Int -> AvatarData -> MateHandler () avatarUpdate (Just _) aid ad = do conn <- asks rsConnection void $ updateAvatar aid ad (md5 $ BS.pack $ avatarDataData ad) conn avatarUpdate Nothing _ _ = throwError $ err401 { errBody = "No Authentication present." } avatarList :: MateHandler [Avatar] avatarList = do conn <- asks rsConnection liftIO $ avatarSelect conn md5 :: BS.ByteString -> BS.ByteString md5 bs = fromString (show ( hash bs :: Digest MD5))