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