yesod skelton and routes for pairing

yet more changes to pairing message data types
This commit is contained in:
Joey Hess 2012-09-08 00:26:47 -04:00
parent 92df8250fa
commit 3bee6b3c74
5 changed files with 70 additions and 16 deletions

View file

@ -0,0 +1,51 @@
{- git-annex assistant webapp configurator for pairing
-
- Pairing works like this:
-
- * The user optns StartPairR, which prompts them for a secret.
- * The user submits it. A PairReq is broadcast out. The secret is
- stashed away in a list of known pairing secrets.
- * On another device, it's received, and that causes its webapp to
- display an Alert.
- * The user there clicks the button, which opens FinishPairR,
- which prompts them for the same secret.
- * The secret is used to verify the PairReq. If it checks out,
- a PairAck is sent, and the other device adds the ssh key from the
- PairReq. An Alert is displayed noting that the pairing has been set up.
- * The PairAck is received back at the device that started the process.
- It's verified using the stored secret. The ssh key from the PairAck
- is added. An Alert is displayed noting that the pairing has been set
- up. Note that multiple other devices could also send PairAcks, and
- as long as they're valid, all those devices are paired with.
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-}
module Assistant.WebApp.Configurators.Pairing where
import Assistant.Common
import Assistant.Pairing
import Assistant.WebApp
import Assistant.WebApp.Types
import Assistant.WebApp.SideBar
import Utility.Yesod
import Assistant.WebApp.Configurators.Local
import qualified Types.Remote as R
import qualified Remote.Rsync as Rsync
import qualified Command.InitRemote
import Logs.UUID
import Logs.Remote
import Yesod
import Data.Text (Text)
import qualified Data.Text as T
getStartPairR :: Handler RepHtml
getStartPairR = undefined
getFinishPairR :: PairReq -> Handler RepHtml
getFinishPairR = undefined

View file

@ -19,6 +19,7 @@ import Assistant.ScanRemotes
import Assistant.TransferQueue
import Assistant.TransferSlots
import Assistant.Alert
import Assistant.Pairing
import Utility.NotificationBroadcaster
import Utility.WebApp
import Logs.Transfer

View file

@ -11,6 +11,9 @@
/config/repository/add/ssh/make/git/#SshData MakeSshGitR GET
/config/repository/add/ssh/make/rsync/#SshData MakeSshRsyncR GET
/config/repository/add/rsync.net AddRsyncNetR GET
/config/repository/pair/start StartPairR GET
/config/repository/pair/finish/#PairReq FinishPairR GET
/config/repository/first FirstRepositoryR GET
/transfers/#NotificationId TransfersR GET