diff options
Diffstat (limited to 'Role/Developer.hs')
| -rw-r--r-- | Role/Developer.hs | 21 |
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 |