module Erebos.Contact ( Contact, contactIdentity, contactCustomName, contactName, contactSetName, ContactService, contactRequest, contactAccept, contactReject, ) where import Control.Monad import Control.Monad.Except import Control.Monad.Reader import Data.Maybe import Data.Proxy import Data.Text (Text) import qualified Data.Text as T import Erebos.Identity import Erebos.Network import Erebos.Pairing import Erebos.PubKey import Erebos.Service import Erebos.Set import Erebos.State import Erebos.Storage import Erebos.Storage.Merge data Contact = Contact { Contact -> [Stored ContactData] contactData :: [Stored ContactData] , Contact -> Maybe ComposedIdentity contactIdentity_ :: Maybe ComposedIdentity , Contact -> Maybe Text contactCustomName_ :: Maybe Text } data ContactData = ContactData { ContactData -> [Stored ContactData] cdPrev :: [Stored ContactData] , ContactData -> [Stored (Signed ExtendedIdentityData)] cdIdentity :: [Stored (Signed ExtendedIdentityData)] , ContactData -> Maybe Text cdName :: Maybe Text } instance Storable ContactData where store' :: ContactData -> Store store' ContactData x = (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 (Stored ContactData -> StoreRec c) -> [Stored ContactData] -> StoreRec c forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (String -> Stored ContactData -> StoreRec c forall a (c :: * -> *). (Storable a, StorageCompleteness c) => String -> a -> StoreRec c storeRef String "PREV") ([Stored ContactData] -> StoreRec c) -> [Stored ContactData] -> StoreRec c forall a b. (a -> b) -> a -> b $ ContactData -> [Stored ContactData] cdPrev ContactData x (Stored (Signed ExtendedIdentityData) -> StoreRec c) -> [Stored (Signed ExtendedIdentityData)] -> StoreRec c forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (String -> Stored (Signed ExtendedIdentityData) -> StoreRec c forall a (c :: * -> *). (Storable a, StorageCompleteness c) => String -> a -> StoreRec c storeRef String "identity") ([Stored (Signed ExtendedIdentityData)] -> StoreRec c) -> [Stored (Signed ExtendedIdentityData)] -> StoreRec c forall a b. (a -> b) -> a -> b $ ContactData -> [Stored (Signed ExtendedIdentityData)] cdIdentity ContactData x String -> Maybe Text -> StoreRec c forall a (c :: * -> *). StorableText a => String -> Maybe a -> StoreRec c storeMbText String "name" (Maybe Text -> StoreRec c) -> Maybe Text -> StoreRec c forall a b. (a -> b) -> a -> b $ ContactData -> Maybe Text cdName ContactData x load' :: Load ContactData load' = LoadRec ContactData -> Load ContactData forall a. LoadRec a -> Load a loadRec (LoadRec ContactData -> Load ContactData) -> LoadRec ContactData -> Load ContactData forall a b. (a -> b) -> a -> b $ [Stored ContactData] -> [Stored (Signed ExtendedIdentityData)] -> Maybe Text -> ContactData ContactData ([Stored ContactData] -> [Stored (Signed ExtendedIdentityData)] -> Maybe Text -> ContactData) -> LoadRec [Stored ContactData] -> LoadRec ([Stored (Signed ExtendedIdentityData)] -> Maybe Text -> ContactData) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> String -> LoadRec [Stored ContactData] forall a. Storable a => String -> LoadRec [a] loadRefs String "PREV" LoadRec ([Stored (Signed ExtendedIdentityData)] -> Maybe Text -> ContactData) -> LoadRec [Stored (Signed ExtendedIdentityData)] -> LoadRec (Maybe Text -> ContactData) 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 [Stored (Signed ExtendedIdentityData)] forall a. Storable a => String -> LoadRec [a] loadRefs String "identity" LoadRec (Maybe Text -> ContactData) -> LoadRec (Maybe Text) -> LoadRec ContactData 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 (Maybe Text) forall a. StorableText a => String -> LoadRec (Maybe a) loadMbText String "name" instance Mergeable Contact where type Component Contact = ContactData mergeSorted :: [Stored (Component Contact)] -> Contact mergeSorted [Stored (Component Contact)] cdata = Contact { contactData :: [Stored ContactData] contactData = [Stored (Component Contact)] [Stored ContactData] cdata , contactIdentity_ :: Maybe ComposedIdentity contactIdentity_ = [Stored (Signed ExtendedIdentityData)] -> Maybe ComposedIdentity forall (m :: * -> *). IdentityKind m => m (Stored (Signed ExtendedIdentityData)) -> Maybe (Identity m) validateExtendedIdentityF ([Stored (Signed ExtendedIdentityData)] -> Maybe ComposedIdentity) -> [Stored (Signed ExtendedIdentityData)] -> Maybe ComposedIdentity forall a b. (a -> b) -> a -> b $ [[Stored (Signed ExtendedIdentityData)]] -> [Stored (Signed ExtendedIdentityData)] forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat ([[Stored (Signed ExtendedIdentityData)]] -> [Stored (Signed ExtendedIdentityData)]) -> [[Stored (Signed ExtendedIdentityData)]] -> [Stored (Signed ExtendedIdentityData)] forall a b. (a -> b) -> a -> b $ (ContactData -> Maybe [Stored (Signed ExtendedIdentityData)]) -> [Stored ContactData] -> [[Stored (Signed ExtendedIdentityData)]] forall a b. Storable a => (a -> Maybe b) -> [Stored a] -> [b] findProperty ((\case [] -> Maybe [Stored (Signed ExtendedIdentityData)] forall a. Maybe a Nothing; [Stored (Signed ExtendedIdentityData)] xs -> [Stored (Signed ExtendedIdentityData)] -> Maybe [Stored (Signed ExtendedIdentityData)] forall a. a -> Maybe a Just [Stored (Signed ExtendedIdentityData)] xs) ([Stored (Signed ExtendedIdentityData)] -> Maybe [Stored (Signed ExtendedIdentityData)]) -> (ContactData -> [Stored (Signed ExtendedIdentityData)]) -> ContactData -> Maybe [Stored (Signed ExtendedIdentityData)] forall b c a. (b -> c) -> (a -> b) -> a -> c . ContactData -> [Stored (Signed ExtendedIdentityData)] cdIdentity) [Stored (Component Contact)] [Stored ContactData] cdata , contactCustomName_ :: Maybe Text contactCustomName_ = (ContactData -> Maybe Text) -> [Stored ContactData] -> Maybe Text forall a b. Storable a => (a -> Maybe b) -> [Stored a] -> Maybe b findPropertyFirst ContactData -> Maybe Text cdName [Stored (Component Contact)] [Stored ContactData] cdata } toComponents :: Contact -> [Stored (Component Contact)] toComponents = Contact -> [Stored (Component Contact)] Contact -> [Stored ContactData] contactData instance SharedType (Set Contact) where sharedTypeID :: forall (proxy :: * -> *). proxy (Set Contact) -> SharedTypeID sharedTypeID proxy (Set Contact) _ = String -> SharedTypeID mkSharedTypeID String "34fbb61e-6022-405f-b1b3-a5a1abecd25e" contactIdentity :: Contact -> Maybe ComposedIdentity contactIdentity :: Contact -> Maybe ComposedIdentity contactIdentity = Contact -> Maybe ComposedIdentity contactIdentity_ contactCustomName :: Contact -> Maybe Text contactCustomName :: Contact -> Maybe Text contactCustomName = Contact -> Maybe Text contactCustomName_ contactName :: Contact -> Text contactName :: Contact -> Text contactName Contact c = Maybe Text -> Text forall a. HasCallStack => Maybe a -> a fromJust (Maybe Text -> Text) -> Maybe Text -> Text forall a b. (a -> b) -> a -> b $ [Maybe Text] -> Maybe Text forall (t :: * -> *) (m :: * -> *) a. (Foldable t, MonadPlus m) => t (m a) -> m a msum [ Contact -> Maybe Text contactCustomName Contact c , ComposedIdentity -> Maybe Text forall (m :: * -> *). Identity m -> Maybe Text idName (ComposedIdentity -> Maybe Text) -> Maybe ComposedIdentity -> Maybe Text forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Contact -> Maybe ComposedIdentity contactIdentity Contact c , Text -> Maybe Text forall a. a -> Maybe a Just Text T.empty ] contactSetName :: MonadHead LocalState m => Contact -> Text -> Set Contact -> m (Set Contact) contactSetName :: forall (m :: * -> *). MonadHead LocalState m => Contact -> Text -> Set Contact -> m (Set Contact) contactSetName Contact contact Text name Set Contact set = do Storage st <- m Storage forall (m :: * -> *). MonadStorage m => m Storage getStorage Stored ContactData cdata <- Storage -> ContactData -> m (Stored ContactData) forall (m :: * -> *) a. (MonadIO m, Storable a) => Storage -> a -> m (Stored a) wrappedStore Storage st ContactData { cdPrev :: [Stored ContactData] cdPrev = Contact -> [Stored (Component Contact)] forall a. Mergeable a => a -> [Stored (Component a)] toComponents Contact contact , cdIdentity :: [Stored (Signed ExtendedIdentityData)] cdIdentity = [] , cdName :: Maybe Text cdName = Text -> Maybe Text forall a. a -> Maybe a Just Text name } Storage -> Contact -> Set Contact -> m (Set Contact) forall a (m :: * -> *). (Mergeable a, MonadIO m) => Storage -> a -> Set a -> m (Set a) storeSetAdd Storage st (forall a. Mergeable a => [Stored (Component a)] -> a mergeSorted @Contact [Stored (Component Contact) Stored ContactData cdata]) Set Contact set type ContactService = PairingService ContactAccepted data ContactAccepted = ContactAccepted instance Storable ContactAccepted where store' :: ContactAccepted -> Store store' ContactAccepted ContactAccepted = (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 -> String -> StoreRec c forall a (c :: * -> *). StorableText a => String -> a -> StoreRec c storeText String "accept" String "" load' :: Load ContactAccepted load' = LoadRec ContactAccepted -> Load ContactAccepted forall a. LoadRec a -> Load a loadRec (LoadRec ContactAccepted -> Load ContactAccepted) -> LoadRec ContactAccepted -> Load ContactAccepted forall a b. (a -> b) -> a -> b $ do (Text _ :: T.Text) <- String -> LoadRec Text forall a. StorableText a => String -> LoadRec a loadText String "accept" ContactAccepted -> LoadRec ContactAccepted forall a. a -> LoadRec a forall (m :: * -> *) a. Monad m => a -> m a return ContactAccepted ContactAccepted instance PairingResult ContactAccepted where pairingServiceID :: forall (proxy :: * -> *). proxy ContactAccepted -> ServiceID pairingServiceID proxy ContactAccepted _ = String -> ServiceID mkServiceID String "d9c37368-0da1-4280-93e9-d9bd9a198084" pairingVerifyResult :: ContactAccepted -> ServiceHandler (PairingService ContactAccepted) (Maybe (PairingVerifiedResult ContactAccepted)) pairingVerifyResult = Maybe ContactAccepted -> ServiceHandler (PairingService ContactAccepted) (Maybe ContactAccepted) forall a. a -> ServiceHandler (PairingService ContactAccepted) a forall (m :: * -> *) a. Monad m => a -> m a return (Maybe ContactAccepted -> ServiceHandler (PairingService ContactAccepted) (Maybe ContactAccepted)) -> (ContactAccepted -> Maybe ContactAccepted) -> ContactAccepted -> ServiceHandler (PairingService ContactAccepted) (Maybe ContactAccepted) forall b c a. (b -> c) -> (a -> b) -> a -> c . ContactAccepted -> Maybe ContactAccepted forall a. a -> Maybe a Just pairingFinalizeRequest :: PairingVerifiedResult ContactAccepted -> ServiceHandler (PairingService ContactAccepted) () pairingFinalizeRequest PairingVerifiedResult ContactAccepted ContactAccepted ContactAccepted = do UnifiedIdentity pid <- (ServiceInput (PairingService ContactAccepted) -> UnifiedIdentity) -> ServiceHandler (PairingService ContactAccepted) UnifiedIdentity forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ServiceInput (PairingService ContactAccepted) -> UnifiedIdentity forall s. ServiceInput s -> UnifiedIdentity svcPeerIdentity UnifiedIdentity -> ServiceHandler (PairingService ContactAccepted) () forall (m :: * -> *). MonadHead LocalState m => UnifiedIdentity -> m () finalizeContact UnifiedIdentity pid pairingFinalizeResponse :: ServiceHandler (PairingService ContactAccepted) ContactAccepted pairingFinalizeResponse = do UnifiedIdentity pid <- (ServiceInput (PairingService ContactAccepted) -> UnifiedIdentity) -> ServiceHandler (PairingService ContactAccepted) UnifiedIdentity forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ServiceInput (PairingService ContactAccepted) -> UnifiedIdentity forall s. ServiceInput s -> UnifiedIdentity svcPeerIdentity UnifiedIdentity -> ServiceHandler (PairingService ContactAccepted) () forall (m :: * -> *). MonadHead LocalState m => UnifiedIdentity -> m () finalizeContact UnifiedIdentity pid ContactAccepted -> ServiceHandler (PairingService ContactAccepted) ContactAccepted forall a. a -> ServiceHandler (PairingService ContactAccepted) a forall (m :: * -> *) a. Monad m => a -> m a return ContactAccepted ContactAccepted defaultPairingAttributes :: forall (proxy :: * -> *). proxy (PairingService ContactAccepted) -> PairingAttributes ContactAccepted defaultPairingAttributes proxy (PairingService ContactAccepted) _ = PairingAttributes { pairingHookRequest :: ServiceHandler (PairingService ContactAccepted) () pairingHookRequest = do UnifiedIdentity peer <- (ServiceInput (PairingService ContactAccepted) -> UnifiedIdentity) -> ServiceHandler (PairingService ContactAccepted) UnifiedIdentity forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ((ServiceInput (PairingService ContactAccepted) -> UnifiedIdentity) -> ServiceHandler (PairingService ContactAccepted) UnifiedIdentity) -> (ServiceInput (PairingService ContactAccepted) -> UnifiedIdentity) -> ServiceHandler (PairingService ContactAccepted) UnifiedIdentity forall a b. (a -> b) -> a -> b $ ServiceInput (PairingService ContactAccepted) -> UnifiedIdentity forall s. ServiceInput s -> UnifiedIdentity svcPeerIdentity String -> ServiceHandler (PairingService ContactAccepted) () forall s. String -> ServiceHandler s () svcPrint (String -> ServiceHandler (PairingService ContactAccepted) ()) -> String -> ServiceHandler (PairingService ContactAccepted) () forall a b. (a -> b) -> a -> b $ String "Contact pairing 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 ContactAccepted) () pairingHookResponse = \String confirm -> do UnifiedIdentity peer <- (ServiceInput (PairingService ContactAccepted) -> UnifiedIdentity) -> ServiceHandler (PairingService ContactAccepted) UnifiedIdentity forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ((ServiceInput (PairingService ContactAccepted) -> UnifiedIdentity) -> ServiceHandler (PairingService ContactAccepted) UnifiedIdentity) -> (ServiceInput (PairingService ContactAccepted) -> UnifiedIdentity) -> ServiceHandler (PairingService ContactAccepted) UnifiedIdentity forall a b. (a -> b) -> a -> b $ ServiceInput (PairingService ContactAccepted) -> UnifiedIdentity forall s. ServiceInput s -> UnifiedIdentity svcPeerIdentity String -> ServiceHandler (PairingService ContactAccepted) () forall s. String -> ServiceHandler s () svcPrint (String -> ServiceHandler (PairingService ContactAccepted) ()) -> String -> ServiceHandler (PairingService ContactAccepted) () forall a b. (a -> b) -> a -> b $ String "Confirm contact " String -> String -> String forall a. [a] -> [a] -> [a] ++ Text -> String T.unpack (ComposedIdentity -> Text forall (m :: * -> *). (Foldable m, Applicative m) => Identity m -> Text displayIdentity (ComposedIdentity -> Text) -> ComposedIdentity -> Text forall a b. (a -> b) -> a -> b $ UnifiedIdentity -> ComposedIdentity forall (m :: * -> *). (Foldable m, Applicative m) => Identity m -> ComposedIdentity finalOwner 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 ContactAccepted) () pairingHookRequestNonce = \String confirm -> do UnifiedIdentity peer <- (ServiceInput (PairingService ContactAccepted) -> UnifiedIdentity) -> ServiceHandler (PairingService ContactAccepted) UnifiedIdentity forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ((ServiceInput (PairingService ContactAccepted) -> UnifiedIdentity) -> ServiceHandler (PairingService ContactAccepted) UnifiedIdentity) -> (ServiceInput (PairingService ContactAccepted) -> UnifiedIdentity) -> ServiceHandler (PairingService ContactAccepted) UnifiedIdentity forall a b. (a -> b) -> a -> b $ ServiceInput (PairingService ContactAccepted) -> UnifiedIdentity forall s. ServiceInput s -> UnifiedIdentity svcPeerIdentity String -> ServiceHandler (PairingService ContactAccepted) () forall s. String -> ServiceHandler s () svcPrint (String -> ServiceHandler (PairingService ContactAccepted) ()) -> String -> ServiceHandler (PairingService ContactAccepted) () forall a b. (a -> b) -> a -> b $ String "Contact request from " String -> String -> String forall a. [a] -> [a] -> [a] ++ Text -> String T.unpack (ComposedIdentity -> Text forall (m :: * -> *). (Foldable m, Applicative m) => Identity m -> Text displayIdentity (ComposedIdentity -> Text) -> ComposedIdentity -> Text forall a b. (a -> b) -> a -> b $ UnifiedIdentity -> ComposedIdentity forall (m :: * -> *). (Foldable m, Applicative m) => Identity m -> ComposedIdentity finalOwner UnifiedIdentity peer) String -> String -> String forall a. [a] -> [a] -> [a] ++ String ": " String -> String -> String forall a. [a] -> [a] -> [a] ++ String confirm , pairingHookRequestNonceFailed :: ServiceHandler (PairingService ContactAccepted) () pairingHookRequestNonceFailed = do UnifiedIdentity peer <- (ServiceInput (PairingService ContactAccepted) -> UnifiedIdentity) -> ServiceHandler (PairingService ContactAccepted) UnifiedIdentity forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ((ServiceInput (PairingService ContactAccepted) -> UnifiedIdentity) -> ServiceHandler (PairingService ContactAccepted) UnifiedIdentity) -> (ServiceInput (PairingService ContactAccepted) -> UnifiedIdentity) -> ServiceHandler (PairingService ContactAccepted) UnifiedIdentity forall a b. (a -> b) -> a -> b $ ServiceInput (PairingService ContactAccepted) -> UnifiedIdentity forall s. ServiceInput s -> UnifiedIdentity svcPeerIdentity String -> ServiceHandler (PairingService ContactAccepted) () forall s. String -> ServiceHandler s () svcPrint (String -> ServiceHandler (PairingService ContactAccepted) ()) -> String -> ServiceHandler (PairingService ContactAccepted) () forall a b. (a -> b) -> a -> b $ String "Failed contact request 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 ContactAccepted) () pairingHookConfirmedResponse = do String -> ServiceHandler (PairingService ContactAccepted) () forall s. String -> ServiceHandler s () svcPrint (String -> ServiceHandler (PairingService ContactAccepted) ()) -> String -> ServiceHandler (PairingService ContactAccepted) () forall a b. (a -> b) -> a -> b $ String "Contact accepted, waiting for peer confirmation" , pairingHookConfirmedRequest :: ServiceHandler (PairingService ContactAccepted) () pairingHookConfirmedRequest = do String -> ServiceHandler (PairingService ContactAccepted) () forall s. String -> ServiceHandler s () svcPrint (String -> ServiceHandler (PairingService ContactAccepted) ()) -> String -> ServiceHandler (PairingService ContactAccepted) () forall a b. (a -> b) -> a -> b $ String "Contact confirmed by peer" , pairingHookAcceptedResponse :: ServiceHandler (PairingService ContactAccepted) () pairingHookAcceptedResponse = do String -> ServiceHandler (PairingService ContactAccepted) () forall s. String -> ServiceHandler s () svcPrint (String -> ServiceHandler (PairingService ContactAccepted) ()) -> String -> ServiceHandler (PairingService ContactAccepted) () forall a b. (a -> b) -> a -> b $ String "Contact accepted" , pairingHookAcceptedRequest :: ServiceHandler (PairingService ContactAccepted) () pairingHookAcceptedRequest = do String -> ServiceHandler (PairingService ContactAccepted) () forall s. String -> ServiceHandler s () svcPrint (String -> ServiceHandler (PairingService ContactAccepted) ()) -> String -> ServiceHandler (PairingService ContactAccepted) () forall a b. (a -> b) -> a -> b $ String "Contact accepted" , pairingHookVerifyFailed :: ServiceHandler (PairingService ContactAccepted) () pairingHookVerifyFailed = () -> ServiceHandler (PairingService ContactAccepted) () forall a. a -> ServiceHandler (PairingService ContactAccepted) a forall (m :: * -> *) a. Monad m => a -> m a return () , pairingHookRejected :: ServiceHandler (PairingService ContactAccepted) () pairingHookRejected = do String -> ServiceHandler (PairingService ContactAccepted) () forall s. String -> ServiceHandler s () svcPrint (String -> ServiceHandler (PairingService ContactAccepted) ()) -> String -> ServiceHandler (PairingService ContactAccepted) () forall a b. (a -> b) -> a -> b $ String "Contact rejected by peer" , pairingHookFailed :: PairingFailureReason ContactAccepted -> ServiceHandler (PairingService ContactAccepted) () pairingHookFailed = \PairingFailureReason ContactAccepted _ -> do String -> ServiceHandler (PairingService ContactAccepted) () forall s. String -> ServiceHandler s () svcPrint (String -> ServiceHandler (PairingService ContactAccepted) ()) -> String -> ServiceHandler (PairingService ContactAccepted) () forall a b. (a -> b) -> a -> b $ String "Contact failed" } contactRequest :: (MonadIO m, MonadError String m) => Peer -> m () contactRequest :: forall (m :: * -> *). (MonadIO m, MonadError String m) => Peer -> m () contactRequest = forall a (m :: * -> *) (proxy :: * -> *). (PairingResult a, MonadIO m, MonadError String m) => proxy a -> Peer -> m () pairingRequest @ContactAccepted Proxy ContactAccepted forall {k} (t :: k). Proxy t Proxy contactAccept :: (MonadIO m, MonadError String m) => Peer -> m () contactAccept :: forall (m :: * -> *). (MonadIO m, MonadError String m) => Peer -> m () contactAccept = forall a (m :: * -> *) (proxy :: * -> *). (PairingResult a, MonadIO m, MonadError String m) => proxy a -> Peer -> m () pairingAccept @ContactAccepted Proxy ContactAccepted forall {k} (t :: k). Proxy t Proxy contactReject :: (MonadIO m, MonadError String m) => Peer -> m () contactReject :: forall (m :: * -> *). (MonadIO m, MonadError String m) => Peer -> m () contactReject = forall a (m :: * -> *) (proxy :: * -> *). (PairingResult a, MonadIO m, MonadError String m) => proxy a -> Peer -> m () pairingReject @ContactAccepted Proxy ContactAccepted forall {k} (t :: k). Proxy t Proxy finalizeContact :: MonadHead LocalState m => UnifiedIdentity -> m () finalizeContact :: forall (m :: * -> *). MonadHead LocalState m => UnifiedIdentity -> m () finalizeContact UnifiedIdentity identity = (Stored LocalState -> m (Stored LocalState)) -> m () forall a (m :: * -> *). MonadHead a m => (Stored a -> m (Stored a)) -> m () updateLocalHead_ ((Stored LocalState -> m (Stored LocalState)) -> m ()) -> (Stored LocalState -> m (Stored LocalState)) -> m () forall a b. (a -> b) -> a -> b $ (Set Contact -> m (Set Contact)) -> Stored LocalState -> m (Stored LocalState) forall a (m :: * -> *). (SharedType a, MonadHead LocalState m) => (a -> m a) -> Stored LocalState -> m (Stored LocalState) updateSharedState_ ((Set Contact -> m (Set Contact)) -> Stored LocalState -> m (Stored LocalState)) -> (Set Contact -> m (Set Contact)) -> Stored LocalState -> m (Stored LocalState) forall a b. (a -> b) -> a -> b $ \Set Contact contacts -> do Storage st <- m Storage forall (m :: * -> *). MonadStorage m => m Storage getStorage Stored ContactData cdata <- Storage -> ContactData -> m (Stored ContactData) forall (m :: * -> *) a. (MonadIO m, Storable a) => Storage -> a -> m (Stored a) wrappedStore Storage st ContactData { cdPrev :: [Stored ContactData] cdPrev = [] , cdIdentity :: [Stored (Signed ExtendedIdentityData)] cdIdentity = ComposedIdentity -> [Stored (Signed ExtendedIdentityData)] forall (m :: * -> *). Identity m -> m (Stored (Signed ExtendedIdentityData)) idExtDataF (ComposedIdentity -> [Stored (Signed ExtendedIdentityData)]) -> ComposedIdentity -> [Stored (Signed ExtendedIdentityData)] forall a b. (a -> b) -> a -> b $ UnifiedIdentity -> ComposedIdentity forall (m :: * -> *). (Foldable m, Applicative m) => Identity m -> ComposedIdentity finalOwner UnifiedIdentity identity , cdName :: Maybe Text cdName = Maybe Text forall a. Maybe a Nothing } Storage -> Contact -> Set Contact -> m (Set Contact) forall a (m :: * -> *). (Mergeable a, MonadIO m) => Storage -> a -> Set a -> m (Set a) storeSetAdd Storage st (forall a. Mergeable a => [Stored (Component a)] -> a mergeSorted @Contact [Stored (Component Contact) Stored ContactData cdata]) Set Contact contacts