@@ -1,10 +1,13 @@
11{-# LANGUAGE Arrows #-}
22module Network.Azure.ServiceManagement
3− ( -- * Setup
4− AzureSetup(..)
3+ ( -- * Data types
4+ HostedService
5+ -- * Setup
6+ , AzureSetup(..)
57 , azureSetup
68 -- * High-level API
79 , hostedServices
10+ , hostedServiceProperties
811 -- * Low-level API
912 , azureRequest
1013 , azureRawRequest
@@ -12,6 +15,7 @@ module Network.Azure.ServiceManagement
1215
1316import Prelude hiding (id)
1417import Control.Category (id, (>>>))
18+import Control.Arrow (arr)
1519import Data.ByteString.Lazy (ByteString)
1620import Data.ByteString.Char8 as BSC (pack)
1721import Data.ByteString.Lazy.Char8 as BSLC (unpack)
@@ -34,13 +38,25 @@ import Text.XML.HXT.Core
3438 , no
3539 , XmlTree
3640 , IOSArrow
37− , XNode
3841 , ArrowXml
3942 , deep
4043 , hasName
4144 , getText
45+ -- FOR DEBUGGING ONLY
46+ , writeDocument
47+ , withIndent
48+ , yes
4249 )
4350
51+--------------------------------------------------------------------------------
52+-- Data types --
53+--------------------------------------------------------------------------------
54+
55+newtype HostedService = HostedService { unHostedService :: String }
56+
57+instance Show HostedService where
58+ show = unHostedService
59+
4460--------------------------------------------------------------------------------
4561-- Setup --
4662--------------------------------------------------------------------------------
@@ -72,13 +88,25 @@ azureSetup sid certPath pkeyPath = do
7288-- High-level API --
7389--------------------------------------------------------------------------------
7490
75−hostedServices :: AzureSetup -> IO [(String, String)]
91+-- | Get list of available hosted services
92+hostedServices :: AzureSetup -> IO [HostedService]
7693hostedServices 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)
94+ azureRequest setup subURL "2012-03-01" $ proc xml -> do
95+ writeDocument [withIndent yes] "hostedservices.xml" -< xml
96+ hostedService <- deep (hasName "HostedService") -< xml
97+ name <- getTextNode "ServiceName" -< hostedService
98+ arr HostedService -< name
99+ where
100+ subURL = "/services/hostedservices"
101+
102+-- | Get properties of the given hosted service
103+hostedServiceProperties :: AzureSetup -> HostedService -> IO [()]
104+hostedServiceProperties setup (HostedService service) = do
105+ azureRequest setup subURL "2012-03-01" $ proc xml -> do
106+ writeDocument [withIndent yes] "properties.xml" -< xml
107+ id -< ()
108+ where
109+ subURL = "/services/hostedservices/" ++ service ++ "?embed-detail=true"
82110
83111--------------------------------------------------------------------------------
84112-- Low-level API --