module Erebos.Attach ( AttachService, attachToOwner, attachAccept, attachReject, ) where import Control.Monad import Control.Monad.Except import Control.Monad.Reader import Data.ByteArray (ScrubbedBytes) import Data.Maybe import Data.Proxy import qualified Data.Text as T import Erebos.Identity import Erebos.Network import Erebos.Pairing import Erebos.PubKey import Erebos.Service import Erebos.State import Erebos.Storage import Erebos.Storage.Key type AttachService = PairingService AttachIdentity data AttachIdentity = AttachIdentity (Stored (Signed IdentityData)) [ScrubbedBytes] instance Storable AttachIdentity where store' :: AttachIdentity -> Store store' (AttachIdentity Stored (Signed IdentityData) x [ScrubbedBytes] keys) = (forall (c :: * -> *). StorageCompleteness c => StoreRec c) -> Store storeRec ((forall (c :: * -> *). StorageCompleteness c => StoreRec c) -> Store) -> (forall (c :: * -> *). StorageCompleteness c => StoreRec c) -> Store forall a b. (a -> b) -> a -> b $ do String -> Stored (Signed IdentityData) -> StoreRec c forall a (c :: * -> *). (Storable a, StorageCompleteness c) => String -> a -> StoreRec c storeRef String "identity" Stored (Signed IdentityData) x (ScrubbedBytes -> StoreRec c) -> [ScrubbedBytes] -> StoreRec c forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (String -> ScrubbedBytes -> StoreRec c forall a (c :: * -> *). ByteArrayAccess a => String -> a -> StoreRec c storeBinary String "skey") [ScrubbedBytes] keys load' :: Load AttachIdentity load' = LoadRec AttachIdentity -> Load AttachIdentity forall a. LoadRec a -> Load a loadRec (LoadRec AttachIdentity -> Load AttachIdentity) -> LoadRec AttachIdentity -> Load AttachIdentity forall a b. (a -> b) -> a -> b $ Stored (Signed IdentityData) -> [ScrubbedBytes] -> AttachIdentity AttachIdentity (Stored (Signed IdentityData) -> [ScrubbedBytes] -> AttachIdentity) -> LoadRec (Stored (Signed IdentityData)) -> LoadRec ([ScrubbedBytes] -> AttachIdentity) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> String -> LoadRec (Stored (Signed IdentityData)) forall a. Storable a => String -> LoadRec a loadRef String "identity" LoadRec ([ScrubbedBytes] -> AttachIdentity) -> LoadRec [ScrubbedBytes] -> LoadRec AttachIdentity forall a b. LoadRec (a -> b) -> LoadRec a -> LoadRec b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> String -> LoadRec [ScrubbedBytes] forall a. ByteArray a => String -> LoadRec [a] loadBinaries String "skey" instance PairingResult AttachIdentity where pairingServiceID :: forall (proxy :: * -> *). proxy AttachIdentity -> ServiceID pairingServiceID proxy AttachIdentity _ = String -> ServiceID mkServiceID String "4995a5f9-2d4d-48e9-ad3b-0bf1c2a1be7f" type PairingVerifiedResult AttachIdentity = (UnifiedIdentity, [ScrubbedBytes]) pairingVerifyResult :: AttachIdentity -> ServiceHandler (PairingService AttachIdentity) (Maybe (PairingVerifiedResult AttachIdentity)) pairingVerifyResult (AttachIdentity Stored (Signed IdentityData) sdata [ScrubbedBytes] keys) = do Stored (Signed ExtendedIdentityData) curid <- LocalState -> Stored (Signed ExtendedIdentityData) lsIdentity (LocalState -> Stored (Signed ExtendedIdentityData)) -> (Stored LocalState -> LocalState) -> Stored LocalState -> Stored (Signed ExtendedIdentityData) forall b c a. (b -> c) -> (a -> b) -> a -> c . Stored LocalState -> LocalState forall a. Stored a -> a fromStored (Stored LocalState -> Stored (Signed ExtendedIdentityData)) -> ServiceHandler (PairingService AttachIdentity) (Stored LocalState) -> ServiceHandler (PairingService AttachIdentity) (Stored (Signed ExtendedIdentityData)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ServiceHandler (PairingService AttachIdentity) (Stored LocalState) forall s. ServiceHandler s (Stored LocalState) svcGetLocal SecretKey secret <- Stored PublicKey -> ServiceHandler (PairingService AttachIdentity) SecretKey forall sec pub (m :: * -> *). (KeyPair sec pub, MonadIO m, MonadError String m) => Stored pub -> m sec loadKey (Stored PublicKey -> ServiceHandler (PairingService AttachIdentity) SecretKey) -> Stored PublicKey -> ServiceHandler (PairingService AttachIdentity) SecretKey forall a b. (a -> b) -> a -> b $ ExtendedIdentityData -> Stored PublicKey eiddKeyIdentity (ExtendedIdentityData -> Stored PublicKey) -> ExtendedIdentityData -> Stored PublicKey forall a b. (a -> b) -> a -> b $ Stored (Signed ExtendedIdentityData) -> ExtendedIdentityData forall a. Stored (Signed a) -> a fromSigned Stored (Signed ExtendedIdentityData) curid Stored (Signed IdentityData) sdata' <- Signed IdentityData -> ServiceHandler (PairingService AttachIdentity) (Stored (Signed IdentityData)) forall a. Storable a => a -> ServiceHandler (PairingService AttachIdentity) (Stored a) forall (m :: * -> *) a. (MonadStorage m, Storable a) => a -> m (Stored a) mstore (Signed IdentityData -> ServiceHandler (PairingService AttachIdentity) (Stored (Signed IdentityData))) -> ServiceHandler (PairingService AttachIdentity) (Signed IdentityData) -> ServiceHandler (PairingService AttachIdentity) (Stored (Signed IdentityData)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< SecretKey -> Signed IdentityData -> ServiceHandler (PairingService AttachIdentity) (Signed IdentityData) forall (m :: * -> *) a. MonadStorage m => SecretKey -> Signed a -> m (Signed a) signAdd SecretKey secret (Stored (Signed IdentityData) -> Signed IdentityData forall a. Stored a -> a fromStored Stored (Signed IdentityData) sdata) Maybe (UnifiedIdentity, [ScrubbedBytes]) -> ServiceHandler (PairingService AttachIdentity) (Maybe (UnifiedIdentity, [ScrubbedBytes])) forall a. a -> ServiceHandler (PairingService AttachIdentity) a forall (m :: * -> *) a. Monad m => a -> m a return (Maybe (UnifiedIdentity, [ScrubbedBytes]) -> ServiceHandler (PairingService AttachIdentity) (Maybe (UnifiedIdentity, [ScrubbedBytes]))) -> Maybe (UnifiedIdentity, [ScrubbedBytes]) -> ServiceHandler (PairingService AttachIdentity) (Maybe (UnifiedIdentity, [ScrubbedBytes])) forall a b. (a -> b) -> a -> b $ do Bool -> Maybe () forall (f :: * -> *). Alternative f => Bool -> f () guard (Bool -> Maybe ()) -> Bool -> Maybe () forall a b. (a -> b) -> a -> b $ IdentityData -> Stored PublicKey iddKeyIdentity (Stored (Signed IdentityData) -> IdentityData forall a. Stored (Signed a) -> a fromSigned Stored (Signed IdentityData) sdata) Stored PublicKey -> Stored PublicKey -> Bool forall a. Eq a => a -> a -> Bool == ExtendedIdentityData -> Stored PublicKey eiddKeyIdentity (Stored (Signed ExtendedIdentityData) -> ExtendedIdentityData forall a. Stored (Signed a) -> a fromSigned Stored (Signed ExtendedIdentityData) curid) UnifiedIdentity identity <- Stored (Signed IdentityData) -> Maybe UnifiedIdentity validateIdentity Stored (Signed IdentityData) sdata' Bool -> Maybe () forall (f :: * -> *). Alternative f => Bool -> f () guard (Bool -> Maybe ()) -> Bool -> Maybe () forall a b. (a -> b) -> a -> b $ IdentityData -> [Stored (Signed IdentityData)] iddPrev (Stored (Signed IdentityData) -> IdentityData forall a. Stored (Signed a) -> a fromSigned (Stored (Signed IdentityData) -> IdentityData) -> Stored (Signed IdentityData) -> IdentityData forall a b. (a -> b) -> a -> b $ UnifiedIdentity -> Stored (Signed IdentityData) idData UnifiedIdentity identity) [Stored (Signed IdentityData)] -> [Stored (Signed IdentityData)] -> Bool forall a. Eq a => a -> a -> Bool == [Stored (Signed ExtendedIdentityData) -> Stored (Signed IdentityData) eiddStoredBase Stored (Signed ExtendedIdentityData) curid] (UnifiedIdentity, [ScrubbedBytes]) -> Maybe (UnifiedIdentity, [ScrubbedBytes]) forall a. a -> Maybe a forall (m :: * -> *) a. Monad m => a -> m a return (UnifiedIdentity identity, [ScrubbedBytes] keys) pairingFinalizeRequest :: PairingVerifiedResult AttachIdentity -> ServiceHandler (PairingService AttachIdentity) () pairingFinalizeRequest (UnifiedIdentity identity, [ScrubbedBytes] keys) = (Stored LocalState -> ServiceHandler (PairingService AttachIdentity) (Stored LocalState)) -> ServiceHandler (PairingService AttachIdentity) () forall a (m :: * -> *). MonadHead a m => (Stored a -> m (Stored a)) -> m () updateLocalHead_ ((Stored LocalState -> ServiceHandler (PairingService AttachIdentity) (Stored LocalState)) -> ServiceHandler (PairingService AttachIdentity) ()) -> (Stored LocalState -> ServiceHandler (PairingService AttachIdentity) (Stored LocalState)) -> ServiceHandler (PairingService AttachIdentity) () forall a b. (a -> b) -> a -> b $ \Stored LocalState slocal -> do let owner :: ComposedIdentity owner = UnifiedIdentity -> ComposedIdentity forall (m :: * -> *). (Foldable m, Applicative m) => Identity m -> ComposedIdentity finalOwner UnifiedIdentity identity Storage st <- ServiceHandler (PairingService AttachIdentity) Storage forall (m :: * -> *). MonadStorage m => m Storage getStorage [Stored PublicKey] pkeys <- (Stored PublicKey -> ServiceHandler (PairingService AttachIdentity) (Stored PublicKey)) -> [Stored PublicKey] -> ServiceHandler (PairingService AttachIdentity) [Stored PublicKey] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b] mapM (Storage -> Stored PublicKey -> ServiceHandler (PairingService AttachIdentity) (LoadResult Identity (Stored PublicKey)) forall (c :: * -> *) (c' :: * -> *) (m :: * -> *) a. (StorageCompleteness c, StorageCompleteness c', MonadIO m) => Storage' c' -> Stored' c a -> m (LoadResult c (Stored' c' a)) copyStored Storage st) [ ComposedIdentity -> Stored PublicKey forall (m :: * -> *). Identity m -> Stored PublicKey idKeyIdentity ComposedIdentity owner, ComposedIdentity -> Stored PublicKey forall (m :: * -> *). Identity m -> Stored PublicKey idKeyMessage ComposedIdentity owner ] IO () -> ServiceHandler (PairingService AttachIdentity) () forall a. IO a -> ServiceHandler (PairingService AttachIdentity) a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> ServiceHandler (PairingService AttachIdentity) ()) -> IO () -> ServiceHandler (PairingService AttachIdentity) () forall a b. (a -> b) -> a -> b $ (SecretKey -> IO ()) -> [SecretKey] -> IO () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ SecretKey -> IO () forall sec pub. KeyPair sec pub => sec -> IO () storeKey ([SecretKey] -> IO ()) -> [SecretKey] -> IO () forall a b. (a -> b) -> a -> b $ [Maybe SecretKey] -> [SecretKey] forall a. [Maybe a] -> [a] catMaybes [ ScrubbedBytes -> Stored PublicKey -> Maybe SecretKey forall sec pub. KeyPair sec pub => ScrubbedBytes -> Stored pub -> Maybe sec keyFromData ScrubbedBytes sec Stored PublicKey pub | ScrubbedBytes sec <- [ScrubbedBytes] keys, Stored PublicKey pub <- [Stored PublicKey] pkeys ] UnifiedIdentity identity' <- ComposedIdentity -> ServiceHandler (PairingService AttachIdentity) UnifiedIdentity forall (m :: * -> *) (f :: * -> *). (MonadStorage m, MonadError String m, MonadIO m) => Identity f -> m UnifiedIdentity mergeIdentity (ComposedIdentity -> ServiceHandler (PairingService AttachIdentity) UnifiedIdentity) -> ComposedIdentity -> ServiceHandler (PairingService AttachIdentity) UnifiedIdentity forall a b. (a -> b) -> a -> b $ [Stored (Signed ExtendedIdentityData)] -> UnifiedIdentity -> ComposedIdentity forall (m :: * -> *). [Stored (Signed ExtendedIdentityData)] -> Identity m -> ComposedIdentity updateIdentity [ LocalState -> Stored (Signed ExtendedIdentityData) lsIdentity (LocalState -> Stored (Signed ExtendedIdentityData)) -> LocalState -> Stored (Signed ExtendedIdentityData) forall a b. (a -> b) -> a -> b $ Stored LocalState -> LocalState forall a. Stored a -> a fromStored Stored LocalState slocal ] UnifiedIdentity identity Stored SharedState shared <- Storage -> Maybe ComposedIdentity -> [Stored SharedState] -> ServiceHandler (PairingService AttachIdentity) (Stored SharedState) forall a (m :: * -> *). (MonadIO m, SharedType a) => Storage -> a -> [Stored SharedState] -> m (Stored SharedState) makeSharedStateUpdate Storage st (ComposedIdentity -> Maybe ComposedIdentity forall a. a -> Maybe a Just ComposedIdentity owner) (LocalState -> [Stored SharedState] lsShared (LocalState -> [Stored SharedState]) -> LocalState -> [Stored SharedState] forall a b. (a -> b) -> a -> b $ Stored LocalState -> LocalState forall a. Stored a -> a fromStored Stored LocalState slocal) LocalState -> ServiceHandler (PairingService AttachIdentity) (Stored LocalState) forall a. Storable a => a -> ServiceHandler (PairingService AttachIdentity) (Stored a) forall (m :: * -> *) a. (MonadStorage m, Storable a) => a -> m (Stored a) mstore (Stored LocalState -> LocalState forall a. Stored a -> a fromStored Stored LocalState slocal) { lsIdentity = idExtData identity' , lsShared = [ shared ] } pairingFinalizeResponse :: ServiceHandler (PairingService AttachIdentity) AttachIdentity pairingFinalizeResponse = do UnifiedIdentity owner <- ServiceHandler (PairingService AttachIdentity) UnifiedIdentity forall (m :: * -> *). (MonadHead LocalState m, MonadError String m) => m UnifiedIdentity mergeSharedIdentity UnifiedIdentity pid <- (ServiceInput (PairingService AttachIdentity) -> UnifiedIdentity) -> ServiceHandler (PairingService AttachIdentity) UnifiedIdentity forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ServiceInput (PairingService AttachIdentity) -> UnifiedIdentity forall s. ServiceInput s -> UnifiedIdentity svcPeerIdentity SecretKey secret <- Stored PublicKey -> ServiceHandler (PairingService AttachIdentity) SecretKey forall sec pub (m :: * -> *). (KeyPair sec pub, MonadIO m, MonadError String m) => Stored pub -> m sec loadKey (Stored PublicKey -> ServiceHandler (PairingService AttachIdentity) SecretKey) -> Stored PublicKey -> ServiceHandler (PairingService AttachIdentity) SecretKey forall a b. (a -> b) -> a -> b $ UnifiedIdentity -> Stored PublicKey forall (m :: * -> *). Identity m -> Stored PublicKey idKeyIdentity UnifiedIdentity owner Stored (Signed IdentityData) identity <- Signed IdentityData -> ServiceHandler (PairingService AttachIdentity) (Stored (Signed IdentityData)) forall a. Storable a => a -> ServiceHandler (PairingService AttachIdentity) (Stored a) forall (m :: * -> *) a. (MonadStorage m, Storable a) => a -> m (Stored a) mstore (Signed IdentityData -> ServiceHandler (PairingService AttachIdentity) (Stored (Signed IdentityData))) -> ServiceHandler (PairingService AttachIdentity) (Signed IdentityData) -> ServiceHandler (PairingService AttachIdentity) (Stored (Signed IdentityData)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< SecretKey -> Stored IdentityData -> ServiceHandler (PairingService AttachIdentity) (Signed IdentityData) forall (m :: * -> *) a. MonadStorage m => SecretKey -> Stored a -> m (Signed a) sign SecretKey secret (Stored IdentityData -> ServiceHandler (PairingService AttachIdentity) (Signed IdentityData)) -> ServiceHandler (PairingService AttachIdentity) (Stored IdentityData) -> ServiceHandler (PairingService AttachIdentity) (Signed IdentityData) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< IdentityData -> ServiceHandler (PairingService AttachIdentity) (Stored IdentityData) forall a. Storable a => a -> ServiceHandler (PairingService AttachIdentity) (Stored a) forall (m :: * -> *) a. (MonadStorage m, Storable a) => a -> m (Stored a) mstore (Stored PublicKey -> IdentityData emptyIdentityData (Stored PublicKey -> IdentityData) -> Stored PublicKey -> IdentityData forall a b. (a -> b) -> a -> b $ UnifiedIdentity -> Stored PublicKey forall (m :: * -> *). Identity m -> Stored PublicKey idKeyIdentity UnifiedIdentity pid) { iddPrev = [idData pid], iddOwner = Just (idData owner) } [ScrubbedBytes] skeys <- (SecretKey -> ScrubbedBytes) -> [SecretKey] -> [ScrubbedBytes] forall a b. (a -> b) -> [a] -> [b] map SecretKey -> ScrubbedBytes forall sec pub. KeyPair sec pub => sec -> ScrubbedBytes keyGetData ([SecretKey] -> [ScrubbedBytes]) -> ([Maybe SecretKey] -> [SecretKey]) -> [Maybe SecretKey] -> [ScrubbedBytes] forall b c a. (b -> c) -> (a -> b) -> a -> c . [Maybe SecretKey] -> [SecretKey] forall a. [Maybe a] -> [a] catMaybes ([Maybe SecretKey] -> [ScrubbedBytes]) -> ServiceHandler (PairingService AttachIdentity) [Maybe SecretKey] -> ServiceHandler (PairingService AttachIdentity) [ScrubbedBytes] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Stored PublicKey -> ServiceHandler (PairingService AttachIdentity) (Maybe SecretKey)) -> [Stored PublicKey] -> ServiceHandler (PairingService AttachIdentity) [Maybe SecretKey] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b] mapM Stored PublicKey -> ServiceHandler (PairingService AttachIdentity) (Maybe SecretKey) forall sec pub (m :: * -> *). (KeyPair sec pub, MonadIO m) => Stored pub -> m (Maybe sec) loadKeyMb [ UnifiedIdentity -> Stored PublicKey forall (m :: * -> *). Identity m -> Stored PublicKey idKeyIdentity UnifiedIdentity owner, UnifiedIdentity -> Stored PublicKey forall (m :: * -> *). Identity m -> Stored PublicKey idKeyMessage UnifiedIdentity owner ] AttachIdentity -> ServiceHandler (PairingService AttachIdentity) AttachIdentity forall a. a -> ServiceHandler (PairingService AttachIdentity) a forall (m :: * -> *) a. Monad m => a -> m a return (AttachIdentity -> ServiceHandler (PairingService AttachIdentity) AttachIdentity) -> AttachIdentity -> ServiceHandler (PairingService AttachIdentity) AttachIdentity forall a b. (a -> b) -> a -> b $ Stored (Signed IdentityData) -> [ScrubbedBytes] -> AttachIdentity AttachIdentity Stored (Signed IdentityData) identity [ScrubbedBytes] skeys defaultPairingAttributes :: forall (proxy :: * -> *). proxy (PairingService AttachIdentity) -> PairingAttributes AttachIdentity defaultPairingAttributes proxy (PairingService AttachIdentity) _ = PairingAttributes { pairingHookRequest :: ServiceHandler (PairingService AttachIdentity) () pairingHookRequest = do UnifiedIdentity peer <- (ServiceInput (PairingService AttachIdentity) -> UnifiedIdentity) -> ServiceHandler (PairingService AttachIdentity) UnifiedIdentity forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ((ServiceInput (PairingService AttachIdentity) -> UnifiedIdentity) -> ServiceHandler (PairingService AttachIdentity) UnifiedIdentity) -> (ServiceInput (PairingService AttachIdentity) -> UnifiedIdentity) -> ServiceHandler (PairingService AttachIdentity) UnifiedIdentity forall a b. (a -> b) -> a -> b $ ServiceInput (PairingService AttachIdentity) -> UnifiedIdentity forall s. ServiceInput s -> UnifiedIdentity svcPeerIdentity String -> ServiceHandler (PairingService AttachIdentity) () forall s. String -> ServiceHandler s () svcPrint (String -> ServiceHandler (PairingService AttachIdentity) ()) -> String -> ServiceHandler (PairingService AttachIdentity) () forall a b. (a -> b) -> a -> b $ String "Attach from " String -> String -> String forall a. [a] -> [a] -> [a] ++ Text -> String T.unpack (UnifiedIdentity -> Text forall (m :: * -> *). (Foldable m, Applicative m) => Identity m -> Text displayIdentity UnifiedIdentity peer) String -> String -> String forall a. [a] -> [a] -> [a] ++ String " initiated" , pairingHookResponse :: String -> ServiceHandler (PairingService AttachIdentity) () pairingHookResponse = \String confirm -> do UnifiedIdentity peer <- (ServiceInput (PairingService AttachIdentity) -> UnifiedIdentity) -> ServiceHandler (PairingService AttachIdentity) UnifiedIdentity forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ((ServiceInput (PairingService AttachIdentity) -> UnifiedIdentity) -> ServiceHandler (PairingService AttachIdentity) UnifiedIdentity) -> (ServiceInput (PairingService AttachIdentity) -> UnifiedIdentity) -> ServiceHandler (PairingService AttachIdentity) UnifiedIdentity forall a b. (a -> b) -> a -> b $ ServiceInput (PairingService AttachIdentity) -> UnifiedIdentity forall s. ServiceInput s -> UnifiedIdentity svcPeerIdentity String -> ServiceHandler (PairingService AttachIdentity) () forall s. String -> ServiceHandler s () svcPrint (String -> ServiceHandler (PairingService AttachIdentity) ()) -> String -> ServiceHandler (PairingService AttachIdentity) () forall a b. (a -> b) -> a -> b $ String "Attach to " String -> String -> String forall a. [a] -> [a] -> [a] ++ Text -> String T.unpack (UnifiedIdentity -> Text forall (m :: * -> *). (Foldable m, Applicative m) => Identity m -> Text displayIdentity UnifiedIdentity peer) String -> String -> String forall a. [a] -> [a] -> [a] ++ String ": " String -> String -> String forall a. [a] -> [a] -> [a] ++ String confirm , pairingHookRequestNonce :: String -> ServiceHandler (PairingService AttachIdentity) () pairingHookRequestNonce = \String confirm -> do UnifiedIdentity peer <- (ServiceInput (PairingService AttachIdentity) -> UnifiedIdentity) -> ServiceHandler (PairingService AttachIdentity) UnifiedIdentity forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ((ServiceInput (PairingService AttachIdentity) -> UnifiedIdentity) -> ServiceHandler (PairingService AttachIdentity) UnifiedIdentity) -> (ServiceInput (PairingService AttachIdentity) -> UnifiedIdentity) -> ServiceHandler (PairingService AttachIdentity) UnifiedIdentity forall a b. (a -> b) -> a -> b $ ServiceInput (PairingService AttachIdentity) -> UnifiedIdentity forall s. ServiceInput s -> UnifiedIdentity svcPeerIdentity String -> ServiceHandler (PairingService AttachIdentity) () forall s. String -> ServiceHandler s () svcPrint (String -> ServiceHandler (PairingService AttachIdentity) ()) -> String -> ServiceHandler (PairingService AttachIdentity) () forall a b. (a -> b) -> a -> b $ String "Attach from " String -> String -> String forall a. [a] -> [a] -> [a] ++ Text -> String T.unpack (UnifiedIdentity -> Text forall (m :: * -> *). (Foldable m, Applicative m) => Identity m -> Text displayIdentity UnifiedIdentity peer) String -> String -> String forall a. [a] -> [a] -> [a] ++ String ": " String -> String -> String forall a. [a] -> [a] -> [a] ++ String confirm , pairingHookRequestNonceFailed :: ServiceHandler (PairingService AttachIdentity) () pairingHookRequestNonceFailed = do UnifiedIdentity peer <- (ServiceInput (PairingService AttachIdentity) -> UnifiedIdentity) -> ServiceHandler (PairingService AttachIdentity) UnifiedIdentity forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ((ServiceInput (PairingService AttachIdentity) -> UnifiedIdentity) -> ServiceHandler (PairingService AttachIdentity) UnifiedIdentity) -> (ServiceInput (PairingService AttachIdentity) -> UnifiedIdentity) -> ServiceHandler (PairingService AttachIdentity) UnifiedIdentity forall a b. (a -> b) -> a -> b $ ServiceInput (PairingService AttachIdentity) -> UnifiedIdentity forall s. ServiceInput s -> UnifiedIdentity svcPeerIdentity String -> ServiceHandler (PairingService AttachIdentity) () forall s. String -> ServiceHandler s () svcPrint (String -> ServiceHandler (PairingService AttachIdentity) ()) -> String -> ServiceHandler (PairingService AttachIdentity) () forall a b. (a -> b) -> a -> b $ String "Failed attach from " String -> String -> String forall a. [a] -> [a] -> [a] ++ Text -> String T.unpack (UnifiedIdentity -> Text forall (m :: * -> *). (Foldable m, Applicative m) => Identity m -> Text displayIdentity UnifiedIdentity peer) , pairingHookConfirmedResponse :: ServiceHandler (PairingService AttachIdentity) () pairingHookConfirmedResponse = do String -> ServiceHandler (PairingService AttachIdentity) () forall s. String -> ServiceHandler s () svcPrint (String -> ServiceHandler (PairingService AttachIdentity) ()) -> String -> ServiceHandler (PairingService AttachIdentity) () forall a b. (a -> b) -> a -> b $ String "Confirmed peer, waiting for updated identity" , pairingHookConfirmedRequest :: ServiceHandler (PairingService AttachIdentity) () pairingHookConfirmedRequest = do String -> ServiceHandler (PairingService AttachIdentity) () forall s. String -> ServiceHandler s () svcPrint (String -> ServiceHandler (PairingService AttachIdentity) ()) -> String -> ServiceHandler (PairingService AttachIdentity) () forall a b. (a -> b) -> a -> b $ String "Attachment confirmed by peer" , pairingHookAcceptedResponse :: ServiceHandler (PairingService AttachIdentity) () pairingHookAcceptedResponse = do String -> ServiceHandler (PairingService AttachIdentity) () forall s. String -> ServiceHandler s () svcPrint (String -> ServiceHandler (PairingService AttachIdentity) ()) -> String -> ServiceHandler (PairingService AttachIdentity) () forall a b. (a -> b) -> a -> b $ String "Accepted updated identity" , pairingHookAcceptedRequest :: ServiceHandler (PairingService AttachIdentity) () pairingHookAcceptedRequest = do String -> ServiceHandler (PairingService AttachIdentity) () forall s. String -> ServiceHandler s () svcPrint (String -> ServiceHandler (PairingService AttachIdentity) ()) -> String -> ServiceHandler (PairingService AttachIdentity) () forall a b. (a -> b) -> a -> b $ String "Accepted new attached device, seding updated identity" , pairingHookVerifyFailed :: ServiceHandler (PairingService AttachIdentity) () pairingHookVerifyFailed = do String -> ServiceHandler (PairingService AttachIdentity) () forall s. String -> ServiceHandler s () svcPrint (String -> ServiceHandler (PairingService AttachIdentity) ()) -> String -> ServiceHandler (PairingService AttachIdentity) () forall a b. (a -> b) -> a -> b $ String "Failed to verify new identity" , pairingHookRejected :: ServiceHandler (PairingService AttachIdentity) () pairingHookRejected = do String -> ServiceHandler (PairingService AttachIdentity) () forall s. String -> ServiceHandler s () svcPrint (String -> ServiceHandler (PairingService AttachIdentity) ()) -> String -> ServiceHandler (PairingService AttachIdentity) () forall a b. (a -> b) -> a -> b $ String "Attachment rejected by peer" , pairingHookFailed :: PairingFailureReason AttachIdentity -> ServiceHandler (PairingService AttachIdentity) () pairingHookFailed = \PairingFailureReason AttachIdentity _ -> do String -> ServiceHandler (PairingService AttachIdentity) () forall s. String -> ServiceHandler s () svcPrint (String -> ServiceHandler (PairingService AttachIdentity) ()) -> String -> ServiceHandler (PairingService AttachIdentity) () forall a b. (a -> b) -> a -> b $ String "Attachement failed" } attachToOwner :: (MonadIO m, MonadError String m) => Peer -> m () attachToOwner :: forall (m :: * -> *). (MonadIO m, MonadError String m) => Peer -> m () attachToOwner = forall a (m :: * -> *) (proxy :: * -> *). (PairingResult a, MonadIO m, MonadError String m) => proxy a -> Peer -> m () pairingRequest @AttachIdentity Proxy AttachIdentity forall {k} (t :: k). Proxy t Proxy attachAccept :: (MonadIO m, MonadError String m) => Peer -> m () attachAccept :: forall (m :: * -> *). (MonadIO m, MonadError String m) => Peer -> m () attachAccept = forall a (m :: * -> *) (proxy :: * -> *). (PairingResult a, MonadIO m, MonadError String m) => proxy a -> Peer -> m () pairingAccept @AttachIdentity Proxy AttachIdentity forall {k} (t :: k). Proxy t Proxy attachReject :: (MonadIO m, MonadError String m) => Peer -> m () attachReject :: forall (m :: * -> *). (MonadIO m, MonadError String m) => Peer -> m () attachReject = forall a (m :: * -> *) (proxy :: * -> *). (PairingResult a, MonadIO m, MonadError String m) => proxy a -> Peer -> m () pairingReject @AttachIdentity Proxy AttachIdentity forall {k} (t :: k). Proxy t Proxy