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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
|
{- 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 Network.Socket (HostName)
type SshPubKey = String
type HMACDigest = String
type UserName = String
type Secret = String
data HostInfo = HostInfo
{ hostName :: HostName
, userName :: UserName
}
deriving (Eq, Read, Show)
data PairStage
{- "I'd like to pair with somebody who knows a secret.
- Here's my ssh key, and hostinfo, both verifiable with
- our shared secret." -}
= PairRequest
{- "I've checked your PairRequest, and like it; I set up
- your ssh key already. Here's mine, also verified, please set it
- up too, and start syncing!" -}
| PairAck
deriving (Eq, Read, Show)
type PairMsg = Verifiable (PairStage, HostInfo, SshPubKey)
mkPairMsg :: Secret -> PairStage -> HostInfo -> SshPubKey -> PairMsg
mkPairMsg secret pairstage hostinfo sshkey = mkVerifiable
(pairstage, hostinfo, sshkey) secret
{- A value, verifiable using a HMAC digest to encrypt using a shared secret. -}
data Verifiable a = Verifiable
{ val :: a
, digest :: HMACDigest
}
deriving (Eq, Read, Show)
mkVerifiable :: Show a => a -> Secret -> Verifiable a
mkVerifiable a secret = Verifiable a (calcDigest (show a) secret)
verified :: (Eq a, Show a) => Verifiable a -> Secret -> Bool
verified v secret = v == mkVerifiable (val v) secret
calcDigest :: String -> Secret -> HMACDigest
calcDigest = undefined -- TODO
|