Revision ba00ad4d Ganeti/HTools/Rapi.hs

b/Ganeti/HTools/Rapi.hs
18 18 
import Text.Printf (printf)
19 19 
import Ganeti.HTools.Utils
20 20 

  		





  21
  
  
    

  		





  22
  
  
    
-- Some constants


  		





  23
  
  
    

  		





  24
  
  
    
-- | The fixed drbd overhead per disk (only used with 1.2's sdx_size)


  		





  25
  
  
    
drbdOverhead = 128


  		





  26
  
  
    

  		





  27
  
  
    
getUrl :: String -> IO (Result String)


  		





  
  21
  
    
-- | Read an URL via curl and return the body if successful


  		





  
  22
  
    
getUrl :: (Monad m) => String -> IO (m String)


  		





  28
  23
  
    
getUrl url = do


  		





  29
  24
  
    
  (code, body) <- curlGetString url [CurlSSLVerifyPeer False,


  		





  30
  25
  
    
                                     CurlSSLVerifyHost 0]


  		





  31
  26
  
    
  return (case code of


  		





  32
  
  
    
            CurlOK -> Ok body


  		





  33
  
  
    
            _ -> Bad $ printf "Curl error for '%s', error %s"


  		





  
  27
  
    
            CurlOK -> return body


  		





  
  28
  
    
            _ -> fail $ printf "Curl error for '%s', error %s"


  		





  34
  29
  
    
                 url (show code))


  		





  35
  30
  
    

  		





  36
  31
  
    
getInstances :: String -> IO (Result String)


  		





  ......




  54
  49
  
    
parseInstance :: JSObject JSValue -> Result String


  		





  55
  50
  
    
parseInstance a =


  		





  56
  51
  
    
    let name = getStringElement "name" a


  		





  57
  
  
    
        disk = case getIntElement "disk_usage" a of


  		





  58
  
  
    
                 Bad _ -> let log_sz = liftM2 (+)


  		





  59
  
  
    
                                       (getIntElement "sda_size" a)


  		





  60
  
  
    
                                       (getIntElement "sdb_size" a)


  		





  61
  
  
    
                          in liftM2 (+) log_sz (Ok $ drbdOverhead * 2)


  		





  62
  
  
    
                 x@(Ok _) -> x


  		





  63
  
  
    
        bep = fromObj "beparams" a


  		





  
  52
  
    
        disk = getIntElement "disk_usage" a


  		





  
  53
  
    
        mem = getObjectElement "beparams" a >>= getIntElement "memory"


  		





  64
  54
  
    
        pnode = getStringElement "pnode" a


  		





  65
  
  
    
        snode = (liftM head $ getListElement "snodes" a)


  		





  66
  
  
    
                >>= readEitherString


  		





  67
  
  
    
        mem = case bep of


  		





  68
  
  
    
                Bad _ -> getIntElement "admin_ram" a


  		





  69
  
  
    
                Ok o -> getIntElement "memory" o


  		





  
  55
  
    
        snode = (liftM head $ getListElement "snodes" a) >>= readEitherString


  		





  70
  56
  
    
        running = getStringElement "status" a


  		





  71
  57
  
    
    in


  		





  72
  58
  
    
      name |+ (show `liftM` mem) |+


  		












Also available in:
  Unified diff