Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- {-# LANGUAGE TypeFamilies #-}
- {-# LANGUAGE OverloadedStrings #-}
- {-# LANGUAGE FlexibleInstances #-}
- {-# LANGUAGE MultiParamTypeClasses #-}
- module Api.User where
- import Servant
- import Models
- import Enums
- import Config
- import Api.Database
- import Data.Aeson
- import Database.Esqueleto hiding (limit, offset)
- import qualified Database.Esqueleto as E
- import qualified Database.Persist as P
- import Data.Text (Text)
- import Api.User.In as In
- import Api.User.Out as Out
- import Api.User.Query
- import ACL
- import Control.Monad (when)
- instance ServerFor User UserQuery UserIn UserOut where
- doSelect authId muId mq = do
- rows <- runDB $ select $ from $ \(u `InnerJoin` ug) -> do
- on (ug ^. UserGroupId ==. u ^. UserActiveUserGroupId)
- where_ $ maybe (val True) ((==. (u ^. UserId)) . val) muId
- where_ $ (val authId ==. u ^. UserId)
- ||. (hasRoleOnUser authId allValues (u ^. UserId))
- case mq of
- Just q -> do
- orderBy [ asc (u ^. UserName) ]
- E.limit $ limit q
- E.offset $ offset q
- when (onlyActive q) $ where_ $ u ^. UserActive ==. val Active
- Nothing -> E.limit defaultLimit
- return (u, ug)
- return [ Out.fromUser u ug | (u, ug) <- rows ]
- fromIn authId (UserIn n fn ln o e p ugId a) = return $ User {
- userName = n,
- userFirstName = fn,
- userLastName = ln,
- userOrganization = o,
- userEmail = e,
- userPhone = p,
- userPassword = "",
- userActiveUserGroupId = ugId,
- userActive = a
- }
- canPost authId u = hasRole' authId [Admin] (In.activeUserGroupId u)
- canPut authId uId u
- | authId == uId = return True
- | otherwise = do
- ok1 <- hasRoleOnUser' authId [Admin] uId
- ok2 <- hasRole' authId [Admin] (In.activeUserGroupId u)
- return $ ok1 && ok2
- canDel authId uId
- | authId == uId = return False
- | otherwise = hasRoleOnUser' authId [Admin] uId
- doPut _ uId u = do
- mu <- P.get uId
- case mu of
- Just u' -> replace uId $ u' {
- userName = userName u,
- userFirstName = userFirstName u,
- userLastName = userLastName u,
- userOrganization = userOrganization u,
- userEmail = userEmail u,
- userPhone = userPhone u,
- userActiveUserGroupId = userActiveUserGroupId u,
- userActive = userActive u
- }
- Nothing -> return ()
- doDel _ uId = do
- update $ \u -> do
- set u [ UserActive =. val Inactive ]
- where_ $ u ^. UserId ==. val uId
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement