User.hs

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