mateamt/src/Control/Avatar.hs

82 lines
1.8 KiB
Haskell

{-# 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))