aboutsummaryrefslogtreecommitdiff
path: root/Assistant/Pairing.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-09-08 21:06:10 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-09-08 21:06:10 -0400
commit6e60b08060a79182a6ae0180dbb7aefbc6011299 (patch)
treee5ede82a1c690a288ba137eaea065ce0956711fb /Assistant/Pairing.hs
parent1ab3ce352bbaeb0c81fe73563da9d1d141475b03 (diff)
moved the PairStage inside the Verifiable data
Diffstat (limited to 'Assistant/Pairing.hs')
-rw-r--r--Assistant/Pairing.hs39
1 files changed, 15 insertions, 24 deletions
diff --git a/Assistant/Pairing.hs b/Assistant/Pairing.hs
index d25d5e56d..c78deace0 100644
--- a/Assistant/Pairing.hs
+++ b/Assistant/Pairing.hs
@@ -12,35 +12,26 @@ import Utility.Verifiable
import Control.Concurrent
import Network.Socket
-{- "I'll pair with anybody who shares the secret that can be used to verify
- - this request." -}
-data PairReq = PairReq (Verifiable PairData)
+data PairStage
+ {- "I'll pair with anybody who shares the secret that can be used
+ - to verify this request." -}
+ = PairReq
+ {- "I've verified your request, and you can verify this to see
+ - that I know the secret. I set up your ssh key already.
+ - Here's mine for you to set up." -}
+ | PairAck
+ {- "I saw your PairAck; you can stop sending them." -}
+ | PairDone
deriving (Eq, Read, Show)
-{- "I've verified your request, and you can verify mine to see that I know
- - the secret. I set up your ssh key already. Here's mine for you to set up." -}
-data PairAck = PairAck (Verifiable PairData)
+newtype PairMsg = PairMsg (Verifiable (PairStage, PairData))
deriving (Eq, Read, Show)
-{- "I saw your PairAck; you can stop sending them."
- - (This is not repeated, it's just sent in response to a valid PairAck) -}
-data PairDone = PairDone (Verifiable PairData)
- deriving (Eq, Read, Show)
-
-fromPairReq :: PairReq -> Verifiable PairData
-fromPairReq (PairReq v) = v
-
-fromPairAck :: PairAck -> Verifiable PairData
-fromPairAck (PairAck v) = v
+fromPairMsg :: PairMsg -> (Verifiable (PairStage, PairData))
+fromPairMsg (PairMsg m) = m
-fromPairDone :: PairDone -> Verifiable PairData
-fromPairDone (PairDone v) = v
-
-data PairMsg
- = PairReqM PairReq
- | PairAckM PairAck
- | PairDoneM PairDone
- deriving (Eq, Read, Show)
+pairMsgStage :: PairMsg -> PairStage
+pairMsgStage (PairMsg (Verifiable (s, _) _)) = s
data PairData = PairData
-- uname -n output, not a full domain name