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