From a61df1522ddf8a36839cf1180d3b16e354459e9a Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Sat, 29 Apr 2017 14:46:45 -0400
Subject: user gpg key checking and prompting done!

---
 Role/User.hs | 67 +++++++++++++++++++++++-------------------------------------
 1 file changed, 26 insertions(+), 41 deletions(-)

(limited to 'Role/User.hs')

diff --git a/Role/User.hs b/Role/User.hs
index bbf563c..0929f74 100644
--- a/Role/User.hs
+++ b/Role/User.hs
@@ -202,33 +202,13 @@ sendPtyInput ichan ochan controlinput p us logger = go
 				go
 			Just (InputMessage msg@(ControlMessage (Control c _))) -> do
 				logger $ Developer msg
-				case c of
-					SessionKey pk -> do
-						checkDeveloperPublicKey ochan us logger pk
-						go
-					ChatMessage _ _ -> do
-						atomically $ writeTMChan controlinput (ControlInputAction c)
-						go
-					Rejected r -> error $ "User side received a Rejected: " ++ show r
-					SessionKeyAccepted _ -> error "User side received a SessionKeyAccepted"
-					SessionKeyRejected _ -> error "User side received a SessionKeyRejected"
+				atomically $ writeTMChan controlinput (ControlInputAction c)
+				go
 			Just (RejectedMessage rej) -> do
 				logger $ User rej
 				go
 			Just (BadlySignedMessage _) -> go
 
-sendControlOutput :: TMChan ControlOutput -> TMChan (Message Seen) -> TVar UserState -> Logger -> IO ()
-sendControlOutput controloutput ochan us logger = loop
-  where
-	loop = go =<< atomically (readTMChan controloutput)
-	go Nothing = return ()
-	go (Just ControlWindowOpened) = loop
-	go (Just (ControlOutputAction c)) = do
-		now <- getPOSIXTime
-		l <- atomically $ sendDeveloper ochan us c now
-		logger (User l)
-		loop
-
 data Input
 	= InputMessage (Message Entered)
 	| RejectedMessage (Message Seen)
@@ -276,25 +256,6 @@ getDeveloperMessage' msg ochan us now = do
 					return (InputMessage msg)
 			else return (BadlySignedMessage msg)
 
--- | 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 -> PerhapsSigned PublicKey -> IO ()
-checkDeveloperPublicKey ochan us logger spk = do
-	now <- getPOSIXTime
-	-- TODO check gpg sig..
-	msg <- atomically $ do
-		st <- readTVar us
-		let sv = sigVerifier st
-		let sv' = sv `mappend` mkSigVerifier pk
-		let st' = st { sigVerifier = sv' }
-		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
 -- to Activity is an Activity Seen. 
@@ -357,3 +318,27 @@ isLegalEntered (Activity a (Just hp) _ _) us
 	(lastact :| bl) = backLog us
 	getseen (User (ActivityMessage as)) = seenData $ activity as
 	getseen _ = mempty
+
+-- | Forward messages from the control window to the developer.
+--
+-- When the control window sends a SessionKeyAccepted, add it to the
+-- sigVerifier.
+sendControlOutput :: TMChan ControlOutput -> TMChan (Message Seen) -> TVar UserState -> Logger -> IO ()
+sendControlOutput controloutput ochan us logger = loop
+  where
+	loop = go =<< atomically (readTMChan controloutput)
+	go Nothing = return ()
+	go (Just ControlWindowOpened) = loop
+	go (Just (ControlOutputAction c)) = do
+		case c of
+			SessionKeyAccepted pk -> atomically $ do
+				st <- readTVar us
+				let sv = sigVerifier st
+				let sv' = sv `mappend` mkSigVerifier pk
+				let st' = st { sigVerifier = sv' }
+				writeTVar us st'		
+			_ -> return ()
+		now <- getPOSIXTime
+		l <- atomically $ sendDeveloper ochan us c now
+		logger (User l)
+		loop
-- 
cgit v1.2.3