module RESTng.System.Permission where

import Control.Monad.Trans (lift)
import RESTng.RESTngMonad (RESTng, getAuthUser)

import RESTng.RqHandlers (RequestContext, RqHandlerT, ifReq, ifGet, anyOf, okNonCxMLStrRsp, RESTngResp)
import RESTng.System.Resource (Proxy, proxyOf, Resource, ownerId, setOwnerId, ownable)
import RESTng.System.Authentication (withAuthentication)
import RESTng.Resources.User (User, UserRole, UserRole(Admin), user_id, roles)


type Permission a = a -> Maybe User -> Bool

withAnyRoleCan, ownerOrWithAnyRoleCan :: Resource a => [UserRole] -> Permission a

withAnyRoleCan        rs _   (Just uid) = any (\role -> elem role (roles uid)) rs
withAnyRoleCan        _  _   _          = False

ownerOrWithAnyRoleCan rs a u = onlyOwnerCan a u || withAnyRoleCan rs a u


onlyAdminCan, onlyOwnerCan, ownerOrAdminCan, authdCan, everybodyCan, nobodyCan :: Resource a => Permission a

onlyAdminCan    a   (Just u) = elem Admin (roles u)
onlyAdminCan    _   _ = False

onlyOwnerCan    a   (Just u) = ownable (proxyOf a) && (ownerId a == user_id u)
onlyOwnerCan    _   _ = False

ownerOrAdminCan a u = onlyOwnerCan a u || onlyAdminCan a u

authdCan        _   (Just uid) = True
authdCan        _    _         = False

everybodyCan    _    _         = True

nobodyCan       _    _         = False


-- Permission combinators
allPerm :: [Permission a] -> Permission a
allPerm ps a u = all (\p' -> p' a u) ps

anyPerm :: [Permission a] -> Permission a
anyPerm ps a u = any (\p' -> p' a u) ps

-- testing permissions

allowedForUser :: Resource a => a -> Permission a -> RESTng Bool
allowedForUser a p = fmap (p a) getAuthUser

checkPermissions :: Resource a => [Permission a] -> a -> RqHandlerT RESTng RESTngResp -> RqHandlerT RESTng RESTngResp
checkPermissions ps a han = do u <- lift $ getAuthUser
                               if all (\p -> p a u) ps
                                 then han
                                 else (anyOf [ifGet $ withAuthentication forbidden, forbidden] )

-- the evaluation of (withAuthentication forbidden) when checking the permissions has failed is tricky. 
-- If the user was authenticated, then the permissions are not enought so the result is forbidden
-- If the user was not authenticated, after requiring authentication the request will be retried
-- Retry in withAuthentication is not implemented for post request for the moment


forbidden :: Monad m => RqHandlerT m RESTngResp
forbidden = return $ okNonCxMLStrRsp "Operation forbidden"