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