detachInstanceDisk is a part of remove instance disk, which itself is a part of remove instance. Remove instance could be potentially used in instance creation and is used in instance removal.
Signed-off-by: BSRK Aditya <[email protected]> --- src/Ganeti/WConfd/ConfigModifications.hs | 46 +++++++++++++++++++++++++++++- 1 file changed, 45 insertions(+), 1 deletion(-) diff --git a/src/Ganeti/WConfd/ConfigModifications.hs b/src/Ganeti/WConfd/ConfigModifications.hs index 2bed978..ffc7b04 100644 --- a/src/Ganeti/WConfd/ConfigModifications.hs +++ b/src/Ganeti/WConfd/ConfigModifications.hs @@ -44,9 +44,10 @@ import Control.Lens (_2) import Control.Lens.Getter ((^.)) import Control.Lens.Setter ((.~), (%~)) import Control.Lens.Traversal (mapMOf) -import Control.Monad (unless, when, forM_) +import Control.Monad (unless, when, forM_, foldM, join, liftM2) import Control.Monad.Error (throwError, MonadError) import Control.Monad.IO.Class (liftIO) +import Data.List (elemIndex) import Data.Maybe (isJust, maybeToList, fromMaybe) import Language.Haskell.TH (Name) import System.Time (getClockTime, ClockTime) @@ -380,6 +381,48 @@ attachInstanceDisk iUuid dUuid idx = do (return ()) return $ isJust r +-- | Detach a disk from an instance. +detachInstanceDisk :: InstanceUUID -> DiskUUID -> WConfdMonad Bool +detachInstanceDisk iUuid dUuid = do + let iL = csConfigDataL . configInstancesL . alterContainerL iUuid + + operateOverInstanceDisk :: MonadError GanetiException m + => (Instance -> Int -> m a) + -> Maybe Instance + -> m a + operateOverInstanceDisk _ Nothing = throwError . ConfigurationError $ + printf "Could not find instance with UUID %s" iUuid + operateOverInstanceDisk m (Just ist) = + case elemIndex dUuid (instDisks ist) of + Nothing -> throwError . ConfigurationError $ + printf "Disk %s is not attached to instance %s" dUuid iUuid + Just idx -> m ist idx + + resetIv :: MonadError GanetiException m + => (Int, [DiskUUID]) -> ConfigState + -> m ConfigState + resetIv (startIdx, disks) = mapMOf (csConfigDataL . configDisksL) + (\cd -> foldM (\c (idx, dUuid') -> mapMOf (alterContainerL dUuid') + (\md -> case md of + Nothing -> throwError . ConfigurationError $ + printf "Could not find disk with UUID %s" dUuid' + Just disk -> return + . Just + . (diskIvNameL .~ ("disk/" ++ show idx)) + $ disk) c) + cd (zip [startIdx..] disks)) + ct <- liftIO getClockTime + isJust <$> modifyConfigWithLock (\_ cs -> join $ liftM2 resetIv + (operateOverInstanceDisk + (\ist idx -> return (idx, drop (idx + 1) (instDisks ist))) + (cs ^. iL)) + (mapMOf iL (operateOverInstanceDisk (\ist _ -> return + . Just + . (instDisksL %~ filter (/= dUuid)) + . (instSerialL %~ (+1)) + . (instMtimeL .~ ct) + $ ist)) cs)) (return ()) + -- | Allocate a port. -- The port will be taken from the available port pool or from the -- default port range (and in this case we increase @@ -511,6 +554,7 @@ exportedFunctions = [ 'addInstance , 'addInstanceDisk , 'allocatePort , 'attachInstanceDisk + , 'detachInstanceDisk , 'markInstanceDisksActive , 'setInstancePrimaryNode , 'updateCluster -- 1.7.10.4
