clckwrks-0.27.1: Clckwrks/Authenticate/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.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
  , acidStatePassword     :: AcidState PasswordState                                                }
  deriving Typeable

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

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