diff options
Diffstat (limited to 'Role/Developer.hs')
| -rw-r--r-- | Role/Developer.hs | 51 |
1 files changed, 45 insertions, 6 deletions
diff --git a/Role/Developer.hs b/Role/Developer.hs index e3d4a8c..89ce2cf 100644 --- a/Role/Developer.hs +++ b/Role/Developer.hs @@ -43,12 +43,22 @@ developer ichan ochan _ = withLogger "debug-me-developer.log" $ \logger -> do data DeveloperState = DeveloperState { lastSeen :: Hash + -- ^ Last Seen value received from the user. , sentSince :: [B.ByteString] + -- ^ Keys pressed since last Seen. , enteredSince :: [Hash] + -- ^ Messages we've sent since the last Seen. , lastActivity :: Hash + -- ^ Last message sent or received. + , fromOtherDevelopersSince :: [Hash] + -- ^ Messages received from other developers since the last Seen. + -- (The next Seen may chain from one of these.) , developerSessionKey :: MySessionKey + -- ^ Our session key. , userSigVerifier :: SigVerifier -- ^ Used to verify signatures on messages from the user. + , developerSigVerifier :: SigVerifier + -- ^ Used to verify signatures on messages from other developers. } -- | Read things typed by the developer, and forward them to the TMChan. @@ -149,6 +159,7 @@ emitOutput NoOutput = -- are properly chained from past messages, before returning. getServerMessage :: TMChan LogMessage -> TVar DeveloperState -> STM (Maybe (Output, LogMessage)) getServerMessage ochan devstate = do + let ignore = getServerMessage ochan devstate mmsg <- readTMChan ochan case mmsg of Nothing -> return Nothing @@ -159,11 +170,28 @@ getServerMessage ochan devstate = do then do o <- processuser ds msg return (Just (o, User msg)) - else getServerMessage ochan devstate + else ignore + -- When other developers connect, learn their SessionKeys. + Just (Developer msg@(ControlMessage (Control (SessionKey pk) _))) -> do + let sigverifier = mkSigVerifier pk + if verifySigned sigverifier msg + then do + ds <- readTVar devstate + let sv = developerSigVerifier ds + let sv' = sv `mappend` sigverifier + writeTVar devstate $ ds + { developerSigVerifier = sv' + } + processdeveloper ds msg + return (Just (NoOutput, Developer msg)) + else ignore Just (Developer msg) -> do - -- Not bothering to check signatures of messages - -- from other developers. XXX - return (Just (NoOutput, Developer msg)) + ds <- readTVar devstate + if verifySigned (developerSigVerifier ds) msg + then do + processdeveloper ds msg + return (Just (NoOutput, Developer msg)) + else ignore where processuser ds (ActivityMessage act@(Activity (Seen (Val b)) _ _)) = do let (legal, ds') = isLegalSeen act ds @@ -189,6 +217,12 @@ getServerMessage ochan devstate = do processuser _ (ControlMessage (Control c@(SessionKeyRejected _) _)) = return (GotControl c) + processdeveloper ds (ActivityMessage a) = do + let msghash = hash a + let ss = msghash : fromOtherDevelopersSince ds + writeTVar devstate (ds { fromOtherDevelopersSince = ss }) + processdeveloper _ (ControlMessage _) = return () + -- | Check if the Seen activity is legal, forming a chain with previous -- ones, and returns an updated DeveloperState. -- @@ -196,8 +230,9 @@ getServerMessage ochan devstate = do isLegalSeen :: Activity Seen -> DeveloperState -> (Bool, DeveloperState) isLegalSeen (Activity _ Nothing _) ds = (False, ds) isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _) ds - -- Does it chain to the last Seen activity? - | hp == lastSeen ds = + -- Does it chain to the last Seen activity or to + -- something sent by another developer since the last Seen? + | hp == lastSeen ds || hp `elem` fromOtherDevelopersSince ds = -- Trim sentSince and enteredSince to -- values after the Seen value. let ss = sentSince ds @@ -211,6 +246,7 @@ isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _) ds , sentSince = ss' , enteredSince = es' , lastActivity = acth + , fromOtherDevelopersSince = mempty } -- Does it chain to something we've entered since the last Seen -- value? Eg, user sent A, we replied B C, and the user has @@ -229,6 +265,7 @@ isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _) ds , sentSince = ss' , enteredSince = es' , lastActivity = acth + , fromOtherDevelopersSince = mempty } where acth = hash act @@ -262,7 +299,9 @@ processSessionStart ochan logger = do , sentSince = mempty , enteredSince = mempty , lastActivity = starthash + , fromOtherDevelopersSince = mempty , developerSessionKey = sk , userSigVerifier = sigverifier + , developerSigVerifier = mempty } return (st, output) |