git.iko.soy/distributed-process
on master help sign in
Add Binary instance for AzureSetup
fa28db9Edsko de Vries
azure-service-api/azure-service-api.cabal+2
@@ -26,6 +26,8 @@ Library
26 case-insensitive >= 0.4 && < 0.5,
26 case-insensitive >= 0.4 && < 0.5,
27 hxt >= 9.2 && < 9.3,
27 hxt >= 9.2 && < 9.3,
28 pretty >= 1.1 && < 1.2,
28 pretty >= 1.1 && < 1.2,
29+ crypto-pubkey-types >= 0.1 && < 0.2,
30+ binary >= 0.5 && < 0.6,
29 resourcet,
31 resourcet,
30 transformers,
32 transformers,
31 hxt-xpath
33 hxt-xpath
azure-service-api/src/Network/Azure/ServiceManagement.hs+43−2
@@ -19,12 +19,18 @@ import Prelude hiding (id, (.))
19import Control.Category (id, (.))
19import Control.Category (id, (.))
20import Control.Arrow (arr)
20import Control.Arrow (arr)
21import Control.Monad (forM)
21import Control.Monad (forM)
22+import Control.Applicative ((<$>), (<*>))
22import Data.Maybe (listToMaybe)
23import Data.Maybe (listToMaybe)
24+import Data.ByteString.Lazy (ByteString)
23import Data.ByteString.Char8 as BSC (pack)
25import Data.ByteString.Char8 as BSC (pack)
24import Data.ByteString.Lazy.Char8 as BSLC (unpack)
26import Data.ByteString.Lazy.Char8 as BSLC (unpack)
27+import Data.Binary (Binary(get,put))
28+import Data.Binary.Put (runPut)
29+import Data.Binary.Get (Get, runGet)
25−import Network.TLS (PrivateKey)
30+import Network.TLS (PrivateKey(PrivRSA))
26import Network.TLS.Extra (fileReadCertificate, fileReadPrivateKey)
31import Network.TLS.Extra (fileReadCertificate, fileReadPrivateKey)
27−import Data.Certificate.X509 (X509)
32+import Data.Certificate.X509 (X509, encodeCertificate, decodeCertificate)
33+import qualified Crypto.Types.PubKey.RSA as RSA (PrivateKey(..))
28import Control.Monad.Trans.Resource (ResourceT)
34import Control.Monad.Trans.Resource (ResourceT)
29import Control.Monad.IO.Class (liftIO)
35import Control.Monad.IO.Class (liftIO)
30import Control.Arrow.ArrowList (listA, arr2A)
36import Control.Arrow.ArrowList (listA, arr2A)
@@ -161,6 +167,41 @@ data AzureSetup = AzureSetup
161 , baseUrl :: String
167 , baseUrl :: String
162 }
168 }
163
169
170+-- TODO: it's dubious to be transferring private keys, but we transfer them
171+-- over a secure connection and it can be argued that it's safer than actually
172+-- storing the private key on each remote server
173+
174+encodePrivateKey :: PrivateKey -> ByteString
175+encodePrivateKey (PrivRSA pkey) = runPut $ do
176+ put (RSA.private_size pkey)
177+ put (RSA.private_n pkey)
178+ put (RSA.private_d pkey)
179+ put (RSA.private_p pkey)
180+ put (RSA.private_q pkey)
181+ put (RSA.private_dP pkey)
182+ put (RSA.private_dQ pkey)
183+ put (RSA.private_qinv pkey)
184+
185+decodePrivateKey :: ByteString -> PrivateKey
186+decodePrivateKey = PrivRSA . runGet getPrivateKey
187+ where
188+ getPrivateKey :: Get RSA.PrivateKey
189+ getPrivateKey =
190+ RSA.PrivateKey <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get
191+
192+instance Binary AzureSetup where
193+ put (AzureSetup sid cert pkey url) = do
194+ put sid
195+ put (encodeCertificate cert)
196+ put (encodePrivateKey pkey)
197+ put url
198+ get = do
199+ sid <- get
200+ Right cert <- decodeCertificate <$> get
201+ pkey <- decodePrivateKey <$> get
202+ url <- get
203+ return $ AzureSetup sid cert pkey url
204+
164-- | Initialize Azure
205-- | Initialize Azure
165azureSetup :: String -- ^ Subscription ID
206azureSetup :: String -- ^ Subscription ID
166 -> String -- ^ Path to certificate
207 -> String -- ^ Path to certificate