Revision a317d77a

b/src/Ganeti/WConfd/Monad.hs
43 43 
  , runWConfdMonadInt
44 44 
  , WConfdMonad
45 45 
  , modifyConfigState
46 
  , modifyLockAllocation
46 47 
  ) where
47 48 

  		





  48
  49
  
    
import Control.Applicative


  		





  ......




  55
  56
  
    

  		





  56
  57
  
    
import Ganeti.BasicTypes


  		





  57
  58
  
    
import Ganeti.Errors


  		





  
  59
  
    
import Ganeti.Locking.Locks


  		





  58
  60
  
    
import Ganeti.Logging


  		





  59
  61
  
    
import Ganeti.Types


  		





  60
  62
  
    
import Ganeti.WConfd.ConfigState


  		





  ......




  63
  65
  
    

  		





  64
  66
  
    
-- | The state of the daemon, capturing both the configuration state and the


  		





  65
  67
  
    
-- locking state.


  		





  66
  
  
    
--


  		





  67
  
  
    
-- Currently contains only the configuration state, the the locking state will


  		





  68
  
  
    
-- go here in the future as well.


  		





  69
  68
  
    
data DaemonState = DaemonState


  		





  70
  69
  
    
  { dsConfigState :: ConfigState


  		





  
  70
  
    
  , dsLockAllocation :: GanetiLockAllocation


  		





  71
  71
  
    
  }


  		





  72
  72
  
    

  		





  73
  73
  
    
data DaemonHandle = DaemonHandle


  		





  ......




  80
  80
  
    

  		





  81
  81
  
    
mkDaemonHandle :: FilePath


  		





  82
  82
  
    
               -> ConfigState


  		





  
  83
  
    
               -> GanetiLockAllocation


  		





  83
  84
  
    
               -> ResultT GanetiException IO DaemonHandle


  		





  84
  
  
    
mkDaemonHandle cp cs =


  		





  85
  
  
    
  DaemonHandle <$> liftBase (newIORef $ DaemonState cs) <*> pure cp


  		





  
  85
  
    
mkDaemonHandle cp cs la =


  		





  
  86
  
    
  DaemonHandle <$> liftBase (newIORef $ DaemonState cs la) <*> pure cp


  		





  86
  87
  
    

  		





  87
  88
  
    
data ClientState = ClientState


  		





  88
  89
  
    
  { clLiveFilePath :: FilePath


  		





  ......




  145
  146
  
    
  let mf ds = let (cs', r) = f (dsConfigState ds)


  		





  146
  147
  
    
              in (ds { dsConfigState = cs' }, r)


  		





  147
  148
  
    
  liftBase $ atomicModifyIORef (dhDaemonState dh) mf


  		





  
  149
  
    

  		





  
  150
  
    
-- | Atomically modifies the lock allocation state in WConfdMonad.


  		





  
  151
  
    
modifyLockAllocation :: (GanetiLockAllocation -> (GanetiLockAllocation, a))


  		





  
  152
  
    
                     -> WConfdMonad a


  		





  
  153
  
    
modifyLockAllocation f = do


  		





  
  154
  
    
  dh <- lift . WConfdMonadInt $ ask


  		





  
  155
  
    
  let mf ds = let (la', r) = f (dsLockAllocation ds)


  		





  
  156
  
    
              in (ds { dsLockAllocation = la' }, r)


  		





  
  157
  
    
  liftBase $ atomicModifyIORef (dhDaemonState dh) mf


  		












  

    
      b/src/Ganeti/WConfd/Server.hs
    
  






  37
  37
  
    

  		





  38
  38
  
    
import Ganeti.BasicTypes


  		





  39
  39
  
    
import Ganeti.Daemon


  		





  
  40
  
    
import Ganeti.Locking.Allocation


  		





  40
  41
  
    
import qualified Ganeti.Path as Path


  		





  41
  42
  
    
import Ganeti.THH.RPC


  		





  42
  43
  
    
import Ganeti.UDSServer


  		





  ......




  67
  68
  
    
  -- TODO: Lock the configuration file so that running the daemon twice fails?


  		





  68
  69
  
    
  conf_file <- Path.clusterConfFile


  		





  69
  70
  
    

  		





  70
  
  
    
  dhOpt <- runResultT $ mkDaemonHandle conf_file mkConfigState


  		





  
  71
  
    
  dhOpt <- runResultT $ mkDaemonHandle conf_file mkConfigState emptyAllocation


  		





  
  72
  
    
  -- TODO: read current lock allocation from disk


  		





  71
  73
  
    
  dh <- withError (strMsg . ("Initialization of the daemon failed" ++) . show)


  		





  72
  74
  
    
                  dhOpt


  		





  73
  75
  
    

  		












  

    
      b/test/hs/Test/Ganeti/Locking/Allocation.hs
    
  






  125
  125
  
    
  forAll (arbitrary :: Gen TestOwner) $ \a ->


  		





  126
  126
  
    
  forAll (arbitrary :: Gen [LockRequest TestLock]) $ \request ->


  		





  127
  127
  
    
  let (state', result) = updateLocks a request state


  		





  128
  
  
    
  in if result == Ok (S.empty)


  		





  
  128
  
    
  in if result == Ok S.empty


  		





  129
  129
  
    
       then printTestCase


  		





  130
  130
  
    
            ("Update suceeded, but in final state " ++ show state'


  		





  131
  131
  
    
              ++ "not all locks are as requested")


  		












Also available in:
  Unified diff