git.iko.soy/distributed-process
on master help sign in
Update to use patched http-conduit
b988676Edsko de Vries
azure-service-api/azure-service-api.cabal+16−12
compare with master
unifiedsplit
@@ -18,23 +18,27 @@ Cabal-Version: >=1.8
18Library
18Library
19 Exposed-Modules: Network.Azure.ServiceManagement
19 Exposed-Modules: Network.Azure.ServiceManagement
20 Build-Depends: base ==4.5.*,
20 Build-Depends: base ==4.5.*,
21+ http-conduit >= 1.5.1 && < 1.6,
21− tls >= 1.0,
22+ tls >= 1.0 && < 1.1,
22− tls-extra
23+ tls-extra >= 0.5 && < 0.6,
24+ bytestring >= 0.9 && < 1.0,
25+ certificate >= 1.2 && < 1.3,
26+ case-insensitive >= 0.4 && < 0.5
23 HS-Source-Dirs: src
27 HS-Source-Dirs: src
24 ghc-options: -Wall
28 ghc-options: -Wall
25
29
26Executable hs-azure-service-api
30Executable hs-azure-service-api
27 Main-Is: src/Network/Azure/ServiceManagement/CommandLine.hs
31 Main-Is: src/Network/Azure/ServiceManagement/CommandLine.hs
28 Build-Depends: base ==4.5.*,
32 Build-Depends: base ==4.5.*,
33+ http-conduit >= 1.5.1 && < 1.6,
29− tls >= 1.0,
34+ tls >= 1.0 && < 1.1,
30− tls-extra,
35+ tls-extra >= 0.5 && < 0.6,
36+ bytestring >= 0.9 && < 1.0,
37+ certificate >= 1.2 && < 1.3,
38+ case-insensitive >= 0.4 && < 0.5,
39+ utf8-string >= 0.3 && < 0.4,
40+ filepath >= 1.3 && < 1.4,
31− azure-service-api,
41+ azure-service-api >= 0.1 && < 0.2,
32− cprng-aes,
33− network,
34− certificate,
35− bytestring,
36− filepath,
37− libssh2,
42+ libssh2
38− utf8-string
39 Extensions: ScopedTypeVariables
43 Extensions: ScopedTypeVariables
40 ghc-options: -Wall -rtsopts
44 ghc-options: -Wall -rtsopts
azure-service-api/src/Network/Azure/ServiceManagement.hs+36−2
@@ -1,8 +1,42 @@
1module Network.Azure.ServiceManagement
1module Network.Azure.ServiceManagement
2 (
2 (
3+ -- * Submitting requests
4+ SubscriptionId(SubscriptionId)
5+ , azureRequest
3 -- * Re-export functionality from TLS
6 -- * Re-export functionality from TLS
4− fileReadCertificate
7+ , fileReadCertificate
5 , fileReadPrivateKey
8 , fileReadPrivateKey
6 ) where
9 ) where
7
10
8−import Network.TLS.Extra
11+import Data.ByteString.Lazy (ByteString)
12+import Data.ByteString.Char8 as BSC (pack)
13+import Network.TLS (PrivateKey)
14+import Network.TLS.Extra (fileReadCertificate, fileReadPrivateKey)
15+import Data.Certificate.X509 (X509)
16+import Network.HTTP.Conduit
17+ ( parseUrl
18+ , clientCertificates
19+ , requestHeaders
20+ , withManager
21+ , Response(Response)
22+ , httpLbs
23+ )
24+import Data.CaseInsensitive as CI (mk)
25+
26+newtype SubscriptionId = SubscriptionId { unSubscriptionId :: String }
27+
28+azureRequest :: SubscriptionId -> X509 -> PrivateKey -> String -> IO ByteString
29+azureRequest sid cert pkey subURL = do
30+ req <- parseUrl ( "https://management.core.windows.net/"
31+ ++ unSubscriptionId sid
32+ ++ subURL
33+ )
34+ withManager $ \manager -> do
35+ let req' = req {
36+ clientCertificates = [ (cert, Just pkey) ]
37+ , requestHeaders = [ (CI.mk $ BSC.pack "x-ms-version", BSC.pack "2010-10-28")
38+ , (CI.mk $ BSC.pack "content-type", BSC.pack "application/xml")
39+ ]
40+ }
41+ Response _ _ _ lbs <- httpLbs req' manager
42+ return lbs
azure-service-api/src/Network/Azure/ServiceManagement/CommandLine.hs+8−116
@@ -1,65 +1,17 @@
1-- Base
1-- Base
2import Prelude hiding (catch)
2import Prelude hiding (catch)
3import System.Environment (getArgs, getEnv)
3import System.Environment (getArgs, getEnv)
4−import System.IO (IOMode(ReadWriteMode), hClose)
5import System.FilePath ((</>))
4import System.FilePath ((</>))
6import System.Posix.Types (Fd)
5import System.Posix.Types (Fd)
7−import Data.IORef (IORef, writeIORef, readIORef, newIORef)
8−import qualified Data.ByteString.Lazy.Char8 as BSLC (pack, putStrLn)
6+import qualified Data.ByteString.Lazy.Char8 as BSLC (putStrLn)
9−import Control.Exception (SomeException, catch)
10
7
11-- SSL
8-- SSL
12−import qualified Crypto.Random.AESCtr as RNG (makeSystem)
13−import Network.Azure.ServiceManagement
9+import Network.Azure.ServiceManagement
10+ ( SubscriptionId(SubscriptionId)
11+ , azureRequest
14− ( fileReadCertificate
12+ , fileReadCertificate
15 , fileReadPrivateKey
13 , fileReadPrivateKey
16 )
14 )
17−import Network.Socket
18− ( socket
19− , Family(AF_INET)
20− , SocketType(Stream)
21− , defaultProtocol
22− , SockAddr(SockAddrInet)
23− , connect
24− , sClose
25− , socketToHandle
26− , HostName
27− , PortNumber
28− )
29−import Network.BSD (getHostByName, hostAddresses)
30−import Network.TLS
31− ( contextNewOnHandle
32− , Params
33− , Context
34− , defaultLogging
35− , loggingPacketSent
36− , loggingPacketRecv
37− , onCertificateRequest
38− , onCertificatesRecv
39− , pLogging
40− , pCertificates
41− , pCiphers
42− , pConnectVersion
43− , pAllowedVersions
44− , setSessionManager
45− , defaultParamsClient
46− , updateClientParams
47− , clientWantSessionResume
48− , Version(TLS10, TLS11, TLS12)
49− , SessionManager(sessionEstablish, sessionResume, sessionInvalidate)
50− , SessionID
51− , SessionData
52− , PrivateKey
53− , handshake
54− , sendData
55− , recvData'
56− , bye
57− )
58−import Network.TLS.Extra
59− ( certificateVerifyChain
60− , ciphersuite_all
61− )
62−import Data.Certificate.X509 (X509)
63
15
64-- SSH
16-- SSH
65import Network.SSH.Client.LibSSH2
17import Network.SSH.Client.LibSSH2
@@ -116,68 +68,8 @@ ssh login host port actions = do
116--------------------------------------------------------------------------------
68--------------------------------------------------------------------------------
117
69
118tryConnectToAzure :: String -> String -> String -> IO ()
70tryConnectToAzure :: String -> String -> String -> IO ()
119−tryConnectToAzure subscriptionId pathToCert pathToKey = do
71+tryConnectToAzure sid pathToCert pathToKey = do
120 cert <- fileReadCertificate pathToCert
72 cert <- fileReadCertificate pathToCert
121 key <- fileReadPrivateKey pathToKey
73 key <- fileReadPrivateKey pathToKey
122− sessionState <- newIORef undefined
123− let hostname = "management.core.windows.net"
124− let port = 443
125− runTLS (getDefaultParams sessionState [(cert, Just key)]) hostname port $ \ctx -> do
126− handshake ctx
127− sendData ctx $ BSLC.pack $ concat
128− [ "GET /" ++ subscriptionId ++ "/services/hostedservices HTTP/1.1\r\n"
74+ outp <- azureRequest (SubscriptionId sid) cert key "/services/hostedservices"
129− , "host: " ++ hostname ++ "\r\n"
130− , "content-type: application/xml\r\n"
131− , "x-ms-version: 2010-10-28\r\n"
132− , "\r\n"
133− ]
134− d <- recvData' ctx
135− bye ctx
136− BSLC.putStrLn d
75+ BSLC.putStrLn outp
137−
138−runTLS :: Params -> HostName -> PortNumber -> (Context -> IO a) -> IO ()
139−runTLS params hostname portNumber f = do
140− rng <- RNG.makeSystem
141− he <- getHostByName hostname
142− sock <- socket AF_INET Stream defaultProtocol
143− let sockaddr = SockAddrInet portNumber (head $ hostAddresses he)
144− catch (connect sock sockaddr)
145− (\(e :: SomeException) -> sClose sock >> error ("cannot open socket " ++ show sockaddr ++ " " ++ show e))
146− dsth <- socketToHandle sock ReadWriteMode
147− ctx <- contextNewOnHandle dsth params rng
148− _ <- f ctx
149− hClose dsth
150−
151−getDefaultParams :: IORef (SessionID, SessionData)
152− -> [(X509, Maybe PrivateKey)]
153− -> Params
154−getDefaultParams sessionState certs =
155− updateClientParams setCParams $ setSessionManager (SessionRef sessionState) $ defaultParamsClient
156− { pConnectVersion = TLS10
157− , pAllowedVersions = [TLS10,TLS11,TLS12]
158− , pCiphers = ciphersuite_all
159− , pCertificates = certs
160− , pLogging = logging
161− , onCertificatesRecv = crecv
162− }
163− where
164− setCParams cparams = cparams { clientWantSessionResume = Nothing
165− , onCertificateRequest = creq
166− }
167− logging = defaultLogging
168− { loggingPacketSent = putStrLn . ("debug: >> " ++)
169− , loggingPacketRecv = putStrLn . ("debug: << " ++)
170− }
171− crecv = certificateVerifyChain
172− creq _ = return certs
173−
174−data SessionRef = SessionRef (IORef (SessionID, SessionData))
175−
176−instance SessionManager SessionRef where
177− sessionEstablish (SessionRef ref) sid sdata =
178− writeIORef ref (sid,sdata)
179− sessionResume (SessionRef ref) sid = do
180− (s, d) <- readIORef ref
181− if s == sid then return (Just d) else return Nothing
182− sessionInvalidate _ _ =
183− return ()