diff options
-rw-r--r-- | Crypto.hs | 18 | ||||
-rw-r--r-- | Role/Developer.hs | 11 | ||||
-rw-r--r-- | Role/Downloader.hs | 2 |
3 files changed, 19 insertions, 12 deletions
@@ -48,7 +48,7 @@ toSign = val . hashValue . hashExceptSignature -- | Verifiy the signature of a Signed value. verifySigned :: Signed v => SigVerifier -> v -> Bool -verifySigned (SigVerifier verifier) v = +verifySigned (SigVerifier _ verifier) v = case getSignature v of Ed25519Signature (Val s) -> case Ed25519.signature s of @@ -56,21 +56,27 @@ verifySigned (SigVerifier verifier) v = CryptoFailed _ -> False OtherSignature _ -> False -data SigVerifier = SigVerifier (B.ByteString -> Ed25519.Signature -> Bool) +data SigVerifier = SigVerifier Int (B.ByteString -> Ed25519.Signature -> Bool) + +instance Show SigVerifier where + show (SigVerifier n _) = "SigVerifier (" ++ show n ++ ")" mkSigVerifier :: PublicKey -> SigVerifier mkSigVerifier (PublicKey (Val pk)) = case Ed25519.publicKey pk of - CryptoPassed pk' -> SigVerifier (Ed25519.verify pk') + CryptoPassed pk' -> SigVerifier 1 (Ed25519.verify pk') CryptoFailed _ -> mempty instance Monoid SigVerifier where - mempty = SigVerifier $ \_b _s -> False - mappend (SigVerifier a) (SigVerifier b) = - SigVerifier $ \d s -> b d s || a d s + mempty = SigVerifier 0 $ \_b _s -> False + mappend (SigVerifier na a) (SigVerifier nb b) = + SigVerifier (na+nb) $ \d s -> b d s || a d s data MySessionKey = MySessionKey Ed25519.SecretKey Ed25519.PublicKey +instance Show MySessionKey where + show _ = "<MySessionKey>" + genMySessionKey :: IO MySessionKey genMySessionKey = do -- Crypto.Random.Entropy may use rdrand, or /dev/random. diff --git a/Role/Developer.hs b/Role/Developer.hs index 1deb3a0..56af3b4 100644 --- a/Role/Developer.hs +++ b/Role/Developer.hs @@ -115,6 +115,7 @@ data DeveloperState = DeveloperState , developerSigVerifier :: SigVerifier -- ^ Used to verify signatures on messages from other developers. } + deriving (Show) -- | RecentActivity that uses the DeveloperState. developerStateRecentActivity :: TMVar (TVar DeveloperState) -> RecentActivity @@ -242,13 +243,13 @@ authUser spk ichan ochan devstate logger = do data Output = TtyOutput B.ByteString | Beep - | ProtocolError String + | ProtocolError DeveloperState String | GotControl ControlAction | NoOutput emitOutput :: Output -> IO () -emitOutput (ProtocolError e) = - error ("Protocol error: " ++ e) +emitOutput (ProtocolError ds e) = + error ("Protocol error: " ++ e ++ "\nState: " ++ show ds) emitOutput (TtyOutput b) = do B.hPut stdout b hFlush stdout @@ -275,7 +276,7 @@ getServerMessage ochan devstate ts = do then do o <- processuser ds msg return (Just (o, User msg)) - else return $ Just (ProtocolError $ "Bad signature on message from user: " ++ show msg, User msg) + else return $ Just (ProtocolError ds $ "Bad signature on message from user: " ++ show msg, User msg) -- When other developers connect, learn their SessionKeys. Just (Developer msg@(ControlMessage (Control (SessionKey spk) _))) -> do let sigverifier = mkSigVerifier $ case spk of @@ -306,7 +307,7 @@ getServerMessage ochan devstate ts = do then do writeTVar devstate ds' return (TtyOutput b) - else return (ProtocolError $ "Illegal Seen value: " ++ show act) + else return (ProtocolError ds $ "Illegal Seen value: " ++ show act) processuser ds (ControlMessage (Control (Rejected _) _)) = do -- When they rejected a message we sent, -- anything we sent subsequently will diff --git a/Role/Downloader.hs b/Role/Downloader.hs index c3d6b73..094e7de 100644 --- a/Role/Downloader.hs +++ b/Role/Downloader.hs @@ -32,5 +32,5 @@ downloader dsv _ichan ochan sid = do Just (o, msg) -> do _ <- logger msg case o of - ProtocolError e -> error ("Protocol error: " ++ e) + ProtocolError {} -> emitOutput o _ -> go logger st |