Synnefo » snf-ganeti

{-| DRBD Data Types

This module holds the definition of the data types describing the status of

DRBD.

-}

{-

Copyright (C) 2012 Google Inc.

This program is free software; you can redistribute it and/or modify

it under the terms of the GNU General Public License as published by

the Free Software Foundation; either version 2 of the License, or

(at your option) any later version.

This program is distributed in the hope that it will be useful, but

WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

General Public License for more details.

You should have received a copy of the GNU General Public License

along with this program; if not, write to the Free Software

Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA

02110-1301, USA.

-}

module Ganeti.Storage.Drbd.Types

  ( DRBDStatus(..)

  , VersionInfo(..)

  , DeviceInfo(..)

  , ConnState(..)

  , LocalRemote(..)

  , Role(..)

  , DiskState(..)

  , PerfIndicators(..)

  , SyncStatus(..)

  , SizeUnit(..)

  , Time(..)

  , TimeUnit(..)

  , AdditionalInfo(..)

  , DrbdInstMinor(..)

  ) where

import Control.Monad

import Text.JSON

import Text.Printf

import Ganeti.JSON

--TODO: consider turning deviceInfos into an IntMap

-- | Data type contaning all the data about the status of DRBD.

data DRBDStatus =

  DRBDStatus

  { versionInfo :: VersionInfo  -- ^ Version information about DRBD

  , deviceInfos :: [DeviceInfo] -- ^ Per-minor information

  } deriving (Eq, Show)

-- | The DRBDStatus instance of JSON.

instance JSON DRBDStatus where

  showJSON d = makeObj

    [ ("versionInfo", showJSON $ versionInfo d)

    , ("deviceInfos", showJSONs $ deviceInfos d)

    ]

  readJSON = error "JSON read instance not implemented for type DRBDStatus"

-- | Data type describing the DRBD version.

data VersionInfo =

  VersionInfo

  { version    :: Maybe String -- ^ DRBD driver version

  , api        :: Maybe String -- ^ The api version

  , proto      :: Maybe String -- ^ The protocol version

  , srcversion :: Maybe String -- ^ The version of the source files

  , gitHash    :: Maybe String -- ^ Git hash of the source files

  , buildBy    :: Maybe String -- ^ Who built the binary (and,

                               -- optionally, when)

  } deriving (Eq, Show)

-- | The VersionInfo instance of JSON.

instance JSON VersionInfo where

  showJSON (VersionInfo versionF apiF protoF srcversionF gitHashF buildByF) =

    optFieldsToObj

      [ optionalJSField "version" versionF

      , optionalJSField "api" apiF

      , optionalJSField "proto" protoF

      , optionalJSField "srcversion" srcversionF

      , optionalJSField "gitHash" gitHashF

      , optionalJSField "buildBy" buildByF

      ]

  readJSON = error "JSON read instance not implemented for type VersionInfo"

-- | Data type describing a device.

data DeviceInfo =

  UnconfiguredDevice Int -- ^ An DRBD minor marked as unconfigured

  | -- | A configured DRBD minor

    DeviceInfo

      { minorNumber :: Int                  -- ^ The minor index of the device

      , connectionState :: ConnState        -- ^ State of the connection

      , resourceRoles :: LocalRemote Role   -- ^ Roles of the resources

      , diskStates :: LocalRemote DiskState -- ^ Status of the disks

      , replicationProtocol :: Char         -- ^ The replication protocol

                                            -- being used

      , ioFlags :: String                   -- ^ The input/output flags

      , perfIndicators :: PerfIndicators    -- ^ Performance indicators

      , syncStatus :: Maybe SyncStatus      -- ^ The status of the

                                            -- syncronization of the disk

                                            -- (only if it is happening)

      , resync :: Maybe AdditionalInfo      -- ^ Additional info by DRBD 8.0

      , actLog :: Maybe AdditionalInfo      -- ^ Additional info by DRBD 8.0

      , instName :: Maybe String            -- ^ The name of the associated

                                            -- instance

      } deriving (Eq, Show)

-- | The DeviceInfo instance of JSON.

instance JSON DeviceInfo where

  showJSON (UnconfiguredDevice num) = makeObj

    [ ("minor", showJSON num)

    , ("connectionState", showJSON Unconfigured)

    ]

  showJSON (DeviceInfo minorNumberF connectionStateF (LocalRemote

    localRole remoteRole) (LocalRemote localState remoteState)

    replicProtocolF ioFlagsF perfIndicatorsF syncStatusF _ _ instNameF) =

    optFieldsToObj

    [ Just ("minor", showJSON minorNumberF)

    , Just ("connectionState", showJSON connectionStateF)

    , Just ("localRole", showJSON localRole)

    , Just ("remoteRole", showJSON remoteRole)

    , Just ("localState", showJSON localState)

    , Just ("remoteState", showJSON remoteState)

    , Just ("replicationProtocol", showJSON replicProtocolF)

    , Just ("ioFlags", showJSON ioFlagsF)

    , Just ("perfIndicators", showJSON perfIndicatorsF)

    , optionalJSField "syncStatus" syncStatusF

    , Just ("instance", maybe JSNull showJSON instNameF)

    ]

  readJSON = error "JSON read instance not implemented for type DeviceInfo"

-- | Data type describing the state of the connection.

data ConnState

  = StandAlone     -- ^  No network configuration available

  | Disconnecting  -- ^ Temporary state during disconnection

  | Unconnected    -- ^ Prior to a connection attempt

  | Timeout        -- ^ Following a timeout in the communication

  | BrokenPipe     -- ^ After the connection to the peer was lost

  | NetworkFailure -- ^ After the connection to the partner was lost

  | ProtocolError  -- ^ After the connection to the partner was lost

  | TearDown       -- ^ The peer is closing the connection

  | WFConnection   -- ^ Waiting for the peer to become visible

  | WFReportParams -- ^ Waiting for first packet from peer

  | Connected      -- ^ Connected, data mirroring active

  | StartingSyncS  -- ^ Source of a full sync started by admin

  | StartingSyncT  -- ^ Target of a full sync started by admin

  | WFBitMapS      -- ^ Source of a just starting partial sync

  | WFBitMapT      -- ^ Target of a just starting partial sync

  | WFSyncUUID     -- ^ Synchronization is about to begin

  | SyncSource     -- ^ Source of a running synchronization

  | SyncTarget     -- ^ Target of a running synchronization

  | PausedSyncS    -- ^ Source of a paused synchronization

  | PausedSyncT    -- ^ Target of a paused synchronization

  | VerifyS        -- ^ Source of a running verification

  | VerifyT        -- ^ Target of a running verification

  | Unconfigured   -- ^ The device is not configured

    deriving (Show, Eq)

-- | The ConnState instance of JSON.

instance JSON ConnState where

  showJSON = showJSON . show

  readJSON = error "JSON read instance not implemented for type ConnState"

-- | Algebraic data type describing something that has a local and a remote

-- value.

data LocalRemote a =

  LocalRemote

  { local  :: a -- ^ The local value

  , remote :: a -- ^ The remote value

  } deriving (Eq, Show)

-- | Data type describing.

data Role = Primary   -- ^ The device role is primary

          | Secondary -- ^ The device role is secondary

          | Unknown   -- ^ The device role is unknown

            deriving (Eq, Show)

-- | The Role instance of JSON.

instance JSON Role where

  showJSON = showJSON . show

  readJSON = error "JSON read instance not implemented for type Role"

-- | Data type describing disk states.

data DiskState

  = Diskless     -- ^ No local block device assigned to the DRBD driver

  | Attaching    -- ^ Reading meta data

  | Failed       -- ^ I/O failure

  | Negotiating  -- ^ "Attach" on an already-connected device

  | Inconsistent -- ^ The data is inconsistent between nodes.

  | Outdated     -- ^ Data consistent but outdated

  | DUnknown     -- ^ No network connection available

  | Consistent   -- ^ Consistent data, but without network connection

  | UpToDate     -- ^ Consistent, up-to-date. This is the normal state

    deriving (Eq, Show)

-- | The DiskState instance of JSON.

instance JSON DiskState where

  showJSON = showJSON . show

  readJSON = error "JSON read instance not implemented for type DiskState"

-- | Data type containing data about performance indicators.

data PerfIndicators = PerfIndicators

  { networkSend :: Int -- ^ KiB of data sent on the network

  , networkReceive :: Int -- ^ KiB of data received from the network

  , diskWrite :: Int -- ^ KiB of data written on local disk

  , diskRead :: Int -- ^ KiB of data read from local disk

  , activityLog :: Int -- ^ Number of updates of the activity log

  , bitMap :: Int -- ^ Number of updates to the bitmap area of the metadata

  , localCount :: Int -- ^ Number of open requests to the local I/O subsystem

  , pending :: Int -- ^ Num of requests sent to the partner but not yet answered

  , unacknowledged :: Int -- ^ Num of requests received by the partner but still

                        -- to be answered

  , applicationPending :: Int -- ^ Num of block I/O requests forwarded

                              -- to DRBD but that have not yet been

                              -- answered

  , epochs :: Maybe Int -- ^ Number of epoch objects

  , writeOrder :: Maybe Char -- ^ Currently used write ordering method

  , outOfSync :: Maybe Int -- ^ KiB of storage currently out of sync

  } deriving (Eq, Show)

-- | The PerfIndicators instance of JSON.

instance JSON PerfIndicators where

  showJSON p = optFieldsToObj

    [ Just ("networkSend", showJSON $ networkSend p)

    , Just ("networkReceive", showJSON $ networkReceive p)

    , Just ("diskWrite", showJSON $ diskWrite p)

    , Just ("diskRead", showJSON $ diskRead p)

    , Just ("activityLog", showJSON $ activityLog p)

    , Just ("bitMap", showJSON $ bitMap p)

    , Just ("localCount", showJSON $ localCount p)

    , Just ("pending", showJSON $ pending p)

    , Just ("unacknowledged", showJSON $ unacknowledged p)

    , Just ("applicationPending", showJSON $ applicationPending p)

    , optionalJSField "epochs" $ epochs p

    , optionalJSField "writeOrder" $ writeOrder p

    , optionalJSField "outOfSync" $ outOfSync p

    ]

  readJSON = error "JSON read instance not implemented for type PerfIndicators"

-- | Data type containing data about the synchronization status of a device.

data SyncStatus =

  SyncStatus

  { percentage      :: Double    -- ^ Percentage of syncronized data

  , partialSyncSize :: Int       -- ^ Numerator of the fraction of synced data

  , totalSyncSize   :: Int       -- ^ Denominator of the fraction of

                                 -- synced data

  , syncUnit        :: SizeUnit  -- ^ Measurement unit of the previous

                                 -- fraction

  , timeToFinish    :: Time      -- ^ Expected time before finishing

                                 -- the syncronization

  , speed           :: Int       -- ^ Speed of the syncronization

  , want            :: Maybe Int -- ^ Want of the syncronization

  , speedSizeUnit   :: SizeUnit  -- ^ Size unit of the speed

  , speedTimeUnit   :: TimeUnit  -- ^ Time unit of the speed

  } deriving (Eq, Show)

-- | The SyncStatus instance of JSON.

instance JSON SyncStatus where

  showJSON s = optFieldsToObj

    [ Just ("percentage", showJSON $ percentage s)

    , Just ("progress", showJSON $ show (partialSyncSize s) ++ "/" ++

        show (totalSyncSize s))

    , Just ("progressUnit", showJSON $ syncUnit s)

    , Just ("timeToFinish", showJSON $ timeToFinish s)

    , Just ("speed", showJSON $ speed s)

    , optionalJSField "want" $ want s

    , Just ("speedUnit", showJSON $ show (speedSizeUnit s) ++ "/" ++

        show (speedTimeUnit s))

    ]

  readJSON = error "JSON read instance not implemented for type SyncStatus"

-- | Data type describing a size unit for memory.

data SizeUnit = KiloByte | MegaByte deriving (Eq, Show)

-- | The SizeUnit instance of JSON.

instance JSON SizeUnit where

  showJSON = showJSON . show

  readJSON = error "JSON read instance not implemented for type SizeUnit"

-- | Data type describing a time (hh:mm:ss).

data Time = Time

  { hour :: Int

  , min  :: Int

  , sec  :: Int

  } deriving (Eq, Show)

-- | The Time instance of JSON.

instance JSON Time where

  showJSON (Time h m s) = showJSON (printf "%02d:%02d:%02d" h m s :: String)

  readJSON = error "JSON read instance not implemented for type Time"

-- | Data type describing a time unit.

data TimeUnit = Second deriving (Eq, Show)

-- | The TimeUnit instance of JSON.

instance JSON TimeUnit where

  showJSON Second = showJSON "Second"

  readJSON = error "JSON read instance not implemented for type TimeUnit"

-- | Additional device-specific cache-like information produced by

-- drbd <= 8.0.

--

-- Internal debug information exported by old DRBD versions.

-- Undocumented both in DRBD and here.

data AdditionalInfo = AdditionalInfo

  { partialUsed :: Int

  , totalUsed   :: Int

  , hits        :: Int

  , misses      :: Int

  , starving    :: Int

  , dirty       :: Int

  , changed     :: Int

  } deriving (Eq, Show)

-- | Data type representing the pairing of a DRBD minor with an instance.

data DrbdInstMinor = DrbdInstMinor

  { dimNode :: String

  , dimMinor :: Int

  , dimInstName :: String

  , dimDiskIdx :: String

  , dimRole :: String

  , dimPeer :: String

  } deriving (Show)

-- | The DrbdInstMinor instance of JSON.

instance JSON DrbdInstMinor where

  showJSON (DrbdInstMinor a b c d e f) =

    JSArray

      [ showJSON a

      , showJSON b

      , showJSON c

      , showJSON d

      , showJSON e

      , showJSON f

      ]

  readJSON (JSArray [a, b, c, d, e, f]) =

    DrbdInstMinor

      `fmap` readJSON a

      `ap` readJSON b

      `ap` readJSON c

      `ap` readJSON d

      `ap` readJSON e

      `ap` readJSON f

  readJSON _ = fail "Unable to read a DrbdInstMinor"