diff options
Diffstat (limited to 'src/Contact.hs')
-rw-r--r-- | src/Contact.hs | 34 |
1 files changed, 18 insertions, 16 deletions
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 |