mateamt/src/Control/Avatar.hs

75 lines
1.6 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module Control.Avatar where
import Control.Monad (void)
import Control.Monad.Reader (ask)
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 <- rsConnection <$> ask
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
-> AvatarData
-> MateHandler Int
avatarInsert (Just _) ad = do
conn <- rsConnection <$> ask
insertAvatar ad conn
avatarInsert Nothing _ =
throwError $ err401
{ errBody = "No Authentication present."
}
avatarUpdate
:: Maybe Int
-> Int
-> AvatarData
-> MateHandler ()
avatarUpdate (Just _) aid ad = do
conn <- rsConnection <$> ask
void $ updateAvatar aid ad conn
avatarUpdate Nothing _ _ = do
throwError $ err401
{ errBody = "No Authentication present."
}
avatarList
:: MateHandler [Avatar]
avatarList = do
conn <- rsConnection <$> ask
liftIO $ avatarSelect conn