summaryrefslogtreecommitdiff
path: root/Command/P2P.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2016-12-18 17:01:15 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2016-12-18 17:11:13 -0400
commitecd79dd69dad3474abf78085cbd401c227853b74 (patch)
tree471abdea8e27891072e0171b15a622f916cc1156 /Command/P2P.hs
parent09e3fc83f8e9a006cea239fabcff81692e938ddc (diff)
check if wormhole is installed
Diffstat (limited to 'Command/P2P.hs')
-rw-r--r--Command/P2P.hs28
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