diff options
| -rw-r--r-- | main/Main.hs | 5 | ||||
| -rw-r--r-- | src/Erebos/Invite.hs | 20 |
2 files changed, 20 insertions, 5 deletions
diff --git a/main/Main.hs b/main/Main.hs index a876d7b..c1f30f2 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -37,12 +37,13 @@ import System.Exit import System.IO import Erebos.Attach -import Erebos.Contact import Erebos.Chatroom +import Erebos.Contact import Erebos.Conversation import Erebos.DirectMessage import Erebos.Discovery import Erebos.Identity +import Erebos.Invite import Erebos.Network import Erebos.Object import Erebos.PubKey @@ -111,6 +112,8 @@ availableServices = True "direct messages" , ServiceOption "discovery" (someService @DiscoveryService Proxy) True "peer discovery" + , ServiceOption "invite" (someService @InviteService Proxy) + True "invites handling" ] options :: [ OptDescr (Options -> Writer [ String ] Options) ] diff --git a/src/Erebos/Invite.hs b/src/Erebos/Invite.hs index bbd280d..faeb646 100644 --- a/src/Erebos/Invite.hs +++ b/src/Erebos/Invite.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + module Erebos.Invite ( Invite(..), InviteData(..), @@ -23,6 +25,7 @@ import Data.ByteString.Char8 qualified as BC import Data.Foldable import Data.Ord import Data.Text (Text) +import Data.Text qualified as T import Data.Text.Encoding import Erebos.Contact @@ -140,9 +143,19 @@ data InviteServiceAttributes = InviteServiceAttributes defaultInviteServiceAttributes :: InviteServiceAttributes defaultInviteServiceAttributes = InviteServiceAttributes - { inviteHookAccepted = \_ -> return () - , inviteHookReplyContact = \_ _ -> return () - , inviteHookReplyInvalid = \_ -> return () + { inviteHookAccepted = \token -> do + pid <- asks $ svcPeerIdentity + svcPrint $ T.unpack $ "Invite accepted by " <> displayIdentity pid + <> " (token: " <> textInviteToken token <> ")" + , inviteHookReplyContact = \token mbName -> do + pid <- asks $ svcPeerIdentity + svcPrint $ T.unpack $ "Invite confirmed by " <> displayIdentity pid + <> (maybe "" (" with name " <>) mbName) + <> " (token: " <> textInviteToken token <> ")" + , inviteHookReplyInvalid = \token -> do + pid <- asks $ svcPeerIdentity + svcPrint $ T.unpack $ "Invite rejected as invalid by " <> displayIdentity pid + <> " (token: " <> textInviteToken token <> ")" } instance Storable InviteService where @@ -207,7 +220,6 @@ instance Service InviteService where InvalidInvite token -> do asks (inviteHookReplyInvalid . svcAttributes) >>= ($ token) svcModify $ filter (/= token) - svcPrint $ "Invite " <> BC.unpack (showHex token) <> " rejected as invalid" ContactInvite token mbName -> do asks (inviteHookReplyContact . svcAttributes) >>= ($ mbName) . ($ token) |