Merge tag '1.20190926'

tagging package debug-me version 1.20190926

# gpg: Signature made Thu 26 Sep 2019 05:05:32 PM MST
# gpg:                using RSA key 28A500C35207EAB72F6C0F25DB12DB0FF05F8F38
# gpg: Good signature from "Joey Hess <joeyh@joeyh.name>" [full]
# Primary key fingerprint: E85A 5F63 B31D 24C1 EBF0  D81C C910 D922 2512 E3C7
#      Subkey fingerprint: 28A5 00C3 5207 EAB7 2F6C  0F25 DB12 DB0F F05F 8F38

1 files changed, 16 insertions, 12 deletions

diff --git a/Role/User.hs b/Role/User.hs
index 6ec0302..987b880 100644
--- a/Role/User.hs
+++ b/Role/User.hs
@@ -247,17 +247,17 @@ getDeveloperMessage ichan ochan us now = maybe
 getDeveloperMessage' :: MissingHashes (Message Entered) -> TMChan (Message Seen) -> TVar UserState -> POSIXTime -> STM Input
 getDeveloperMessage' (MissingHashes wiremsg) ochan us now = do
 	st <- readTVar us
-	Developer msg <- restoreHashes (userStateRecentActivity us) (MissingHashes (Developer wiremsg))
+	msg <- restoreHashes (userStateRecentActivity us) (MissingHashes (Developer wiremsg))
 	case msg of
-		ControlMessage (Control (SessionKey spk _) _) -> do
+		Developer cmsg@(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)
-		_ -> if verifySigned (sigVerifier st) msg
-			then case msg of
+			if verifySigned sigverifier cmsg
+				then return (InputMessage cmsg)
+				else return (BadlySignedMessage cmsg)
+		Developer cmsg -> if verifySigned (sigVerifier st) cmsg
+			then case cmsg of
 				ActivityMessage entered -> do
 					-- Don't need to retain backlog
 					-- before the Activity that entered
@@ -266,22 +266,26 @@ getDeveloperMessage' (MissingHashes wiremsg) ochan us now = do
 						truncateBacklog (backLog st) entered
 					if isLegalEntered entered (st { backLog = bl' })
 						then do
-							let l = mkLog (Developer msg) now
+							let l = mkLog (Developer cmsg) now
 							writeTVar us $ st 
 								{ backLog = l :| toList bl'
 								, lastAcceptedEntered = Just (hash entered)
 								}
-							return (InputMessage msg)
+							return (InputMessage cmsg)
 						else do
 							let reject = EnteredRejected 
 								{ enteredRejected = hash entered
 								, enteredLastAccepted = lastAcceptedEntered st
 								}
-							RejectedMessage msg
+							RejectedMessage cmsg
 								<$> sendDeveloper ochan us reject now
 				ControlMessage (Control _ _) ->
-					return (InputMessage msg)
-			else return (BadlySignedMessage msg)
+					return (InputMessage cmsg)
+			else return (BadlySignedMessage cmsg)
+		-- This cannot really happen, because restoreHashes is
+		-- always passed a Developer message, but ghc doesn't know
+		-- that.
+		User _ -> error "unexpectedly received User message where Developer message expected"
 
 -- | Truncate the Backlog to remove entries older than the one
 -- that the Activity Entered refers to, but only if the referred