diff options
author | 2012-09-10 15:20:18 -0400 | |
---|---|---|
committer | 2012-09-10 15:21:34 -0400 | |
commit | b573d91aa27a315fe9b155349a0a90805dc01181 (patch) | |
tree | 5ec983836c6ea1baa3ca5676eb295747f73d447a /Assistant/WebApp/Configurators/Pairing.hs | |
parent | 34a0e09d4be5ab9cc285dd7a3a72aea8460bdcdc (diff) |
broke out fairly generic ssh stuff to Assistant.Ssh so pairing can use it too
I'd rather Utility.Ssh, but the SshData type is not sufficiently clean and
generic for Utility.
Diffstat (limited to 'Assistant/WebApp/Configurators/Pairing.hs')
-rw-r--r-- | Assistant/WebApp/Configurators/Pairing.hs | 19 |
1 files changed, 11 insertions, 8 deletions
diff --git a/Assistant/WebApp/Configurators/Pairing.hs b/Assistant/WebApp/Configurators/Pairing.hs index d4301473f..da54e6a88 100644 --- a/Assistant/WebApp/Configurators/Pairing.hs +++ b/Assistant/WebApp/Configurators/Pairing.hs @@ -29,18 +29,19 @@ module Assistant.WebApp.Configurators.Pairing where import Assistant.Pairing +import Assistant.WebApp +import Assistant.WebApp.Types +import Assistant.WebApp.SideBar +import Utility.Yesod #ifdef WITH_PAIRING import Assistant.Pairing.Network +import Assistant.Ssh import Assistant.Common import Assistant.Alert import Assistant.DaemonStatus import Utility.Verifiable import Utility.Network #endif -import Assistant.WebApp -import Assistant.WebApp.Types -import Assistant.WebApp.SideBar -import Utility.Yesod import Yesod import Data.Text (Text) @@ -60,15 +61,17 @@ getStartPairR = promptSecret Nothing $ \rawsecret secret -> do dstatus <- daemonStatus <$> lift getYesod urlrender <- lift getUrlRender let homeurl = urlrender HomeR - hostname <- liftIO $ getHostname - username <- liftIO $ getUserName + hostname <- liftIO getHostname + username <- liftIO getUserName reldir <- fromJust . relDir <$> lift getYesod - let sshkey = "" -- TODO generate/read ssh key + keypair <- liftIO genSshKeyPair + let pubkey = sshPubKey keypair ++ "foo" let mkmsg addr = PairMsg $ mkVerifiable - (PairReq, PairData hostname addr username reldir sshkey) secret + (PairReq, PairData hostname addr username reldir pubkey) secret liftIO $ do pip <- PairingInProgress secret <$> sendrequests mkmsg dstatus homeurl + <*> pure keypair oldpip <- modifyDaemonStatus dstatus $ \s -> (s { pairingInProgress = Just pip }, pairingInProgress s) maybe noop stopold oldpip |