diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-12-18 17:01:15 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-12-18 17:11:13 -0400 |
commit | ecd79dd69dad3474abf78085cbd401c227853b74 (patch) | |
tree | 471abdea8e27891072e0171b15a622f916cc1156 /Command/P2P.hs | |
parent | 09e3fc83f8e9a006cea239fabcff81692e938ddc (diff) |
check if wormhole is installed
Diffstat (limited to 'Command/P2P.hs')
-rw-r--r-- | Command/P2P.hs | 28 |
1 files changed, 21 insertions, 7 deletions
diff --git a/Command/P2P.hs b/Command/P2P.hs index ddc6c29df..f2443e787 100644 --- a/Command/P2P.hs +++ b/Command/P2P.hs @@ -67,10 +67,10 @@ seek (LinkRemote, Just name) = commandAction $ seek (LinkRemote, Nothing) = commandAction $ linkRemote =<< unusedPeerRemoteName seek (Pair, Just name) = commandAction $ - pairing name =<< loadP2PAddresses + startPairing name =<< loadP2PAddresses seek (Pair, Nothing) = commandAction $ do name <- unusedPeerRemoteName - pairing name =<< loadP2PAddresses + startPairing name =<< loadP2PAddresses unusedPeerRemoteName :: Annex RemoteName unusedPeerRemoteName = go (1 :: Integer) =<< usednames @@ -119,11 +119,23 @@ linkRemote remotename = do ConnectionError e -> giveup e AuthenticationError e -> giveup e -pairing :: RemoteName -> [P2PAddress] -> CommandStart -pairing _ [] = giveup "No P2P networks are currrently available." -pairing remotename addrs = do +startPairing :: RemoteName -> [P2PAddress] -> CommandStart +startPairing _ [] = giveup "No P2P networks are currrently available." +startPairing remotename addrs = do showStart "p2p pair" remotename - next $ next $ do + ifM (liftIO Wormhole.isInstalled) + ( next $ performPairing remotename addrs + , giveup "Magic Wormhole is not installed, and is needed for pairing. Install it from your distribution or from https://github.com/warner/magic-wormhole/" + ) + +performPairing :: RemoteName -> [P2PAddress] -> CommandPerform +performPairing remotename addrs = do + -- This note is displayed mainly so when magic wormhole + -- complains about possible protocol mismatches or other problems, + -- it's clear what's doing the complaining. + showLongNote "Will use Magic Wormhole for pairing." + next $ do + showOutput r <- wormholePairing remotename addrs ui case r of PairSuccess -> return True @@ -153,7 +165,9 @@ pairing remotename addrs = do l <- getLine case Wormhole.toCode l of Just code - | code /= ourcode -> return code + | code /= ourcode -> do + putStrLn "Pairing in process..." + return code | otherwise -> do putStrLn "Oops -- You entered this repository's pairing code. We need the pairing code of the *other* repository." getcode ourcode |