Monad.hs

{-# 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
  { acidStateAuthenticate   :: AcidState AuthenticateState
  , acidStatePassword       :: AcidState PasswordState
  , apsAuthenticateConfigTV :: TVar AuthenticateConfig
  , apsPasswordConfigTV     :: TVar PasswordConfig
  }
  deriving Typeable

instance (Functor m, MonadIO m) => GetAcidState (ClckT url m) AuthenticateState where
    getAcidState =
      do p <- plugins <$> get
         ~(Just aps) <- getPluginState p "authenticate"
         pure (acidStateAuthenticate aps)

instance (Functor m, MonadIO m) => GetAcidState (ClckT url m) PasswordState where
    getAcidState =
      do p <- plugins <$> get
         ~(Just aps) <- getPluginState p "authenticate"
         pure (acidStatePassword aps)