diff options
Diffstat (limited to 'src/Attach.hs')
-rw-r--r-- | src/Attach.hs | 69 |
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 |