mocked up wormhole pairing interface in webapp

Assistant/Sync.hs

@@ -18,8 +18,6 @@ import qualified Command.Sync
 import Utility.Parallel
 import qualified Git
 import qualified Git.Command
-import qualified Git.Merge
-import qualified Git.Ref
 import qualified Remote
 import qualified Types.Remote as Remote
 import qualified Remote.List as Remote

Assistant/WebApp/Configurators.hs

@@ -31,6 +31,9 @@ makeMiscRepositories = $(widgetFile "configurators/addrepository/misc")
 makeCloudRepositories :: Widget
 makeCloudRepositories = $(widgetFile "configurators/addrepository/cloud")
 
+makeTorConnection :: Widget
+makeTorConnection = $(widgetFile "configurators/addrepository/torconnection")
+
 makeSshRepository :: Widget
 makeSshRepository = $(widgetFile "configurators/addrepository/ssh")
 

Assistant/WebApp/Configurators/Pairing.hs

@@ -1,6 +1,6 @@
 {- git-annex assistant webapp configurator for pairing
  -
- - Copyright 2012 Joey Hess <id@joeyh.name>
+ - Copyright 2012,2016 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -22,6 +22,7 @@ import Assistant.DaemonStatus
 import Utility.Verifiable
 #endif
 import Utility.UserInfo
+import qualified Utility.MagicWormhole as Wormhole
 import Git
 
 import qualified Data.Text as T
@@ -33,6 +34,38 @@ import qualified Control.Exception as E
 import Control.Concurrent
 #endif
 
+data PairingWith = PairingWithSelf | PairingWithFriend
+
+getStartTorPairFriendR :: Handler Html
+getStartTorPairFriendR = postStartTorPairR PairingWithFriend
+
+getStartTorPairSelfR :: Handler Html
+getStartTorPairSelfR = postStartTorPairR PairingWithSelf
+
+postStartTorPairFriendR :: Handler Html
+postStartTorPairFriendR = postStartTorPairR PairingWithFriend
+
+postStartTorPairSelfR :: Handler Html
+postStartTorPairSelfR = postStartTorPairR PairingWithSelf
+
+postStartTorPairR :: PairingWith -> Handler Html
+postStartTorPairR pairingwith = pairPage $ do
+	let Just ourcode = Wormhole.mkCode "11-bannana-bananna" -- XXX tmp
+	((result, form), enctype) <- liftH $
+		runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $
+			areq wormholeCodeField (bfs codeprompt) Nothing
+	case result of
+		FormSuccess v -> error "TODO"
+		_ -> showform form enctype ourcode
+  where
+	showform form enctype ourcode = $(widgetFile "configurators/pairing/tor/prompt")
+	codeprompt = case pairingwith of
+		PairingWithFriend -> "Your friend's pairing code"
+		PairingWithSelf -> "The other device's pairing code"
+	wormholeCodeField = checkBool (Wormhole.validCode . T.unpack)
+		("That does not look like a valid code. Try again..." :: T.Text)
+		textField
+
 {- Starts local pairing. -}
 getStartLocalPairR :: Handler Html
 getStartLocalPairR = postStartLocalPairR

Assistant/WebApp/routes

@@ -62,6 +62,9 @@
 /config/repository/pair/local/running/#SecretReminder RunningLocalPairR GET
 /config/repository/pair/local/finish/#PairMsg FinishLocalPairR GET POST
 
+/config/repository/pair/tor/self/start StartTorPairSelfR GET POST
+/config/repository/pair/tor/friend/start StartTorPairFriendR GET POST
+
 /config/repository/enable/rsync/#UUID EnableRsyncR GET POST
 /config/repository/enable/gcrypt/#UUID EnableSshGCryptR GET POST
 /config/repository/enable/directory/#UUID EnableDirectoryR GET

git-annex.cabal

@@ -197,6 +197,7 @@ Extra-Source-Files:
   templates/configurators/enablewebdav.hamlet
   templates/configurators/pairing/local/inprogress.hamlet
   templates/configurators/pairing/local/prompt.hamlet
+  templates/configurators/pairing/tor/prompt.hamlet
   templates/configurators/pairing/disabled.hamlet
   templates/configurators/addglacier.hamlet
   templates/configurators/fsck.cassius
@@ -219,6 +220,7 @@ Extra-Source-Files:
   templates/configurators/addrepository/archive.hamlet
   templates/configurators/addrepository/cloud.hamlet
   templates/configurators/addrepository/connection.hamlet
+  templates/configurators/addrepository/torconnection.hamlet
   templates/configurators/addrepository/ssh.hamlet
   templates/configurators/addrepository/misc.hamlet
   templates/configurators/rsync.net/add.hamlet

templates/configurators/addrepository/connection.hamlet

@@ -1 +1,3 @@
 ^{makeSshRepository}
+
+^{makeTorConnection}

templates/configurators/addrepository/misc.hamlet

@@ -8,6 +8,8 @@
   <a href="http://en.wikipedia.org/wiki/Sneakernet">SneakerNet</a> #
   between computers. 
 
+^{makeTorConnection}
+
 <h3>
   <a href="@{StartLocalPairR}">
     <span .glyphicon .glyphicon-plus-sign>

templates/configurators/addrepository/torconnection.hamlet

@@ -0,0 +1,13 @@
+<h3>
+  <a href="@{StartTorPairSelfR}">
+    <span .glyphicon .glyphicon-plus-sign>
+    \ Share with your other devices
+<p>
+  Keep files in sync between your devices running git-annex.
+
+<h3>
+  <a href="@{StartTorPairFriendR}">
+    <span .glyphicon .glyphicon-plus-sign>
+    \ Share with a friend
+<p>
+  Combine your repository with a friend's repository, and share your files.

templates/configurators/pairing/tor/prompt.hamlet

@@ -0,0 +1,35 @@
+<div .col-sm-9>
+  <div .content-box>
+    <h2>
+      $case pairingwith
+        $of PairingWithSelf
+          Pairing your devices
+        $of PairingWithFriend
+          Pairing with a friend
+    <p>
+      Pairing will connect two git-annex repositories using #
+      <a href="https://torproject.org/">Tor</a>, #
+      allowing files to be shared between them.
+    <p>
+      $case pairingwith
+        $of PairingWithSelf
+          This device's #
+        $of PairingWithFriend
+          Your repository's #
+      pairing code is: <b><big>#{Wormhole.fromCode ourcode}</big></b>
+    <p>
+      $case pairingwith
+        $of PairingWithSelf
+          Enter that code into the webapp of the device you want to #
+          pair with.
+        $of PairingWithFriend
+          Tell that code to your friend. #
+    <p>
+      <form method="post" .form-horizontal enctype=#{enctype}>
+        <fieldset>
+          ^{form}
+          ^{webAppFormAuthToken}
+          <div .form-group>
+            <div .col-sm-10 .col-sm-offset-2>
+              <button .btn .btn-primary type=submit>
+                Finish pairing