Pairing: use service attributes for hooks

1 files changed, 35 insertions, 34 deletions

diff --git a/src/Attach.hs b/src/Attach.hs
index adb9d2f..89ed4bb 100644
--- a/src/Attach.hs
+++ b/src/Attach.hs
@@ -36,40 +36,41 @@ instance Storable AttachIdentity where
 
 instance PairingResult AttachIdentity where
     pairingServiceID _ = mkServiceID "4995a5f9-2d4d-48e9-ad3b-0bf1c2a1be7f"
-
-    pairingHookRequest = do
-        peer <- asks $ svcPeerIdentity
-        svcPrint $ "Attach from " ++ T.unpack (displayIdentity peer) ++ " initiated"
-
-    pairingHookResponse confirm = do
-        peer <- asks $ svcPeerIdentity
-        svcPrint $ "Attach to " ++ T.unpack (displayIdentity peer) ++ ": " ++ confirm
-
-    pairingHookRequestNonce confirm = do
-        peer <- asks $ svcPeerIdentity
-        svcPrint $ "Attach from " ++ T.unpack (displayIdentity peer) ++ ": " ++ confirm
-
-    pairingHookRequestNonceFailed = do
-        peer <- asks $ svcPeerIdentity
-        svcPrint $ "Failed attach from " ++ T.unpack (displayIdentity peer)
-
-    pairingHookConfirm (AttachIdentity sdata keys _) = do
-        verifyAttachedIdentity sdata >>= \case
-            Just identity -> do
-                svcPrint $ "Attachment confirmed by peer"
-                return $ Just $ AttachIdentity sdata keys (Just identity)
-            Nothing -> do
-                svcPrint $ "Failed to verify new identity"
-                throwError "Failed to verify new identity"
-
-    pairingHookAccept (AttachIdentity sdata keys _) = do
-        verifyAttachedIdentity sdata >>= \case
-            Just identity -> do
-                svcPrint $ "Accepted updated identity"
-                svcSetLocal =<< finalizeAttach identity keys =<< svcGetLocal
-            Nothing -> do
-                svcPrint $ "Failed to verify new identity"
-                throwError "Failed to verify new identity"
+    defaultPairingAttributes _ = PairingAttributes
+        { pairingHookRequest = do
+            peer <- asks $ svcPeerIdentity
+            svcPrint $ "Attach from " ++ T.unpack (displayIdentity peer) ++ " initiated"
+
+        , pairingHookResponse = \confirm -> do
+            peer <- asks $ svcPeerIdentity
+            svcPrint $ "Attach to " ++ T.unpack (displayIdentity peer) ++ ": " ++ confirm
+
+        , pairingHookRequestNonce = \confirm -> do
+            peer <- asks $ svcPeerIdentity
+            svcPrint $ "Attach from " ++ T.unpack (displayIdentity peer) ++ ": " ++ confirm
+
+        , pairingHookRequestNonceFailed = do
+            peer <- asks $ svcPeerIdentity
+            svcPrint $ "Failed attach from " ++ T.unpack (displayIdentity peer)
+
+        , pairingHookConfirm = \(AttachIdentity sdata keys _) -> do
+            verifyAttachedIdentity sdata >>= \case
+                Just identity -> do
+                    svcPrint $ "Attachment confirmed by peer"
+                    return $ Just $ AttachIdentity sdata keys (Just identity)
+                Nothing -> do
+                    svcPrint $ "Failed to verify new identity"
+                    throwError "Failed to verify new identity"
+
+        , pairingHookAccept = \(AttachIdentity sdata keys _) -> do
+            verifyAttachedIdentity sdata >>= \case
+                Just identity -> do
+                    svcPrint $ "Accepted updated identity"
+                    svcSetLocal =<< finalizeAttach identity keys =<< svcGetLocal
+                Nothing -> do
+                    svcPrint $ "Failed to verify new identity"
+                    throwError "Failed to verify new identity"
+        }
 
 attachToOwner :: (MonadIO m, MonadError String m) => (String -> IO ()) -> Peer -> m ()
 attachToOwner _ = pairingRequest @AttachIdentity Proxy