diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2020-02-03 22:29:31 +0100 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2020-02-04 22:52:47 +0100 |
| commit | 6f0bcff200598d085c89d167aa126d25fc5df3ed (patch) | |
| tree | 0868edc1759b7c90eaba7ab8d4835179b42541ff /src/Attach.hs | |
| parent | 84d7c83bc85ff0862a39d6de3bd227550175ebce (diff) | |
Service: stored or ref-only reply packet
Use the ref-only packet to acknowledge successful storage of received
direct message.
Diffstat (limited to 'src/Attach.hs')
| -rw-r--r-- | src/Attach.hs | 29 |
1 files changed, 13 insertions, 16 deletions
diff --git a/src/Attach.hs b/src/Attach.hs index f3a98b3..10a87f3 100644 --- a/src/Attach.hs +++ b/src/Attach.hs @@ -84,8 +84,8 @@ instance Service AttachService where svcPrint $ "Attach from " ++ T.unpack (displayIdentity peer) ++ " initiated" nonce <- liftIO $ getRandomBytes 32 svcSet $ PeerRequest nonce confirm - return $ Just $ AttachResponse nonce - (NoAttach, _) -> return Nothing + replyPacket $ AttachResponse nonce + (NoAttach, _) -> return () (OurRequest nonce, AttachResponse pnonce) -> do peer <- asks $ svcPeer @@ -93,24 +93,23 @@ instance Service AttachService where validateIdentity . lsIdentity . fromStored =<< svcGetLocal svcPrint $ "Attach to " ++ T.unpack (displayIdentity peer) ++ ": " ++ confirmationNumber (nonceDigest self peer nonce pnonce) svcSet $ OurRequestConfirm Nothing - return $ Just $ AttachRequestNonce nonce + replyPacket $ AttachRequestNonce nonce (OurRequest _, _) -> do svcSet $ AttachFailed - return $ Just $ AttachDecline + replyPacket AttachDecline (OurRequestConfirm _, AttachIdentity sdata keys) -> do verifyAttachedIdentity sdata >>= \case Just owner -> do svcPrint $ "Attachment confirmed by peer" svcSet $ OurRequestConfirm $ Just (owner, keys) - return Nothing Nothing -> do svcPrint $ "Failed to verify new identity" svcSet $ AttachFailed - return $ Just AttachDecline + replyPacket AttachDecline (OurRequestConfirm _, _) -> do svcSet $ AttachFailed - return $ Just $ AttachDecline + replyPacket AttachDecline (OurRequestReady, AttachIdentity sdata keys) -> do verifyAttachedIdentity sdata >>= \case @@ -118,14 +117,13 @@ instance Service AttachService where svcPrint $ "Accepted updated identity" st <- storedStorage <$> svcGetLocal finalizeAttach st identity keys - return Nothing Nothing -> do svcPrint $ "Failed to verify new identity" svcSet $ AttachFailed - return $ Just AttachDecline + replyPacket AttachDecline (OurRequestReady, _) -> do svcSet $ AttachFailed - return $ Just $ AttachDecline + replyPacket AttachDecline (PeerRequest nonce dgst, AttachRequestNonce pnonce) -> do peer <- asks $ svcPeer @@ -134,19 +132,18 @@ instance Service AttachService where if dgst == nonceDigest peer self pnonce BA.empty then do svcPrint $ "Attach from " ++ T.unpack (displayIdentity peer) ++ ": " ++ confirmationNumber (nonceDigest peer self pnonce nonce) svcSet PeerRequestConfirm - return Nothing else do svcPrint $ "Failed attach from " ++ T.unpack (displayIdentity peer) svcSet AttachFailed - return $ Just $ AttachDecline + replyPacket AttachDecline (PeerRequest _ _, _) -> do svcSet $ AttachFailed - return $ Just $ AttachDecline + replyPacket AttachDecline (PeerRequestConfirm, _) -> do svcSet $ AttachFailed - return $ Just $ AttachDecline + replyPacket AttachDecline - (AttachDone, _) -> return Nothing - (AttachFailed, _) -> return Nothing + (AttachDone, _) -> return () + (AttachFailed, _) -> return () attachToOwner :: (MonadIO m, MonadError String m) => (String -> IO ()) -> UnifiedIdentity -> Peer -> m () attachToOwner _ self peer = do |