From a6b07d2758c185cde10a0b07161c18c288c02cfc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Tue, 28 Dec 2021 22:46:43 +0100
Subject: Pairing: reject and restart

---
 src/Contact.hs | 10 ++++++++++
 1 file changed, 10 insertions(+)

(limited to 'src/Contact.hs')

diff --git a/src/Contact.hs b/src/Contact.hs
index a4b5cf2..73a179f 100644
--- a/src/Contact.hs
+++ b/src/Contact.hs
@@ -5,6 +5,7 @@ module Contact (
     ContactService,
     contactRequest,
     contactAccept,
+    contactReject,
 ) where
 
 import Control.Arrow
@@ -127,6 +128,12 @@ instance PairingResult ContactAccepted where
             svcPrint $ "Contact accepted"
 
         , pairingHookVerifyFailed = return ()
+
+        , pairingHookRejected = do
+            svcPrint $ "Contact rejected by peer"
+
+        , pairingHookFailed = do
+            svcPrint $ "Contact failed"
         }
 
 contactRequest :: (MonadIO m, MonadError String m) => Peer -> m ()
@@ -135,6 +142,9 @@ contactRequest = pairingRequest @ContactAccepted Proxy
 contactAccept :: (MonadIO m, MonadError String m) => Peer -> m ()
 contactAccept = pairingAccept @ContactAccepted Proxy
 
+contactReject :: (MonadIO m, MonadError String m) => Peer -> m ()
+contactReject = pairingReject @ContactAccepted Proxy
+
 finalizeContact :: MonadIO m => UnifiedIdentity -> Stored LocalState -> m (Stored LocalState)
 finalizeContact identity slocal = liftIO $ do
     let st = storedStorage slocal
-- 
cgit v1.2.3