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, 44 insertions(+), 2 deletions(-) diff --git a/src/Ganeti/WConfd/ConfigModifications.hs b/src/Ganeti/WConfd/ConfigModifications.hs index 2bed978..ab7f0f4 100644 --- a/src/Ganeti/WConfd/ConfigModifications.hs +++ b/src/Ganeti/WConfd/ConfigModifications.hs @@ -40,14 +40,17 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. module Ganeti.WConfd.ConfigModifications where import Control.Applicative ((<$>)) -import Control.Lens (_2) +import Control.Lens (_1, _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) import Control.Monad.Error (throwError, MonadError) import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Writer (WriterT(..), tell) +import Data.List (elemIndex) import Data.Maybe (isJust, maybeToList, fromMaybe) +import Data.Monoid (Sum(..)) import Language.Haskell.TH (Name) import System.Time (getClockTime, ClockTime) import Text.Printf (printf) @@ -380,6 +383,44 @@ attachInstanceDisk iUuid dUuid idx = do (return ()) return $ isJust r +detachInstanceDisk :: InstanceUUID -> DiskUUID -> WConfdMonad Bool +detachInstanceDisk iUuid dUuid = do + ct <- liftIO getClockTime + isJust <$> modifyConfigWithLock (\_ -> + (dOp =<<) . ((_2 . _1 %~ getSum) <$>) . runWriterT . (iOp ct)) (return ()) + where + iOp :: MonadError GanetiException m + => ClockTime + -> ConfigState + -> WriterT (Sum Int, [DiskUUID]) m ConfigState + iOp ct = mapMOf (csConfigDataL . configInstancesL . alterContainerL iUuid) + (\mi -> case mi of + Nothing -> throwError . ConfigurationError $ + printf "Could not find instance with UUID %s" iUuid + Just ist -> case elemIndex dUuid (instDisks ist) of + Nothing -> throwError . ProgrammerError $ + printf "Disk %s is not attached to instance %s" dUuid iUuid + Just idx -> do + tell (Sum idx, drop (idx + 1) (instDisks ist)) + return . Just + . (instDisksL %~ filter (/= dUuid)) + . (instSerialL %~ (+1)) + . (instMtimeL .~ ct) + $ ist) + dOp :: MonadError GanetiException m + => (ConfigState, (Int, [DiskUUID])) + -> m ConfigState + dOp (cs, (startIdx, disks)) = mapMOf (csConfigDataL . configDisksL) + (\container -> 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) + container (zip [startIdx..] disks)) cs + -- | 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 +552,7 @@ exportedFunctions = [ 'addInstance , 'addInstanceDisk , 'allocatePort , 'attachInstanceDisk + , 'detachInstanceDisk , 'markInstanceDisksActive , 'setInstancePrimaryNode , 'updateCluster -- 1.7.10.4
