diff --git a/obelisk/frontend/src/Pages/TechDemo.hs b/obelisk/frontend/src/Pages/TechDemo.hs index 2772033926ea3a75181f28573a82f4928a56f414..03655714972221ef1ba119977efdd3c34bb50af2 100644 --- a/obelisk/frontend/src/Pages/TechDemo.hs +++ b/obelisk/frontend/src/Pages/TechDemo.hs @@ -340,8 +340,13 @@ networkWidget = pure $ Just txt --- | actual work of doing invite (XXX naming is hard) -doWormholeInvite :: T.Text -> IO (Maybe T.Text) +-- | Accept an invitation to a magic-folder. +doWormholeInvite + -- | The wormhole-code for the invitation. + :: T.Text + -- | If the invite is is successful, Just the read cap of the collective + -- of the magic-folder. Otherwise, Nothing. + -> IO (Maybe T.Text) doWormholeInvite citd = do inv <- acceptFolderInvite citd Just fd <- getFilesDir diff --git a/obelisk/frontend/src/WormholeInvite.hs b/obelisk/frontend/src/WormholeInvite.hs index df557684eaf10f67823d3c7fba8d5d5e47d2d88b..a763ad7ba939531648ce9acb7fec0699c650f156 100644 --- a/obelisk/frontend/src/WormholeInvite.hs +++ b/obelisk/frontend/src/WormholeInvite.hs @@ -40,6 +40,8 @@ instance FromJSON InviteMessage where parseJSON _ = error "fixme" +-- | Complete a Magic-Folder invitation conversation as a receiver over the +-- given wormhole connection. performInvite :: EncryptedConnection -> IO InviteMessage performInvite conn = do MagicWormhole.PlainText invite_msg <- atomically $ receiveMessage conn @@ -80,18 +82,12 @@ instance FromJSON InvitesVersion0 where receiveInvite :: T.Text -> T.Text -> MagicWormhole.Session -> IO InviteMessage receiveInvite nameplate code session = do - -- nameplate <- liftIO $ MagicWormhole.allocate session - print nameplate mailbox <- liftIO $ MagicWormhole.claim session (MagicWormhole.Nameplate nameplate) - print mailbox peer <- liftIO $ MagicWormhole.open session mailbox let passcode = T.encodeUtf8 . T.append (T.append nameplate "-") $ code - print passcode result <- liftIO $ MagicWormhole.withEncryptedConnection peer (Crypto.Spake2.makePassword passcode) InvitesVersion0 performInvite - print result MagicWormhole.release session (Just (MagicWormhole.Nameplate nameplate)) _x <- MagicWormhole.close session (Just mailbox) (Just Happy) - print ("done with session" :: T.Text) pure result -- | Take a code like "1-foo-bar" and split off the mailbox, returning a tuple diff --git a/obelisk/haskell-overrides.nix b/obelisk/haskell-overrides.nix index bbca33164b4ea271712fdd3903590da48398eb03..9ef790d32befae0c054b73ede59f59a2c8f87a73 100644 --- a/obelisk/haskell-overrides.nix +++ b/obelisk/haskell-overrides.nix @@ -7,9 +7,12 @@ with pkgs.haskell.lib; { "tahoe-chk" (nix-thunk.thunkSource ./dep/tahoe-chk) {}; + + # magic-wormhole depends on this extra crypto library. saltine = super.saltine.overrideAttrs (old : { nativeBuildInputs = old.nativeBuildInputs ++ [ pkgs.pkg-config ]; }); + tahoe-ssk = self.callCabal2nix "tahoe-ssk" (nix-thunk.thunkSource ./dep/tahoe-ssk)