From 8416b3e959fd0f6ade7c2b61a6caea681ee03e15 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sun, 19 Dec 2021 22:59:01 +0100
Subject: Pairing: use service attributes for hooks

---
 src/Contact.hs | 34 ++++++++++++++++++----------------
 1 file changed, 18 insertions(+), 16 deletions(-)

(limited to 'src/Contact.hs')

diff --git a/src/Contact.hs b/src/Contact.hs
index 01bd49d..9accc4d 100644
--- a/src/Contact.hs
+++ b/src/Contact.hs
@@ -86,27 +86,29 @@ instance Storable ContactAccepted where
 instance PairingResult ContactAccepted where
     pairingServiceID _ = mkServiceID "d9c37368-0da1-4280-93e9-d9bd9a198084"
 
-    pairingHookRequest = do
-        peer <- asks $ svcPeerIdentity
-        svcPrint $ "Contact pairing from " ++ T.unpack (displayIdentity peer) ++ " initiated"
+    defaultPairingAttributes _ = PairingAttributes
+        { pairingHookRequest = do
+            peer <- asks $ svcPeerIdentity
+            svcPrint $ "Contact pairing from " ++ T.unpack (displayIdentity peer) ++ " initiated"
 
-    pairingHookResponse confirm = do
-        peer <- asks $ svcPeerIdentity
-        svcPrint $ "Confirm contact " ++ T.unpack (displayIdentity $ finalOwner peer) ++ ": " ++ confirm
+        , pairingHookResponse = \confirm -> do
+            peer <- asks $ svcPeerIdentity
+            svcPrint $ "Confirm contact " ++ T.unpack (displayIdentity $ finalOwner peer) ++ ": " ++ confirm
 
-    pairingHookRequestNonce confirm = do
-        peer <- asks $ svcPeerIdentity
-        svcPrint $ "Contact request from " ++ T.unpack (displayIdentity $ finalOwner peer) ++ ": " ++ confirm
+        , pairingHookRequestNonce = \confirm -> do
+            peer <- asks $ svcPeerIdentity
+            svcPrint $ "Contact request from " ++ T.unpack (displayIdentity $ finalOwner peer) ++ ": " ++ confirm
 
-    pairingHookRequestNonceFailed = do
-        peer <- asks $ svcPeerIdentity
-        svcPrint $ "Failed contact request from " ++ T.unpack (displayIdentity peer)
+        , pairingHookRequestNonceFailed = do
+            peer <- asks $ svcPeerIdentity
+            svcPrint $ "Failed contact request from " ++ T.unpack (displayIdentity peer)
 
-    pairingHookConfirm ContactAccepted = do
-        svcPrint $ "Contact confirmed by peer"
-        return $ Just ContactAccepted
+        , pairingHookConfirm = \ContactAccepted -> do
+            svcPrint $ "Contact confirmed by peer"
+            return $ Just ContactAccepted
 
-    pairingHookAccept ContactAccepted = return ()
+        , pairingHookAccept = \ContactAccepted -> return ()
+        }
 
 contactRequest :: (MonadIO m, MonadError String m) => (String -> IO ()) -> Peer -> m ()
 contactRequest _ = pairingRequest @ContactAccepted Proxy
-- 
cgit v1.2.3