basic mailbox creation

This commit is contained in:
voidlizard 2024-10-09 09:56:54 +03:00
parent e3383a06d4
commit f2b8bc1517
3 changed files with 21 additions and 5 deletions

View File

@ -104,10 +104,10 @@ see hbs2-cli for sigil commands (create, store, load, etc)
case syn of case syn of
[ StringLike "--key", SignPubKeyLike puk, MailboxTypeLike tp ] -> do [ StringLike "--key", SignPubKeyLike puk, MailboxTypeLike tp ] -> do
_ <- callRpcWaitMay @RpcMailboxCreate t api (puk, tp) r <- callRpcWaitMay @RpcMailboxCreate t api (puk, tp)
>>= orThrowUser "rpc call timeout" >>= orThrowUser "rpc call timeout"
liftIO $ print $ pretty "done" liftIO $ print $ viaShow r
[ StringLike "--sigil", HashLike sh, StringLike tp ] -> do [ StringLike "--sigil", HashLike sh, StringLike tp ] -> do
-- TODO: implement-create-by-sigil -- TODO: implement-create-by-sigil

View File

@ -68,9 +68,25 @@ instance (s ~ HBS2Basic) => IsMailboxProtoAdapter s (MailboxProtoWorker s e) whe
writeTBQueue inMessageQueue (m,c) writeTBQueue inMessageQueue (m,c)
instance (s ~ HBS2Basic) => IsMailboxService s (MailboxProtoWorker s e) where instance (s ~ HBS2Basic) => IsMailboxService s (MailboxProtoWorker s e) where
mailboxCreate _ t p = do mailboxCreate MailboxProtoWorker{..} t p = do
debug $ "mailboxWorker.mailboxCreate" <+> pretty (AsBase58 p) <+> pretty t debug $ "mailboxWorker.mailboxCreate" <+> pretty (AsBase58 p) <+> pretty t
pure $ Right ()
flip runContT pure $ callCC \exit -> do
mdbe <- readTVarIO mailboxDB
dbe <- ContT $ maybe1 mdbe (pure $ Left (MailboxCreateFailed "database not ready"))
r <- liftIO $ try @_ @SomeException $ withDB dbe do
insert [qc|
insert into mailbox (recipient,type)
values (?,?)
on conflict (recipient) do nothing
|] (show $ pretty $ AsBase58 p, show $ pretty t)
case r of
Right{} -> pure $ Right ()
Left{} -> pure $ Left (MailboxCreateFailed "database operation")
createMailboxProtoWorker :: forall e m . MonadIO m createMailboxProtoWorker :: forall e m . MonadIO m
=> AnyStorage => AnyStorage

View File

@ -83,7 +83,7 @@ class IsMailboxProtoAdapter s a where
-> m () -> m ()
data MailboxServiceError = data MailboxServiceError =
MailboxCreateFailed MailboxCreateFailed String
deriving stock (Typeable,Show) deriving stock (Typeable,Show)
class IsMailboxService s a where class IsMailboxService s a where