74 lines
1.6 KiB
Haskell
74 lines
1.6 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
module Control.Avatar where
|
|
|
|
import Control.Monad (void)
|
|
|
|
import Control.Monad.Reader (asks)
|
|
|
|
import Control.Monad.Trans (liftIO)
|
|
|
|
import Data.Text.Encoding (encodeUtf8)
|
|
|
|
import Data.ByteString.Builder (byteString)
|
|
|
|
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 ((\_ respond -> respond $ responseStream status404 [] $
|
|
\write flush -> do
|
|
write "No avatar found."
|
|
flush
|
|
) :: Application)
|
|
else
|
|
return ((\_ respond -> respond $ responseStream status200 [(hETag, encodeUtf8 (avatarHash (head as)))] $
|
|
\write flush -> do
|
|
write $ byteString $ encodeUtf8 $ avatarData $ head as
|
|
flush
|
|
) :: Application)
|
|
|
|
avatarInsert
|
|
:: Maybe (Int, AuthMethod)
|
|
-> AvatarData
|
|
-> MateHandler Int
|
|
avatarInsert (Just _) ad = do
|
|
conn <- asks rsConnection
|
|
insertAvatar 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 conn
|
|
avatarUpdate Nothing _ _ =
|
|
throwError $ err401
|
|
{ errBody = "No Authentication present."
|
|
}
|
|
|
|
avatarList
|
|
:: MateHandler [Avatar]
|
|
avatarList = do
|
|
conn <- asks rsConnection
|
|
liftIO $ avatarSelect conn
|