git.iko.soy/distributed-process
on master help sign in
Better naming
a81f853Edsko de Vries
azure-service-api/src/Network/Azure/ServiceManagement.hs+20−22
@@ -2,17 +2,17 @@
2module Network.Azure.ServiceManagement
2module Network.Azure.ServiceManagement
3 ( -- * Data types
3 ( -- * Data types
4 HostedService(..)
4 HostedService(..)
5− , Role(..)
5+ , CloudService(..)
6− , Endpoint(..)
7 , VirtualMachine(..)
6 , VirtualMachine(..)
7+ , Endpoint(..)
8 -- * Pure functions
8 -- * Pure functions
9− , vmSshEndpoints
9+ , cloudServiceSshEndpoints
10 -- * Setup
10 -- * Setup
11 , AzureSetup(..)
11 , AzureSetup(..)
12 , azureSetup
12 , azureSetup
13 -- * High-level API
13 -- * High-level API
14 , hostedServices
14 , hostedServices
15− , virtualMachines
15+ , cloudServices
16 ) where
16 ) where
17
17
18import Prelude hiding (id, (.))
18import Prelude hiding (id, (.))
@@ -56,13 +56,17 @@ import Text.XML.HXT.XPath (getXPathTrees)
56data HostedService = HostedService {
56data HostedService = HostedService {
57 hostedServiceName :: String
57 hostedServiceName :: String
58 }
58 }
59+ deriving Show
59
60
60−instance Show HostedService where
61+data CloudService = CloudService {
61− show = hostedServiceName
62+ cloudServiceName :: String
63+ , cloudServiceVMs :: [VirtualMachine]
64+ }
65+ deriving Show
62
66
63−data Role = Role {
67+data VirtualMachine = VirtualMachine {
64− roleName :: String
68+ vmName :: String
65− , roleInputEndpoints :: [Endpoint]
69+ , vmInputEndpoints :: [Endpoint]
66 }
70 }
67 deriving Show
71 deriving Show
68
72
@@ -73,20 +77,14 @@ data Endpoint = Endpoint {
73 }
77 }
74 deriving Show
78 deriving Show
75
79
76−data VirtualMachine = VirtualMachine {
77− vmService :: HostedService
78− , vmRoles :: [Role]
79− }
80− deriving Show
81−
82--------------------------------------------------------------------------------
80--------------------------------------------------------------------------------
83-- Pure operations --
81-- Pure operations --
84--------------------------------------------------------------------------------
82--------------------------------------------------------------------------------
85
83
86−vmSshEndpoints :: VirtualMachine -> [Endpoint]
84+cloudServiceSshEndpoints :: CloudService -> [Endpoint]
87−vmSshEndpoints vm =
85+cloudServiceSshEndpoints cs =
88 [ ep
86 [ ep
89− | ep <- concatMap roleInputEndpoints (vmRoles vm)
87+ | ep <- concatMap vmInputEndpoints (cloudServiceVMs cs)
90 , endpointName ep == "SSH"
88 , endpointName ep == "SSH"
91 ]
89 ]
92
90
@@ -122,8 +120,8 @@ azureSetup sid certPath pkeyPath = do
122--------------------------------------------------------------------------------
120--------------------------------------------------------------------------------
123
121
124-- | Get a list of virtual machines
122-- | Get a list of virtual machines
125−virtualMachines :: AzureSetup -> IO [VirtualMachine]
123+cloudServices :: AzureSetup -> IO [CloudService]
126−virtualMachines setup = azureExecute setup $ \exec -> do
124+cloudServices setup = azureExecute setup $ \exec -> do
127 services <- exec hostedServicesRequest
125 services <- exec hostedServicesRequest
128 forM services $ \service -> do
126 forM services $ \service -> do
129 roles <- exec AzureRequest {
127 roles <- exec AzureRequest {
@@ -134,9 +132,9 @@ virtualMachines setup = azureExecute setup $ \exec -> do
134 role <- getXPathTrees "//Role[@type='PersistentVMRole']" -< xml
132 role <- getXPathTrees "//Role[@type='PersistentVMRole']" -< xml
135 name <- getText . getXPathTrees "/Role/RoleName/text()" -< role
133 name <- getText . getXPathTrees "/Role/RoleName/text()" -< role
136 endpoints <- listA (parseEndpoint . getXPathTrees "//InputEndpoint") -< role
134 endpoints <- listA (parseEndpoint . getXPathTrees "//InputEndpoint") -< role
137− id -< Role name endpoints
135+ id -< VirtualMachine name endpoints
138 }
136 }
139− return $ VirtualMachine service roles
137+ return $ CloudService (hostedServiceName service) roles
140
138
141-- | Get list of available hosted services
139-- | Get list of available hosted services
142hostedServices :: AzureSetup -> IO [HostedService]
140hostedServices :: AzureSetup -> IO [HostedService]
distributed-process-azure/distributed-process-azure.cabal+2−1
@@ -21,7 +21,8 @@ Source-Repository head
21Library
21Library
22 Build-Depends: base >= 4.4 && < 5,
22 Build-Depends: base >= 4.4 && < 5,
23 azure-service-api >= 0.1 && < 0.2,
23 azure-service-api >= 0.1 && < 0.2,
24− filepath >= 1.3 && < 1.4
24+ filepath >= 1.3 && < 1.4,
25+ executable-path >= 0.0.3 && < 0.1
25 Exposed-modules: Control.Distributed.Process.Backend.Azure
26 Exposed-modules: Control.Distributed.Process.Backend.Azure
26 ghc-options: -Wall
27 ghc-options: -Wall
27 HS-Source-Dirs: src
28 HS-Source-Dirs: src
distributed-process-azure/src/Control/Distributed/Process/Backend/Azure.hs+16−11
@@ -5,20 +5,24 @@ module Control.Distributed.Process.Backend.Azure
5 , defaultAzureParameters
5 , defaultAzureParameters
6 , initializeBackend
6 , initializeBackend
7 -- * Re-exports from Azure Service Management
7 -- * Re-exports from Azure Service Management
8− , VirtualMachine(..)
8+ , CloudService(..)
9 ) where
9 ) where
10
10
11import System.Environment (getEnv)
11import System.Environment (getEnv)
12import System.FilePath ((</>))
12import System.FilePath ((</>))
13+import System.Environment.Executable (getExecutablePath)
13import Network.Azure.ServiceManagement
14import Network.Azure.ServiceManagement
14− ( VirtualMachine
15+ ( CloudService )
15− , virtualMachines
16+import qualified Network.Azure.ServiceManagement as Azure
17+ ( cloudServices
18+ , AzureSetup
16 , azureSetup
19 , azureSetup
17− )
20+ )
18
21
19-- | Azure backend
22-- | Azure backend
20data Backend = Backend {
23data Backend = Backend {
21− findVMs :: IO [VirtualMachine]
24+ -- | Find virtual machines
25+ cloudServices :: IO [CloudService]
22 }
26 }
23
27
24data AzureParameters = AzureParameters {
28data AzureParameters = AzureParameters {
@@ -31,7 +35,7 @@ data AzureParameters = AzureParameters {
31 }
35 }
32
36
33-- | Create default azure parameters
37-- | Create default azure parameters
34−defaultAzureParameters :: String -- ^ Azure subscription ID
38+defaultAzureParameters :: String -- ^ Azure subscription ID
35 -> FilePath -- ^ Path to X509 certificate
39 -> FilePath -- ^ Path to X509 certificate
36 -> FilePath -- ^ Path to private key
40 -> FilePath -- ^ Path to private key
37 -> IO AzureParameters
41 -> IO AzureParameters
@@ -49,10 +53,11 @@ defaultAzureParameters sid x509 pkey = do
49-- | Initialize the backend
53-- | Initialize the backend
50initializeBackend :: AzureParameters -> IO Backend
54initializeBackend :: AzureParameters -> IO Backend
51initializeBackend params = do
55initializeBackend params = do
52− setup <- azureSetup (azureSubscriptionId params)
56+ setup <- Azure.azureSetup (azureSubscriptionId params)
53− (azureAuthCertificate params)
57+ (azureAuthCertificate params)
54− (azureAuthPrivateKey params)
58+ (azureAuthPrivateKey params)
59+ exe <- getExecutablePath
60+ print exe
55 return Backend {
61 return Backend {
56− findVMs = virtualMachines setup
62+ cloudServices = Azure.cloudServices setup
57 }
63 }
58−
distributed-process-azure/src/Control/Distributed/Process/Backend/Azure/CommandLine.hs+3−3
@@ -4,7 +4,7 @@ import System.Posix.Types (Fd)
4import Control.Distributed.Process.Backend.Azure
4import Control.Distributed.Process.Backend.Azure
5 ( defaultAzureParameters
5 ( defaultAzureParameters
6 , initializeBackend
6 , initializeBackend
7− , findVMs
7+ , cloudServices
8 )
8 )
9
9
10-- SSH
10-- SSH
@@ -65,5 +65,5 @@ tryConnectToAzure :: String -> String -> String -> IO ()
65tryConnectToAzure sid pathToCert pathToKey = do
65tryConnectToAzure sid pathToCert pathToKey = do
66 params <- defaultAzureParameters sid pathToCert pathToKey
66 params <- defaultAzureParameters sid pathToCert pathToKey
67 backend <- initializeBackend params
67 backend <- initializeBackend params
68− vms <- findVMs backend
68+ css <- cloudServices backend
69− mapM_ print vms
69+ mapM_ print css