Merge branch 'entr-flake' into 'main'

Add `downloadDirectory` function!

See merge request !8

cabal.project

-packages: .
-          -- These aren't released on hackage yet so we have to grab them
-          -- straight from the vcs host.  Probably should do some releases
-          -- soon.
-          https://whetstone.private.storage/privatestorage/tahoe-ssk/-/archive/0.2.0.0/tahoe-ssk-0.2.0.0.tar.gz
-          https://whetstone.private.storage/privatestorage/tahoe-chk/-/archive/0.1.0.1/tahoe-chk-0.1.0.1.tar.gz
-          https://whetstone.private.storage/privatestorage/tahoe-great-black-swamp/-/archive/0.3.0.0/tahoe-great-black-swamp-0.3.0.0.tar.gz
-          ../tahoe-directory
-
-package zlib
-        -- Turn on discovery of the underlying zlib using pkg-config.  This
-        -- fixes build failures when the underlying zlib is not in the
-        -- traditional location but is discoverable with pkg-config.  It might
-        -- break non-pkg-config platforms.
-        flags: +pkg-config

flake.nix

@@ -7,16 +7,14 @@
     flake-utils.url = github:numtide/flake-utils;
     hs-flake-utils.url = "git+https://whetstone.private.storage/jcalderone/hs-flake-utils.git?ref=main";
 
-    tahoe-chk = {
-      url = "git+https://whetstone.private.storage/PrivateStorage/tahoe-chk?ref=refs/tags/0.1.0.1";
+    tahoe-directory = {
+      url = "git+https://whetstone.private.storage/PrivateStorage/tahoe-directory.git";
       inputs.nixpkgs.follows = "hs-flake-utils/nixpkgs";
     };
 
-    tahoe-ssk = {
-      url = "git+https://whetstone.private.storage/PrivateStorage/tahoe-ssk?ref=refs/tags/0.2.0.0";
-      inputs.nixpkgs.follows = "hs-flake-utils/nixpkgs";
-      inputs.tahoe-chk.follows = "tahoe-chk";
-    };
+    tahoe-chk.follows = "tahoe-directory/tahoe-chk";
+    tahoe-ssk.follows = "tahoe-directory/tahoe-ssk";
+    tahoe-capabilities.follows = "tahoe-directory/tahoe-capabilities";
 
     tahoe-great-black-swamp = {
       url = "git+https://whetstone.private.storage/PrivateStorage/tahoe-great-black-swamp?ref=refs/tags/0.3.0.0";
@@ -32,6 +30,8 @@
     hs-flake-utils,
     tahoe-chk,
     tahoe-ssk,
+    tahoe-capabilities,
+    tahoe-directory,
     tahoe-great-black-swamp,
   }: let
     ulib = flake-utils.lib;
@@ -47,16 +47,24 @@
         src = ./.;
         compilerVersion = ghcVersion;
         packageName = "gbs-downloader";
-        hsPkgsOverrides = import ./nix/haskell-packages.nix {
+        hsPkgsOverrides = hfinal: hprev: {
           tahoe-chk = tahoe-chk.outputs.packages.${system}.default;
           tahoe-ssk = tahoe-ssk.outputs.packages.${system}.default;
+          tahoe-directory = tahoe-directory.outputs.packages.${system}.default;
+          tahoe-capabilities = tahoe-capabilities.outputs.packages.${system}.default;
           tahoe-great-black-swamp = tahoe-great-black-swamp.outputs.packages.${system}.default;
-          haskellLib = pkgs.haskell.lib;
+
+          # A broken dependency of a tahoe-great-black-swamp executable that
+          # we don't use.  Flip the broken bit so we can get a build.
+          language-ecmascript = pkgs.haskell.unmarkBroken hprev.language-ecmascript;
         };
       };
     in {
       checks = hslib.checks {};
       devShells = hslib.devShells {
+        shellHook = ''
+          nix run .#generate-cabal-project
+        '';
         extraBuildInputs = pkgs:
           with pkgs; [
             # We configure cabal to use zlib:pkg-config so we better supply
@@ -70,6 +78,51 @@
       };
       packages = hslib.packages {};
       apps.hlint = hslib.apps.hlint {};
+      apps.generate-cabal-project = {
+        type = "app";
+        program = "${
+          pkgs.writeShellApplication {
+            name = "generate-cabal-project";
+            text = ''
+              cat >cabal.project.local <<EOF
+              -- This file is auto-generated by the flake devShell's shellHook.  Do
+              -- not edit this file.  Make changes in flake.nix.
+              packages:
+                -- These aren't released on hackage yet so we have to get them
+                -- another way.  Here, we get them from the Nix store.
+                -- tahoe-chk
+                ${tahoe-chk}
+                -- tahoe-ssk
+                ${tahoe-ssk}
+                -- tahoe-capabilities
+                ${tahoe-capabilities}
+                -- tahoe-directory
+                ${tahoe-directory}
+                -- tahoe-great-black-swamp
+                ${tahoe-great-black-swamp}
+              EOF
+            '';
+          }
+        }/bin/generate-cabal-project";
+      };
+
+      apps.entr-test = {
+        type = "app";
+        program = "${
+          pkgs.writeShellApplication {
+            name = "entr-test";
+            runtimeInputs = with pkgs; [
+              entr
+              cabal-install
+              haskell.compiler.${ghcVersion}
+            ];
+
+            text = ''
+              find . -iname '*.hs' -or -iname '*.cabal' | entr bash -c "cabal run tests; if [ \$? != 0 ]; then printf '\e[31m%s\e[0m\n' \"FAILED: \$?\"; else printf '\e[32m%s\e[0m\n' 'SUCCESS'; fi"
+            '';
+          }
+        }/bin/entr-test";
+      };
 
       # Using the working directory of `nix run`, do a build with cabal and
       # then run the test suite.
@@ -88,6 +141,8 @@
             ];
 
             text = ''
+              nix run .#generate-cabal-project
+
               # Here we make zlib discoverable by pkg-config so cabal can find
               # headers and stuff.
               export PKG_CONFIG_PATH=${pkgs.lib.makeSearchPath "lib/pkgconfig" [pkgs.zlib.dev]}
@@ -96,9 +151,10 @@
               # solve our dependencies.
               cabal update hackage.haskell.org
 
-              # Configure with tests enable, build the tests (if necessary),
-              # and run the default test suite.
-              cabal run --enable-tests tests
+              # Run the default test suite.  The local cabal project file
+              # written above should have enabled tests so the build plan will
+              # support them.
+              cabal run tests
             '';
           }
         }/bin/cabal-build-and-test";

gbs-downloader.cabal

@@ -111,6 +111,7 @@ library
     , servant-client
     , servant-client-core
     , tahoe-chk
+    , tahoe-directory
     , tahoe-great-black-swamp  >=0.3 && <0.4
     , tahoe-ssk                >=0.2 && <0.3
     , text
@@ -122,7 +123,7 @@ library
   -- Base language which the package is written in.
   default-language: Haskell2010
 
-executable gbs-download-chk
+executable download-chk
   -- Import common warning flags.
   import:
     warnings
@@ -155,7 +156,7 @@ executable gbs-download-chk
   -- Base language which the package is written in.
   default-language: Haskell2010
 
-executable gbs-download-sdmf
+executable download-sdmf
   import:
     warnings
     , language
@@ -175,6 +176,28 @@ executable gbs-download-sdmf
   hs-source-dirs:   download-sdmf
   default-language: Haskell2010
 
+executable list-dircap
+  import:
+    warnings
+    , language
+
+  main-is:          Main.hs
+  build-depends:
+    , aeson
+    , base
+    , bytestring
+    , containers
+    , gbs-downloader
+    , megaparsec
+    , tahoe-chk
+    , tahoe-directory
+    , tahoe-ssk        >=0.2 && <0.3
+    , text
+    , yaml
+
+  hs-source-dirs:   list-dircap
+  default-language: Haskell2010
+
 test-suite gbs-downloader-test
   -- Import common warning flags.
   import:

list-dircap/Main.hs

+{-# LANGUAGE FlexibleContexts #-}
+
+module Main where
+
+import qualified Data.ByteString as B
+import qualified Data.Text as T
+import Data.Yaml (decodeEither')
+import System.Environment (getArgs)
+import Tahoe.Announcement (Announcements (..))
+import qualified Tahoe.Directory as TD
+import Text.Megaparsec (parse)
+
+import Tahoe.Download (announcementToImmutableStorageServer, announcementToMutableStorageServer, downloadDirectory)
+
+main :: IO ()
+main = do
+    [announcementPath, dirReadCap] <- getArgs
+    -- Load server announcements
+    announcementsBytes <- B.readFile announcementPath
+    let Right (Announcements announcements) = decodeEither' announcementsBytes
+
+    -- Accept & parse read capability
+    case parse TD.pReadSDMF "<argv>" (T.pack dirReadCap) of
+        Right r -> go announcements r announcementToMutableStorageServer
+        Left eSDMF -> case parse TD.pReadCHK "<argv>" (T.pack dirReadCap) of
+            Right r -> go announcements r announcementToImmutableStorageServer
+            Left eCHK -> do
+                print $ "Failed to parse cap: " <> show eSDMF
+                print $ "Failed to parse cap: " <> show eCHK
+  where
+    go announcements cap lookupServer = do
+        -- Download & decode the shares
+        result <- downloadDirectory announcements cap lookupServer
+
+        -- Show the result
+        putStrLn "Your result:"
+        either print print result

nix/haskell-packages.nix

-{
-  haskellLib,
-  tahoe-chk,
-  tahoe-ssk,
-  tahoe-great-black-swamp,
-}: hfinal: hprev: {
-  inherit tahoe-chk;
-  inherit tahoe-ssk;
-  inherit tahoe-great-black-swamp;
-
-  # A broken dependency of a tahoe-great-black-swamp executable that we don't
-  # use.  Flip the broken bit so we can get a build.
-  language-ecmascript = haskellLib.unmarkBroken hprev.language-ecmascript;
-}

src/Tahoe/Download.hs

@@ -10,6 +10,7 @@ module Tahoe.Download (
     DiscoverError (..),
     discoverShares,
     download,
+    downloadDirectory,
     announcementToImmutableStorageServer,
     announcementToMutableStorageServer,
     getShareNumbers,
@@ -28,6 +29,8 @@ import qualified Data.Set as Set
 import Tahoe.Announcement (StorageServerAnnouncement)
 import Tahoe.CHK.Server (StorageServer (..), StorageServerID)
 import Tahoe.CHK.Types (ShareNum, StorageIndex)
+import Tahoe.Directory (Directory, DirectoryCapability (DirectoryCapability))
+import qualified Tahoe.Directory as Directory
 import Tahoe.Download.Internal.Capability
 import Tahoe.Download.Internal.Client
 import Tahoe.Download.Internal.Immutable
@@ -226,3 +229,29 @@ downloadShare storageIndex (shareNum, s) = do
     let massaged = first (ShareDownloadError . (displayException :: SomeException -> String)) shareBytes
     print' "Downloaded it"
     pure (shareNum, LB.fromStrict <$> massaged)
+
+{- | Download the data associated with a directory capability and interpret it
+ as a collection of entries.
+-}
+downloadDirectory ::
+    (MonadIO m, Readable readCap, Verifiable v, Verifier readCap ~ v) =>
+    -- | Information about the servers from which to consider downloading shares
+    -- representing the application data.
+    Map.Map StorageServerID StorageServerAnnouncement ->
+    -- | The read capability for the application data.
+    DirectoryCapability readCap ->
+    -- | Get functions for interacting with a server given its URL.
+    LookupServer m ->
+    -- | Either a description of how the recovery failed or the recovered
+    -- application data.
+    m (Either DirectoryDownloadError Directory)
+downloadDirectory anns (DirectoryCapability cap) lookupServer = do
+    bs <- download anns cap lookupServer
+    pure $ do
+        bs' <- first UnderlyingDownloadError bs
+        first (const DecodingError) $ Directory.parse (LB.toStrict bs')
+
+data DirectoryDownloadError
+    = UnderlyingDownloadError DownloadError
+    | DecodingError
+    deriving (Ord, Eq, Show)