gpg sign developer session key

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

This commit was sponsored by andrea rota.

1 files changed, 14 insertions, 7 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