git.iko.soy/distributed-process
on master help sign in
Minor feature enhancements
19c8e72ghc742
azure-service-api/src/Network/Azure/ServiceManagement.hs+26−7
compare with master
unifiedsplit
@@ -4,6 +4,9 @@ module Network.Azure.ServiceManagement
4 HostedService(..)
4 HostedService(..)
5 , Role(..)
5 , Role(..)
6 , Endpoint(..)
6 , Endpoint(..)
7+ , VirtualMachine(..)
8+ -- * Pure functions
9+ , vmSshEndpoints
7 -- * Setup
10 -- * Setup
8 , AzureSetup(..)
11 , AzureSetup(..)
9 , azureSetup
12 , azureSetup
@@ -58,11 +61,10 @@ instance Show HostedService where
58 show = hostedServiceName
61 show = hostedServiceName
59
62
60data Role = Role {
63data Role = Role {
61− roleName :: String
64+ roleName :: String
65+ , roleInputEndpoints :: [Endpoint]
62 }
66 }
63−
67+ deriving Show
64−instance Show Role where
65− show = roleName
66
68
67data Endpoint = Endpoint {
69data Endpoint = Endpoint {
68 endpointName :: String
70 endpointName :: String
@@ -71,6 +73,23 @@ data Endpoint = Endpoint {
71 }
73 }
72 deriving Show
74 deriving Show
73
75
76+data VirtualMachine = VirtualMachine {
77+ vmService :: HostedService
78+ , vmRoles :: [Role]
79+ }
80+ deriving Show
81+
82+--------------------------------------------------------------------------------
83+-- Pure operations --
84+--------------------------------------------------------------------------------
85+
86+vmSshEndpoints :: VirtualMachine -> [Endpoint]
87+vmSshEndpoints vm =
88+ [ ep
89+ | ep <- concatMap roleInputEndpoints (vmRoles vm)
90+ , endpointName ep == "SSH"
91+ ]
92+
74--------------------------------------------------------------------------------
93--------------------------------------------------------------------------------
75-- Setup --
94-- Setup --
76--------------------------------------------------------------------------------
95--------------------------------------------------------------------------------
@@ -103,7 +122,7 @@ azureSetup sid certPath pkeyPath = do
103--------------------------------------------------------------------------------
122--------------------------------------------------------------------------------
104
123
105-- | Get a list of virtual machines
124-- | Get a list of virtual machines
106−virtualMachines :: AzureSetup -> IO [(HostedService, [(Role, [Endpoint])])]
125+virtualMachines :: AzureSetup -> IO [VirtualMachine]
107virtualMachines setup = azureExecute setup $ \exec -> do
126virtualMachines setup = azureExecute setup $ \exec -> do
108 services <- exec hostedServicesRequest
127 services <- exec hostedServicesRequest
109 forM services $ \service -> do
128 forM services $ \service -> do
@@ -115,9 +134,9 @@ virtualMachines setup = azureExecute setup $ \exec -> do
115 role <- getXPathTrees "//Role[@type='PersistentVMRole']" -< xml
134 role <- getXPathTrees "//Role[@type='PersistentVMRole']" -< xml
116 name <- getText . getXPathTrees "/Role/RoleName/text()" -< role
135 name <- getText . getXPathTrees "/Role/RoleName/text()" -< role
117 endpoints <- listA (parseEndpoint . getXPathTrees "//InputEndpoint") -< role
136 endpoints <- listA (parseEndpoint . getXPathTrees "//InputEndpoint") -< role
118− id -< (Role name, endpoints)
137+ id -< Role name endpoints
119 }
138 }
120− return (service, roles)
139+ return $ VirtualMachine service roles
121
140
122-- | Get list of available hosted services
141-- | Get list of available hosted services
123hostedServices :: AzureSetup -> IO [HostedService]
142hostedServices :: AzureSetup -> IO [HostedService]
azure-service-api/src/Network/Azure/ServiceManagement/CommandLine.hs+2−1
@@ -7,6 +7,7 @@ import System.Posix.Types (Fd)
7import Network.Azure.ServiceManagement
7import Network.Azure.ServiceManagement
8 ( azureSetup
8 ( azureSetup
9 , virtualMachines
9 , virtualMachines
10+ , vmSshEndpoints
10 )
11 )
11
12
12-- SSH
13-- SSH
@@ -67,4 +68,4 @@ tryConnectToAzure :: String -> String -> String -> IO ()
67tryConnectToAzure sid pathToCert pathToKey = do
68tryConnectToAzure sid pathToCert pathToKey = do
68 setup <- azureSetup sid pathToCert pathToKey
69 setup <- azureSetup sid pathToCert pathToKey
69 vms <- virtualMachines setup
70 vms <- virtualMachines setup
70− mapM_ print vms
71+ mapM_ print (map vmSshEndpoints vms)