gpg sign developer session key

And part of what we need to have users verify them.

This commit was sponsored by andrea rota.

2 files changed, 25 insertions, 12 deletions

diff --git a/Role/Developer.hs b/Role/Developer.hs
index 8e27b30..d5c3463 100644
--- a/Role/Developer.hs
+++ b/Role/Developer.hs
@@ -122,12 +122,14 @@ sendTtyOutput ochan devstate logger = go
 authUser :: TMChan (Message Entered) -> TMChan LogMessage -> TVar DeveloperState -> Logger -> IO Bool
 authUser ichan ochan devstate logger = do
 	ds <- atomically $ readTVar devstate
-	pk <- myPublicKey (developerSessionKey ds)
+	spk <- myPublicKey (developerSessionKey ds) (GpgSign True)
 	let msg = ControlMessage $ mkSigned (developerSessionKey ds) 
-		(Control (SessionKey pk))
+		(Control (SessionKey spk))
 	atomically $ writeTMChan ichan msg
 	logger $ Developer msg
-	waitresp pk
+	waitresp $ case spk of
+		GpgSigned pk _ -> pk
+		UnSigned pk -> pk
   where
 	waitresp pk = do
 		ts <- getPOSIXTime
@@ -180,8 +182,10 @@ getServerMessage ochan devstate ts = do
 					return (Just (o, User msg))
 				else ignore
 		-- When other developers connect, learn their SessionKeys.
-		Just (Developer msg@(ControlMessage (Control (SessionKey pk) _))) -> do
-			let sigverifier = mkSigVerifier pk
+		Just (Developer msg@(ControlMessage (Control (SessionKey spk) _))) -> do
+			let sigverifier = mkSigVerifier $ case spk of
+				GpgSigned pk _ -> pk
+				UnSigned pk -> pk
 			if verifySigned sigverifier msg
 				then do
 					ds <- readTVar devstate
@@ -290,9 +294,12 @@ processSessionStart ochan logger = do
 		<$> atomically (readTMChan ochan)
 	logger sessionmsg
 	sigverifier <- case sessionmsg of
-		User (ControlMessage c@(Control (SessionKey pk) _)) ->
+		User (ControlMessage c@(Control (SessionKey spk) _)) -> do
+			let pk = case spk of
+				GpgSigned k _ -> k
+				UnSigned k -> k
 			let sv = mkSigVerifier pk
-			in if verifySigned sv c
+			if verifySigned sv c
 				then return sv
 				else error "Badly signed session initialization message"
 		_ -> error $ "Unexpected session initialization message: " ++ show sessionmsg
diff --git a/Role/User.hs b/Role/User.hs
index fc6eaea..51688af 100644
--- a/Role/User.hs
+++ b/Role/User.hs
@@ -80,7 +80,7 @@ startProtocol starttxt ochan logger = do
 		atomically $ writeTMChan ochan msg
 		logger $ User msg
 	sk <- genMySessionKey
-	pk <- myPublicKey sk
+	pk <- myPublicKey sk (GpgSign False)
 	let c = mkSigned sk $ Control (SessionKey pk)
 	initialmessage $ ControlMessage c
 	let starttxt' = rawLine starttxt
@@ -209,8 +209,10 @@ getDeveloperMessage' :: Message Entered -> TMChan (Message Seen) -> TVar UserSta
 getDeveloperMessage' msg ochan us now = do
 	st <- readTVar us
 	case msg of
-		ControlMessage (Control (SessionKey pk) _) -> do
-			let sigverifier = mkSigVerifier pk
+		ControlMessage (Control (SessionKey spk) _) -> do
+			let sigverifier = mkSigVerifier $ case spk of
+				GpgSigned pk _ -> pk
+				UnSigned pk -> pk
 			if verifySigned sigverifier msg
 				then return (InputMessage msg)
 				else return (BadlySignedMessage msg)
@@ -236,8 +238,8 @@ getDeveloperMessage' msg ochan us now = do
 
 -- | Check if the public key a developer presented is one we want to use,
 -- and if so, add it to the sigVerifier.
-checkDeveloperPublicKey :: TMChan (Message Seen) -> TVar UserState -> Logger -> PublicKey -> IO ()
-checkDeveloperPublicKey ochan us logger pk = do
+checkDeveloperPublicKey :: TMChan (Message Seen) -> TVar UserState -> Logger -> PerhapsSigned PublicKey -> IO ()
+checkDeveloperPublicKey ochan us logger spk = do
 	now <- getPOSIXTime
 	-- TODO check gpg sig..
 	msg <- atomically $ do
@@ -248,6 +250,10 @@ checkDeveloperPublicKey ochan us logger pk = do
 		writeTVar us st'
 		sendDeveloper ochan us (SessionKeyAccepted pk) now
 	logger $ User msg
+  where
+	pk = case spk of
+		GpgSigned k _ -> k
+		UnSigned k -> k
 
 -- | Truncate the Backlog to remove entries older than the one
 -- that the Activity Entered refers to, but only if the referred