Revision 683b1ca7 Ganeti/Luxi.hs

b/Ganeti/Luxi.hs
45 45 
import Ganeti.HTools.Types
46 46 

  		





  47
  47
  
    
import Ganeti.Jobs (JobStatus)


  		





  
  48
  
    
import Ganeti.OpCodes (OpCode)


  		





  48
  49
  
    

  		





  49
  50
  
    
-- * Utility functions


  		





  50
  51
  
    

  		





  ......




  59
  60
  
    
-- * Generic protocol functionality


  		





  60
  61
  
    

  		





  61
  62
  
    
-- | Currently supported Luxi operations.


  		





  62
  
  
    
data LuxiOp = QueryInstances


  		





  63
  
  
    
            | QueryNodes


  		





  64
  
  
    
            | QueryJobs


  		





  
  63
  
    
data LuxiOp = QueryInstances [String] [String] Bool


  		





  
  64
  
    
            | QueryNodes [String] [String] Bool


  		





  
  65
  
    
            | QueryJobs [Int] [String]


  		





  65
  66
  
    
            | QueryClusterInfo


  		





  66
  
  
    
            | SubmitManyJobs


  		





  
  67
  
    
            | SubmitManyJobs [[OpCode]]


  		





  67
  68
  
    

  		





  68
  69
  
    
-- | The serialisation of LuxiOps into strings in messages.


  		





  69
  70
  
    
strOfOp :: LuxiOp -> String


  		





  70
  
  
    
strOfOp QueryNodes = "QueryNodes"


  		





  71
  
  
    
strOfOp QueryInstances = "QueryInstances"


  		





  72
  
  
    
strOfOp QueryJobs = "QueryJobs"


  		





  73
  
  
    
strOfOp QueryClusterInfo = "QueryClusterInfo"


  		





  74
  
  
    
strOfOp SubmitManyJobs = "SubmitManyJobs"


  		





  
  71
  
    
strOfOp QueryNodes {}       = "QueryNodes"


  		





  
  72
  
    
strOfOp QueryInstances {}   = "QueryInstances"


  		





  
  73
  
    
strOfOp QueryJobs {}        = "QueryJobs"


  		





  
  74
  
    
strOfOp QueryClusterInfo {} = "QueryClusterInfo"


  		





  
  75
  
    
strOfOp SubmitManyJobs {}   = "SubmitManyJobs"


  		





  75
  76
  
    

  		





  76
  77
  
    
-- | The end-of-message separator.


  		





  77
  78
  
    
eOM :: Char


  		





  ......




  133
  134
  
    
  writeIORef (rbuf s) nbuf


  		





  134
  135
  
    
  return msg


  		





  135
  136
  
    

  		





  
  137
  
    
-- | Compute the serialized form of a Luxi operation


  		





  
  138
  
    
opToArgs :: LuxiOp -> JSValue


  		





  
  139
  
    
opToArgs (QueryInstances names fields lock) = J.showJSON (names, fields, lock)


  		





  
  140
  
    
opToArgs (QueryNodes names fields lock) = J.showJSON (names, fields, lock)


  		





  
  141
  
    
opToArgs (QueryJobs ids fields) = J.showJSON (map show ids, fields)


  		





  
  142
  
    
opToArgs (QueryClusterInfo) = J.showJSON ()


  		





  
  143
  
    
opToArgs (SubmitManyJobs ops) = J.showJSON ops


  		





  
  144
  
    

  		





  136
  145
  
    
-- | Serialize a request to String.


  		





  137
  146
  
    
buildCall :: LuxiOp  -- ^ The method


  		





  138
  
  
    
          -> JSValue -- ^ The arguments


  		





  139
  147
  
    
          -> String  -- ^ The serialized form


  		





  140
  
  
    
buildCall msg args =


  		





  141
  
  
    
    let ja = [(strOfKey Method,


  		





  142
  
  
    
               JSString $ toJSString $ strOfOp msg::JSValue),


  		





  143
  
  
    
              (strOfKey Args,


  		





  144
  
  
    
               args::JSValue)


  		





  
  148
  
    
buildCall lo =


  		





  
  149
  
    
    let ja = [ (strOfKey Method, JSString $ toJSString $ strOfOp lo::JSValue)


  		





  
  150
  
    
             , (strOfKey Args, opToArgs lo::JSValue)


  		





  145
  151
  
    
             ]


  		





  146
  152
  
    
        jo = toJSObject ja


  		





  147
  153
  
    
    in encodeStrict jo


  		





  ......




  160
  166
  
    
   else fromObj rkey arr >>= fail)


  		





  161
  167
  
    

  		





  162
  168
  
    
-- | Generic luxi method call.


  		





  163
  
  
    
callMethod :: LuxiOp -> JSValue -> Client -> IO (Result JSValue)


  		





  164
  
  
    
callMethod method args s = do


  		





  165
  
  
    
  sendMsg s $ buildCall method args


  		





  
  169
  
    
callMethod :: LuxiOp -> Client -> IO (Result JSValue)


  		





  
  170
  
    
callMethod method s = do


  		





  
  171
  
    
  sendMsg s $ buildCall method


  		





  166
  172
  
    
  result <- recvMsg s


  		





  167
  173
  
    
  let rval = validateResult result


  		





  168
  174
  
    
  return rval


  		





  169
  175
  
    

  		





  170
  176
  
    
-- | Specialized submitManyJobs call.


  		





  171
  
  
    
submitManyJobs :: Client -> JSValue -> IO (Result [String])


  		





  
  177
  
    
submitManyJobs :: Client -> [[OpCode]] -> IO (Result [String])


  		





  172
  178
  
    
submitManyJobs s jobs = do


  		





  173
  
  
    
  rval <- callMethod SubmitManyJobs jobs s


  		





  
  179
  
    
  rval <- callMethod (SubmitManyJobs jobs) s


  		





  174
  180
  
    
  -- map each result (status, payload) pair into a nice Result ADT


  		





  175
  181
  
    
  return $ case rval of


  		





  176
  182
  
    
             Bad x -> Bad x


  		





  ......




  187
  193
  
    
-- | Custom queryJobs call.


  		





  188
  194
  
    
queryJobsStatus :: Client -> [String] -> IO (Result [JobStatus])


  		





  189
  195
  
    
queryJobsStatus s jids = do


  		





  190
  
  
    
  rval <- callMethod QueryJobs (J.showJSON (jids, ["status"])) s


  		





  
  196
  
    
  rval <- callMethod (QueryJobs (map read jids) ["status"]) s


  		





  191
  197
  
    
  return $ case rval of


  		





  192
  198
  
    
             Bad x -> Bad x


  		





  193
  199
  
    
             Ok y -> case J.readJSON y::(J.Result [[JobStatus]]) of


  		












Also available in:
  Unified diff