content: {-# LANGUAGE OverloadedStrings #-}
  module Clckwrks.Authenticate.Route where
  
  import Control.Applicative         ((<$>))
  import Clckwrks.Monad              (ClckT(..), plugins)
  import Clckwrks.Authenticate.URL   (AuthURL(..))
  import Clckwrks.Authenticate.Page.AuthModes (authModesPage)
  import Clckwrks.Authenticate.Page.Login (loginPage)
  import Clckwrks.Authenticate.Page.ChangePassword (changePasswordPanel)
  import Clckwrks.Authenticate.Page.ResetPassword  (resetPasswordPage)
  import Clckwrks.Authenticate.Page.OpenIdRealm    (openIdRealmPanel)
  import Clckwrks.Authenticate.Page.ViewUsers      (viewUsers)
  import Clckwrks.ProfileData.API    (Role(..), requiresRole_)
  import Clckwrks.URL                (ClckURL)
  -- import Clckwrks.Plugin             (clckPlugin)
  import Control.Monad.State         (get)
  import Control.Monad.Trans         (lift)
  import qualified Data.Set          as Set
  import Happstack.Authenticate.Core (AuthenticateURL)
  import Happstack.Server            (Happstack, Response, ServerPartT)
  import Web.Routes                  (RouteT(..), askRouteFn, runRouteT)
  import Web.Plugins.Core            (getPluginRouteFn, pluginName)
  
  -- | routeAuth
  -- there is much craziness here. This should be more like clckwrks-plugin-page or something
  routeAuth :: (AuthenticateURL -> RouteT AuthenticateURL (ServerPartT IO) Response)
            -> AuthURL
            -> ClckT AuthURL (ServerPartT IO) Response
  routeAuth routeAuthenticate u' =
    do u <- checkAuth u'
       p <- plugins <$> get
       ~(Just clckShowFn) <- getPluginRouteFn p "clck" -- (pluginName clckPlugin) -- a mildly dangerous hack to avoid circular depends
       let withClckURL m =  ClckT $ RouteT $ \_ -> unRouteT (unClckT m) clckShowFn
       case u of
         (Auth authenticateURL) ->
           do p <- plugins <$> get
              ~(Just authShowFn) <- getPluginRouteFn p "authenticate"
              lift $ runRouteT routeAuthenticate (authShowFn . Auth) authenticateURL
         Login          -> withClckURL loginPage
         ResetPassword  -> withClckURL resetPasswordPage
         ChangePassword -> withClckURL changePasswordPanel
         OpenIdRealm    -> withClckURL openIdRealmPanel
         AuthModes      -> authModesPage u
         ViewUsers      -> withClckURL viewUsers
  
  checkAuth :: (Happstack m, Monad m) =>
               AuthURL
            -> ClckT AuthURL m AuthURL
  checkAuth url =
    do p <- plugins <$> get
       ~(Just clckShowFn) <- getPluginRouteFn p "clck" -- (pluginName clckPlugin) -- a mildly dangerous hack to avoid circular depends
       let requiresRole = requiresRole_ clckShowFn
       case url of
         (Auth {})      -> pure url
         Login          -> pure url
         ResetPassword  -> pure url
         AuthModes      -> requiresRole (Set.fromList [Administrator]) url
         ChangePassword -> requiresRole (Set.fromList [Visitor]) url
         OpenIdRealm    -> requiresRole (Set.fromList [Administrator]) url
         ViewUsers      -> requiresRole (Set.fromList [Administrator]) url
  