summaryrefslogtreecommitdiff
path: root/src/Erebos
diff options
context:
space:
mode:
Diffstat (limited to 'src/Erebos')
-rw-r--r--src/Erebos/Invite.hs36
1 files changed, 26 insertions, 10 deletions
diff --git a/src/Erebos/Invite.hs b/src/Erebos/Invite.hs
index f860fbc..bbd280d 100644
--- a/src/Erebos/Invite.hs
+++ b/src/Erebos/Invite.hs
@@ -1,6 +1,7 @@
module Erebos.Invite (
Invite(..),
InviteData(..),
+ InviteToken, showInviteToken, textInviteToken, parseInviteToken,
InviteService,
InviteServiceAttributes(..),
@@ -16,11 +17,13 @@ import Control.Monad.Reader
import Crypto.Random
+import Data.ByteArray (ByteArray, ByteArrayAccess)
import Data.ByteString (ByteString)
import Data.ByteString.Char8 qualified as BC
import Data.Foldable
import Data.Ord
import Data.Text (Text)
+import Data.Text.Encoding
import Erebos.Contact
import Erebos.Identity
@@ -37,14 +40,14 @@ import Erebos.Util
data Invite = Invite
{ inviteData :: [ Stored InviteData ]
- , inviteToken :: Maybe ByteString
+ , inviteToken :: Maybe InviteToken
, inviteAccepted :: [ Stored (Signed ExtendedIdentityData) ]
, inviteContact :: Maybe Text
}
data InviteData = InviteData
{ invdPrev :: [ Stored InviteData ]
- , invdToken :: Maybe ByteString
+ , invdToken :: Maybe InviteToken
, invdAccepted :: Maybe (Stored (Signed ExtendedIdentityData))
, invdContact :: Maybe Text
}
@@ -63,6 +66,19 @@ instance Storable InviteData where
<*> loadMbText "contact"
+newtype InviteToken = InviteToken ByteString
+ deriving (Eq, Ord, Semigroup, Monoid, ByteArray, ByteArrayAccess)
+
+showInviteToken :: InviteToken -> String
+showInviteToken (InviteToken token) = BC.unpack (showHex token)
+
+textInviteToken :: InviteToken -> Text
+textInviteToken (InviteToken token) = decodeUtf8 (showHex token)
+
+parseInviteToken :: Text -> Maybe InviteToken
+parseInviteToken text = InviteToken <$> (readHex $ encodeUtf8 text)
+
+
instance Mergeable Invite where
type Component Invite = InviteData
@@ -95,7 +111,7 @@ createSingleContactInvite name = do
identityOwnerDigests :: Foldable f => Identity f -> [ RefDigest ]
identityOwnerDigests pid = map (refDigest . storedRef) $ concatMap toList $ toList $ generations $ idExtDataF $ finalOwner pid
-acceptInvite :: (MonadIO m, MonadError e m, FromErebosError e) => Server -> RefDigest -> ByteString -> m ()
+acceptInvite :: (MonadIO m, MonadError e m, FromErebosError e) => Server -> RefDigest -> InviteToken -> m ()
acceptInvite server from token = do
let matchPeer peer = do
getPeerIdentity peer >>= \case
@@ -111,15 +127,15 @@ acceptInvite server from token = do
data InviteService
- = AcceptInvite ByteString
- | InvalidInvite ByteString
- | ContactInvite ByteString (Maybe Text)
+ = AcceptInvite InviteToken
+ | InvalidInvite InviteToken
+ | ContactInvite InviteToken (Maybe Text)
| UnknownInvitePacket
data InviteServiceAttributes = InviteServiceAttributes
- { inviteHookAccepted :: ByteString -> ServiceHandler InviteService ()
- , inviteHookReplyContact :: ByteString -> Maybe Text -> ServiceHandler InviteService ()
- , inviteHookReplyInvalid :: ByteString -> ServiceHandler InviteService ()
+ { inviteHookAccepted :: InviteToken -> ServiceHandler InviteService ()
+ , inviteHookReplyContact :: InviteToken -> Maybe Text -> ServiceHandler InviteService ()
+ , inviteHookReplyInvalid :: InviteToken -> ServiceHandler InviteService ()
}
defaultInviteServiceAttributes :: InviteServiceAttributes
@@ -151,7 +167,7 @@ instance Storable InviteService where
instance Service InviteService where
serviceID _ = mkServiceID "70bff715-6856-43a0-8c58-007a06a26eb1"
- type ServiceState InviteService = [ ByteString ] -- accepted invites, waiting for reply
+ type ServiceState InviteService = [ InviteToken ] -- accepted invites, waiting for reply
emptyServiceState _ = []
type ServiceAttributes InviteService = InviteServiceAttributes