mateamt/src/Control/Avatar.hs

82 lines
1.8 KiB
Haskell
Raw Normal View History

2019-09-07 18:05:24 +00:00
{-# LANGUAGE OverloadedStrings #-}
module Control.Avatar where
import Control.Monad (void)
2019-10-14 20:50:42 +00:00
import Control.Monad.Reader (asks)
2019-09-07 18:05:24 +00:00
import Control.Monad.Trans (liftIO)
import Crypto.Hash
import qualified Data.ByteString as BS
2019-09-07 18:05:24 +00:00
import Data.ByteString.Builder (byteString)
2022-04-16 12:22:52 +00:00
import Data.ByteString.Base64
2019-09-07 18:05:24 +00:00
import Data.String (fromString)
2022-04-16 10:40:23 +00:00
import Data.Text.Encoding (encodeUtf8)
2019-09-07 18:05:24 +00:00
import Servant
import Network.Wai
import Network.HTTP.Types.Status (status200, status404)
import Network.HTTP.Types.Header (hETag)
-- internal imports
import Types
import Model
2022-07-30 23:43:46 +00:00
import Util (throwMissingAuth)
2019-09-07 18:05:24 +00:00
avatarGet
:: Int
-> MateHandler Application
avatarGet aid = do
2019-10-14 20:50:42 +00:00
conn <- asks rsConnection
2019-09-07 18:05:24 +00:00
as <- liftIO $ avatarSelectById aid conn
if null as
then
2022-04-15 18:51:22 +00:00
return ((\_ response -> response $ responseStream status404 [] $
2019-09-07 18:05:24 +00:00
\write flush -> do
write "No avatar found."
flush
) :: Application)
else
2022-04-16 10:40:23 +00:00
return ((\_ response -> response $ responseStream status200 [(hETag, encodeUtf8 (avatarHash (head as)))] $
2019-09-07 18:05:24 +00:00
\write flush -> do
write $ byteString $ BS.pack $ avatarData $ head as
2019-09-07 18:05:24 +00:00
flush
) :: Application)
avatarInsert
2019-09-15 12:59:22 +00:00
:: Maybe (Int, AuthMethod)
2019-09-07 18:05:24 +00:00
-> AvatarData
-> MateHandler Int
avatarInsert (Just _) ad = do
2019-10-14 20:50:42 +00:00
conn <- asks rsConnection
insertAvatar ad (md5 $ BS.pack $ avatarDataData ad) conn
2019-09-07 18:05:24 +00:00
avatarInsert Nothing _ =
2022-07-30 23:43:46 +00:00
throwMissingAuth
2019-09-07 18:05:24 +00:00
avatarUpdate
2019-09-15 12:59:22 +00:00
:: Maybe (Int, AuthMethod)
2019-09-07 18:05:24 +00:00
-> Int
-> AvatarData
2022-07-17 19:28:22 +00:00
-> MateHandler NoContent
2019-09-07 18:05:24 +00:00
avatarUpdate (Just _) aid ad = do
2019-10-14 20:50:42 +00:00
conn <- asks rsConnection
void $ updateAvatar aid ad (md5 $ BS.pack $ avatarDataData ad) conn
2022-07-17 19:28:22 +00:00
return NoContent
2019-10-14 20:50:42 +00:00
avatarUpdate Nothing _ _ =
2022-07-30 23:43:46 +00:00
throwMissingAuth
2019-09-07 18:05:24 +00:00
avatarList
:: MateHandler [Avatar]
avatarList = do
2019-10-14 20:50:42 +00:00
conn <- asks rsConnection
2019-09-07 18:05:24 +00:00
liftIO $ avatarSelect conn
md5 :: BS.ByteString -> BS.ByteString
2022-04-16 12:22:52 +00:00
md5 bs = encode $ fromString (show ( hash bs :: Digest MD5))