{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TemplateHaskell, TypeFamilies #-}
module Clckwrks.Acid where

import Clckwrks.NavBar.Acid        (NavBarState       , initialNavBarState)
import Clckwrks.ProfileData.Acid   (ProfileDataState, initialProfileDataState)
import Clckwrks.Types              (UUID)
import Clckwrks.URL                (ClckURL)
import Control.Applicative         ((<$>))
import Control.Exception           (bracket, catch, throw)
import Control.Lens                ((?=), (.=), (^.), (.~), makeLenses, view, set)
import Control.Lens.At             (IxValue(..), Ixed(..), Index(..), At(at))
import Control.Concurrent          (killThread, forkIO)
import Control.Monad.Reader        (ask)
import Control.Monad.State         (modify, put)
import Data.Acid                   (AcidState, Query, Update, createArchive, makeAcidic)
import Data.Acid.Local             (openLocalStateFrom, createCheckpointAndClose)
#if MIN_VERSION_acid_state (0,16,0)
import Data.Acid.Remote            (acidServerSockAddr, skipAuthenticationCheck)
import Data.Int                    (Int64)
import Network.Socket              (SockAddr(SockAddrUnix))
#else
import Data.Acid.Remote            (acidServer, skipAuthenticationCheck)
import Network                     (PortID(UnixSocket))
#endif
import Data.Data                   (Data, Typeable)
import Data.Maybe                  (fromMaybe)
import Data.SafeCopy               (Migrate(..), base, deriveSafeCopy, extension)
import Data.Text                   (Text)
import Happstack.Authenticate.Core (AuthenticateState, SimpleAddress(..))
import Happstack.Authenticate.Password.Core (PasswordState)
import Prelude                     hiding (catch)
import System.Directory            (removeFile)
import System.FilePath             ((</>))
import System.IO.Error             (isDoesNotExistError)
import HSP.Google.Analytics        (UACCT)

-- | 'CoreState' holds some values that are required by the core
-- itself, or which are useful enough to be shared with numerous
-- plugins/themes.
data CoreState_v0 = CoreState_v0
    { CoreState_v0 -> Maybe UACCT
coreUACCT_v0        :: Maybe UACCT  -- ^ Google Account UAACT
    , CoreState_v0 -> Maybe Text
coreRootRedirect_v0 :: Maybe Text
    }
    deriving (CoreState_v0 -> CoreState_v0 -> Bool
(CoreState_v0 -> CoreState_v0 -> Bool)
-> (CoreState_v0 -> CoreState_v0 -> Bool) -> Eq CoreState_v0
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoreState_v0 -> CoreState_v0 -> Bool
$c/= :: CoreState_v0 -> CoreState_v0 -> Bool
== :: CoreState_v0 -> CoreState_v0 -> Bool
$c== :: CoreState_v0 -> CoreState_v0 -> Bool
Eq, Typeable CoreState_v0
DataType
Constr
Typeable CoreState_v0
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CoreState_v0 -> c CoreState_v0)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CoreState_v0)
-> (CoreState_v0 -> Constr)
-> (CoreState_v0 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CoreState_v0))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CoreState_v0))
-> ((forall b. Data b => b -> b) -> CoreState_v0 -> CoreState_v0)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CoreState_v0 -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CoreState_v0 -> r)
-> (forall u. (forall d. Data d => d -> u) -> CoreState_v0 -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CoreState_v0 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CoreState_v0 -> m CoreState_v0)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CoreState_v0 -> m CoreState_v0)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CoreState_v0 -> m CoreState_v0)
-> Data CoreState_v0
CoreState_v0 -> DataType
CoreState_v0 -> Constr
(forall b. Data b => b -> b) -> CoreState_v0 -> CoreState_v0
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CoreState_v0 -> c CoreState_v0
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CoreState_v0
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CoreState_v0 -> u
forall u. (forall d. Data d => d -> u) -> CoreState_v0 -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState_v0 -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState_v0 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CoreState_v0 -> m CoreState_v0
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CoreState_v0 -> m CoreState_v0
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CoreState_v0
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CoreState_v0 -> c CoreState_v0
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CoreState_v0)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CoreState_v0)
$cCoreState_v0 :: Constr
$tCoreState_v0 :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> CoreState_v0 -> m CoreState_v0
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CoreState_v0 -> m CoreState_v0
gmapMp :: (forall d. Data d => d -> m d) -> CoreState_v0 -> m CoreState_v0
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CoreState_v0 -> m CoreState_v0
gmapM :: (forall d. Data d => d -> m d) -> CoreState_v0 -> m CoreState_v0
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CoreState_v0 -> m CoreState_v0
gmapQi :: Int -> (forall d. Data d => d -> u) -> CoreState_v0 -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CoreState_v0 -> u
gmapQ :: (forall d. Data d => d -> u) -> CoreState_v0 -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CoreState_v0 -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState_v0 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState_v0 -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState_v0 -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState_v0 -> r
gmapT :: (forall b. Data b => b -> b) -> CoreState_v0 -> CoreState_v0
$cgmapT :: (forall b. Data b => b -> b) -> CoreState_v0 -> CoreState_v0
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CoreState_v0)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CoreState_v0)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CoreState_v0)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CoreState_v0)
dataTypeOf :: CoreState_v0 -> DataType
$cdataTypeOf :: CoreState_v0 -> DataType
toConstr :: CoreState_v0 -> Constr
$ctoConstr :: CoreState_v0 -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CoreState_v0
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CoreState_v0
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CoreState_v0 -> c CoreState_v0
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CoreState_v0 -> c CoreState_v0
$cp1Data :: Typeable CoreState_v0
Data, Typeable, Int -> CoreState_v0 -> ShowS
[CoreState_v0] -> ShowS
CoreState_v0 -> String
(Int -> CoreState_v0 -> ShowS)
-> (CoreState_v0 -> String)
-> ([CoreState_v0] -> ShowS)
-> Show CoreState_v0
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoreState_v0] -> ShowS
$cshowList :: [CoreState_v0] -> ShowS
show :: CoreState_v0 -> String
$cshow :: CoreState_v0 -> String
showsPrec :: Int -> CoreState_v0 -> ShowS
$cshowsPrec :: Int -> CoreState_v0 -> ShowS
Show)
$(deriveSafeCopy 0 'base ''CoreState_v0)

-- | 'CoreState' holds some values that are required by the core
-- itself, or which are useful enough to be shared with numerous
-- plugins/themes.
data CoreState_1 = CoreState_1
    { CoreState_1 -> Maybe Text
coreSiteName_1      :: Maybe Text
    , CoreState_1 -> Maybe UACCT
coreUACCT_1         :: Maybe UACCT  -- ^ Google Account UAACT
    , CoreState_1 -> Maybe Text
coreRootRedirect_1  :: Maybe Text
    , CoreState_1 -> Maybe Text
coreLoginRedirect_1 :: Maybe Text

    }
    deriving (CoreState_1 -> CoreState_1 -> Bool
(CoreState_1 -> CoreState_1 -> Bool)
-> (CoreState_1 -> CoreState_1 -> Bool) -> Eq CoreState_1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoreState_1 -> CoreState_1 -> Bool
$c/= :: CoreState_1 -> CoreState_1 -> Bool
== :: CoreState_1 -> CoreState_1 -> Bool
$c== :: CoreState_1 -> CoreState_1 -> Bool
Eq, Typeable CoreState_1
DataType
Constr
Typeable CoreState_1
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CoreState_1 -> c CoreState_1)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CoreState_1)
-> (CoreState_1 -> Constr)
-> (CoreState_1 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CoreState_1))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CoreState_1))
-> ((forall b. Data b => b -> b) -> CoreState_1 -> CoreState_1)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CoreState_1 -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CoreState_1 -> r)
-> (forall u. (forall d. Data d => d -> u) -> CoreState_1 -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CoreState_1 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CoreState_1 -> m CoreState_1)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CoreState_1 -> m CoreState_1)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CoreState_1 -> m CoreState_1)
-> Data CoreState_1
CoreState_1 -> DataType
CoreState_1 -> Constr
(forall b. Data b => b -> b) -> CoreState_1 -> CoreState_1
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CoreState_1 -> c CoreState_1
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CoreState_1
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CoreState_1 -> u
forall u. (forall d. Data d => d -> u) -> CoreState_1 -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState_1 -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState_1 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CoreState_1 -> m CoreState_1
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CoreState_1 -> m CoreState_1
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CoreState_1
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CoreState_1 -> c CoreState_1
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CoreState_1)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CoreState_1)
$cCoreState_1 :: Constr
$tCoreState_1 :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> CoreState_1 -> m CoreState_1
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CoreState_1 -> m CoreState_1
gmapMp :: (forall d. Data d => d -> m d) -> CoreState_1 -> m CoreState_1
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CoreState_1 -> m CoreState_1
gmapM :: (forall d. Data d => d -> m d) -> CoreState_1 -> m CoreState_1
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CoreState_1 -> m CoreState_1
gmapQi :: Int -> (forall d. Data d => d -> u) -> CoreState_1 -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CoreState_1 -> u
gmapQ :: (forall d. Data d => d -> u) -> CoreState_1 -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CoreState_1 -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState_1 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState_1 -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState_1 -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState_1 -> r
gmapT :: (forall b. Data b => b -> b) -> CoreState_1 -> CoreState_1
$cgmapT :: (forall b. Data b => b -> b) -> CoreState_1 -> CoreState_1
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CoreState_1)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CoreState_1)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CoreState_1)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CoreState_1)
dataTypeOf :: CoreState_1 -> DataType
$cdataTypeOf :: CoreState_1 -> DataType
toConstr :: CoreState_1 -> Constr
$ctoConstr :: CoreState_1 -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CoreState_1
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CoreState_1
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CoreState_1 -> c CoreState_1
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CoreState_1 -> c CoreState_1
$cp1Data :: Typeable CoreState_1
Data, Typeable, Int -> CoreState_1 -> ShowS
[CoreState_1] -> ShowS
CoreState_1 -> String
(Int -> CoreState_1 -> ShowS)
-> (CoreState_1 -> String)
-> ([CoreState_1] -> ShowS)
-> Show CoreState_1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoreState_1] -> ShowS
$cshowList :: [CoreState_1] -> ShowS
show :: CoreState_1 -> String
$cshow :: CoreState_1 -> String
showsPrec :: Int -> CoreState_1 -> ShowS
$cshowsPrec :: Int -> CoreState_1 -> ShowS
Show)
$(deriveSafeCopy 1 'extension ''CoreState_1)

instance Migrate CoreState_1 where
    type MigrateFrom CoreState_1 = CoreState_v0
    migrate :: MigrateFrom CoreState_1 -> CoreState_1
migrate (CoreState_v0 ua rr) = Maybe Text
-> Maybe UACCT -> Maybe Text -> Maybe Text -> CoreState_1
CoreState_1 Maybe Text
forall a. Maybe a
Nothing Maybe UACCT
ua Maybe Text
rr Maybe Text
forall a. Maybe a
Nothing


-- | 'CoreState' holds some values that are required by the core
-- itself, or which are useful enough to be shared with numerous
-- plugins/themes.
data CoreState_2 = CoreState_2
    { CoreState_2 -> Maybe Text
_coreSiteName_2       :: Maybe Text
    , CoreState_2 -> Maybe UACCT
_coreUACCT_2          :: Maybe UACCT  -- ^ Google Account UAACT
    , CoreState_2 -> Maybe Text
_coreRootRedirect_2   :: Maybe Text
    , CoreState_2 -> Maybe Text
_coreLoginRedirect_2  :: Maybe Text
    , CoreState_2 -> Maybe SimpleAddress
_coreFromAddress_2    :: Maybe SimpleAddress
    , CoreState_2 -> Maybe SimpleAddress
_coreReplyToAddress_2 :: Maybe SimpleAddress
    , CoreState_2 -> Maybe String
_coreSendmailPath_2   :: Maybe FilePath
    , CoreState_2 -> Bool
_coreEnableOpenId_2   :: Bool -- ^ allow OpenId authentication
    }
    deriving (CoreState_2 -> CoreState_2 -> Bool
(CoreState_2 -> CoreState_2 -> Bool)
-> (CoreState_2 -> CoreState_2 -> Bool) -> Eq CoreState_2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoreState_2 -> CoreState_2 -> Bool
$c/= :: CoreState_2 -> CoreState_2 -> Bool
== :: CoreState_2 -> CoreState_2 -> Bool
$c== :: CoreState_2 -> CoreState_2 -> Bool
Eq, Typeable CoreState_2
DataType
Constr
Typeable CoreState_2
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CoreState_2 -> c CoreState_2)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CoreState_2)
-> (CoreState_2 -> Constr)
-> (CoreState_2 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CoreState_2))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CoreState_2))
-> ((forall b. Data b => b -> b) -> CoreState_2 -> CoreState_2)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CoreState_2 -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CoreState_2 -> r)
-> (forall u. (forall d. Data d => d -> u) -> CoreState_2 -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CoreState_2 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CoreState_2 -> m CoreState_2)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CoreState_2 -> m CoreState_2)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CoreState_2 -> m CoreState_2)
-> Data CoreState_2
CoreState_2 -> DataType
CoreState_2 -> Constr
(forall b. Data b => b -> b) -> CoreState_2 -> CoreState_2
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CoreState_2 -> c CoreState_2
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CoreState_2
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CoreState_2 -> u
forall u. (forall d. Data d => d -> u) -> CoreState_2 -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState_2 -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState_2 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CoreState_2 -> m CoreState_2
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CoreState_2 -> m CoreState_2
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CoreState_2
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CoreState_2 -> c CoreState_2
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CoreState_2)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CoreState_2)
$cCoreState_2 :: Constr
$tCoreState_2 :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> CoreState_2 -> m CoreState_2
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CoreState_2 -> m CoreState_2
gmapMp :: (forall d. Data d => d -> m d) -> CoreState_2 -> m CoreState_2
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CoreState_2 -> m CoreState_2
gmapM :: (forall d. Data d => d -> m d) -> CoreState_2 -> m CoreState_2
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CoreState_2 -> m CoreState_2
gmapQi :: Int -> (forall d. Data d => d -> u) -> CoreState_2 -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CoreState_2 -> u
gmapQ :: (forall d. Data d => d -> u) -> CoreState_2 -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CoreState_2 -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState_2 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState_2 -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState_2 -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState_2 -> r
gmapT :: (forall b. Data b => b -> b) -> CoreState_2 -> CoreState_2
$cgmapT :: (forall b. Data b => b -> b) -> CoreState_2 -> CoreState_2
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CoreState_2)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CoreState_2)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CoreState_2)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CoreState_2)
dataTypeOf :: CoreState_2 -> DataType
$cdataTypeOf :: CoreState_2 -> DataType
toConstr :: CoreState_2 -> Constr
$ctoConstr :: CoreState_2 -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CoreState_2
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CoreState_2
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CoreState_2 -> c CoreState_2
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CoreState_2 -> c CoreState_2
$cp1Data :: Typeable CoreState_2
Data, Typeable, Int -> CoreState_2 -> ShowS
[CoreState_2] -> ShowS
CoreState_2 -> String
(Int -> CoreState_2 -> ShowS)
-> (CoreState_2 -> String)
-> ([CoreState_2] -> ShowS)
-> Show CoreState_2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoreState_2] -> ShowS
$cshowList :: [CoreState_2] -> ShowS
show :: CoreState_2 -> String
$cshow :: CoreState_2 -> String
showsPrec :: Int -> CoreState_2 -> ShowS
$cshowsPrec :: Int -> CoreState_2 -> ShowS
Show)
$(deriveSafeCopy 2 'extension ''CoreState_2)

instance Migrate CoreState_2 where
    type MigrateFrom CoreState_2 = CoreState_1
    migrate :: MigrateFrom CoreState_2 -> CoreState_2
migrate (CoreState_1 sn ua rr lr) = Maybe Text
-> Maybe UACCT
-> Maybe Text
-> Maybe Text
-> Maybe SimpleAddress
-> Maybe SimpleAddress
-> Maybe String
-> Bool
-> CoreState_2
CoreState_2 Maybe Text
sn Maybe UACCT
ua Maybe Text
rr Maybe Text
lr Maybe SimpleAddress
forall a. Maybe a
Nothing Maybe SimpleAddress
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Bool
True

-- | 'CoreState' holds some values that are required by the core
-- itself, or which are useful enough to be shared with numerous
-- plugins/themes.
data CoreState = CoreState
    { CoreState -> Maybe Text
_coreSiteName       :: Maybe Text
    , CoreState -> Maybe UACCT
_coreUACCT          :: Maybe UACCT  -- ^ Google Account UAACT
    , CoreState -> Maybe Text
_coreRootRedirect   :: Maybe Text
    , CoreState -> Maybe Text
_coreLoginRedirect  :: Maybe Text
    , CoreState -> Maybe SimpleAddress
_coreFromAddress    :: Maybe SimpleAddress
    , CoreState -> Maybe SimpleAddress
_coreReplyToAddress :: Maybe SimpleAddress
    , CoreState -> Maybe String
_coreSendmailPath   :: Maybe FilePath
    , CoreState -> Bool
_coreEnableOpenId   :: Bool -- ^ allow OpenId authentication
    , CoreState -> (String, Int64, Int64, Int64)
_coreBodyPolicy     :: (FilePath, Int64, Int64, Int64) -- ^ (temp directory for uploads, maxDisk, maxRAM, maxHeader)
    }
    deriving (CoreState -> CoreState -> Bool
(CoreState -> CoreState -> Bool)
-> (CoreState -> CoreState -> Bool) -> Eq CoreState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoreState -> CoreState -> Bool
$c/= :: CoreState -> CoreState -> Bool
== :: CoreState -> CoreState -> Bool
$c== :: CoreState -> CoreState -> Bool
Eq, Typeable CoreState
DataType
Constr
Typeable CoreState
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CoreState -> c CoreState)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CoreState)
-> (CoreState -> Constr)
-> (CoreState -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CoreState))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CoreState))
-> ((forall b. Data b => b -> b) -> CoreState -> CoreState)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CoreState -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CoreState -> r)
-> (forall u. (forall d. Data d => d -> u) -> CoreState -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CoreState -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CoreState -> m CoreState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CoreState -> m CoreState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CoreState -> m CoreState)
-> Data CoreState
CoreState -> DataType
CoreState -> Constr
(forall b. Data b => b -> b) -> CoreState -> CoreState
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CoreState -> c CoreState
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CoreState
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CoreState -> u
forall u. (forall d. Data d => d -> u) -> CoreState -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CoreState -> m CoreState
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CoreState -> m CoreState
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CoreState
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CoreState -> c CoreState
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CoreState)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CoreState)
$cCoreState :: Constr
$tCoreState :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> CoreState -> m CoreState
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CoreState -> m CoreState
gmapMp :: (forall d. Data d => d -> m d) -> CoreState -> m CoreState
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CoreState -> m CoreState
gmapM :: (forall d. Data d => d -> m d) -> CoreState -> m CoreState
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CoreState -> m CoreState
gmapQi :: Int -> (forall d. Data d => d -> u) -> CoreState -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CoreState -> u
gmapQ :: (forall d. Data d => d -> u) -> CoreState -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CoreState -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CoreState -> r
gmapT :: (forall b. Data b => b -> b) -> CoreState -> CoreState
$cgmapT :: (forall b. Data b => b -> b) -> CoreState -> CoreState
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CoreState)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CoreState)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CoreState)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CoreState)
dataTypeOf :: CoreState -> DataType
$cdataTypeOf :: CoreState -> DataType
toConstr :: CoreState -> Constr
$ctoConstr :: CoreState -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CoreState
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CoreState
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CoreState -> c CoreState
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CoreState -> c CoreState
$cp1Data :: Typeable CoreState
Data, Typeable, Int -> CoreState -> ShowS
[CoreState] -> ShowS
CoreState -> String
(Int -> CoreState -> ShowS)
-> (CoreState -> String)
-> ([CoreState] -> ShowS)
-> Show CoreState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoreState] -> ShowS
$cshowList :: [CoreState] -> ShowS
show :: CoreState -> String
$cshow :: CoreState -> String
showsPrec :: Int -> CoreState -> ShowS
$cshowsPrec :: Int -> CoreState -> ShowS
Show)
$(deriveSafeCopy 3 'extension ''CoreState)

makeLenses ''CoreState

instance Migrate CoreState where
    type MigrateFrom CoreState = CoreState_2
    migrate :: MigrateFrom CoreState -> CoreState
migrate (CoreState_2 sn ua rr lr fa rta smp eo) = Maybe Text
-> Maybe UACCT
-> Maybe Text
-> Maybe Text
-> Maybe SimpleAddress
-> Maybe SimpleAddress
-> Maybe String
-> Bool
-> (String, Int64, Int64, Int64)
-> CoreState
CoreState Maybe Text
sn Maybe UACCT
ua Maybe Text
rr Maybe Text
lr Maybe SimpleAddress
fa Maybe SimpleAddress
rta Maybe String
smp Bool
eo (String
"/tmp/", (Int64
10 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
10Int64 -> Integer -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
6), (Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
10Int64 -> Integer -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
6), (Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
10Int64 -> Integer -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
6))

initialCoreState :: CoreState
initialCoreState :: CoreState
initialCoreState = CoreState :: Maybe Text
-> Maybe UACCT
-> Maybe Text
-> Maybe Text
-> Maybe SimpleAddress
-> Maybe SimpleAddress
-> Maybe String
-> Bool
-> (String, Int64, Int64, Int64)
-> CoreState
CoreState
    { _coreSiteName :: Maybe Text
_coreSiteName       = Maybe Text
forall a. Maybe a
Nothing
    , _coreUACCT :: Maybe UACCT
_coreUACCT          = Maybe UACCT
forall a. Maybe a
Nothing
    , _coreRootRedirect :: Maybe Text
_coreRootRedirect   = Maybe Text
forall a. Maybe a
Nothing
    , _coreLoginRedirect :: Maybe Text
_coreLoginRedirect  = Maybe Text
forall a. Maybe a
Nothing
    , _coreFromAddress :: Maybe SimpleAddress
_coreFromAddress    = Maybe SimpleAddress
forall a. Maybe a
Nothing
    , _coreReplyToAddress :: Maybe SimpleAddress
_coreReplyToAddress = Maybe SimpleAddress
forall a. Maybe a
Nothing
    , _coreSendmailPath :: Maybe String
_coreSendmailPath   = Maybe String
forall a. Maybe a
Nothing
    , _coreEnableOpenId :: Bool
_coreEnableOpenId   = Bool
True
    , _coreBodyPolicy :: (String, Int64, Int64, Int64)
_coreBodyPolicy     = (String
"/tmp/", (Int64
10 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
10Int64 -> Integer -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
6), (Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
10Int64 -> Integer -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
6), (Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
10Int64 -> Integer -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
6))
    }

-- | get the site name
getSiteName :: Query CoreState (Maybe Text)
getSiteName :: Query CoreState (Maybe Text)
getSiteName = Getting (Maybe Text) CoreState (Maybe Text)
-> Query CoreState (Maybe Text)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Text) CoreState (Maybe Text)
Lens' CoreState (Maybe Text)
coreSiteName

-- | set the site name
setSiteName :: Maybe Text -> Update CoreState ()
setSiteName :: Maybe Text -> Update CoreState ()
setSiteName Maybe Text
name = (Maybe Text -> Identity (Maybe Text))
-> CoreState -> Identity CoreState
Lens' CoreState (Maybe Text)
coreSiteName ((Maybe Text -> Identity (Maybe Text))
 -> CoreState -> Identity CoreState)
-> Maybe Text -> Update CoreState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Text
name

-- | get the 'UACCT' for Google Analytics
getUACCT :: Query CoreState (Maybe UACCT)
getUACCT :: Query CoreState (Maybe UACCT)
getUACCT = Getting (Maybe UACCT) CoreState (Maybe UACCT)
-> Query CoreState (Maybe UACCT)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe UACCT) CoreState (Maybe UACCT)
Lens' CoreState (Maybe UACCT)
coreUACCT

-- | set the 'UACCT' for Google Analytics
setUACCT :: Maybe UACCT -> Update CoreState ()
setUACCT :: Maybe UACCT -> Update CoreState ()
setUACCT Maybe UACCT
mua = (Maybe UACCT -> Identity (Maybe UACCT))
-> CoreState -> Identity CoreState
Lens' CoreState (Maybe UACCT)
coreUACCT ((Maybe UACCT -> Identity (Maybe UACCT))
 -> CoreState -> Identity CoreState)
-> Maybe UACCT -> Update CoreState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe UACCT
mua

-- | get the path that @/@ should redirect to
getRootRedirect :: Query CoreState (Maybe Text)
getRootRedirect :: Query CoreState (Maybe Text)
getRootRedirect = Getting (Maybe Text) CoreState (Maybe Text)
-> Query CoreState (Maybe Text)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Text) CoreState (Maybe Text)
Lens' CoreState (Maybe Text)
coreRootRedirect

-- | set the path that @/@ should redirect to
setRootRedirect :: Maybe Text -> Update CoreState ()
setRootRedirect :: Maybe Text -> Update CoreState ()
setRootRedirect Maybe Text
path = (Maybe Text -> Identity (Maybe Text))
-> CoreState -> Identity CoreState
Lens' CoreState (Maybe Text)
coreRootRedirect ((Maybe Text -> Identity (Maybe Text))
 -> CoreState -> Identity CoreState)
-> Maybe Text -> Update CoreState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Text
path

-- | get the 'BodyPolicy' data for requests which can have bodies
getBodyPolicy :: Query CoreState (FilePath, Int64, Int64, Int64)
getBodyPolicy :: Query CoreState (String, Int64, Int64, Int64)
getBodyPolicy = Getting
  (String, Int64, Int64, Int64)
  CoreState
  (String, Int64, Int64, Int64)
-> Query CoreState (String, Int64, Int64, Int64)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (String, Int64, Int64, Int64)
  CoreState
  (String, Int64, Int64, Int64)
Lens' CoreState (String, Int64, Int64, Int64)
coreBodyPolicy

-- | set the 'BodyPolicy' data for requests which can have bodies
setBodyPolicy :: (FilePath, Int64, Int64, Int64) -> Update CoreState ()
setBodyPolicy :: (String, Int64, Int64, Int64) -> Update CoreState ()
setBodyPolicy (String, Int64, Int64, Int64)
bp = ((String, Int64, Int64, Int64)
 -> Identity (String, Int64, Int64, Int64))
-> CoreState -> Identity CoreState
Lens' CoreState (String, Int64, Int64, Int64)
coreBodyPolicy (((String, Int64, Int64, Int64)
  -> Identity (String, Int64, Int64, Int64))
 -> CoreState -> Identity CoreState)
-> (String, Int64, Int64, Int64) -> Update CoreState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (String, Int64, Int64, Int64)
bp

-- | get the path that we should redirect to after login
getLoginRedirect :: Query CoreState (Maybe Text)
getLoginRedirect :: Query CoreState (Maybe Text)
getLoginRedirect = Getting (Maybe Text) CoreState (Maybe Text)
-> Query CoreState (Maybe Text)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Text) CoreState (Maybe Text)
Lens' CoreState (Maybe Text)
coreLoginRedirect

-- | set the path that we should redirect to after login
setLoginRedirect :: Maybe Text -> Update CoreState ()
setLoginRedirect :: Maybe Text -> Update CoreState ()
setLoginRedirect Maybe Text
path = (Maybe Text -> Identity (Maybe Text))
-> CoreState -> Identity CoreState
Lens' CoreState (Maybe Text)
coreLoginRedirect ((Maybe Text -> Identity (Maybe Text))
 -> CoreState -> Identity CoreState)
-> Maybe Text -> Update CoreState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Text
path

-- | get the From: address for system emails
getFromAddress :: Query CoreState (Maybe SimpleAddress)
getFromAddress :: Query CoreState (Maybe SimpleAddress)
getFromAddress = Getting (Maybe SimpleAddress) CoreState (Maybe SimpleAddress)
-> Query CoreState (Maybe SimpleAddress)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe SimpleAddress) CoreState (Maybe SimpleAddress)
Lens' CoreState (Maybe SimpleAddress)
coreFromAddress

-- | get the From: address for system emails
setFromAddress :: Maybe SimpleAddress -> Update CoreState ()
setFromAddress :: Maybe SimpleAddress -> Update CoreState ()
setFromAddress Maybe SimpleAddress
addr = (Maybe SimpleAddress -> Identity (Maybe SimpleAddress))
-> CoreState -> Identity CoreState
Lens' CoreState (Maybe SimpleAddress)
coreFromAddress ((Maybe SimpleAddress -> Identity (Maybe SimpleAddress))
 -> CoreState -> Identity CoreState)
-> Maybe SimpleAddress -> Update CoreState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe SimpleAddress
addr

-- | get the Reply-To: address for system emails
getReplyToAddress :: Query CoreState (Maybe SimpleAddress)
getReplyToAddress :: Query CoreState (Maybe SimpleAddress)
getReplyToAddress = Getting (Maybe SimpleAddress) CoreState (Maybe SimpleAddress)
-> Query CoreState (Maybe SimpleAddress)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe SimpleAddress) CoreState (Maybe SimpleAddress)
Lens' CoreState (Maybe SimpleAddress)
coreReplyToAddress

-- | get the Reply-To: address for system emails
setReplyToAddress :: Maybe SimpleAddress -> Update CoreState ()
setReplyToAddress :: Maybe SimpleAddress -> Update CoreState ()
setReplyToAddress Maybe SimpleAddress
addr = (Maybe SimpleAddress -> Identity (Maybe SimpleAddress))
-> CoreState -> Identity CoreState
Lens' CoreState (Maybe SimpleAddress)
coreReplyToAddress ((Maybe SimpleAddress -> Identity (Maybe SimpleAddress))
 -> CoreState -> Identity CoreState)
-> Maybe SimpleAddress -> Update CoreState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe SimpleAddress
addr

-- | get the path to the sendmail executable
getSendmailPath :: Query CoreState (Maybe FilePath)
getSendmailPath :: Query CoreState (Maybe String)
getSendmailPath = Getting (Maybe String) CoreState (Maybe String)
-> Query CoreState (Maybe String)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe String) CoreState (Maybe String)
Lens' CoreState (Maybe String)
coreSendmailPath

-- | set the path to the sendmail executable
setSendmailPath :: Maybe FilePath -> Update CoreState ()
setSendmailPath :: Maybe String -> Update CoreState ()
setSendmailPath Maybe String
path = (Maybe String -> Identity (Maybe String))
-> CoreState -> Identity CoreState
Lens' CoreState (Maybe String)
coreSendmailPath ((Maybe String -> Identity (Maybe String))
 -> CoreState -> Identity CoreState)
-> Maybe String -> Update CoreState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe String
path

-- | get the status of enabling OpenId
getEnableOpenId :: Query CoreState Bool
getEnableOpenId :: Query CoreState Bool
getEnableOpenId = Getting Bool CoreState Bool -> Query CoreState Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool CoreState Bool
Lens' CoreState Bool
coreEnableOpenId

-- | set the status of enabling OpenId
setEnableOpenId :: Bool -> Update CoreState ()
setEnableOpenId :: Bool -> Update CoreState ()
setEnableOpenId Bool
b = (Bool -> Identity Bool) -> CoreState -> Identity CoreState
Lens' CoreState Bool
coreEnableOpenId ((Bool -> Identity Bool) -> CoreState -> Identity CoreState)
-> Bool -> Update CoreState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
b

-- | get the entire 'CoreState'
getCoreState :: Query CoreState CoreState
getCoreState :: Query CoreState CoreState
getCoreState = Query CoreState CoreState
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | set the entire 'CoreState'
setCoreState :: CoreState -> Update CoreState ()
setCoreState :: CoreState -> Update CoreState ()
setCoreState = CoreState -> Update CoreState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put

$(makeAcidic ''CoreState
  [ 'getUACCT
  , 'setUACCT
  , 'getRootRedirect
  , 'setRootRedirect
  , 'getLoginRedirect
  , 'setLoginRedirect
  , 'getBodyPolicy
  , 'setBodyPolicy
  , 'getSiteName
  , 'setSiteName
  , 'getFromAddress
  , 'setFromAddress
  , 'getReplyToAddress
  , 'setReplyToAddress
  , 'getSendmailPath
  , 'setSendmailPath
  , 'setEnableOpenId
  , 'getEnableOpenId
  , 'getCoreState
  , 'setCoreState
  ])

data Acid = Acid
    { -- acidAuthenticate :: AcidState AuthenticateState
      Acid -> AcidState ProfileDataState
acidProfileData  :: AcidState ProfileDataState
    , Acid -> AcidState CoreState
acidCore         :: AcidState CoreState
    , Acid -> AcidState NavBarState
acidNavBar       :: AcidState NavBarState
    }

class GetAcidState m st where
    getAcidState :: m (AcidState st)

withAcid :: Maybe FilePath -> (Acid -> IO a) -> IO a
withAcid :: Maybe String -> (Acid -> IO a) -> IO a
withAcid Maybe String
mBasePath Acid -> IO a
f =
    let basePath :: String
basePath = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"_state" Maybe String
mBasePath in
    -- open acid-state databases
    IO (AcidState CoreState)
-> (AcidState CoreState -> IO ())
-> (AcidState CoreState -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (String -> CoreState -> IO (AcidState CoreState)
forall st.
(IsAcidic st, SafeCopy st) =>
String -> st -> IO (AcidState st)
openLocalStateFrom (String
basePath String -> ShowS
</> String
"core")        CoreState
initialCoreState)        (AcidState CoreState -> IO ()
forall st. (IsAcidic st, Typeable st) => AcidState st -> IO ()
createArchiveCheckpointAndClose) ((AcidState CoreState -> IO a) -> IO a)
-> (AcidState CoreState -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \AcidState CoreState
core ->
    IO (AcidState ProfileDataState)
-> (AcidState ProfileDataState -> IO ())
-> (AcidState ProfileDataState -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (String -> ProfileDataState -> IO (AcidState ProfileDataState)
forall st.
(IsAcidic st, SafeCopy st) =>
String -> st -> IO (AcidState st)
openLocalStateFrom (String
basePath String -> ShowS
</> String
"profileData") ProfileDataState
initialProfileDataState) (AcidState ProfileDataState -> IO ()
forall st. (IsAcidic st, Typeable st) => AcidState st -> IO ()
createArchiveCheckpointAndClose) ((AcidState ProfileDataState -> IO a) -> IO a)
-> (AcidState ProfileDataState -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \AcidState ProfileDataState
profileData ->
    IO (AcidState NavBarState)
-> (AcidState NavBarState -> IO ())
-> (AcidState NavBarState -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (String -> NavBarState -> IO (AcidState NavBarState)
forall st.
(IsAcidic st, SafeCopy st) =>
String -> st -> IO (AcidState st)
openLocalStateFrom (String
basePath String -> ShowS
</> String
"navBar")      NavBarState
initialNavBarState)      (AcidState NavBarState -> IO ()
forall st. (IsAcidic st, Typeable st) => AcidState st -> IO ()
createArchiveCheckpointAndClose) ((AcidState NavBarState -> IO a) -> IO a)
-> (AcidState NavBarState -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \AcidState NavBarState
navBar ->
    -- create sockets to allow `clckwrks-cli` to talk to the databases
#if MIN_VERSION_acid_state (0,16,0)
    IO ThreadId -> (ThreadId -> IO ()) -> (ThreadId -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (IO () -> IO ThreadId
forkIO (String -> IO ()
tryRemoveFile (String
basePath String -> ShowS
</> String
"core_socket") IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (CommChannel -> IO Bool)
-> SockAddr -> AcidState ProfileDataState -> IO ()
forall st.
(CommChannel -> IO Bool) -> SockAddr -> AcidState st -> IO ()
acidServerSockAddr CommChannel -> IO Bool
skipAuthenticationCheck (String -> SockAddr
SockAddrUnix (String -> SockAddr) -> String -> SockAddr
forall a b. (a -> b) -> a -> b
$ String
basePath String -> ShowS
</> String
"core_socket") AcidState ProfileDataState
profileData))
            (\ThreadId
tid -> ThreadId -> IO ()
killThread ThreadId
tid IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
tryRemoveFile (String
basePath String -> ShowS
</> String
"core_socket")) ((ThreadId -> IO a) -> IO a) -> (ThreadId -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ IO a -> ThreadId -> IO a
forall a b. a -> b -> a
const (IO a -> ThreadId -> IO a) -> IO a -> ThreadId -> IO a
forall a b. (a -> b) -> a -> b
$

#else
    bracket (forkIO (tryRemoveFile (basePath </> "core_socket") >> acidServer skipAuthenticationCheck (UnixSocket $ basePath </> "core_socket") profileData))
            (\tid -> killThread tid >> tryRemoveFile (basePath </> "core_socket")) $ const $
#endif
#if MIN_VERSION_acid_state (0,16,0)
    IO ThreadId -> (ThreadId -> IO ()) -> (ThreadId -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (IO () -> IO ThreadId
forkIO (String -> IO ()
tryRemoveFile (String
basePath String -> ShowS
</> String
"profileData_socket") IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (CommChannel -> IO Bool)
-> SockAddr -> AcidState ProfileDataState -> IO ()
forall st.
(CommChannel -> IO Bool) -> SockAddr -> AcidState st -> IO ()
acidServerSockAddr CommChannel -> IO Bool
skipAuthenticationCheck (String -> SockAddr
SockAddrUnix (String -> SockAddr) -> String -> SockAddr
forall a b. (a -> b) -> a -> b
$ String
basePath String -> ShowS
</> String
"profileData_socket") AcidState ProfileDataState
profileData))
            (\ThreadId
tid -> ThreadId -> IO ()
killThread ThreadId
tid IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
tryRemoveFile (String
basePath String -> ShowS
</> String
"profileData_socket"))
#else
    bracket (forkIO (tryRemoveFile (basePath </> "profileData_socket") >> acidServer skipAuthenticationCheck (UnixSocket $ basePath </> "profileData_socket") profileData))
            (\tid -> killThread tid >> tryRemoveFile (basePath </> "profileData_socket"))
#endif
            (IO a -> ThreadId -> IO a
forall a b. a -> b -> a
const (IO a -> ThreadId -> IO a) -> IO a -> ThreadId -> IO a
forall a b. (a -> b) -> a -> b
$ Acid -> IO a
f (AcidState ProfileDataState
-> AcidState CoreState -> AcidState NavBarState -> Acid
Acid AcidState ProfileDataState
profileData AcidState CoreState
core AcidState NavBarState
navBar))
    where
      tryRemoveFile :: String -> IO ()
tryRemoveFile String
fp = String -> IO ()
removeFile String
fp IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\IOError
e -> if IOError -> Bool
isDoesNotExistError IOError
e then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else IOError -> IO ()
forall a e. Exception e => e -> a
throw IOError
e)
      createArchiveCheckpointAndClose :: AcidState st -> IO ()
createArchiveCheckpointAndClose AcidState st
acid =
          do AcidState st -> IO ()
forall st. AcidState st -> IO ()
createArchive AcidState st
acid
             AcidState st -> IO ()
forall st. (IsAcidic st, Typeable st) => AcidState st -> IO ()
createCheckpointAndClose AcidState st
acid