module Erebos.Pairing (
    PairingService(..),
    PairingState(..),
    PairingAttributes(..),
    PairingResult(..),
    PairingFailureReason(..),

    pairingRequest,
    pairingAccept,
    pairingReject,
) where

import Control.Monad
import Control.Monad.Except
import Control.Monad.Reader

import Crypto.Random

import Data.Bits
import Data.ByteArray (Bytes, convert)
import qualified Data.ByteArray as BA
import qualified Data.ByteString.Char8 as BC
import Data.Kind
import Data.Maybe
import Data.Typeable
import Data.Word

import Erebos.Identity
import Erebos.Network
import Erebos.PubKey
import Erebos.Service
import Erebos.State
import Erebos.Storage

data PairingService a = PairingRequest (Stored (Signed IdentityData)) (Stored (Signed IdentityData)) RefDigest
                      | PairingResponse Bytes
                      | PairingRequestNonce Bytes
                      | PairingAccept a
                      | PairingReject

data PairingState a = NoPairing
                    | OurRequest UnifiedIdentity UnifiedIdentity Bytes
                    | OurRequestConfirm (Maybe (PairingVerifiedResult a))
                    | OurRequestReady
                    | PeerRequest UnifiedIdentity UnifiedIdentity Bytes RefDigest
                    | PeerRequestConfirm
                    | PairingDone

data PairingFailureReason a = PairingUserRejected
                            | PairingUnexpectedMessage (PairingState a) (PairingService a)
                            | PairingFailedOther String

data PairingAttributes a = PairingAttributes
    { forall a.
PairingAttributes a -> ServiceHandler (PairingService a) ()
pairingHookRequest :: ServiceHandler (PairingService a) ()
    , forall a.
PairingAttributes a
-> String -> ServiceHandler (PairingService a) ()
pairingHookResponse :: String -> ServiceHandler (PairingService a) ()
    , forall a.
PairingAttributes a
-> String -> ServiceHandler (PairingService a) ()
pairingHookRequestNonce :: String -> ServiceHandler (PairingService a) ()
    , forall a.
PairingAttributes a -> ServiceHandler (PairingService a) ()
pairingHookRequestNonceFailed :: ServiceHandler (PairingService a) ()
    , forall a.
PairingAttributes a -> ServiceHandler (PairingService a) ()
pairingHookConfirmedResponse :: ServiceHandler (PairingService a) ()
    , forall a.
PairingAttributes a -> ServiceHandler (PairingService a) ()
pairingHookConfirmedRequest :: ServiceHandler (PairingService a) ()
    , forall a.
PairingAttributes a -> ServiceHandler (PairingService a) ()
pairingHookAcceptedResponse :: ServiceHandler (PairingService a) ()
    , forall a.
PairingAttributes a -> ServiceHandler (PairingService a) ()
pairingHookAcceptedRequest :: ServiceHandler (PairingService a) ()
    , forall a.
PairingAttributes a -> ServiceHandler (PairingService a) ()
pairingHookVerifyFailed :: ServiceHandler (PairingService a) ()
    , forall a.
PairingAttributes a -> ServiceHandler (PairingService a) ()
pairingHookRejected :: ServiceHandler (PairingService a) ()
    , forall a.
PairingAttributes a
-> PairingFailureReason a -> ServiceHandler (PairingService a) ()
pairingHookFailed :: PairingFailureReason a -> ServiceHandler (PairingService a) ()
    }

class (Typeable a, Storable a) => PairingResult a where
    type PairingVerifiedResult a :: Type
    type PairingVerifiedResult a = a

    pairingServiceID :: proxy a -> ServiceID
    pairingVerifyResult :: a -> ServiceHandler (PairingService a) (Maybe (PairingVerifiedResult a))
    pairingFinalizeRequest :: PairingVerifiedResult a -> ServiceHandler (PairingService a) ()
    pairingFinalizeResponse :: ServiceHandler (PairingService a) a
    defaultPairingAttributes :: proxy (PairingService a) -> PairingAttributes a


instance Storable a => Storable (PairingService a) where
    store' :: PairingService a -> Store
store' (PairingRequest Stored (Signed IdentityData)
idReq Stored (Signed IdentityData)
idRsp RefDigest
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
        String -> Stored (Signed IdentityData) -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
String -> a -> StoreRec c
storeRef String
"id-req" Stored (Signed IdentityData)
idReq
        String -> Stored (Signed IdentityData) -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
String -> a -> StoreRec c
storeRef String
"id-rsp" Stored (Signed IdentityData)
idRsp
        String -> RefDigest -> StoreRec c
forall a (c :: * -> *).
ByteArrayAccess a =>
String -> a -> StoreRec c
storeBinary String
"request" RefDigest
x
    store' (PairingResponse Bytes
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
$ String -> Bytes -> StoreRec c
forall a (c :: * -> *).
ByteArrayAccess a =>
String -> a -> StoreRec c
storeBinary String
"response" Bytes
x
    store' (PairingRequestNonce Bytes
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
$ String -> Bytes -> StoreRec c
forall a (c :: * -> *).
ByteArrayAccess a =>
String -> a -> StoreRec c
storeBinary String
"reqnonce" Bytes
x
    store' (PairingAccept a
x) = a -> Store
forall a. Storable a => a -> Store
store' a
x
    store' (PairingService a
PairingReject) = (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
$ String -> StoreRec c
forall (c :: * -> *). String -> StoreRec c
storeEmpty String
"reject"

    load' :: Load (PairingService a)
load' = do
        [PairingService a]
res <- LoadRec [PairingService a] -> Load [PairingService a]
forall a. LoadRec a -> Load a
loadRec (LoadRec [PairingService a] -> Load [PairingService a])
-> LoadRec [PairingService a] -> Load [PairingService a]
forall a b. (a -> b) -> a -> b
$ do
            (Maybe Bytes
req :: Maybe Bytes) <- String -> LoadRec (Maybe Bytes)
forall a. ByteArray a => String -> LoadRec (Maybe a)
loadMbBinary String
"request"
            Maybe (Stored (Signed IdentityData))
idReq <- String -> LoadRec (Maybe (Stored (Signed IdentityData)))
forall a. Storable a => String -> LoadRec (Maybe a)
loadMbRef String
"id-req"
            Maybe (Stored (Signed IdentityData))
idRsp <- String -> LoadRec (Maybe (Stored (Signed IdentityData)))
forall a. Storable a => String -> LoadRec (Maybe a)
loadMbRef String
"id-rsp"
            Maybe Bytes
rsp <- String -> LoadRec (Maybe Bytes)
forall a. ByteArray a => String -> LoadRec (Maybe a)
loadMbBinary String
"response"
            Maybe Bytes
rnonce <- String -> LoadRec (Maybe Bytes)
forall a. ByteArray a => String -> LoadRec (Maybe a)
loadMbBinary String
"reqnonce"
            Maybe ()
rej <- String -> LoadRec (Maybe ())
loadMbEmpty String
"reject"
            [PairingService a] -> LoadRec [PairingService a]
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PairingService a] -> LoadRec [PairingService a])
-> [PairingService a] -> LoadRec [PairingService a]
forall a b. (a -> b) -> a -> b
$ [Maybe (PairingService a)] -> [PairingService a]
forall a. [Maybe a] -> [a]
catMaybes
                    [ Stored (Signed IdentityData)
-> Stored (Signed IdentityData) -> RefDigest -> PairingService a
forall a.
Stored (Signed IdentityData)
-> Stored (Signed IdentityData) -> RefDigest -> PairingService a
PairingRequest (Stored (Signed IdentityData)
 -> Stored (Signed IdentityData) -> RefDigest -> PairingService a)
-> Maybe (Stored (Signed IdentityData))
-> Maybe
     (Stored (Signed IdentityData) -> RefDigest -> PairingService a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Stored (Signed IdentityData))
idReq Maybe
  (Stored (Signed IdentityData) -> RefDigest -> PairingService a)
-> Maybe (Stored (Signed IdentityData))
-> Maybe (RefDigest -> PairingService a)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Stored (Signed IdentityData))
idRsp Maybe (RefDigest -> PairingService a)
-> Maybe RefDigest -> Maybe (PairingService a)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bytes -> Maybe RefDigest
forall ba. ByteArrayAccess ba => ba -> Maybe RefDigest
refDigestFromByteString (Bytes -> Maybe RefDigest) -> Maybe Bytes -> Maybe RefDigest
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Bytes
req)
                    , Bytes -> PairingService a
forall a. Bytes -> PairingService a
PairingResponse (Bytes -> PairingService a)
-> Maybe Bytes -> Maybe (PairingService a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bytes
rsp
                    , Bytes -> PairingService a
forall a. Bytes -> PairingService a
PairingRequestNonce (Bytes -> PairingService a)
-> Maybe Bytes -> Maybe (PairingService a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bytes
rnonce
                    , PairingService a -> () -> PairingService a
forall a b. a -> b -> a
const PairingService a
forall a. PairingService a
PairingReject (() -> PairingService a) -> Maybe () -> Maybe (PairingService a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ()
rej
                    ]
        case [PairingService a]
res of
             PairingService a
x:[PairingService a]
_ -> PairingService a -> Load (PairingService a)
forall a. a -> Load a
forall (m :: * -> *) a. Monad m => a -> m a
return PairingService a
x
             [] -> a -> PairingService a
forall a. a -> PairingService a
PairingAccept (a -> PairingService a) -> Load a -> Load (PairingService a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Load a
forall a. Storable a => Load a
load'


instance PairingResult a => Service (PairingService a) where
    serviceID :: forall (proxy :: * -> *). proxy (PairingService a) -> ServiceID
serviceID proxy (PairingService a)
_ = forall a (proxy :: * -> *). PairingResult a => proxy a -> ServiceID
pairingServiceID @a Proxy a
forall {k} (t :: k). Proxy t
Proxy

    type ServiceAttributes (PairingService a) = PairingAttributes a
    defaultServiceAttributes :: forall (proxy :: * -> *).
proxy (PairingService a) -> ServiceAttributes (PairingService a)
defaultServiceAttributes = proxy (PairingService a) -> ServiceAttributes (PairingService a)
proxy (PairingService a) -> PairingAttributes a
forall a (proxy :: * -> *).
PairingResult a =>
proxy (PairingService a) -> PairingAttributes a
forall (proxy :: * -> *).
proxy (PairingService a) -> PairingAttributes a
defaultPairingAttributes

    type ServiceState (PairingService a) = PairingState a
    emptyServiceState :: forall (proxy :: * -> *).
proxy (PairingService a) -> ServiceState (PairingService a)
emptyServiceState proxy (PairingService a)
_ = ServiceState (PairingService a)
PairingState a
forall a. PairingState a
NoPairing

    serviceHandler :: Stored (PairingService a) -> ServiceHandler (PairingService a) ()
serviceHandler Stored (PairingService a)
spacket = ((,Stored (PairingService a) -> PairingService a
forall a. Stored a -> a
fromStored Stored (PairingService a)
spacket) (PairingState a -> (PairingState a, PairingService a))
-> ServiceHandler (PairingService a) (PairingState a)
-> ServiceHandler
     (PairingService a) (PairingState a, PairingService a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceHandler (PairingService a) (ServiceState (PairingService a))
ServiceHandler (PairingService a) (PairingState a)
forall s. ServiceHandler s (ServiceState s)
svcGet) ServiceHandler
  (PairingService a) (PairingState a, PairingService a)
-> ((PairingState a, PairingService a)
    -> ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall a b.
ServiceHandler (PairingService a) a
-> (a -> ServiceHandler (PairingService a) b)
-> ServiceHandler (PairingService a) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        (PairingState a
NoPairing, PairingRequest Stored (Signed IdentityData)
pdata Stored (Signed IdentityData)
sdata RefDigest
confirm) -> do
            UnifiedIdentity
self <- ServiceHandler (PairingService a) UnifiedIdentity
-> (UnifiedIdentity
    -> ServiceHandler (PairingService a) UnifiedIdentity)
-> Maybe UnifiedIdentity
-> ServiceHandler (PairingService a) UnifiedIdentity
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ServiceHandler (PairingService a) UnifiedIdentity
forall a. String -> ServiceHandler (PairingService a) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"failed to validate received identity") UnifiedIdentity
-> ServiceHandler (PairingService a) UnifiedIdentity
forall a. a -> ServiceHandler (PairingService a) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe UnifiedIdentity
 -> ServiceHandler (PairingService a) UnifiedIdentity)
-> Maybe UnifiedIdentity
-> ServiceHandler (PairingService a) UnifiedIdentity
forall a b. (a -> b) -> a -> b
$ Stored (Signed IdentityData) -> Maybe UnifiedIdentity
validateIdentity Stored (Signed IdentityData)
sdata
            UnifiedIdentity
self' <- ServiceHandler (PairingService a) UnifiedIdentity
-> (UnifiedIdentity
    -> ServiceHandler (PairingService a) UnifiedIdentity)
-> Maybe UnifiedIdentity
-> ServiceHandler (PairingService a) UnifiedIdentity
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ServiceHandler (PairingService a) UnifiedIdentity
forall a. String -> ServiceHandler (PairingService a) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"failed to validate own identity") UnifiedIdentity
-> ServiceHandler (PairingService a) UnifiedIdentity
forall a. a -> ServiceHandler (PairingService a) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe UnifiedIdentity
 -> ServiceHandler (PairingService a) UnifiedIdentity)
-> (Stored LocalState -> Maybe UnifiedIdentity)
-> Stored LocalState
-> ServiceHandler (PairingService a) UnifiedIdentity
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Stored (Signed ExtendedIdentityData) -> Maybe UnifiedIdentity
validateExtendedIdentity (Stored (Signed ExtendedIdentityData) -> Maybe UnifiedIdentity)
-> (Stored LocalState -> Stored (Signed ExtendedIdentityData))
-> Stored LocalState
-> Maybe UnifiedIdentity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
 -> ServiceHandler (PairingService a) UnifiedIdentity)
-> ServiceHandler (PairingService a) (Stored LocalState)
-> ServiceHandler (PairingService a) UnifiedIdentity
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ServiceHandler (PairingService a) (Stored LocalState)
forall s. ServiceHandler s (Stored LocalState)
svcGetLocal
            Bool
-> ServiceHandler (PairingService a) ()
-> ServiceHandler (PairingService a) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ UnifiedIdentity
self UnifiedIdentity -> UnifiedIdentity -> Bool
forall (m :: * -> *) (m' :: * -> *).
(Foldable m, Foldable m') =>
Identity m -> Identity m' -> Bool
`sameIdentity` UnifiedIdentity
self') (ServiceHandler (PairingService a) ()
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
-> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ do
                String -> ServiceHandler (PairingService a) ()
forall a. String -> ServiceHandler (PairingService a) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"pairing request to different identity"

            UnifiedIdentity
peer <- ServiceHandler (PairingService a) UnifiedIdentity
-> (UnifiedIdentity
    -> ServiceHandler (PairingService a) UnifiedIdentity)
-> Maybe UnifiedIdentity
-> ServiceHandler (PairingService a) UnifiedIdentity
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ServiceHandler (PairingService a) UnifiedIdentity
forall a. String -> ServiceHandler (PairingService a) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"failed to validate received peer identity") UnifiedIdentity
-> ServiceHandler (PairingService a) UnifiedIdentity
forall a. a -> ServiceHandler (PairingService a) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe UnifiedIdentity
 -> ServiceHandler (PairingService a) UnifiedIdentity)
-> Maybe UnifiedIdentity
-> ServiceHandler (PairingService a) UnifiedIdentity
forall a b. (a -> b) -> a -> b
$ Stored (Signed IdentityData) -> Maybe UnifiedIdentity
validateIdentity Stored (Signed IdentityData)
pdata
            UnifiedIdentity
peer' <- (ServiceInput (PairingService a) -> UnifiedIdentity)
-> ServiceHandler (PairingService a) UnifiedIdentity
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((ServiceInput (PairingService a) -> UnifiedIdentity)
 -> ServiceHandler (PairingService a) UnifiedIdentity)
-> (ServiceInput (PairingService a) -> UnifiedIdentity)
-> ServiceHandler (PairingService a) UnifiedIdentity
forall a b. (a -> b) -> a -> b
$ ServiceInput (PairingService a) -> UnifiedIdentity
forall s. ServiceInput s -> UnifiedIdentity
svcPeerIdentity
            Bool
-> ServiceHandler (PairingService a) ()
-> ServiceHandler (PairingService a) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ UnifiedIdentity
peer UnifiedIdentity -> UnifiedIdentity -> Bool
forall (m :: * -> *) (m' :: * -> *).
(Foldable m, Foldable m') =>
Identity m -> Identity m' -> Bool
`sameIdentity` UnifiedIdentity
peer') (ServiceHandler (PairingService a) ()
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
-> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ do
                String -> ServiceHandler (PairingService a) ()
forall a. String -> ServiceHandler (PairingService a) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"pairing request from different identity"

            ServiceHandler
  (PairingService a) (ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ServiceHandler
   (PairingService a) (ServiceHandler (PairingService a) ())
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ (ServiceInput (PairingService a)
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((ServiceInput (PairingService a)
  -> ServiceHandler (PairingService a) ())
 -> ServiceHandler
      (PairingService a) (ServiceHandler (PairingService a) ()))
-> (ServiceInput (PairingService a)
    -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
forall a b. (a -> b) -> a -> b
$ PairingAttributes a -> ServiceHandler (PairingService a) ()
forall a.
PairingAttributes a -> ServiceHandler (PairingService a) ()
pairingHookRequest (PairingAttributes a -> ServiceHandler (PairingService a) ())
-> (ServiceInput (PairingService a) -> PairingAttributes a)
-> ServiceInput (PairingService a)
-> ServiceHandler (PairingService a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceInput (PairingService a)
-> ServiceAttributes (PairingService a)
ServiceInput (PairingService a) -> PairingAttributes a
forall s. ServiceInput s -> ServiceAttributes s
svcAttributes
            Bytes
nonce <- IO Bytes -> ServiceHandler (PairingService a) Bytes
forall a. IO a -> ServiceHandler (PairingService a) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bytes -> ServiceHandler (PairingService a) Bytes)
-> IO Bytes -> ServiceHandler (PairingService a) Bytes
forall a b. (a -> b) -> a -> b
$ Int -> IO Bytes
forall byteArray. ByteArray byteArray => Int -> IO byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
            ServiceState (PairingService a)
-> ServiceHandler (PairingService a) ()
forall s. ServiceState s -> ServiceHandler s ()
svcSet (ServiceState (PairingService a)
 -> ServiceHandler (PairingService a) ())
-> ServiceState (PairingService a)
-> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ UnifiedIdentity
-> UnifiedIdentity -> Bytes -> RefDigest -> PairingState a
forall a.
UnifiedIdentity
-> UnifiedIdentity -> Bytes -> RefDigest -> PairingState a
PeerRequest UnifiedIdentity
peer UnifiedIdentity
self Bytes
nonce RefDigest
confirm
            PairingService a -> ServiceHandler (PairingService a) ()
forall s. Service s => s -> ServiceHandler s ()
replyPacket (PairingService a -> ServiceHandler (PairingService a) ())
-> PairingService a -> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ Bytes -> PairingService a
forall a. Bytes -> PairingService a
PairingResponse Bytes
nonce
        (PairingState a
NoPairing, PairingService a
_) -> () -> ServiceHandler (PairingService a) ()
forall a. a -> ServiceHandler (PairingService a) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        (PairingState a
PairingDone, PairingService a
_) -> () -> ServiceHandler (PairingService a) ()
forall a. a -> ServiceHandler (PairingService a) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        (PairingState a
_, PairingService a
PairingReject) -> do
            ServiceHandler
  (PairingService a) (ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ServiceHandler
   (PairingService a) (ServiceHandler (PairingService a) ())
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ (ServiceInput (PairingService a)
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((ServiceInput (PairingService a)
  -> ServiceHandler (PairingService a) ())
 -> ServiceHandler
      (PairingService a) (ServiceHandler (PairingService a) ()))
-> (ServiceInput (PairingService a)
    -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
forall a b. (a -> b) -> a -> b
$ PairingAttributes a -> ServiceHandler (PairingService a) ()
forall a.
PairingAttributes a -> ServiceHandler (PairingService a) ()
pairingHookRejected (PairingAttributes a -> ServiceHandler (PairingService a) ())
-> (ServiceInput (PairingService a) -> PairingAttributes a)
-> ServiceInput (PairingService a)
-> ServiceHandler (PairingService a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceInput (PairingService a)
-> ServiceAttributes (PairingService a)
ServiceInput (PairingService a) -> PairingAttributes a
forall s. ServiceInput s -> ServiceAttributes s
svcAttributes
            ServiceState (PairingService a)
-> ServiceHandler (PairingService a) ()
forall s. ServiceState s -> ServiceHandler s ()
svcSet ServiceState (PairingService a)
PairingState a
forall a. PairingState a
NoPairing

        (OurRequest UnifiedIdentity
self UnifiedIdentity
peer Bytes
nonce, PairingResponse Bytes
pnonce) -> do
            String -> ServiceHandler (PairingService a) ()
hook <- (ServiceInput (PairingService a)
 -> String -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (String -> ServiceHandler (PairingService a) ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((ServiceInput (PairingService a)
  -> String -> ServiceHandler (PairingService a) ())
 -> ServiceHandler
      (PairingService a)
      (String -> ServiceHandler (PairingService a) ()))
-> (ServiceInput (PairingService a)
    -> String -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (String -> ServiceHandler (PairingService a) ())
forall a b. (a -> b) -> a -> b
$ PairingAttributes a
-> String -> ServiceHandler (PairingService a) ()
forall a.
PairingAttributes a
-> String -> ServiceHandler (PairingService a) ()
pairingHookResponse (PairingAttributes a
 -> String -> ServiceHandler (PairingService a) ())
-> (ServiceInput (PairingService a) -> PairingAttributes a)
-> ServiceInput (PairingService a)
-> String
-> ServiceHandler (PairingService a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceInput (PairingService a)
-> ServiceAttributes (PairingService a)
ServiceInput (PairingService a) -> PairingAttributes a
forall s. ServiceInput s -> ServiceAttributes s
svcAttributes
            String -> ServiceHandler (PairingService a) ()
hook (String -> ServiceHandler (PairingService a) ())
-> String -> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ RefDigest -> String
confirmationNumber (RefDigest -> String) -> RefDigest -> String
forall a b. (a -> b) -> a -> b
$ UnifiedIdentity -> UnifiedIdentity -> Bytes -> Bytes -> RefDigest
nonceDigest UnifiedIdentity
self UnifiedIdentity
peer Bytes
nonce Bytes
pnonce
            ServiceState (PairingService a)
-> ServiceHandler (PairingService a) ()
forall s. ServiceState s -> ServiceHandler s ()
svcSet (ServiceState (PairingService a)
 -> ServiceHandler (PairingService a) ())
-> ServiceState (PairingService a)
-> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ Maybe (PairingVerifiedResult a) -> PairingState a
forall a. Maybe (PairingVerifiedResult a) -> PairingState a
OurRequestConfirm Maybe (PairingVerifiedResult a)
forall a. Maybe a
Nothing
            PairingService a -> ServiceHandler (PairingService a) ()
forall s. Service s => s -> ServiceHandler s ()
replyPacket (PairingService a -> ServiceHandler (PairingService a) ())
-> PairingService a -> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ Bytes -> PairingService a
forall a. Bytes -> PairingService a
PairingRequestNonce Bytes
nonce
        x :: (PairingState a, PairingService a)
x@(OurRequest {}, PairingService a
_) -> PairingFailureReason a -> ServiceHandler (PairingService a) ()
forall a.
PairingResult a =>
PairingFailureReason a -> ServiceHandler (PairingService a) ()
reject (PairingFailureReason a -> ServiceHandler (PairingService a) ())
-> PairingFailureReason a -> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ (PairingState a -> PairingService a -> PairingFailureReason a)
-> (PairingState a, PairingService a) -> PairingFailureReason a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PairingState a -> PairingService a -> PairingFailureReason a
forall a.
PairingState a -> PairingService a -> PairingFailureReason a
PairingUnexpectedMessage (PairingState a, PairingService a)
x

        (OurRequestConfirm Maybe (PairingVerifiedResult a)
_, PairingAccept a
x) -> do
            (ServiceHandler (PairingService a) ()
 -> (String -> ServiceHandler (PairingService a) ())
 -> ServiceHandler (PairingService a) ())
-> (String -> ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
-> ServiceHandler (PairingService a) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ServiceHandler (PairingService a) ()
-> (String -> ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall a.
ServiceHandler (PairingService a) a
-> (String -> ServiceHandler (PairingService a) a)
-> ServiceHandler (PairingService a) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (PairingFailureReason a -> ServiceHandler (PairingService a) ()
forall a.
PairingResult a =>
PairingFailureReason a -> ServiceHandler (PairingService a) ()
reject (PairingFailureReason a -> ServiceHandler (PairingService a) ())
-> (String -> PairingFailureReason a)
-> String
-> ServiceHandler (PairingService a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PairingFailureReason a
forall a. String -> PairingFailureReason a
PairingFailedOther) (ServiceHandler (PairingService a) ()
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
-> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ do
                a
-> ServiceHandler
     (PairingService a) (Maybe (PairingVerifiedResult a))
forall a.
PairingResult a =>
a
-> ServiceHandler
     (PairingService a) (Maybe (PairingVerifiedResult a))
pairingVerifyResult a
x ServiceHandler (PairingService a) (Maybe (PairingVerifiedResult a))
-> (Maybe (PairingVerifiedResult a)
    -> ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall a b.
ServiceHandler (PairingService a) a
-> (a -> ServiceHandler (PairingService a) b)
-> ServiceHandler (PairingService a) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Just PairingVerifiedResult a
x' -> do
                        ServiceHandler
  (PairingService a) (ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ServiceHandler
   (PairingService a) (ServiceHandler (PairingService a) ())
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ (ServiceInput (PairingService a)
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((ServiceInput (PairingService a)
  -> ServiceHandler (PairingService a) ())
 -> ServiceHandler
      (PairingService a) (ServiceHandler (PairingService a) ()))
-> (ServiceInput (PairingService a)
    -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
forall a b. (a -> b) -> a -> b
$ PairingAttributes a -> ServiceHandler (PairingService a) ()
forall a.
PairingAttributes a -> ServiceHandler (PairingService a) ()
pairingHookConfirmedRequest (PairingAttributes a -> ServiceHandler (PairingService a) ())
-> (ServiceInput (PairingService a) -> PairingAttributes a)
-> ServiceInput (PairingService a)
-> ServiceHandler (PairingService a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceInput (PairingService a)
-> ServiceAttributes (PairingService a)
ServiceInput (PairingService a) -> PairingAttributes a
forall s. ServiceInput s -> ServiceAttributes s
svcAttributes
                        ServiceState (PairingService a)
-> ServiceHandler (PairingService a) ()
forall s. ServiceState s -> ServiceHandler s ()
svcSet (ServiceState (PairingService a)
 -> ServiceHandler (PairingService a) ())
-> ServiceState (PairingService a)
-> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ Maybe (PairingVerifiedResult a) -> PairingState a
forall a. Maybe (PairingVerifiedResult a) -> PairingState a
OurRequestConfirm (PairingVerifiedResult a -> Maybe (PairingVerifiedResult a)
forall a. a -> Maybe a
Just PairingVerifiedResult a
x')
                    Maybe (PairingVerifiedResult a)
Nothing -> do
                        ServiceHandler
  (PairingService a) (ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ServiceHandler
   (PairingService a) (ServiceHandler (PairingService a) ())
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ (ServiceInput (PairingService a)
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((ServiceInput (PairingService a)
  -> ServiceHandler (PairingService a) ())
 -> ServiceHandler
      (PairingService a) (ServiceHandler (PairingService a) ()))
-> (ServiceInput (PairingService a)
    -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
forall a b. (a -> b) -> a -> b
$ PairingAttributes a -> ServiceHandler (PairingService a) ()
forall a.
PairingAttributes a -> ServiceHandler (PairingService a) ()
pairingHookVerifyFailed (PairingAttributes a -> ServiceHandler (PairingService a) ())
-> (ServiceInput (PairingService a) -> PairingAttributes a)
-> ServiceInput (PairingService a)
-> ServiceHandler (PairingService a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceInput (PairingService a)
-> ServiceAttributes (PairingService a)
ServiceInput (PairingService a) -> PairingAttributes a
forall s. ServiceInput s -> ServiceAttributes s
svcAttributes
                        ServiceState (PairingService a)
-> ServiceHandler (PairingService a) ()
forall s. ServiceState s -> ServiceHandler s ()
svcSet ServiceState (PairingService a)
PairingState a
forall a. PairingState a
NoPairing
                        PairingService a -> ServiceHandler (PairingService a) ()
forall s. Service s => s -> ServiceHandler s ()
replyPacket PairingService a
forall a. PairingService a
PairingReject

        x :: (PairingState a, PairingService a)
x@(OurRequestConfirm Maybe (PairingVerifiedResult a)
_, PairingService a
_) -> PairingFailureReason a -> ServiceHandler (PairingService a) ()
forall a.
PairingResult a =>
PairingFailureReason a -> ServiceHandler (PairingService a) ()
reject (PairingFailureReason a -> ServiceHandler (PairingService a) ())
-> PairingFailureReason a -> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ (PairingState a -> PairingService a -> PairingFailureReason a)
-> (PairingState a, PairingService a) -> PairingFailureReason a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PairingState a -> PairingService a -> PairingFailureReason a
forall a.
PairingState a -> PairingService a -> PairingFailureReason a
PairingUnexpectedMessage (PairingState a, PairingService a)
x

        (PairingState a
OurRequestReady, PairingAccept a
x) -> do
            (ServiceHandler (PairingService a) ()
 -> (String -> ServiceHandler (PairingService a) ())
 -> ServiceHandler (PairingService a) ())
-> (String -> ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
-> ServiceHandler (PairingService a) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ServiceHandler (PairingService a) ()
-> (String -> ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall a.
ServiceHandler (PairingService a) a
-> (String -> ServiceHandler (PairingService a) a)
-> ServiceHandler (PairingService a) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (PairingFailureReason a -> ServiceHandler (PairingService a) ()
forall a.
PairingResult a =>
PairingFailureReason a -> ServiceHandler (PairingService a) ()
reject (PairingFailureReason a -> ServiceHandler (PairingService a) ())
-> (String -> PairingFailureReason a)
-> String
-> ServiceHandler (PairingService a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PairingFailureReason a
forall a. String -> PairingFailureReason a
PairingFailedOther) (ServiceHandler (PairingService a) ()
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
-> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ do
                a
-> ServiceHandler
     (PairingService a) (Maybe (PairingVerifiedResult a))
forall a.
PairingResult a =>
a
-> ServiceHandler
     (PairingService a) (Maybe (PairingVerifiedResult a))
pairingVerifyResult a
x ServiceHandler (PairingService a) (Maybe (PairingVerifiedResult a))
-> (Maybe (PairingVerifiedResult a)
    -> ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall a b.
ServiceHandler (PairingService a) a
-> (a -> ServiceHandler (PairingService a) b)
-> ServiceHandler (PairingService a) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Just PairingVerifiedResult a
x' -> do
                        PairingVerifiedResult a -> ServiceHandler (PairingService a) ()
forall a.
PairingResult a =>
PairingVerifiedResult a -> ServiceHandler (PairingService a) ()
pairingFinalizeRequest PairingVerifiedResult a
x'
                        ServiceHandler
  (PairingService a) (ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ServiceHandler
   (PairingService a) (ServiceHandler (PairingService a) ())
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ (ServiceInput (PairingService a)
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((ServiceInput (PairingService a)
  -> ServiceHandler (PairingService a) ())
 -> ServiceHandler
      (PairingService a) (ServiceHandler (PairingService a) ()))
-> (ServiceInput (PairingService a)
    -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
forall a b. (a -> b) -> a -> b
$ PairingAttributes a -> ServiceHandler (PairingService a) ()
forall a.
PairingAttributes a -> ServiceHandler (PairingService a) ()
pairingHookAcceptedResponse (PairingAttributes a -> ServiceHandler (PairingService a) ())
-> (ServiceInput (PairingService a) -> PairingAttributes a)
-> ServiceInput (PairingService a)
-> ServiceHandler (PairingService a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceInput (PairingService a)
-> ServiceAttributes (PairingService a)
ServiceInput (PairingService a) -> PairingAttributes a
forall s. ServiceInput s -> ServiceAttributes s
svcAttributes
                        ServiceState (PairingService a)
-> ServiceHandler (PairingService a) ()
forall s. ServiceState s -> ServiceHandler s ()
svcSet (ServiceState (PairingService a)
 -> ServiceHandler (PairingService a) ())
-> ServiceState (PairingService a)
-> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ ServiceState (PairingService a)
PairingState a
forall a. PairingState a
PairingDone
                    Maybe (PairingVerifiedResult a)
Nothing -> do
                        ServiceHandler
  (PairingService a) (ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ServiceHandler
   (PairingService a) (ServiceHandler (PairingService a) ())
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ (ServiceInput (PairingService a)
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((ServiceInput (PairingService a)
  -> ServiceHandler (PairingService a) ())
 -> ServiceHandler
      (PairingService a) (ServiceHandler (PairingService a) ()))
-> (ServiceInput (PairingService a)
    -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
forall a b. (a -> b) -> a -> b
$ PairingAttributes a -> ServiceHandler (PairingService a) ()
forall a.
PairingAttributes a -> ServiceHandler (PairingService a) ()
pairingHookVerifyFailed (PairingAttributes a -> ServiceHandler (PairingService a) ())
-> (ServiceInput (PairingService a) -> PairingAttributes a)
-> ServiceInput (PairingService a)
-> ServiceHandler (PairingService a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceInput (PairingService a)
-> ServiceAttributes (PairingService a)
ServiceInput (PairingService a) -> PairingAttributes a
forall s. ServiceInput s -> ServiceAttributes s
svcAttributes
                        String -> ServiceHandler (PairingService a) ()
forall a. String -> ServiceHandler (PairingService a) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
""
        x :: (PairingState a, PairingService a)
x@(PairingState a
OurRequestReady, PairingService a
_) -> PairingFailureReason a -> ServiceHandler (PairingService a) ()
forall a.
PairingResult a =>
PairingFailureReason a -> ServiceHandler (PairingService a) ()
reject (PairingFailureReason a -> ServiceHandler (PairingService a) ())
-> PairingFailureReason a -> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ (PairingState a -> PairingService a -> PairingFailureReason a)
-> (PairingState a, PairingService a) -> PairingFailureReason a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PairingState a -> PairingService a -> PairingFailureReason a
forall a.
PairingState a -> PairingService a -> PairingFailureReason a
PairingUnexpectedMessage (PairingState a, PairingService a)
x

        (PeerRequest UnifiedIdentity
peer UnifiedIdentity
self Bytes
nonce RefDigest
dgst, PairingRequestNonce Bytes
pnonce) -> do
            if RefDigest
dgst RefDigest -> RefDigest -> Bool
forall a. Eq a => a -> a -> Bool
== UnifiedIdentity -> UnifiedIdentity -> Bytes -> Bytes -> RefDigest
nonceDigest UnifiedIdentity
peer UnifiedIdentity
self Bytes
pnonce Bytes
forall a. ByteArray a => a
BA.empty
               then do String -> ServiceHandler (PairingService a) ()
hook <- (ServiceInput (PairingService a)
 -> String -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (String -> ServiceHandler (PairingService a) ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((ServiceInput (PairingService a)
  -> String -> ServiceHandler (PairingService a) ())
 -> ServiceHandler
      (PairingService a)
      (String -> ServiceHandler (PairingService a) ()))
-> (ServiceInput (PairingService a)
    -> String -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (String -> ServiceHandler (PairingService a) ())
forall a b. (a -> b) -> a -> b
$ PairingAttributes a
-> String -> ServiceHandler (PairingService a) ()
forall a.
PairingAttributes a
-> String -> ServiceHandler (PairingService a) ()
pairingHookRequestNonce (PairingAttributes a
 -> String -> ServiceHandler (PairingService a) ())
-> (ServiceInput (PairingService a) -> PairingAttributes a)
-> ServiceInput (PairingService a)
-> String
-> ServiceHandler (PairingService a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceInput (PairingService a)
-> ServiceAttributes (PairingService a)
ServiceInput (PairingService a) -> PairingAttributes a
forall s. ServiceInput s -> ServiceAttributes s
svcAttributes
                       String -> ServiceHandler (PairingService a) ()
hook (String -> ServiceHandler (PairingService a) ())
-> String -> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ RefDigest -> String
confirmationNumber (RefDigest -> String) -> RefDigest -> String
forall a b. (a -> b) -> a -> b
$ UnifiedIdentity -> UnifiedIdentity -> Bytes -> Bytes -> RefDigest
nonceDigest UnifiedIdentity
peer UnifiedIdentity
self Bytes
pnonce Bytes
nonce
                       ServiceState (PairingService a)
-> ServiceHandler (PairingService a) ()
forall s. ServiceState s -> ServiceHandler s ()
svcSet ServiceState (PairingService a)
PairingState a
forall a. PairingState a
PeerRequestConfirm
               else do ServiceHandler
  (PairingService a) (ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ServiceHandler
   (PairingService a) (ServiceHandler (PairingService a) ())
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ (ServiceInput (PairingService a)
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((ServiceInput (PairingService a)
  -> ServiceHandler (PairingService a) ())
 -> ServiceHandler
      (PairingService a) (ServiceHandler (PairingService a) ()))
-> (ServiceInput (PairingService a)
    -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
forall a b. (a -> b) -> a -> b
$ PairingAttributes a -> ServiceHandler (PairingService a) ()
forall a.
PairingAttributes a -> ServiceHandler (PairingService a) ()
pairingHookRequestNonceFailed (PairingAttributes a -> ServiceHandler (PairingService a) ())
-> (ServiceInput (PairingService a) -> PairingAttributes a)
-> ServiceInput (PairingService a)
-> ServiceHandler (PairingService a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceInput (PairingService a)
-> ServiceAttributes (PairingService a)
ServiceInput (PairingService a) -> PairingAttributes a
forall s. ServiceInput s -> ServiceAttributes s
svcAttributes
                       ServiceState (PairingService a)
-> ServiceHandler (PairingService a) ()
forall s. ServiceState s -> ServiceHandler s ()
svcSet ServiceState (PairingService a)
PairingState a
forall a. PairingState a
NoPairing
                       PairingService a -> ServiceHandler (PairingService a) ()
forall s. Service s => s -> ServiceHandler s ()
replyPacket PairingService a
forall a. PairingService a
PairingReject
        x :: (PairingState a, PairingService a)
x@(PeerRequest {}, PairingService a
_) -> PairingFailureReason a -> ServiceHandler (PairingService a) ()
forall a.
PairingResult a =>
PairingFailureReason a -> ServiceHandler (PairingService a) ()
reject (PairingFailureReason a -> ServiceHandler (PairingService a) ())
-> PairingFailureReason a -> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ (PairingState a -> PairingService a -> PairingFailureReason a)
-> (PairingState a, PairingService a) -> PairingFailureReason a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PairingState a -> PairingService a -> PairingFailureReason a
forall a.
PairingState a -> PairingService a -> PairingFailureReason a
PairingUnexpectedMessage (PairingState a, PairingService a)
x
        x :: (PairingState a, PairingService a)
x@(PairingState a
PeerRequestConfirm, PairingService a
_) -> PairingFailureReason a -> ServiceHandler (PairingService a) ()
forall a.
PairingResult a =>
PairingFailureReason a -> ServiceHandler (PairingService a) ()
reject (PairingFailureReason a -> ServiceHandler (PairingService a) ())
-> PairingFailureReason a -> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ (PairingState a -> PairingService a -> PairingFailureReason a)
-> (PairingState a, PairingService a) -> PairingFailureReason a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PairingState a -> PairingService a -> PairingFailureReason a
forall a.
PairingState a -> PairingService a -> PairingFailureReason a
PairingUnexpectedMessage (PairingState a, PairingService a)
x

reject :: PairingResult a => PairingFailureReason a -> ServiceHandler (PairingService a) ()
reject :: forall a.
PairingResult a =>
PairingFailureReason a -> ServiceHandler (PairingService a) ()
reject PairingFailureReason a
reason = do
    ServiceHandler
  (PairingService a) (ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ServiceHandler
   (PairingService a) (ServiceHandler (PairingService a) ())
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ (ServiceInput (PairingService a)
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((ServiceInput (PairingService a)
  -> ServiceHandler (PairingService a) ())
 -> ServiceHandler
      (PairingService a) (ServiceHandler (PairingService a) ()))
-> (ServiceInput (PairingService a)
    -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
forall a b. (a -> b) -> a -> b
$ (PairingAttributes a
 -> PairingFailureReason a -> ServiceHandler (PairingService a) ())
-> PairingFailureReason a
-> PairingAttributes a
-> ServiceHandler (PairingService a) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip PairingAttributes a
-> PairingFailureReason a -> ServiceHandler (PairingService a) ()
forall a.
PairingAttributes a
-> PairingFailureReason a -> ServiceHandler (PairingService a) ()
pairingHookFailed PairingFailureReason a
reason (PairingAttributes a -> ServiceHandler (PairingService a) ())
-> (ServiceInput (PairingService a) -> PairingAttributes a)
-> ServiceInput (PairingService a)
-> ServiceHandler (PairingService a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceInput (PairingService a)
-> ServiceAttributes (PairingService a)
ServiceInput (PairingService a) -> PairingAttributes a
forall s. ServiceInput s -> ServiceAttributes s
svcAttributes
    ServiceState (PairingService a)
-> ServiceHandler (PairingService a) ()
forall s. ServiceState s -> ServiceHandler s ()
svcSet ServiceState (PairingService a)
PairingState a
forall a. PairingState a
NoPairing
    PairingService a -> ServiceHandler (PairingService a) ()
forall s. Service s => s -> ServiceHandler s ()
replyPacket PairingService a
forall a. PairingService a
PairingReject


nonceDigest :: UnifiedIdentity -> UnifiedIdentity -> Bytes -> Bytes -> RefDigest
nonceDigest :: UnifiedIdentity -> UnifiedIdentity -> Bytes -> Bytes -> RefDigest
nonceDigest UnifiedIdentity
idReq UnifiedIdentity
idRsp Bytes
nonceReq Bytes
nonceRsp = ByteString -> RefDigest
hashToRefDigest (ByteString -> RefDigest) -> ByteString -> RefDigest
forall a b. (a -> b) -> a -> b
$ Object' Identity -> ByteString
forall (c :: * -> *). Object' c -> ByteString
serializeObject (Object' Identity -> ByteString) -> Object' Identity -> ByteString
forall a b. (a -> b) -> a -> b
$ [(ByteString, RecItem' Identity)] -> Object' Identity
forall (c :: * -> *). [(ByteString, RecItem' c)] -> Object' c
Rec
        [ (String -> ByteString
BC.pack String
"id-req", Ref -> RecItem' Identity
forall (c :: * -> *). Ref' c -> RecItem' c
RecRef (Ref -> RecItem' Identity) -> Ref -> RecItem' Identity
forall a b. (a -> b) -> a -> b
$ Stored (Signed IdentityData) -> Ref
forall a. Stored a -> Ref
storedRef (Stored (Signed IdentityData) -> Ref)
-> Stored (Signed IdentityData) -> Ref
forall a b. (a -> b) -> a -> b
$ UnifiedIdentity -> Stored (Signed IdentityData)
idData UnifiedIdentity
idReq)
        , (String -> ByteString
BC.pack String
"id-rsp", Ref -> RecItem' Identity
forall (c :: * -> *). Ref' c -> RecItem' c
RecRef (Ref -> RecItem' Identity) -> Ref -> RecItem' Identity
forall a b. (a -> b) -> a -> b
$ Stored (Signed IdentityData) -> Ref
forall a. Stored a -> Ref
storedRef (Stored (Signed IdentityData) -> Ref)
-> Stored (Signed IdentityData) -> Ref
forall a b. (a -> b) -> a -> b
$ UnifiedIdentity -> Stored (Signed IdentityData)
idData UnifiedIdentity
idRsp)
        , (String -> ByteString
BC.pack String
"nonce-req", ByteString -> RecItem' Identity
forall (c :: * -> *). ByteString -> RecItem' c
RecBinary (ByteString -> RecItem' Identity)
-> ByteString -> RecItem' Identity
forall a b. (a -> b) -> a -> b
$ Bytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert Bytes
nonceReq)
        , (String -> ByteString
BC.pack String
"nonce-rsp", ByteString -> RecItem' Identity
forall (c :: * -> *). ByteString -> RecItem' c
RecBinary (ByteString -> RecItem' Identity)
-> ByteString -> RecItem' Identity
forall a b. (a -> b) -> a -> b
$ Bytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert Bytes
nonceRsp)
        ]

confirmationNumber :: RefDigest -> String
confirmationNumber :: RefDigest -> String
confirmationNumber RefDigest
dgst =
    case (Word8 -> Word32) -> [Word8] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word8] -> [Word32]) -> [Word8] -> [Word32]
forall a b. (a -> b) -> a -> b
$ RefDigest -> [Word8]
forall a. ByteArrayAccess a => a -> [Word8]
BA.unpack RefDigest
dgst :: [Word32] of
         (Word32
a:Word32
b:Word32
c:Word32
d:[Word32]
_) -> let str :: String
str = Word32 -> String
forall a. Show a => a -> String
show (Word32 -> String) -> Word32 -> String
forall a b. (a -> b) -> a -> b
$ ((Word32
a Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shift` Int
24) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
b Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shift` Int
16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
c Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shift` Int
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
d) Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`mod` (Word32
10 Word32 -> Int -> Word32
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
len)
                         in Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str) Char
'0' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str
         [Word32]
_ -> String
""
    where len :: Int
len = Int
6

pairingRequest :: forall a m proxy. (PairingResult a, MonadIO m, MonadError String m) => proxy a -> Peer -> m ()
pairingRequest :: forall a (m :: * -> *) (proxy :: * -> *).
(PairingResult a, MonadIO m, MonadError String m) =>
proxy a -> Peer -> m ()
pairingRequest proxy a
_ Peer
peer = do
    UnifiedIdentity
self <- IO UnifiedIdentity -> m UnifiedIdentity
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UnifiedIdentity -> m UnifiedIdentity)
-> IO UnifiedIdentity -> m UnifiedIdentity
forall a b. (a -> b) -> a -> b
$ Server -> IO UnifiedIdentity
serverIdentity (Server -> IO UnifiedIdentity) -> Server -> IO UnifiedIdentity
forall a b. (a -> b) -> a -> b
$ Peer -> Server
peerServer Peer
peer
    Bytes
nonce <- IO Bytes -> m Bytes
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bytes -> m Bytes) -> IO Bytes -> m Bytes
forall a b. (a -> b) -> a -> b
$ Int -> IO Bytes
forall byteArray. ByteArray byteArray => Int -> IO byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
    UnifiedIdentity
pid <- Peer -> m PeerIdentity
forall (m :: * -> *). MonadIO m => Peer -> m PeerIdentity
peerIdentity Peer
peer m PeerIdentity
-> (PeerIdentity -> m UnifiedIdentity) -> m UnifiedIdentity
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        PeerIdentityFull UnifiedIdentity
pid -> UnifiedIdentity -> m UnifiedIdentity
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UnifiedIdentity
pid
        PeerIdentity
_ -> String -> m UnifiedIdentity
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"incomplete peer identity"
    forall s (m :: * -> *).
(Service s, MonadIO m, MonadError String m) =>
Peer
-> (ServiceState s -> ExceptT String IO (Maybe s, ServiceState s))
-> m ()
sendToPeerWith @(PairingService a) Peer
peer ((ServiceState (PairingService a)
  -> ExceptT
       String
       IO
       (Maybe (PairingService a), ServiceState (PairingService a)))
 -> m ())
-> (ServiceState (PairingService a)
    -> ExceptT
         String
         IO
         (Maybe (PairingService a), ServiceState (PairingService a)))
-> m ()
forall a b. (a -> b) -> a -> b
$ \case
        ServiceState (PairingService a)
PairingState a
NoPairing -> (Maybe (PairingService a), PairingState a)
-> ExceptT String IO (Maybe (PairingService a), PairingState a)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PairingService a -> Maybe (PairingService a)
forall a. a -> Maybe a
Just (PairingService a -> Maybe (PairingService a))
-> PairingService a -> Maybe (PairingService a)
forall a b. (a -> b) -> a -> b
$ Stored (Signed IdentityData)
-> Stored (Signed IdentityData) -> RefDigest -> PairingService a
forall a.
Stored (Signed IdentityData)
-> Stored (Signed IdentityData) -> RefDigest -> PairingService a
PairingRequest (UnifiedIdentity -> Stored (Signed IdentityData)
idData UnifiedIdentity
self) (UnifiedIdentity -> Stored (Signed IdentityData)
idData UnifiedIdentity
pid) (UnifiedIdentity -> UnifiedIdentity -> Bytes -> Bytes -> RefDigest
nonceDigest UnifiedIdentity
self UnifiedIdentity
pid Bytes
nonce Bytes
forall a. ByteArray a => a
BA.empty), UnifiedIdentity -> UnifiedIdentity -> Bytes -> PairingState a
forall a.
UnifiedIdentity -> UnifiedIdentity -> Bytes -> PairingState a
OurRequest UnifiedIdentity
self UnifiedIdentity
pid Bytes
nonce)
        ServiceState (PairingService a)
_ -> String
-> ExceptT String IO (Maybe (PairingService a), PairingState a)
forall a. String -> ExceptT String IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"already in progress"

pairingAccept :: forall a m proxy. (PairingResult a, MonadIO m, MonadError String m) => proxy a -> Peer -> m ()
pairingAccept :: forall a (m :: * -> *) (proxy :: * -> *).
(PairingResult a, MonadIO m, MonadError String m) =>
proxy a -> Peer -> m ()
pairingAccept proxy a
_ Peer
peer = forall s (m :: * -> *).
(Service s, MonadIO m) =>
Peer -> ServiceHandler s () -> m ()
runPeerService @(PairingService a) Peer
peer (ServiceHandler (PairingService a) () -> m ())
-> ServiceHandler (PairingService a) () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    ServiceHandler (PairingService a) (ServiceState (PairingService a))
ServiceHandler (PairingService a) (PairingState a)
forall s. ServiceHandler s (ServiceState s)
svcGet ServiceHandler (PairingService a) (PairingState a)
-> (PairingState a -> ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall a b.
ServiceHandler (PairingService a) a
-> (a -> ServiceHandler (PairingService a) b)
-> ServiceHandler (PairingService a) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        PairingState a
NoPairing -> String -> ServiceHandler (PairingService a) ()
forall a. String -> ServiceHandler (PairingService a) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ServiceHandler (PairingService a) ())
-> String -> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ String
"none in progress"
        OurRequest {} -> String -> ServiceHandler (PairingService a) ()
forall a. String -> ServiceHandler (PairingService a) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ServiceHandler (PairingService a) ())
-> String -> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ String
"waiting for peer"
        OurRequestConfirm Maybe (PairingVerifiedResult a)
Nothing -> do
            ServiceHandler
  (PairingService a) (ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ServiceHandler
   (PairingService a) (ServiceHandler (PairingService a) ())
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ (ServiceInput (PairingService a)
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((ServiceInput (PairingService a)
  -> ServiceHandler (PairingService a) ())
 -> ServiceHandler
      (PairingService a) (ServiceHandler (PairingService a) ()))
-> (ServiceInput (PairingService a)
    -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
forall a b. (a -> b) -> a -> b
$ PairingAttributes a -> ServiceHandler (PairingService a) ()
forall a.
PairingAttributes a -> ServiceHandler (PairingService a) ()
pairingHookConfirmedResponse (PairingAttributes a -> ServiceHandler (PairingService a) ())
-> (ServiceInput (PairingService a) -> PairingAttributes a)
-> ServiceInput (PairingService a)
-> ServiceHandler (PairingService a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceInput (PairingService a)
-> ServiceAttributes (PairingService a)
ServiceInput (PairingService a) -> PairingAttributes a
forall s. ServiceInput s -> ServiceAttributes s
svcAttributes
            ServiceState (PairingService a)
-> ServiceHandler (PairingService a) ()
forall s. ServiceState s -> ServiceHandler s ()
svcSet ServiceState (PairingService a)
PairingState a
forall a. PairingState a
OurRequestReady
        OurRequestConfirm (Just PairingVerifiedResult a
verified) -> do
            ServiceHandler
  (PairingService a) (ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ServiceHandler
   (PairingService a) (ServiceHandler (PairingService a) ())
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ (ServiceInput (PairingService a)
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((ServiceInput (PairingService a)
  -> ServiceHandler (PairingService a) ())
 -> ServiceHandler
      (PairingService a) (ServiceHandler (PairingService a) ()))
-> (ServiceInput (PairingService a)
    -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
forall a b. (a -> b) -> a -> b
$ PairingAttributes a -> ServiceHandler (PairingService a) ()
forall a.
PairingAttributes a -> ServiceHandler (PairingService a) ()
pairingHookAcceptedResponse (PairingAttributes a -> ServiceHandler (PairingService a) ())
-> (ServiceInput (PairingService a) -> PairingAttributes a)
-> ServiceInput (PairingService a)
-> ServiceHandler (PairingService a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceInput (PairingService a)
-> ServiceAttributes (PairingService a)
ServiceInput (PairingService a) -> PairingAttributes a
forall s. ServiceInput s -> ServiceAttributes s
svcAttributes
            PairingVerifiedResult a -> ServiceHandler (PairingService a) ()
forall a.
PairingResult a =>
PairingVerifiedResult a -> ServiceHandler (PairingService a) ()
pairingFinalizeRequest PairingVerifiedResult a
verified
            ServiceState (PairingService a)
-> ServiceHandler (PairingService a) ()
forall s. ServiceState s -> ServiceHandler s ()
svcSet ServiceState (PairingService a)
PairingState a
forall a. PairingState a
PairingDone
        PairingState a
OurRequestReady -> String -> ServiceHandler (PairingService a) ()
forall a. String -> ServiceHandler (PairingService a) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ServiceHandler (PairingService a) ())
-> String -> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ String
"already accepted, waiting for peer"
        PeerRequest {} -> String -> ServiceHandler (PairingService a) ()
forall a. String -> ServiceHandler (PairingService a) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ServiceHandler (PairingService a) ())
-> String -> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ String
"waiting for peer"
        PairingState a
PeerRequestConfirm -> do
            ServiceHandler
  (PairingService a) (ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ServiceHandler
   (PairingService a) (ServiceHandler (PairingService a) ())
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ (ServiceInput (PairingService a)
 -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((ServiceInput (PairingService a)
  -> ServiceHandler (PairingService a) ())
 -> ServiceHandler
      (PairingService a) (ServiceHandler (PairingService a) ()))
-> (ServiceInput (PairingService a)
    -> ServiceHandler (PairingService a) ())
-> ServiceHandler
     (PairingService a) (ServiceHandler (PairingService a) ())
forall a b. (a -> b) -> a -> b
$ PairingAttributes a -> ServiceHandler (PairingService a) ()
forall a.
PairingAttributes a -> ServiceHandler (PairingService a) ()
pairingHookAcceptedRequest (PairingAttributes a -> ServiceHandler (PairingService a) ())
-> (ServiceInput (PairingService a) -> PairingAttributes a)
-> ServiceInput (PairingService a)
-> ServiceHandler (PairingService a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceInput (PairingService a)
-> ServiceAttributes (PairingService a)
ServiceInput (PairingService a) -> PairingAttributes a
forall s. ServiceInput s -> ServiceAttributes s
svcAttributes
            PairingService a -> ServiceHandler (PairingService a) ()
forall s. Service s => s -> ServiceHandler s ()
replyPacket (PairingService a -> ServiceHandler (PairingService a) ())
-> (a -> PairingService a)
-> a
-> ServiceHandler (PairingService a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PairingService a
forall a. a -> PairingService a
PairingAccept (a -> ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) a
-> ServiceHandler (PairingService a) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ServiceHandler (PairingService a) a
forall a. PairingResult a => ServiceHandler (PairingService a) a
pairingFinalizeResponse
            ServiceState (PairingService a)
-> ServiceHandler (PairingService a) ()
forall s. ServiceState s -> ServiceHandler s ()
svcSet ServiceState (PairingService a)
PairingState a
forall a. PairingState a
PairingDone
        PairingState a
PairingDone -> String -> ServiceHandler (PairingService a) ()
forall a. String -> ServiceHandler (PairingService a) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ServiceHandler (PairingService a) ())
-> String -> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ String
"already done"

pairingReject :: forall a m proxy. (PairingResult a, MonadIO m, MonadError String m) => proxy a -> Peer -> m ()
pairingReject :: forall a (m :: * -> *) (proxy :: * -> *).
(PairingResult a, MonadIO m, MonadError String m) =>
proxy a -> Peer -> m ()
pairingReject proxy a
_ Peer
peer = forall s (m :: * -> *).
(Service s, MonadIO m) =>
Peer -> ServiceHandler s () -> m ()
runPeerService @(PairingService a) Peer
peer (ServiceHandler (PairingService a) () -> m ())
-> ServiceHandler (PairingService a) () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    ServiceHandler (PairingService a) (ServiceState (PairingService a))
ServiceHandler (PairingService a) (PairingState a)
forall s. ServiceHandler s (ServiceState s)
svcGet ServiceHandler (PairingService a) (PairingState a)
-> (PairingState a -> ServiceHandler (PairingService a) ())
-> ServiceHandler (PairingService a) ()
forall a b.
ServiceHandler (PairingService a) a
-> (a -> ServiceHandler (PairingService a) b)
-> ServiceHandler (PairingService a) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        PairingState a
NoPairing -> String -> ServiceHandler (PairingService a) ()
forall a. String -> ServiceHandler (PairingService a) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ServiceHandler (PairingService a) ())
-> String -> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ String
"none in progress"
        PairingState a
PairingDone -> String -> ServiceHandler (PairingService a) ()
forall a. String -> ServiceHandler (PairingService a) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ServiceHandler (PairingService a) ())
-> String -> ServiceHandler (PairingService a) ()
forall a b. (a -> b) -> a -> b
$ String
"already done"
        PairingState a
_ -> PairingFailureReason a -> ServiceHandler (PairingService a) ()
forall a.
PairingResult a =>
PairingFailureReason a -> ServiceHandler (PairingService a) ()
reject PairingFailureReason a
forall a. PairingFailureReason a
PairingUserRejected