{-# LANGUAGE DeriveDataTypeable, RecordWildCards, FlexibleContexts, Rank2Types, OverloadedStrings, MultiParamTypeClasses #-}
module Clckwrks.Authenticate.Monad where

import Clckwrks.Acid               (GetAcidState(..), GetCoreState(..), GetEnableOpenId(..), acidCore, acidProfileData, coreFromAddress, coreReplyToAddress, coreSendmailPath, getAcidState)
import Clckwrks.Monad
import Control.Concurrent.STM.TVar (TVar)
import Control.Monad.State         (get)
import Control.Monad.Trans         (MonadIO, lift)
import Data.Acid as Acid           (AcidState, query)
import Data.Typeable               (Typeable)
import Happstack.Authenticate.Core (AuthenticateState, AuthenticateConfig(..), User, getToken, tokenUser, userId, usernamePolicy)
import Happstack.Authenticate.Password.Core (PasswordConfig, PasswordState)
import Web.Plugins.Core            (getPluginState)

data AuthenticatePluginState = AuthenticatePluginState
  { AuthenticatePluginState -> AcidState AuthenticateState
acidStateAuthenticate   :: AcidState AuthenticateState
  , AuthenticatePluginState -> AcidState PasswordState
acidStatePassword       :: AcidState PasswordState
  , AuthenticatePluginState -> TVar AuthenticateConfig
apsAuthenticateConfigTV :: TVar AuthenticateConfig
  , AuthenticatePluginState -> TVar PasswordConfig
apsPasswordConfigTV     :: TVar PasswordConfig
  }
  deriving Typeable

instance (Functor m, MonadIO m) => GetAcidState (ClckT url m) AuthenticateState where
    getAcidState :: ClckT url m (AcidState AuthenticateState)
getAcidState =
      do ClckPlugins
p <- ClckState -> ClckPlugins
plugins (ClckState -> ClckPlugins)
-> ClckT url m ClckState -> ClckT url m ClckPlugins
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClckT url m ClckState
forall s (m :: * -> *). MonadState s m => m s
get
         ~(Just AuthenticatePluginState
aps) <- ClckPlugins -> Text -> ClckT url m (Maybe AuthenticatePluginState)
forall (m :: * -> *) state theme n hook config st.
(MonadIO m, Typeable state) =>
Plugins theme n hook config st -> Text -> m (Maybe state)
getPluginState ClckPlugins
p Text
"authenticate"
         AcidState AuthenticateState
-> ClckT url m (AcidState AuthenticateState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthenticatePluginState -> AcidState AuthenticateState
acidStateAuthenticate AuthenticatePluginState
aps)

instance (Functor m, MonadIO m) => GetAcidState (ClckT url m) PasswordState where
    getAcidState :: ClckT url m (AcidState PasswordState)
getAcidState =
      do ClckPlugins
p <- ClckState -> ClckPlugins
plugins (ClckState -> ClckPlugins)
-> ClckT url m ClckState -> ClckT url m ClckPlugins
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClckT url m ClckState
forall s (m :: * -> *). MonadState s m => m s
get
         ~(Just AuthenticatePluginState
aps) <- ClckPlugins -> Text -> ClckT url m (Maybe AuthenticatePluginState)
forall (m :: * -> *) state theme n hook config st.
(MonadIO m, Typeable state) =>
Plugins theme n hook config st -> Text -> m (Maybe state)
getPluginState ClckPlugins
p Text
"authenticate"
         AcidState PasswordState -> ClckT url m (AcidState PasswordState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthenticatePluginState -> AcidState PasswordState
acidStatePassword AuthenticatePluginState
aps)