{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
module Clckwrks.ProfileData.API
    ( getDisplayName
    , getProfileData
    , getUserRoles
    , requiresRole
    , requiresRole_
    , whoami
    , Role(..)
    )  where

import Clckwrks.Acid  (Acid(..))
import Clckwrks.Monad
import Clckwrks.URL                 (ClckURL)
import {-# SOURCE #-} Clckwrks.Authenticate.Plugin (getUserId)
import Clckwrks.ProfileData.Acid
import Clckwrks.ProfileData.Types
import Clckwrks.Unauthorized        (unauthorizedPage)
import Control.Applicative          ((<$>))
import Control.Monad.State          (get)
import Control.Monad.Trans          (MonadIO)
import           Data.Set           (Set)
import qualified Data.Set           as Set
import Data.Text                    (Text)
import qualified Data.Text.Lazy     as TL
import Data.UserId                  (UserId(..))
import Happstack.Authenticate.Core  (Username(..))
import Happstack.Server             (Happstack, askRq, escape, rqUri, rqQuery)
import Web.Routes                   (RouteT(..))

getProfileData :: UserId -> Clck url ProfileData
getProfileData :: UserId -> Clck url ProfileData
getProfileData UserId
uid = GetProfileData
-> ClckT url (ServerPartT IO) (EventResult GetProfileData)
forall event (m :: * -> *).
(QueryEvent event, GetAcidState m (EventState event), Functor m,
 MonadIO m, MonadState ClckState m) =>
event -> m (EventResult event)
query (UserId -> GetProfileData
GetProfileData UserId
uid)

getDisplayName :: UserId -> Clck url (Maybe DisplayName)
getDisplayName :: UserId -> Clck url (Maybe DisplayName)
getDisplayName UserId
uid = ProfileData -> Maybe DisplayName
displayName (ProfileData -> Maybe DisplayName)
-> ClckT url (ServerPartT IO) ProfileData
-> Clck url (Maybe DisplayName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetProfileData
-> ClckT url (ServerPartT IO) (EventResult GetProfileData)
forall event (m :: * -> *).
(QueryEvent event, GetAcidState m (EventState event), Functor m,
 MonadIO m, MonadState ClckState m) =>
event -> m (EventResult event)
query (UserId -> GetProfileData
GetProfileData UserId
uid)

whoami :: Clck url (Maybe UserId)
whoami :: Clck url (Maybe UserId)
whoami = Clck url (Maybe UserId)
forall (m :: * -> *) url. Happstack m => ClckT url m (Maybe UserId)
getUserId

requiresRole_ :: (Happstack  m) => (ClckURL -> [(Text, Maybe Text)] -> Text) -> Set Role -> url -> ClckT u m url
requiresRole_ :: (ClckURL -> [(Text, Maybe Text)] -> Text)
-> Set Role -> url -> ClckT u m url
requiresRole_ ClckURL -> [(Text, Maybe Text)] -> Text
showFn Set Role
role url
url =
    RouteT u (StateT ClckState m) url -> ClckT u m url
forall url (m :: * -> *) a.
RouteT url (StateT ClckState m) a -> ClckT url m a
ClckT (RouteT u (StateT ClckState m) url -> ClckT u m url)
-> RouteT u (StateT ClckState m) url -> ClckT u m url
forall a b. (a -> b) -> a -> b
$ ((u -> [(Text, Maybe Text)] -> Text) -> StateT ClckState m url)
-> RouteT u (StateT ClckState m) url
forall url (m :: * -> *) a.
((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
RouteT (((u -> [(Text, Maybe Text)] -> Text) -> StateT ClckState m url)
 -> RouteT u (StateT ClckState m) url)
-> ((u -> [(Text, Maybe Text)] -> Text) -> StateT ClckState m url)
-> RouteT u (StateT ClckState m) url
forall a b. (a -> b) -> a -> b
$ \u -> [(Text, Maybe Text)] -> Text
_ -> RouteT ClckURL (StateT ClckState m) url
-> (ClckURL -> [(Text, Maybe Text)] -> Text)
-> StateT ClckState m url
forall url (m :: * -> *) a.
RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
unRouteT (ClckT ClckURL m url -> RouteT ClckURL (StateT ClckState m) url
forall url (m :: * -> *) a.
ClckT url m a -> RouteT url (StateT ClckState m) a
unClckT (Set Role -> url -> ClckT ClckURL m url
forall (m :: * -> *) url.
Happstack m =>
Set Role -> url -> ClckT ClckURL m url
requiresRole Set Role
role url
url)) ClckURL -> [(Text, Maybe Text)] -> Text
showFn

requiresRole :: (Happstack m) => Set Role -> url -> ClckT ClckURL m url
requiresRole :: Set Role -> url -> ClckT ClckURL m url
requiresRole Set Role
role url
url =
    do Maybe UserId
mu <- ClckT ClckURL m (Maybe UserId)
forall (m :: * -> *) url. Happstack m => ClckT url m (Maybe UserId)
getUserId
       case Maybe UserId
mu of
         Maybe UserId
Nothing ->
             do Request
rq <- ClckT ClckURL m Request
forall (m :: * -> *). ServerMonad m => m Request
askRq
                ClckT ClckURL m Response -> ClckT ClckURL m url
forall a (m :: * -> *) b.
(WebMonad a m, FilterMonad a m) =>
m a -> m b
escape (ClckT ClckURL m Response -> ClckT ClckURL m url)
-> ClckT ClckURL m Response -> ClckT ClckURL m url
forall a b. (a -> b) -> a -> b
$ do String -> ClckT ClckURL m ()
forall (m :: * -> *). Happstack m => String -> m ()
setRedirectCookie (Request -> String
rqUri Request
rq String -> String -> String
forall a. [a] -> [a] -> [a]
++ Request -> String
rqQuery Request
rq)
                            -- FIXME; redirect after login
                            Text -> ClckT ClckURL m Response
forall (m :: * -> *) msg.
(Happstack m, XMLGenerator m, StringType m ~ Text,
 EmbedAsChild m msg, ToMessage (XMLType m)) =>
msg -> m Response
unauthorizedPage  (Text
"You do not have permission to view this page." :: TL.Text)
--                            seeOtherURL (Auth $ AuthURL A_Login)
         (Just UserId
uid) ->
             do Bool
r <- HasRole -> ClckT ClckURL m (EventResult HasRole)
forall event (m :: * -> *).
(QueryEvent event, GetAcidState m (EventState event), Functor m,
 MonadIO m, MonadState ClckState m) =>
event -> m (EventResult event)
query (UserId -> Set Role -> HasRole
HasRole UserId
uid Set Role
role)
                if Bool
r
                   then url -> ClckT ClckURL m url
forall (m :: * -> *) a. Monad m => a -> m a
return url
url
                   else ClckT ClckURL m Response -> ClckT ClckURL m url
forall a (m :: * -> *) b.
(WebMonad a m, FilterMonad a m) =>
m a -> m b
escape (ClckT ClckURL m Response -> ClckT ClckURL m url)
-> ClckT ClckURL m Response -> ClckT ClckURL m url
forall a b. (a -> b) -> a -> b
$ Text -> ClckT ClckURL m Response
forall (m :: * -> *) msg.
(Happstack m, XMLGenerator m, StringType m ~ Text,
 EmbedAsChild m msg, ToMessage (XMLType m)) =>
msg -> m Response
unauthorizedPage (Text
"You do not have permission to view this page." :: TL.Text)

getUserRoles :: (Happstack m, MonadIO m) => ClckT u m (Set Role)
getUserRoles :: ClckT u m (Set Role)
getUserRoles =
    do Maybe UserId
mu <- ClckT u m (Maybe UserId)
forall (m :: * -> *) url. Happstack m => ClckT url m (Maybe UserId)
getUserId
       case Maybe UserId
mu of
         Maybe UserId
Nothing -> Set Role -> ClckT u m (Set Role)
forall (m :: * -> *) a. Monad m => a -> m a
return (Role -> Set Role
forall a. a -> Set a
Set.singleton Role
Visitor)
         (Just UserId
u) -> GetRoles -> ClckT u m (EventResult GetRoles)
forall event (m :: * -> *).
(QueryEvent event, GetAcidState m (EventState event), Functor m,
 MonadIO m, MonadState ClckState m) =>
event -> m (EventResult event)
query (UserId -> GetRoles
GetRoles UserId
u)