summaryrefslogtreecommitdiff
path: root/Assistant/Pairing.hs
blob: ef7b66d5c2e05640a6dd8a3663b979c6c2b4a2ad (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
{- git-annex assistant repo pairing
 -
 - Copyright 2012 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Assistant.Pairing where

import Assistant.Common
import Utility.Verifiable

import Network.Socket (HostName)

{- Messages sent in pairing are all verifiable using a secret that
 - should be shared between the systems being paired. -}
type PairMsg = Verifiable (PairStage, HostInfo, SshPubKey)

mkPairMsg :: Secret -> PairStage -> HostInfo -> SshPubKey -> PairMsg
mkPairMsg secret pairstage hostinfo sshkey = mkVerifiable
	(pairstage, hostinfo, sshkey) secret

data PairStage
	{- "I'd like to pair with somebody who knows a secret.
	 - Here's my ssh key, and hostinfo." -}
	= PairRequest
	{- "I've checked your PairRequest, and like it; I set up
	 - your ssh key already. Here's mine." -}
	| PairAck
	deriving (Eq, Read, Show)

data HostInfo = HostInfo
	{ hostName :: HostName
	, userName :: UserName
	}
	deriving (Eq, Read, Show)

type SshPubKey = String
type UserName = String