Revision cd3b4ff4 src/Ganeti/Objects.hs
b/src/Ganeti/Objects.hs | ||
---|---|---|
41 | 41 |
, FileDriver(..) |
42 | 42 |
, BlockDriver(..) |
43 | 43 |
, DiskMode(..) |
44 |
, DiskType(..) |
|
45 | 44 |
, DiskLogicalId(..) |
46 | 45 |
, Disk(..) |
47 | 46 |
, includesLogicalId |
... | ... | |
303 | 302 |
]) |
304 | 303 |
$(makeJSONInstance ''DiskMode) |
305 | 304 |
|
306 |
$(declareSADT "DiskType" |
|
307 |
[ ("LD_LV", 'C.ldLv) |
|
308 |
, ("LD_DRBD8", 'C.ldDrbd8) |
|
309 |
, ("LD_FILE", 'C.ldFile) |
|
310 |
, ("LD_BLOCKDEV", 'C.ldBlockdev) |
|
311 |
, ("LD_RADOS", 'C.ldRbd) |
|
312 |
, ("LD_EXT", 'C.ldExt) |
|
313 |
]) |
|
314 |
$(makeJSONInstance ''DiskType) |
|
315 |
|
|
316 | 305 |
-- | The persistent block driver type. Currently only one type is allowed. |
317 | 306 |
$(declareSADT "BlockDriver" |
318 | 307 |
[ ("BlockDrvManual", 'C.blockdevDriverManual) |
... | ... | |
332 | 321 |
| LIDDrbd8 String String Int Int Int String |
333 | 322 |
-- ^ NodeA, NodeB, Port, MinorA, MinorB, Secret |
334 | 323 |
| LIDFile FileDriver String -- ^ Driver, path |
324 |
| LIDSharedFile FileDriver String -- ^ Driver, path |
|
335 | 325 |
| LIDBlockDev BlockDriver String -- ^ Driver, path (must be under /dev) |
336 | 326 |
| LIDRados String String -- ^ Unused, path |
337 | 327 |
| LIDExt String String -- ^ ExtProvider, unique name |
338 | 328 |
deriving (Show, Eq) |
339 | 329 |
|
340 | 330 |
-- | Mapping from a logical id to a disk type. |
341 |
lidDiskType :: DiskLogicalId -> DiskType |
|
342 |
lidDiskType (LIDPlain {}) = LD_LV |
|
343 |
lidDiskType (LIDDrbd8 {}) = LD_DRBD8 |
|
344 |
lidDiskType (LIDFile {}) = LD_FILE |
|
345 |
lidDiskType (LIDBlockDev {}) = LD_BLOCKDEV |
|
346 |
lidDiskType (LIDRados {}) = LD_RADOS |
|
347 |
lidDiskType (LIDExt {}) = LD_EXT |
|
331 |
lidDiskType :: DiskLogicalId -> DiskTemplate |
|
332 |
lidDiskType (LIDPlain {}) = DTPlain |
|
333 |
lidDiskType (LIDDrbd8 {}) = DTDrbd8 |
|
334 |
lidDiskType (LIDFile {}) = DTFile |
|
335 |
lidDiskType (LIDSharedFile {}) = DTSharedFile |
|
336 |
lidDiskType (LIDBlockDev {}) = DTBlock |
|
337 |
lidDiskType (LIDRados {}) = DTRbd |
|
338 |
lidDiskType (LIDExt {}) = DTExt |
|
348 | 339 |
|
349 | 340 |
-- | Builds the extra disk_type field for a given logical id. |
350 | 341 |
lidEncodeType :: DiskLogicalId -> [(String, JSValue)] |
... | ... | |
358 | 349 |
, showJSON minorA, showJSON minorB, showJSON key ] |
359 | 350 |
encodeDLId (LIDRados pool name) = JSArray [showJSON pool, showJSON name] |
360 | 351 |
encodeDLId (LIDFile driver name) = JSArray [showJSON driver, showJSON name] |
352 |
encodeDLId (LIDSharedFile driver name) = |
|
353 |
JSArray [showJSON driver, showJSON name] |
|
361 | 354 |
encodeDLId (LIDBlockDev driver name) = JSArray [showJSON driver, showJSON name] |
362 | 355 |
encodeDLId (LIDExt extprovider name) = |
363 | 356 |
JSArray [showJSON extprovider, showJSON name] |
... | ... | |
373 | 366 |
decodeDLId obj lid = do |
374 | 367 |
dtype <- fromObj obj devType |
375 | 368 |
case dtype of |
376 |
LD_DRBD8 ->
|
|
369 |
DTDrbd8 ->
|
|
377 | 370 |
case lid of |
378 | 371 |
JSArray [nA, nB, p, mA, mB, k] -> do |
379 | 372 |
nA' <- readJSON nA |
... | ... | |
384 | 377 |
k' <- readJSON k |
385 | 378 |
return $ LIDDrbd8 nA' nB' p' mA' mB' k' |
386 | 379 |
_ -> fail "Can't read logical_id for DRBD8 type" |
387 |
LD_LV ->
|
|
380 |
DTPlain ->
|
|
388 | 381 |
case lid of |
389 | 382 |
JSArray [vg, lv] -> do |
390 | 383 |
vg' <- readJSON vg |
391 | 384 |
lv' <- readJSON lv |
392 | 385 |
return $ LIDPlain vg' lv' |
393 | 386 |
_ -> fail "Can't read logical_id for plain type" |
394 |
LD_FILE ->
|
|
387 |
DTFile ->
|
|
395 | 388 |
case lid of |
396 | 389 |
JSArray [driver, path] -> do |
397 | 390 |
driver' <- readJSON driver |
398 | 391 |
path' <- readJSON path |
399 | 392 |
return $ LIDFile driver' path' |
400 | 393 |
_ -> fail "Can't read logical_id for file type" |
401 |
LD_BLOCKDEV -> |
|
394 |
DTSharedFile -> |
|
395 |
case lid of |
|
396 |
JSArray [driver, path] -> do |
|
397 |
driver' <- readJSON driver |
|
398 |
path' <- readJSON path |
|
399 |
return $ LIDSharedFile driver' path' |
|
400 |
_ -> fail "Can't read logical_id for shared file type" |
|
401 |
DTBlock -> |
|
402 | 402 |
case lid of |
403 | 403 |
JSArray [driver, path] -> do |
404 | 404 |
driver' <- readJSON driver |
405 | 405 |
path' <- readJSON path |
406 | 406 |
return $ LIDBlockDev driver' path' |
407 | 407 |
_ -> fail "Can't read logical_id for blockdev type" |
408 |
LD_RADOS ->
|
|
408 |
DTRbd ->
|
|
409 | 409 |
case lid of |
410 | 410 |
JSArray [driver, path] -> do |
411 | 411 |
driver' <- readJSON driver |
412 | 412 |
path' <- readJSON path |
413 | 413 |
return $ LIDRados driver' path' |
414 | 414 |
_ -> fail "Can't read logical_id for rdb type" |
415 |
LD_EXT ->
|
|
415 |
DTExt ->
|
|
416 | 416 |
case lid of |
417 | 417 |
JSArray [extprovider, name] -> do |
418 | 418 |
extprovider' <- readJSON extprovider |
419 | 419 |
name' <- readJSON name |
420 | 420 |
return $ LIDExt extprovider' name' |
421 | 421 |
_ -> fail "Can't read logical_id for extstorage type" |
422 |
DTDiskless -> |
|
423 |
fail "Retrieved 'diskless' disk." |
|
422 | 424 |
|
423 | 425 |
-- | Disk data structure. |
424 | 426 |
-- |
Also available in: Unified diff