Merge branch '66.download-files' into 'main'

Make regular files clickable

Closes #66 and #76

See merge request !68

obelisk/frontend/android-src/FrontendPaths.hs

 -- | Implement platform-specific path-related operations for the Android
 -- platform.
-module FrontendPaths (getFilesDir, runWithRef) where
+module FrontendPaths (getFilesDir, getCacheDir, runWithRef, viewFile) where
 
 import Control.Concurrent (threadDelay)
 import Control.Monad (forever)
@@ -13,6 +13,16 @@ import System.IO (hSetBuffering, stdout, stderr, BufferMode(LineBuffering))
 import qualified Android.HaskellActivity as Android
 import PlatformEvents (PlatformEventCallbacks(..))
 
+-- | Get the path to a directory that is private to the application where
+-- internal application cache data may be written (and read back).
+--
+-- The application requires no special permissions to use this directory.  If
+-- the app is uninstalled the directory and its children will be deleted.
+--
+-- https://developer.android.com/reference/android/content/Context#getCacheDir()
+getCacheDir :: IO (Maybe FilePath)
+getCacheDir = Android.getHaskellActivity >>= Android.getCacheDir
+
 -- | Get the path to a directory that is private to the application where
 -- internal application data may be written (and read back).
 --
@@ -52,3 +62,11 @@ runWithRef makeJSM = do
           onBackPressed f
     }
   forever $ threadDelay 1000000000
+
+
+-- | Allow the operator of the device to view the contents of the file at the
+-- given path.
+--
+-- TODO: Make it work.
+viewFile :: FilePath -> IO ()
+viewFile p = print $  "I viewed " <> p

obelisk/frontend/frontend.cabal

@@ -47,6 +47,7 @@ library
                , tahoe-great-black-swamp
                , tahoe-ssk
                , text
+               , unix
                , yaml
 
   if os(android)

obelisk/frontend/linux-src/FrontendPaths.hs

 -- | Implement platform-specific path-related operations for the Linux
 -- platform.
-module FrontendPaths (getFilesDir, runWithRef) where
+module FrontendPaths (getFilesDir, getCacheDir, runWithRef, viewFile) where
 
 import Data.IORef (IORef, newIORef)
-import System.Environment.XDG.BaseDir (getUserDataDir)
+import System.Environment.XDG.BaseDir (getUserCacheDir, getUserDataDir)
 import System.Directory (createDirectoryIfMissing)
 import Reflex.Dom (run)
 import PlatformEvents (PlatformEventCallbacks)
 import Language.Javascript.JSaddle (JSM)
 import Data.Default.Class (def)
 
+-- | Get a dedicated directory for this application beneath the XDG standard
+-- cache directory.
+getCacheDir :: IO (Maybe FilePath)
+getCacheDir = do
+  dataPath <- getUserCacheDir "privatestoragemobile"
+
+  createDirectoryIfMissing True dataPath
+  pure $ Just dataPath
+
 -- | Get the path to a directory that is specific to the application where
 -- internal application data may be written (and read back).
 getFilesDir :: IO (Maybe FilePath)
@@ -27,3 +36,7 @@ runWithRef makeJSM =
   -- Off Android, we have no platform integration or event handlers so just
   -- supply a no-op callback to fill the slot and then proceed.
   newIORef def >>= run . makeJSM . Just
+
+-- | Show a file to the user.
+viewFile :: FilePath -> IO ()
+viewFile p = print $ "I viewed " <> p

obelisk/frontend/src/Controller.hs

@@ -105,10 +105,10 @@ fileBrowser'
     -> FolderEntry
     -- ^ The root of the magic-folder to browser.
     -> m ()
-fileBrowser' App{appUpdateFolder} folder path rootEntry  = do
+fileBrowser' app@App{appUpdateFolder} folder path rootEntry  = do
   goEv <- getPostBuild
   performEvent_ $ ffor goEv $ \() -> liftIO $ appUpdateFolder folder
-  fileBrowser (listWhichDir path rootEntry)
+  fileBrowser app (listWhichDir path rootEntry)
 
 -- | List the contents of a directory arbitrarily deeply nested beneath some
 -- root.

obelisk/frontend/src/Pages/FileBrowser.hs

@@ -3,12 +3,23 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TupleSections #-}
 
 module Pages.FileBrowser (fileBrowser) where
 
+import Data.Tuple.Extra (uncurry3)
+import System.IO.Extra (newTempFileWithin)
 import Data.List.Extra
 import Reflex.Dom.Core
-
+import Control.Monad (void)
+import Tahoe.Announcement (Announcements(..))
+import App (App(App, appGrid))
+import System.Posix.Files (rename)
+import FrontendPaths (getCacheDir, viewFile)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as LB
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Tahoe.Download (download, announcementToImmutableStorageServer)
 import qualified Data.Text as T
 import Obelisk.Route.Frontend
 import Common.Route
@@ -69,11 +80,13 @@ leaveActionIcon Up = "arrow_back"
 -- | Define the entire view for looking at a single folder and its direct
 -- contents.
 fileBrowser :: ( DomBuilder t m
+               , PerformEvent t m
+               , MonadIO (Performable m)
                , PostBuild t m
                , SetRoute t (R FrontendRoute) m
                , Routed t FolderLocation m
-               ) => [(EntryName, FolderEntry)] -> m ()
-fileBrowser entries = do
+               ) => App t -> [(EntryName, FolderEntry)] -> m ()
+fileBrowser App{appGrid} entries = do
       routeDyn <- askRoute
       elAttr "header" ("class" =: "mdc-top-app-bar mdc-top-app-bar--fixed" <> "data-mdc-auto-init" =: "MDCTopAppBar") $
         divClass "mdc-top-app-bar__row" $ do
@@ -99,7 +112,7 @@ fileBrowser entries = do
       elClass "main" "mdc-top-app-bar--fixed-adjust" $ do
 
         elAttr "ul" ("class" =: "mdc-list mdc-list--two-line inline-demo-list" <> "data-mdc-auto-init" =: "MDCList") $
-            mapM_ (uncurry fileBrowserEntryWidget) entries
+            mapM_ (uncurry $ fileBrowserEntryWidget appGrid) entries
 
       el "script" $
           text "mdc.autoInit();"
@@ -107,8 +120,18 @@ fileBrowser entries = do
 
 -- | Define the view for a single item in a file browser, including an icon,
 -- the item name, and some metadata.
-fileBrowserEntryWidget :: (DomBuilder t m, SetRoute t (R FrontendRoute) m, Routed t FolderLocation m) => EntryName -> FolderEntry -> m ()
-fileBrowserEntryWidget (EntryName name) entry = do
+fileBrowserEntryWidget
+    :: ( DomBuilder t m
+       , PerformEvent t m
+       , MonadIO (Performable m)
+       , SetRoute t (R FrontendRoute) m
+       , Routed t FolderLocation m
+       )
+    => Dynamic t (Either T.Text Announcements)
+    -> EntryName
+    -> FolderEntry
+    -> m ()
+fileBrowserEntryWidget gridDyn (EntryName name) entry = do
     (theEl, _) <- elClass' "li" "mdc-list-item mdc-ripple-surface" $ do
       elAttr "span" ("class" =: "mdc-list-item__graphic material-icons" <> "aria-hidden" =: "true") $
         text $ iconForEntry entry
@@ -125,4 +148,34 @@ fileBrowserEntryWidget (EntryName name) entry = do
         setRoute $ ffor navigateEv $
             \(folder, path) -> FrontendRoute_FileBrowser :/ (folder, Data.List.Extra.snoc path name)
 
+      File { fileContent } ->
+        void $ performEvent $ ffor ((,name,fileContent) <$> canDownloadEv) $ liftIO . uncurry3 viewContent
+          where
+            downloadEv = tag (current gridDyn) (domEvent Click theEl)
+            -- XXX If we don't have a grid right now we can't even try to
+            -- download.  It would be great if something took care of this
+            -- before we got here.  For the moment, we do nothing with this
+            -- information - we just silently don't act.
+            (_cantDownloadEv, canDownloadEv) = fanEither downloadEv
+
       _ -> pure ()
+
+-- | Use the given capability to download some content and attempt to display
+-- it to the user of the device.
+viewContent :: Announcements -> T.Text -> CHK.Reader -> IO ()
+viewContent (Announcements grid) name fileContent = do
+  p <- getCacheDir
+  case p of
+    Nothing -> print ("Could not find cache directory for download." :: String)
+    Just cacheDir -> do
+      result <- download grid fileContent announcementToImmutableStorageServer
+      case result of
+        Left err -> print $ "Could not download " <> T.unpack name <> ": " <> show err
+        Right content -> do
+          (tempName, _) <- newTempFileWithin cacheDir
+          -- XXX Ideally we could do _some_ laziness here.
+          B.writeFile tempName (LB.toStrict content)
+          rename tempName finalName
+          viewFile finalName
+          where
+            finalName = cacheDir <> "/" <> T.unpack name