mirror of https://github.com/voidlizard/hbs2
basic mailbox creation
This commit is contained in:
parent
e3383a06d4
commit
f2b8bc1517
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue