git.iko.soy/distributed-process
on master help sign in
Parse hosted services XML
65b475eEdsko de Vries
azure-service-api/azure-service-api.cabal+3−1
compare with master
unifiedsplit
@@ -23,7 +23,8 @@ Library
23 tls-extra >= 0.5 && < 0.6,
23 tls-extra >= 0.5 && < 0.6,
24 bytestring >= 0.9 && < 1.0,
24 bytestring >= 0.9 && < 1.0,
25 certificate >= 1.2 && < 1.3,
25 certificate >= 1.2 && < 1.3,
26− case-insensitive >= 0.4 && < 0.5
26+ case-insensitive >= 0.4 && < 0.5,
27+ hxt >= 9.2 && < 9.3
27 HS-Source-Dirs: src
28 HS-Source-Dirs: src
28 ghc-options: -Wall
29 ghc-options: -Wall
29
30
@@ -39,6 +40,7 @@ Executable hs-azure-service-api
39 utf8-string >= 0.3 && < 0.4,
40 utf8-string >= 0.3 && < 0.4,
40 filepath >= 1.3 && < 1.4,
41 filepath >= 1.3 && < 1.4,
41 azure-service-api >= 0.1 && < 0.2,
42 azure-service-api >= 0.1 && < 0.2,
43+ hxt,
42 libssh2
44 libssh2
43 Extensions: ScopedTypeVariables
45 Extensions: ScopedTypeVariables
44 ghc-options: -Wall -rtsopts
46 ghc-options: -Wall -rtsopts
azure-service-api/src/Network/Azure/ServiceManagement.hs+93−15
@@ -1,13 +1,20 @@
1+{-# LANGUAGE Arrows #-}
1module Network.Azure.ServiceManagement
2module Network.Azure.ServiceManagement
2− ( -- * Submitting requests
3+ ( -- * Setup
4+ AzureSetup(..)
5+ , azureSetup
6+ -- * High-level API
7+ , hostedServices
8+ -- * Low-level API
3− azureRequest
9+ , azureRequest
4− -- * Re-export functionality from TLS
10+ , azureRawRequest
5− , fileReadCertificate
6− , fileReadPrivateKey
7 ) where
11 ) where
8
12
13+import Prelude hiding (id)
14+import Control.Category (id, (>>>))
9import Data.ByteString.Lazy (ByteString)
15import Data.ByteString.Lazy (ByteString)
10import Data.ByteString.Char8 as BSC (pack)
16import Data.ByteString.Char8 as BSC (pack)
17+import Data.ByteString.Lazy.Char8 as BSLC (unpack)
11import Network.TLS (PrivateKey)
18import Network.TLS (PrivateKey)
12import Network.TLS.Extra (fileReadCertificate, fileReadPrivateKey)
19import Network.TLS.Extra (fileReadCertificate, fileReadPrivateKey)
13import Data.Certificate.X509 (X509)
20import Data.Certificate.X509 (X509)
@@ -20,22 +27,93 @@ import Network.HTTP.Conduit
20 , httpLbs
27 , httpLbs
21 )
28 )
22import Data.CaseInsensitive as CI (mk)
29import Data.CaseInsensitive as CI (mk)
30+import Text.XML.HXT.Core
31+ ( runX
32+ , readString
33+ , withValidate
34+ , no
35+ , XmlTree
36+ , IOSArrow
37+ , XNode
38+ , ArrowXml
39+ , deep
40+ , hasName
41+ , getText
42+ )
43+
44+--------------------------------------------------------------------------------
45+-- Setup --
46+--------------------------------------------------------------------------------
47+
48+-- | Azure setup
49+data AzureSetup = AzureSetup
50+ { subscriptionId :: String
51+ , certificate :: X509
52+ , privateKey :: PrivateKey
53+ , baseURL :: String
54+ }
55+
56+-- | Initialize Azure
57+azureSetup :: String -- ^ Subscription ID
58+ -> String -- ^ Path to certificate
59+ -> String -- ^ Path to private key
60+ -> IO AzureSetup
61+azureSetup sid certPath pkeyPath = do
62+ cert <- fileReadCertificate certPath
63+ pkey <- fileReadPrivateKey pkeyPath
64+ return AzureSetup {
65+ subscriptionId = sid
66+ , certificate = cert
67+ , privateKey = pkey
68+ , baseURL = "https://management.core.windows.net"
69+ }
70+
71+--------------------------------------------------------------------------------
72+-- High-level API --
73+--------------------------------------------------------------------------------
23
74
75+hostedServices :: AzureSetup -> IO [(String, String)]
76+hostedServices setup =
77+ azureRequest setup "/services/hostedservices" "2012-03-01" $ proc xml -> do
78+ hostedService <- deep (hasName "HostedService") -< xml
79+ url <- getTextNode "Url" -< hostedService
80+ serviceName <- getTextNode "ServiceName" -< hostedService
81+ id -< (url, serviceName)
82+
83+--------------------------------------------------------------------------------
84+-- Low-level API --
85+--------------------------------------------------------------------------------
86+
24−-- ^ Execute an Azure request
87+-- | Execute an Azure request and parse the XML data
25−azureRequest :: String -- ^ Subscription ID
88+azureRequest :: AzureSetup
26− -> X509 -- ^ X509 certificate
89+ -> String
27− -> PrivateKey -- ^ Private key
90+ -> String
91+ -> IOSArrow XmlTree c
92+ -> IO [c]
93+azureRequest setup subURL version f = do
94+ raw <- azureRawRequest setup subURL version
95+ runX $ readString [withValidate no] (BSLC.unpack raw) >>> f
96+
97+-- | Execute an Azure request and return the raw data
98+azureRawRequest :: AzureSetup
28− -> String -- ^ Relative path
99+ -> String -- ^ Relative path
29− -> String -- ^ Version
100+ -> String -- ^ Version
30− -> IO ByteString
101+ -> IO ByteString
31−azureRequest sid cert pkey subURL version = do
102+azureRawRequest setup subURL version = do
32− req <- parseUrl $ "https://management.core.windows.net/" ++ sid++ subURL
103+ req <- parseUrl $ baseURL setup ++ "/" ++ subscriptionId setup ++ "/" ++ subURL
33 withManager $ \manager -> do
104 withManager $ \manager -> do
34 let req' = req {
105 let req' = req {
35− clientCertificates = [ (cert, Just pkey) ]
106+ clientCertificates = [ (certificate setup, Just $ privateKey setup) ]
36 , requestHeaders = [ (CI.mk $ BSC.pack "x-ms-version", BSC.pack version)
107 , requestHeaders = [ (CI.mk $ BSC.pack "x-ms-version", BSC.pack version)
37 , (CI.mk $ BSC.pack "content-type", BSC.pack "application/xml")
108 , (CI.mk $ BSC.pack "content-type", BSC.pack "application/xml")
38 ]
109 ]
39 }
110 }
40 Response _ _ _ lbs <- httpLbs req' manager
111 Response _ _ _ lbs <- httpLbs req' manager
41 return lbs
112 return lbs
113+
114+--------------------------------------------------------------------------------
115+-- XML convenience functions --
116+--------------------------------------------------------------------------------
117+
118+getTextNode :: ArrowXml a => String -> a XmlTree String
119+getTextNode node = deep (hasName node) >>> deep getText
azure-service-api/src/Network/Azure/ServiceManagement/CommandLine.hs+6−9
@@ -1,15 +1,12 @@
1-- Base
1-- Base
2−import Prelude hiding (catch)
3import System.Environment (getArgs, getEnv)
2import System.Environment (getArgs, getEnv)
4import System.FilePath ((</>))
3import System.FilePath ((</>))
5import System.Posix.Types (Fd)
4import System.Posix.Types (Fd)
6−import qualified Data.ByteString.Lazy.Char8 as BSLC (putStrLn)
7
5
8-- SSL
6-- SSL
9import Network.Azure.ServiceManagement
7import Network.Azure.ServiceManagement
10− ( azureRequest
8+ ( azureSetup
11− , fileReadCertificate
9+ , hostedServices
12− , fileReadPrivateKey
13 )
10 )
14
11
15-- SSH
12-- SSH
@@ -68,7 +65,7 @@ ssh login host port actions = do
68
65
69tryConnectToAzure :: String -> String -> String -> IO ()
66tryConnectToAzure :: String -> String -> String -> IO ()
70tryConnectToAzure sid pathToCert pathToKey = do
67tryConnectToAzure sid pathToCert pathToKey = do
71− cert <- fileReadCertificate pathToCert
68+ setup <- azureSetup sid pathToCert pathToKey
72− key <- fileReadPrivateKey pathToKey
69+ services <- hostedServices setup
73− outp <- azureRequest sid cert key "/services/hostedservices" "2012-03-01"
70+ mapM_ print services
74− BSLC.putStrLn outp
71+