@@ -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
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
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)
185+decodePrivateKey :: ByteString -> PrivateKey
186+decodePrivateKey = PrivRSA . runGet getPrivateKey
188+ getPrivateKey :: Get RSA.PrivateKey
190+ RSA.PrivateKey <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get
192+instance Binary AzureSetup where
193+ put (AzureSetup sid cert pkey url) = do
195+ put (encodeCertificate cert)
196+ put (encodePrivateKey pkey)
200+ Right cert <- decodeCertificate <$> get
201+ pkey <- decodePrivateKey <$> get
203+ return $ AzureSetup sid cert pkey url
164-- | Initialize Azure
205-- | Initialize Azure
165azureSetup :: String -- ^ Subscription ID
206azureSetup :: String -- ^ Subscription ID
166 -> String -- ^ Path to certificate
207 -> String -- ^ Path to certificate