Reduce some more code duplication and split code

The Qlang module defines ResultStatus, but it was already defined in
Ganeti/Luxi.hs; let's remove the duplicate definition from there since
the proper place is in the newer module.

Also, in order to ease testing, we split some confd functions into a
separate module; this can be imported easily into QC for testing.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Agata Murawska <agatamurawska@google.com>

Makefile.am

@@ -404,6 +404,7 @@ HS_LIB_SRCS = \
 	htools/Ganeti/BasicTypes.hs \
 	htools/Ganeti/Confd.hs \
 	htools/Ganeti/Confd/Server.hs \
+	htools/Ganeti/Confd/Utils.hs \
 	htools/Ganeti/Config.hs \
 	htools/Ganeti/Daemon.hs \
 	htools/Ganeti/Hash.hs \

htools/Ganeti/Confd/Server.hs

@@ -32,7 +32,6 @@ module Ganeti.Confd.Server
 import Control.Concurrent
 import Control.Exception
 import Control.Monad (forever, liftM, when)
-import qualified Data.ByteString as B
 import Data.IORef
 import Data.List
 import qualified Data.Map as M
@@ -51,6 +50,7 @@ import Ganeti.HTools.Types
 import Ganeti.HTools.Utils
 import Ganeti.Objects
 import Ganeti.Confd
+import Ganeti.Confd.Utils
 import Ganeti.Config
 import Ganeti.Hash
 import Ganeti.Logging
@@ -131,10 +131,6 @@ getCurrentTime = do
 
 -- * Confd base functionality
 
--- | Returns the HMAC key.
-getClusterHmac :: IO HashKey
-getClusterHmac = fmap B.unpack $ B.readFile C.confdHmacKey
-
 -- | Computes the node role.
 nodeRole :: ConfigData -> String -> Result ConfdNodeRole
 nodeRole cfg name =
@@ -242,15 +238,6 @@ buildResponse cdata req@(ConfdRequest { confdRqType = ReqNodeDrbd }) = do
                  (a, b, c, d, e, f) <- minors]
   return (ReplyStatusOk, J.showJSON encoded)
 
--- | Parses a signed request.
-parseRequest :: HashKey -> String -> Result (String, String, ConfdRequest)
-parseRequest key str = do
-  (SignedMessage hmac msg salt) <- fromJResult "parsing request" $ J.decode str
-  req <- if verifyMac key (Just salt) msg hmac
-           then fromJResult "parsing message" $ J.decode msg
-           else Bad "HMAC verification failed"
-  return (salt, msg, req)
-
 -- | Creates a ConfdReply from a given answer.
 serializeResponse :: Result StatusAnswer -> ConfdReply
 serializeResponse r =
@@ -262,15 +249,6 @@ serializeResponse r =
                   , confdReplyAnswer   = result
                   , confdReplySerial   = 0 }
 
--- | Signs a message with a given key and salt.
-signMessage :: HashKey -> String -> String -> SignedMessage
-signMessage key salt msg =
-  SignedMessage { signedMsgMsg  = msg
-                , signedMsgSalt = salt
-                , signedMsgHmac = hmac
-                }
-    where hmac = computeMac key (Just salt) msg
-
 -- * Configuration handling
 
 -- ** Helper functions
@@ -483,17 +461,6 @@ responder cfgref socket hmac msg peer = do
     Bad err -> logInfo $ "Failed to parse incoming message: " ++ err
   return ()
 
--- | Mesage parsing. This can either result in a good, valid message,
--- or fail in the Result monad.
-parseMessage :: HashKey -> String -> Integer
-             -> Result (String, ConfdRequest)
-parseMessage hmac msg curtime = do
-  (salt, origmsg, request) <- parseRequest hmac msg
-  ts <- tryRead "Parsing timestamp" salt::Result Integer
-  if (abs (ts - curtime) > (fromIntegral C.confdMaxClockSkew))
-    then fail "Too old/too new timestamp or clock skew"
-    else return (origmsg, request)
-
 -- | Inner helper function for a given client. This generates the
 -- final encoded message (as a string), ready to be sent out to the
 -- client.

htools/Ganeti/Confd/Utils.hs

+{-| Implementation of the Ganeti confd utilities.
+
+This holds a few utility functions that could be useful in both
+clients and servers.
+
+-}
+
+{-
+
+Copyright (C) 2011, 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.Confd.Utils
+  ( getClusterHmac
+  , parseRequest
+  , parseMessage
+  , signMessage
+  ) where
+
+import qualified Data.ByteString as B
+import qualified Text.JSON as J
+
+import Ganeti.BasicTypes
+import Ganeti.Confd
+import Ganeti.Hash
+import qualified Ganeti.Constants as C
+import Ganeti.HTools.JSON
+import Ganeti.HTools.Utils
+
+-- | Returns the HMAC key.
+getClusterHmac :: IO HashKey
+getClusterHmac = fmap B.unpack $ B.readFile C.confdHmacKey
+
+-- | Parses a signed request.
+parseRequest :: HashKey -> String -> Result (String, String, ConfdRequest)
+parseRequest key str = do
+  (SignedMessage hmac msg salt) <- fromJResult "parsing request" $ J.decode str
+  req <- if verifyMac key (Just salt) msg hmac
+           then fromJResult "parsing message" $ J.decode msg
+           else Bad "HMAC verification failed"
+  return (salt, msg, req)
+
+-- | Mesage parsing. This can either result in a good, valid message,
+-- or fail in the Result monad.
+parseMessage :: HashKey -> String -> Integer
+             -> Result (String, ConfdRequest)
+parseMessage hmac msg curtime = do
+  (salt, origmsg, request) <- parseRequest hmac msg
+  ts <- tryRead "Parsing timestamp" salt::Result Integer
+  if (abs (ts - curtime) > (fromIntegral C.confdMaxClockSkew))
+    then fail "Too old/too new timestamp or clock skew"
+    else return (origmsg, request)
+
+-- | Signs a message with a given key and salt.
+signMessage :: HashKey -> String -> String -> SignedMessage
+signMessage key salt msg =
+  SignedMessage { signedMsgMsg  = msg
+                , signedMsgSalt = salt
+                , signedMsgHmac = hmac
+                }
+    where hmac = computeMac key (Just salt) msg

htools/Ganeti/HTools/Luxi.hs

@@ -33,13 +33,13 @@ import Text.JSON.Types
 import qualified Text.JSON
 
 import qualified Ganeti.Luxi as L
+import qualified Ganeti.Qlang as Qlang
 import Ganeti.HTools.Loader
 import Ganeti.HTools.Types
 import qualified Ganeti.HTools.Group as Group
 import qualified Ganeti.HTools.Node as Node
 import qualified Ganeti.HTools.Instance as Instance
 import Ganeti.HTools.JSON
-import Ganeti.Qlang as Qlang
 
 {-# ANN module "HLint: ignore Eta reduce" #-}
 
@@ -78,7 +78,7 @@ extractArray v =
 fromJValWithStatus :: (Text.JSON.JSON a, Monad m) => (JSValue, JSValue) -> m a
 fromJValWithStatus (st, v) = do
   st' <- fromJVal st
-  L.checkRS st' v >>= fromJVal
+  Qlang.checkRS st' v >>= fromJVal
 
 -- | Annotate errors when converting values with owner/attribute for
 -- better debugging.

htools/Ganeti/HTools/QC.hs

@@ -75,6 +75,8 @@ import System.IO.Error (isEOFErrorType, ioeGetErrorType, isDoesNotExistError)
 import System.Process (readProcessWithExitCode)
 
 import qualified Ganeti.Confd as Confd
+import qualified Ganeti.Confd.Server as Confd.Server
+import qualified Ganeti.Confd.Utils as Confd.Utils
 import qualified Ganeti.Config as Config
 import qualified Ganeti.Daemon as Daemon
 import qualified Ganeti.Hash as Hash

htools/Ganeti/Luxi.hs

@@ -27,14 +27,12 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 
 module Ganeti.Luxi
   ( LuxiOp(..)
-  , ResultStatus(..)
   , LuxiReq(..)
   , Client
   , JobId
   , RecvResult(..)
   , TagObject(..)
   , strOfOp
-  , checkRS
   , getClient
   , getServer
   , acceptClient
@@ -183,27 +181,9 @@ $(makeJSONInstance ''LuxiReq)
 -- | The serialisation of LuxiOps into strings in messages.
 $(genStrOfOp ''LuxiOp "strOfOp")
 
-$(declareIADT "ResultStatus"
-  [ ("RSNormal", 'rsNormal)
-  , ("RSUnknown", 'rsUnknown)
-  , ("RSNoData", 'rsNodata)
-  , ("RSUnavailable", 'rsUnavail)
-  , ("RSOffline", 'rsOffline)
-  ])
-
-$(makeJSONInstance ''ResultStatus)
-
 -- | Type holding the initial (unparsed) Luxi call.
 data LuxiCall = LuxiCall LuxiReq JSValue
 
--- | Check that ResultStatus is success or fail with descriptive message.
-checkRS :: (Monad m) => ResultStatus -> a -> m a
-checkRS RSNormal val    = return val
-checkRS RSUnknown _     = fail "Unknown field"
-checkRS RSNoData _      = fail "No data for a field"
-checkRS RSUnavailable _ = fail "Ganeti reports unavailable data"
-checkRS RSOffline _     = fail "Ganeti reports resource as offline"
-
 -- | The end-of-message separator.
 eOM :: Word8
 eOM = 3

htools/Ganeti/Qlang.hs

@@ -35,6 +35,7 @@ module Ganeti.Qlang
     , FieldDefinition(..)
     , ResultEntry(..)
     , ItemType(..)
+    , checkRS
     ) where
 
 import Control.Applicative
@@ -58,6 +59,15 @@ $(declareIADT "ResultStatus"
   ])
 $(makeJSONInstance ''ResultStatus)
 
+-- | Check that ResultStatus is success or fail with descriptive
+-- message.
+checkRS :: (Monad m) => ResultStatus -> a -> m a
+checkRS RSNormal val = return val
+checkRS RSUnknown  _ = fail "Unknown field"
+checkRS RSNoData   _ = fail "No data for a field"
+checkRS RSUnavail  _ = fail "Ganeti reports unavailable data"
+checkRS RSOffline  _ = fail "Ganeti reports resource as offline"
+
 -- | Type of a query field.
 $(declareSADT "FieldType"
   [ ("QFTUnknown",   'C.qftUnknown )