{-| Implementation of the opcodes.

-}

{-

Copyright (C) 2009 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.OpCodes
    ( OpCode(..)
    , ReplaceDisksMode(..)
    , opID
    ) where

import Control.Monad
import Text.JSON (readJSON, showJSON, makeObj, JSON)
import qualified Text.JSON as J
import Text.JSON.Types

import Ganeti.HTools.Utils

data ReplaceDisksMode = ReplaceOnPrimary
                  | ReplaceOnSecondary
                  | ReplaceNewSecondary
                  | ReplaceAuto
                  deriving (Show, Eq)

instance JSON ReplaceDisksMode where
    showJSON m = case m of
                 ReplaceOnPrimary -> showJSON "replace_on_primary"
                 ReplaceOnSecondary -> showJSON "replace_on_secondary"
                 ReplaceNewSecondary -> showJSON "replace_new_secondary"
                 ReplaceAuto -> showJSON "replace_auto"
    readJSON s = case readJSON s of
                   J.Ok "replace_on_primary" -> J.Ok ReplaceOnPrimary
                   J.Ok "replace_on_secondary" -> J.Ok ReplaceOnSecondary
                   J.Ok "replace_new_secondary" -> J.Ok ReplaceNewSecondary
                   J.Ok "replace_auto" -> J.Ok ReplaceAuto
                   _ -> J.Error "Can't parse a valid ReplaceDisksMode"

data OpCode = OpTestDelay Double Bool [String]
            | OpReplaceDisks String (Maybe String) ReplaceDisksMode
              [Int] (Maybe String)
            | OpFailoverInstance String Bool
            | OpMigrateInstance String Bool Bool
            deriving (Show, Eq)


opID :: OpCode -> String
opID (OpTestDelay _ _ _) = "OP_TEST_DELAY"
opID (OpReplaceDisks _ _ _ _ _) = "OP_INSTANCE_REPLACE_DISKS"
opID (OpFailoverInstance _ _) = "OP_INSTANCE_FAILOVER"
opID (OpMigrateInstance _ _ _) = "OP_INSTANCE_MIGRATE"

loadOpCode :: JSValue -> J.Result OpCode
loadOpCode v = do
  o <- liftM J.fromJSObject (readJSON v)
  op_id <- fromObj "OP_ID" o
  case op_id of
    "OP_TEST_DELAY" -> do
                 on_nodes <- fromObj "on_nodes" o
                 on_master <- fromObj "on_master" o
                 duration <- fromObj "duration" o
                 return $ OpTestDelay duration on_master on_nodes
    "OP_INSTANCE_REPLACE_DISKS" -> do
                 inst <- fromObj "instance_name" o
                 node <- maybeFromObj "remote_node" o
                 mode <- fromObj "mode" o
                 disks <- fromObj "disks" o
                 ialloc <- maybeFromObj "iallocator" o
                 return $ OpReplaceDisks inst node mode disks ialloc
    "OP_INSTANCE_FAILOVER" -> do
                 inst <- fromObj "instance_name" o
                 consist <- fromObj "ignore_consistency" o
                 return $ OpFailoverInstance inst consist
    "OP_INSTANCE_MIGRATE" -> do
                 inst <- fromObj "instance_name" o
                 live <- fromObj "live" o
                 cleanup <- fromObj "cleanup" o
                 return $ OpMigrateInstance inst live cleanup
    _ -> J.Error $ "Unknown opcode " ++ op_id

saveOpCode :: OpCode -> JSValue
saveOpCode op@(OpTestDelay duration on_master on_nodes) =
    let ol = [ ("OP_ID", showJSON $ opID op)
             , ("duration", showJSON duration)
             , ("on_master", showJSON on_master)
             , ("on_nodes", showJSON on_nodes) ]
    in makeObj ol

saveOpCode op@(OpReplaceDisks inst node mode disks iallocator) =
    let ol = [ ("OP_ID", showJSON $ opID op)
             , ("instance_name", showJSON inst)
             , ("mode", showJSON mode)
             , ("disks", showJSON disks)]
        ol2 = case node of
                Just n -> ("remote_node", showJSON n):ol
                Nothing -> ol
        ol3 = case iallocator of
                Just i -> ("iallocator", showJSON i):ol2
                Nothing -> ol2
    in makeObj ol3

saveOpCode op@(OpFailoverInstance inst consist) =
    let ol = [ ("OP_ID", showJSON $ opID op)
             , ("instance_name", showJSON inst)
             , ("ignore_consistency", showJSON consist) ]
    in makeObj ol

saveOpCode op@(OpMigrateInstance inst live cleanup) =
    let ol = [ ("OP_ID", showJSON $ opID op)
             , ("instance_name", showJSON inst)
             , ("live", showJSON live)
             , ("cleanup", showJSON cleanup) ]
    in makeObj ol

instance JSON OpCode where
    readJSON = loadOpCode
    showJSON = saveOpCode