diff options
author | Joey Hess <joey@kitenet.net> | 2012-09-07 23:23:52 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-09-07 23:23:52 -0400 |
commit | 92df8250fa7c6d8c36ca214e45c7b5a6c9d307a9 (patch) | |
tree | 31dff3d544a99f3b53a2a4747d9286dbd52c5b2a /Assistant | |
parent | c12caf0a4e665d121c7ffd5a992306f7511bc305 (diff) |
broke out Verifiable to a utility library, and added a quickcheck test
Diffstat (limited to 'Assistant')
-rw-r--r-- | Assistant/Pairing.hs | 45 |
1 files changed, 14 insertions, 31 deletions
diff --git a/Assistant/Pairing.hs b/Assistant/Pairing.hs index b4861b20d..ef7b66d5c 100644 --- a/Assistant/Pairing.hs +++ b/Assistant/Pairing.hs @@ -8,49 +8,32 @@ module Assistant.Pairing where import Assistant.Common +import Utility.Verifiable import Network.Socket (HostName) -type SshPubKey = String -type HMACDigest = String -type UserName = String -type Secret = String +{- 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) -data HostInfo = HostInfo - { hostName :: HostName - , userName :: UserName - } - deriving (Eq, Read, Show) +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, both verifiable with - - our shared 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, also verified, please set it - - up too, and start syncing!" -} + - your ssh key already. Here's mine." -} | 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 +data HostInfo = HostInfo + { hostName :: HostName + , userName :: UserName } 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 +type SshPubKey = String +type UserName = String |