{-# 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