{-# 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.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(..), getToken, tokenUser, userId, usernamePolicy)
import Happstack.Authenticate.Password.Core (PasswordState)
import Web.Plugins.Core            (getPluginState)

data AcidStateAuthenticate = AcidStateAuthenticate
  { AcidStateAuthenticate -> AcidState AuthenticateState
acidStateAuthenticate :: AcidState AuthenticateState
  , AcidStateAuthenticate -> AcidState PasswordState
acidStatePassword     :: AcidState PasswordState                                                }
  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 (AcidStateAuthenticate AcidState AuthenticateState
authenticateState AcidState PasswordState
_)) <- ClckPlugins -> Text -> ClckT url m (Maybe AcidStateAuthenticate)
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 AcidState AuthenticateState
authenticateState

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 (AcidStateAuthenticate AcidState AuthenticateState
_ AcidState PasswordState
passwordState)) <- ClckPlugins -> Text -> ClckT url m (Maybe AcidStateAuthenticate)
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 AcidState PasswordState
passwordState