@@ -1,10 +1,129 @@
1+import Prelude hiding (catch)
2+import System.Environment (getArgs)
3+import System.IO (IOMode(ReadWriteMode), hClose)
4+import Data.IORef (IORef, writeIORef, readIORef, newIORef)
5+import qualified Data.ByteString.Lazy.Char8 as BSLC (pack, putStrLn)
6+import Control.Exception (SomeException, catch)
7+import qualified Crypto.Random.AESCtr as RNG (makeSystem)
18import Network.Azure.ServiceManagement
29 ( fileReadCertificate
10+ , fileReadPrivateKey
311 )
4−import System.Environment (getArgs)
12+import Network.Socket
13+ ( socket
14+ , Family(AF_INET)
15+ , SocketType(Stream)
16+ , defaultProtocol
17+ , SockAddr(SockAddrInet)
18+ , connect
19+ , sClose
20+ , socketToHandle
21+ , HostName
22+ , PortNumber
23+ )
24+import Network.BSD (getHostByName, hostAddresses)
25+import Network.TLS
26+ ( contextNewOnHandle
27+ , Params
28+ , Context
29+ , defaultLogging
30+ , loggingPacketSent
31+ , loggingPacketRecv
32+ , onCertificateRequest
33+ , onCertificatesRecv
34+ , pLogging
35+ , pCertificates
36+ , pCiphers
37+ , pConnectVersion
38+ , pAllowedVersions
39+ , setSessionManager
40+ , defaultParamsClient
41+ , updateClientParams
42+ , clientWantSessionResume
43+ , Version(TLS10, TLS11, TLS12)
44+ , SessionManager(sessionEstablish, sessionResume, sessionInvalidate)
45+ , SessionID
46+ , SessionData
47+ , PrivateKey
48+ , handshake
49+ , sendData
50+ , recvData'
51+ , bye
52+ )
53+import Network.TLS.Extra
54+ ( certificateVerifyChain
55+ , ciphersuite_all
56+ )
57+import Data.Certificate.X509 (X509)
558
659main :: IO ()
760main = do
8− [cert] <- getArgs
9− x509 <- fileReadCertificate cert
10− print x509
61+ [pathToCert, pathToKey] <- getArgs
62+ cert <- fileReadCertificate pathToCert
63+ key <- fileReadPrivateKey pathToKey
64+ sessionState <- newIORef undefined
65+ let hostname = "management.core.windows.net"
66+ let port = 443
67+ runTLS (getDefaultParams sessionState [(cert, Just key)]) hostname port $ \ctx -> do
68+ handshake ctx
69+ sendData ctx $ BSLC.pack $ concat
70+ [ "GET /aea2f42e-eb22-495a-9e4f-6d07326523f2/services/hostedservices HTTP/1.1\r\n"
71+ , "host: " ++ hostname ++ "\r\n"
72+ , "content-type: application/xml\r\n"
73+ , "x-ms-version: 2010-10-28\r\n"
74+ , "\r\n"
75+ ]
76+ d <- recvData' ctx
77+ bye ctx
78+ BSLC.putStrLn d
79+
80+--------------------------------------------------------------------------------
81+-- Taken from tls-debug/src/SimpleClient.hs --
82+--------------------------------------------------------------------------------
83+
84+runTLS :: Params -> HostName -> PortNumber -> (Context -> IO a) -> IO ()
85+runTLS params hostname portNumber f = do
86+ rng <- RNG.makeSystem
87+ he <- getHostByName hostname
88+ sock <- socket AF_INET Stream defaultProtocol
89+ let sockaddr = SockAddrInet portNumber (head $ hostAddresses he)
90+ catch (connect sock sockaddr)
91+ (\(e :: SomeException) -> sClose sock >> error ("cannot open socket " ++ show sockaddr ++ " " ++ show e))
92+ dsth <- socketToHandle sock ReadWriteMode
93+ ctx <- contextNewOnHandle dsth params rng
94+ _ <- f ctx
95+ hClose dsth
96+
97+getDefaultParams :: IORef (SessionID, SessionData)
98+ -> [(X509, Maybe PrivateKey)]
99+ -> Params
100+getDefaultParams sessionState certs =
101+ updateClientParams setCParams $ setSessionManager (SessionRef sessionState) $ defaultParamsClient
102+ { pConnectVersion = TLS10
103+ , pAllowedVersions = [TLS10,TLS11,TLS12]
104+ , pCiphers = ciphersuite_all
105+ , pCertificates = certs
106+ , pLogging = logging
107+ , onCertificatesRecv = crecv
108+ }
109+ where
110+ setCParams cparams = cparams { clientWantSessionResume = Nothing
111+ , onCertificateRequest = creq
112+ }
113+ logging = defaultLogging
114+ { loggingPacketSent = putStrLn . ("debug: >> " ++)
115+ , loggingPacketRecv = putStrLn . ("debug: << " ++)
116+ }
117+ crecv = certificateVerifyChain
118+ creq _ = return certs
119+
120+data SessionRef = SessionRef (IORef (SessionID, SessionData))
121+
122+instance SessionManager SessionRef where
123+ sessionEstablish (SessionRef ref) sid sdata =
124+ writeIORef ref (sid,sdata)
125+ sessionResume (SessionRef ref) sid = do
126+ (s, d) <- readIORef ref
127+ if s == sid then return (Just d) else return Nothing
128+ sessionInvalidate _ _ =
129+ return ()