Merge branch '62.sdmf-download-proof-of-concept' into 'main'

Add SDMF downloads to the techdemo

Closes #62

See merge request !49

obelisk/dep/gbs-downloader/git.json

 {
   "url": "https://whetstone.private.storage/privatestorage/gbs-downloader",
-  "rev": "27ed5f58163298cc117f479896f41eb13b289142",
-  "sha256": "108391shxz5vi33nkss0higjbd6xn3j6ci4zgmr0lpc0cgi8h435",
+  "rev": "b51c2a1bbad260fa91ad5b55a4195cc3703fff4d",
+  "sha256": "1kyp3gd0slv9am1v6jacfpb2ky88qxippxg4n45aygi1qw6kw9ib",
   "private": false,
   "fetchSubmodules": false,
   "branch": "main"

obelisk/dep/tahoe-great-black-swamp/git.json

 {
   "url": "https://whetstone.private.storage/privatestorage/tahoe-great-black-swamp.git",
-  "rev": "ab799ee24d7150e13b300b86240433ecdb783577",
-  "sha256": "0z77csh0arrschdsmq9lh7j6nlkzsi81wdc3h9g7p46dj3qmqxmm",
+  "rev": "3d00d90d1e64897aa92f33a012343a5ca46fe7fc",
+  "sha256": "0n7jjfjv3laa3xwhlzrwhdj2lbzg94jmazqgh8fddmd6d92mnzyc",
   "private": false,
   "fetchSubmodules": false,
   "branch": "main"

obelisk/dep/tahoe-ssk/default.nix

+# DO NOT HAND-EDIT THIS FILE
+import (import ./thunk.nix)
\ No newline at end of file

obelisk/dep/tahoe-ssk/git.json

+{
+  "url": "https://whetstone.private.storage/privatestorage/tahoe-ssk",
+  "rev": "6595b06599b8cbe8acf96bdf8db97d1cdfbd8866",
+  "sha256": "1klh5pq2abdlk2cfcf6jn522g497r3n8h4x9x37invv2vjkagjcp",
+  "private": false,
+  "fetchSubmodules": false,
+  "branch": "8.ghc865"
+}

obelisk/dep/tahoe-ssk/thunk.nix

+# DO NOT HAND-EDIT THIS FILE
+let fetch = {url, rev, branch ? null, sha256 ? null, fetchSubmodules ? false, private ? false, ...}:
+  let realUrl = let firstChar = builtins.substring 0 1 url; in
+    if firstChar == "/" then /. + url
+    else if firstChar == "." then ./. + url
+    else url;
+  in if !fetchSubmodules && private then builtins.fetchGit {
+    url = realUrl; inherit rev;
+    ${if branch == null then null else "ref"} = branch;
+  } else (import (builtins.fetchTarball {
+  url = "https://github.com/NixOS/nixpkgs/archive/3aad50c30c826430b0270fcf8264c8c41b005403.tar.gz";
+  sha256 = "0xwqsf08sywd23x0xvw4c4ghq0l28w2ki22h0bdn766i16z9q2gr";
+}) {}).fetchgit {
+    url = realUrl; inherit rev sha256;
+  };
+  json = builtins.fromJSON (builtins.readFile ./git.json);
+in fetch json
\ No newline at end of file

obelisk/frontend/frontend.cabal

@@ -24,9 +24,10 @@ library
                , text
                , bytestring
                , tahoe-chk
+               , tahoe-ssk
                , tahoe-great-black-swamp
                , containers
-               , gbs-downloader
+               , gbs-downloader >= 0.1
                , req
                , extra
                , megaparsec

obelisk/frontend/src/Pages/TechDemo.hs

 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE LambdaCase #-}
 
 module Pages.TechDemo where
 
+import Data.Void (Void)
 import Data.Bifunctor (Bifunctor(first))
 import qualified Data.ByteString.Base64 as Base64
-import Tahoe.Download (DownloadError, download, announcementToStorageServer)
+import Tahoe.Download (
+  DownloadError,
+  download,
+  announcementToImmutableStorageServer,
+  announcementToMutableStorageServer
+  )
 import JSDOM (currentWindow)
 import JSDOM.History (back)
 import JSDOM.Window (getHistory)
@@ -27,20 +31,17 @@ import Control.Monad (void)
 import Control.Exception (try)
 import Data.Serialize (encode)
 import Obelisk.Route.Frontend hiding (encode)
-
-import Tahoe.CHK.Capability (CHK(..), Reader(..), Verifier(..), dangerRealShow, pCapability, pReader)
-import Tahoe.CHK.Upload (UploadResult(..), memoryUploadableWithConvergence, store)
-import Tahoe.CHK.Types (Parameters(..))
+import qualified Tahoe.CHK.Capability as CHK
+import qualified Tahoe.CHK.Upload as CHK
+import qualified Tahoe.CHK.Types as CHK
 import Tahoe.CHK.Server (StorageServer)
 import Tahoe.Announcement (Announcements(..), StorageServerAnnouncement(..))
 import Tahoe.Server (nullStorageServer)
 import qualified Data.Map.Strict as Map
-
+import qualified Tahoe.SDMF as SDMF
 import Reflex.Dom.Core
 import Language.Javascript.JSaddle (eval, liftJSM)
-
-import Text.Megaparsec (ParseErrorBundle, parse)
-
+import Text.Megaparsec (ParseErrorBundle, Parsec, parse, (<|>))
 import FrontendPaths (getFilesDir)
 import Common.Route
 
@@ -65,12 +66,12 @@ techDemoPage = prerender_ (pure ()) $ do
     let serversBehavior = constant (nullStorageServer :| [])
         -- It also requires some encoding parameters.  Handle those
         -- likewise.
-        paramsBehavior = constant Parameters
+        paramsBehavior = constant CHK.Parameters
                          -- Note this is an unreasonably small segment size.
-                         { paramSegmentSize = 128
-                         , paramRequiredShares = 7
-                         , paramHappyShares = 1
-                         , paramTotalShares = 11
+                         { CHK.paramSegmentSize = 128
+                         , CHK.paramRequiredShares = 7
+                         , CHK.paramHappyShares = 1
+                         , CHK.paramTotalShares = 11
                          }
 
     -- Place an input field into the page and retain a reference to it.
@@ -89,7 +90,7 @@ techDemoPage = prerender_ (pure ()) $ do
 
     -- Get an event that triggers with the full string representation of the
     -- capability resulting from encoding the plaintext.
-    let theCapTextEv = dangerRealShow . CHKReader . uploadResultReadCap <$> uploadedEv
+    let theCapTextEv = CHK.dangerRealShow . CHK.CHKReader . CHK.uploadResultReadCap <$> uploadedEv
 
     -- Put the capability string into the page.
     theCapTextDyn <- holdDyn "" theCapTextEv
@@ -176,23 +177,27 @@ parseCapDemo =
 
       -- `Dynamic t (Either ParseErrorBundle s e) CHK` holding a parse error
       -- or a parsed capability.
-      let parsedCap = parse pCapability "" <$> capTextDyn
+      let parsedCap = parseCap <$> capTextDyn
 
       dyn_ (renderCap <$> parsedCap)
 
+        where
+          parseCap = parse CHK.pCapability ""
+
+
 -- | The rendering part of parseCapDemo.
-renderCap :: DomBuilder t m => Either (ParseErrorBundle s e) CHK -> m ()
+renderCap :: DomBuilder t m => Either (ParseErrorBundle s e) CHK.CHK -> m ()
 renderCap (Left _) = text "(unparseable)"
-renderCap (Right (CHKVerifier Verifier { storageIndex, fingerprint, required, total, size })) = do
+renderCap (Right (CHK.CHKVerifier CHK.Verifier { CHK.storageIndex, CHK.fingerprint, CHK.required, CHK.total, CHK.size })) = do
   el "div" $ text ("Storage index: " <> T.toLower (encodeBase32Unpadded storageIndex))
   el "div" $ text ("Fingerprint: " <> T.toLower (encodeBase32Unpadded fingerprint))
   el "div" $ text ("Required shares: " <> T.pack (show required))
   el "div" $ text ("Total shares: " <> T.pack (show total))
   el "div" $ text ("Plaintext size: " <> T.pack (show size))
 
-renderCap (Right (CHKReader r)) = do
-  el "div" $ text ("Read key: " <> (T.toLower . encodeBase32Unpadded . encode . readKey) r)
-  renderCap (Right . CHKVerifier . verifier $ r)
+renderCap (Right (CHK.CHKReader r)) = do
+  el "div" $ text ("Read key: " <> (T.toLower . encodeBase32Unpadded . encode . CHK.readKey) r)
+  renderCap (Right . CHK.CHKVerifier . CHK.verifier $ r)
 
 -- | Given an event of a plaintext create an event of the CHK capability
 -- object representing that plaintext.  Note that since the data is not
@@ -203,13 +208,13 @@ uploadEv ::
     -- | A behavior of the servers we could upload to.
     Behavior t (NonEmpty StorageServer) ->
     -- | A behavior of the encoding parameters we should use.
-    Behavior t Parameters ->
+    Behavior t CHK.Parameters ->
     -- | An event that triggers with plaintext that we should encrypt and
     -- upload.
     Event t LBS.ByteString ->
     -- | An event that triggers with an upload result after an upload
     -- succeeds.
-    m (Event t UploadResult)
+    m (Event t CHK.UploadResult)
 uploadEv servers parameters plaintextEv = do
 
   -- Ignore empty strings, the encoder does not support them (XXX
@@ -223,7 +228,7 @@ uploadEv servers parameters plaintextEv = do
   -- that can be used below.
   uploadableEv <-
       performEvent $ ffor paramsAndPlaintext $ \(params, plaintext) ->
-          liftIO $ memoryUploadableWithConvergence "secret" (fromIntegral $ LBS.length plaintext) plaintext params
+          liftIO $ CHK.memoryUploadableWithConvergence "secret" (fromIntegral $ LBS.length plaintext) plaintext params
 
 
   -- Attach the server list to the uploadable value
@@ -232,7 +237,7 @@ uploadEv servers parameters plaintextEv = do
   -- Run the actual upload of the uploadable to the current servers and return
   -- the result.
   performEvent $ ffor inputsReady $ \(aServer :| moreServers, uploadable) ->
-      liftIO $ store (aServer:moreServers) uploadable
+      liftIO $ CHK.store (aServer:moreServers) uploadable
 
 
 filesDemoWidget ::
@@ -293,7 +298,7 @@ networkWidget =
       getResult = do
         respE <- try $ runReq defaultHttpConfig request
         case respE of
-          Left (err :: HttpException) -> pure . Just . T.pack . ("Error: " <>) . show $ err
+          Left err -> pure . Just . T.pack . ("Error: " <>) . show $ (err :: HttpException)
           Right resp ->
               case T.decodeUtf8' <$> responseHeader resp "age" of
                 Nothing -> pure Nothing
@@ -311,6 +316,11 @@ prerenderWidget =
     -- print "Hello, World!" on the client.
     prerender_ blank $ liftJSM $ void $ eval ("console.log('Hello, World!')" :: T.Text)
 
+data WhichCap = CHKCap CHK.Reader | SDMFCap SDMF.Reader
+
+pCap :: Parsec Void T.Text WhichCap
+pCap = (CHKCap <$> CHK.pReader) <|> (SDMFCap <$> SDMF.pReader)
+
 downloadWidget :: (MonadIO (Performable m), PerformEvent t m, DomBuilder t m, MonadHold t m, PostBuild t m) => m ()
 downloadWidget = do
   -- A place to type the cap
@@ -321,7 +331,7 @@ downloadWidget = do
   let capTextEv = tag (current $ _inputElement_value inputWidget) goEv
 
   -- Get separate events for failures and successes so we can render them separately.
-  let (parseErrorEv, capEv) = fanEither (parse pReader "CHK read cap" <$> capTextEv)
+  let (parseErrorEv, capEv) = fanEither (parse pCap "CHK/SDMF read cap" <$> capTextEv)
 
   -- Track parse errors
   parseErrorDyn <- holdDyn "" (T.pack . show <$> parseErrorEv)
@@ -329,11 +339,13 @@ downloadWidget = do
   -- Run downloads
   downloadedEv <- performEvent $ ffor capEv $ \cap -> liftIO $ do
     (Announcements grid) <- loadGrid
-    download grid cap announcementToStorageServer
+    case cap of
+      CHKCap r -> download grid r announcementToImmutableStorageServer
+      SDMFCap r -> download grid r announcementToMutableStorageServer
 
   -- Process it for display
   plaintextEv <- performEvent $ ffor downloadedEv $ liftIO . \case
-        Left (err :: DownloadError) -> pure . Left . DownloaderError $ err
+        Left err -> pure . Left . DownloaderError $ (err :: DownloadError)
         Right bs -> pure . first DecodingError . T.decodeUtf8' . LBS.toStrict $ bs
 
   -- Separate success from error

obelisk/haskell-overrides.nix

 { pkgs, nix-thunk }:
 self: super:
 with pkgs.haskell.lib; {
-  # Here, we get the tahoe-chk package from its thunk and use callCabal2nix to
-  # get a nix derivation to build it.
+  # Here, we get the tahoe-chk and tahoe-ssk packages from their thunk and use
+  # callCabal2nix to get nix derivations to build them.
   tahoe-chk = self.callCabal2nix
     "tahoe-chk"
     (nix-thunk.thunkSource ./dep/tahoe-chk)
     {};
 
+  tahoe-ssk = self.callCabal2nix
+    "tahoe-ssk"
+    (nix-thunk.thunkSource ./dep/tahoe-ssk)
+    {};
+
   # Similarly, get a package implementing Great Black Swamp.
   tahoe-great-black-swamp = self.callCabal2nix
     "tahoe-great-black-swamp"