diff --git a/obelisk/frontend/frontend.cabal b/obelisk/frontend/frontend.cabal index 18b7dd6cf204ada682db3e9060757610b7a6fe82..62c5191fb85b3095dfb159e8ffba955e12b7550f 100644 --- a/obelisk/frontend/frontend.cabal +++ b/obelisk/frontend/frontend.cabal @@ -87,7 +87,7 @@ library Pages.MagicFolders Pages.FirstRun Pages.TechDemo - ghc-options: -Werror -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O -fno-show-valid-hole-fits + ghc-options: -Werror -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O -fno-show-valid-hole-fits -Wno-missing-home-modules executable frontend main-is: main.hs diff --git a/obelisk/frontend/src/Controller.hs b/obelisk/frontend/src/Controller.hs index 6bba2c49ac65de103d7bafd81d4753a3f5066382..05b48dea715ac93721ce2b3bd4b3b8f97bf981c4 100644 --- a/obelisk/frontend/src/Controller.hs +++ b/obelisk/frontend/src/Controller.hs @@ -58,6 +58,9 @@ pageFromRoute app@App{appFolders} FrontendRoute_FileBrowser = do r <- askRoute dyn_ $ fileBrowserIfYouCan app . head <$> r <*> appFolders +pageFromRoute (App _ _ _ _ _) FrontendRoute_AcceptFolderInvite = do + pure () -- "We got invited, attend the party" + fileBrowserIfYouCan :: (MonadHold t m , MonadIO (Performable m) diff --git a/obelisk/frontend/src/Pages/MagicFolders.hs b/obelisk/frontend/src/Pages/MagicFolders.hs index 8673028e239114110a610e1dbb281786074d952a..022b704382671b686a98d76b04c5980b81a65ad7 100644 --- a/obelisk/frontend/src/Pages/MagicFolders.hs +++ b/obelisk/frontend/src/Pages/MagicFolders.hs @@ -3,7 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecursiveDo #-} -module Pages.MagicFolders (magicFolders) where +module Pages.MagicFolders (magicFolders, receiveFolderInviteText) where import qualified Data.Map.Strict as Map import qualified Data.Text as T @@ -48,8 +48,8 @@ indeterminateLinearProgress acceptInviteState = do inviteWidgetAttributes :: Eq a => a -> a -> Map.Map T.Text T.Text -- XXX maybe MDC has ... a way? too -inviteWidgetAttributes when now - | when == now = ("style" =: "visibility: visible") +inviteWidgetAttributes when now' + | when == now' = ("style" =: "visibility: visible") | otherwise = ("style" =: "visibility: hidden") @@ -166,7 +166,6 @@ receiveFolderInviteUI ReceivingInvite = indeterminateLinearProgress -- The invite has finished (success or failure) receiveFolderInviteUI InviteFinished = blank -} - -- | A widget where a wormhole code can be submitted and when it is, the -- currently active route is changed to the invite-handling route. receiveFolderInviteText diff --git a/obelisk/frontend/src/WormholeInvite.hs b/obelisk/frontend/src/WormholeInvite.hs index 680e73cff3bfe590ce3decf3c6e8964b9b3deed3..43b4c4f9014e188984f816e327bb725ea523da2f 100644 --- a/obelisk/frontend/src/WormholeInvite.hs +++ b/obelisk/frontend/src/WormholeInvite.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module WormholeInvite (InviteMessage(..), acceptFolderInvite) where +module WormholeInvite (InviteMessage(..), acceptFolderInvite, receiveInvite) where import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LBS @@ -69,15 +69,14 @@ instance FromJSON InvitesVersion0 where -- prototyping higher-level API for haskell-magic-wormhole -- "a" = InviteMessage for us -- "j" is InvitesVersion0, or app-versions type -doWormholeInteraction :: ToJSON j => j -> (EncryptedConnection -> IO a) -> T.Text -> IO a -doWormholeInteraction appversion interact code = undefined +-- doWormholeInteraction :: j -> (EncryptedConnection -> IO a) -> T.Text -> IO a +-- doWormholeInteraction _appversion _interact _code = undefined -- "even higher", we can do a magic-folder invite -inviteToMagicFolder :: T.Text -> IO InviteMessage -inviteToMagicFolder = doWormholeInteraction InvitesVersion0 performInvite +-- inviteToMagicFolder :: T.Text -> IO InviteMessage +-- inviteToMagicFolder = doWormholeInteraction InvitesVersion0 performInvite -- equiv: inviteToMagicFolder code = doWormholeInteraction InvitesVersion0 performInvite code - receiveInvite :: T.Text -> T.Text -> MagicWormhole.Session -> IO InviteMessage receiveInvite nameplate code session = do -- nameplate <- liftIO $ MagicWormhole.allocate session @@ -94,7 +93,6 @@ receiveInvite nameplate code session = do print ("done with session" :: T.Text) pure result - -- ^ Take a code like "1-foo-bar" and split off the mailbox, returning -- a tuple like ("1", "foo-bar") splitWormholeCode :: T.Text -> (T.Text, T.Text) @@ -103,7 +101,6 @@ splitWormholeCode entireCode = do let code = Data.Text.tail c (n, code) - -- | public API acceptFolderInvite :: T.Text -> IO InviteMessage acceptFolderInvite code = do @@ -117,4 +114,3 @@ acceptFolderInvite code = do pure inv where appID = MagicWormhole.AppID "private.storage/magic-folder/invites" - diff --git a/obelisk/haskell-overrides.nix b/obelisk/haskell-overrides.nix index 7e9c609c927066d24f27d672fca49d5e46862ebc..bbca33164b4ea271712fdd3903590da48398eb03 100644 --- a/obelisk/haskell-overrides.nix +++ b/obelisk/haskell-overrides.nix @@ -7,7 +7,9 @@ with pkgs.haskell.lib; { "tahoe-chk" (nix-thunk.thunkSource ./dep/tahoe-chk) {}; - + saltine = super.saltine.overrideAttrs (old : { + nativeBuildInputs = old.nativeBuildInputs ++ [ pkgs.pkg-config ]; + }); tahoe-ssk = self.callCabal2nix "tahoe-ssk" (nix-thunk.thunkSource ./dep/tahoe-ssk)