From c9211122e65db16b6824888c2da51b0c17e90ca9 Mon Sep 17 00:00:00 2001
From: Jean-Paul Calderone <exarkun@twistedmatrix.com>
Date: Wed, 7 Jun 2023 15:52:45 -0400
Subject: [PATCH] parse the other SDMF directory capability types
And switch to tahoe-capabilities' ConfidentialShowable for better dependency
directions / code sharing
---
flake.nix | 11 +++--
nix/haskell-packages.nix | 8 ----
src/Tahoe/Directory.hs | 3 +-
src/Tahoe/Directory/Internal/Capability.hs | 49 +++++++++++++++++-----
tahoe-directory.cabal | 4 +-
test/Spec.hs | 28 ++++++++++---
6 files changed, 74 insertions(+), 29 deletions(-)
delete mode 100644 nix/haskell-packages.nix
diff --git a/flake.nix b/flake.nix
index 7b064e5..9d8f32f 100644
--- a/flake.nix
+++ b/flake.nix
@@ -10,12 +10,15 @@
url = "git+https://whetstone.private.storage/PrivateStorage/tahoe-chk?ref=refs/tags/0.1.0.1";
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";
+ url = "git+https://whetstone.private.storage/PrivateStorage/tahoe-ssk.git";
inputs.nixpkgs.follows = "hs-flake-utils/nixpkgs";
inputs.tahoe-chk.follows = "tahoe-chk";
};
+ tahoe-capabilities = {
+ url = "git+https://whetstone.private.storage/PrivateStorage/tahoe-capabilities";
+ inputs.nixpkgs.follows = "hs-flake-utils/nixpkgs";
+ };
};
outputs = {
@@ -25,6 +28,7 @@
hs-flake-utils,
tahoe-chk,
tahoe-ssk,
+ tahoe-capabilities,
}: let
ulib = flake-utils.lib;
ghcVersion = "ghc8107";
@@ -39,9 +43,10 @@
src = ./.;
compilerVersion = ghcVersion;
packageName = "tahoe-directory";
- 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-capabilities = tahoe-capabilities.outputs.packages.${system}.default;
haskellLib = pkgs.haskell.lib;
};
};
diff --git a/nix/haskell-packages.nix b/nix/haskell-packages.nix
deleted file mode 100644
index 54848e9..0000000
--- a/nix/haskell-packages.nix
+++ /dev/null
@@ -1,8 +0,0 @@
-{
- haskellLib,
- tahoe-chk,
- tahoe-ssk,
-}: hfinal: hprev: {
- inherit tahoe-chk;
- inherit tahoe-ssk;
-}
diff --git a/src/Tahoe/Directory.hs b/src/Tahoe/Directory.hs
index 27451c2..dbde173 100644
--- a/src/Tahoe/Directory.hs
+++ b/src/Tahoe/Directory.hs
@@ -5,11 +5,12 @@ module Tahoe.Directory (
) where
import Tahoe.Directory.Internal.Capability (
- ConfidentialShowable (..),
DirectoryCapability (..),
pReadCHK,
pReadSDMF,
pVerifyCHK,
+ pVerifySDMF,
+ pWriteSDMF,
)
import Tahoe.Directory.Internal.Parsing (parse, serialize)
import Tahoe.Directory.Internal.Types (Directory (..), Entry (..))
diff --git a/src/Tahoe/Directory/Internal/Capability.hs b/src/Tahoe/Directory/Internal/Capability.hs
index 87737f1..756a367 100644
--- a/src/Tahoe/Directory/Internal/Capability.hs
+++ b/src/Tahoe/Directory/Internal/Capability.hs
@@ -5,19 +5,11 @@ module Tahoe.Directory.Internal.Capability where
import qualified Data.Text as T
import Data.Void (Void)
import qualified Tahoe.CHK.Capability as CHK
+import Tahoe.Capability (ConfidentialShowable (..))
import qualified Tahoe.SDMF as SDMF
import Text.Megaparsec (Parsec, getInput, setInput)
-{- | Something which contains confidential information and can be rendered as
- text such that the text also includes confidential information. It is
- expected (but not required) that such types will also have a Show instance
- which obscures the confidential information.
--}
-class ConfidentialShowable s where
- -- | Show the value, including any confidential information.
- confidentiallyShow :: s -> T.Text
-
{- | A wrapper around some other capability type which signals that the
plaintext is an encoded list of files.
-}
@@ -31,9 +23,21 @@ instance ConfidentialShowable (DirectoryCapability CHK.Reader) where
confidentiallyShow (DirectoryCapability a) =
T.replace "URI:CHK:" "URI:DIR2-CHK:" (CHK.dangerRealShow (CHK.CHKReader a))
+instance ConfidentialShowable (DirectoryCapability SDMF.Verifier) where
+ confidentiallyShow (DirectoryCapability a) =
+ T.replace "URI:SSK-Verifier:" "URI:DIR2-Verifier:" (confidentiallyShow a)
+
+instance ConfidentialShowable (DirectoryCapability SDMF.Reader) where
+ confidentiallyShow (DirectoryCapability a) =
+ T.replace "URI:SSK-RO:" "URI:DIR2-RO:" (confidentiallyShow a)
+
+instance ConfidentialShowable (DirectoryCapability SDMF.Writer) where
+ confidentiallyShow (DirectoryCapability a) =
+ T.replace "URI:SSK:" "URI:DIR2:" (confidentiallyShow a)
+
type Parser = Parsec Void T.Text
-{- | Parse a CHK verifier directory capability.
+{- | Parse a CHK directory verifier capability.
The implementation is a cheesy hack that does string substitution on the
input before applying the original CHK verifier parser.
@@ -45,7 +49,7 @@ pVerifyCHK = do
v <- CHK.pVerifier
pure $ DirectoryCapability v
-{- | Parse a CHK reader directory capability.
+{- | Parse a CHK directory reader capability.
The implementation is a cheesy hack that does string substitution on the
input before applying the original CHK reader parser.
@@ -57,9 +61,32 @@ pReadCHK = do
v <- CHK.pReader
pure $ DirectoryCapability v
+{- | Parse an SDMF directory verifier capability. As is the case for the other
+ directory capability parsers, the implementation is cheesy.
+-}
+pVerifySDMF :: Parser (DirectoryCapability SDMF.Verifier)
+pVerifySDMF = do
+ s <- getInput
+ setInput $ T.replace "URI:DIR2-Verifier:" "URI:SSK-Verifier:" s
+ v <- SDMF.pVerifier
+ pure $ DirectoryCapability v
+
+{- | Parse an SDMF directory reader capability. As is the case for the other
+ directory capability parsers, the implementation is cheesy.
+-}
pReadSDMF :: Parser (DirectoryCapability SDMF.Reader)
pReadSDMF = do
s <- getInput
setInput $ T.replace "URI:DIR2-RO:" "URI:SSK-RO:" s
v <- SDMF.pReader
pure $ DirectoryCapability v
+
+{- | Parse an SDMF directory writer capability. As is the case for the other
+ directory capability parsers, the implementation is cheesy.
+-}
+pWriteSDMF :: Parser (DirectoryCapability SDMF.Writer)
+pWriteSDMF = do
+ s <- getInput
+ setInput $ T.replace "URI:DIR2:" "URI:SSK:" s
+ v <- SDMF.pWriter
+ pure $ DirectoryCapability v
diff --git a/tahoe-directory.cabal b/tahoe-directory.cabal
index 066745f..de8c35b 100644
--- a/tahoe-directory.cabal
+++ b/tahoe-directory.cabal
@@ -95,9 +95,10 @@ library
Tahoe.Directory.Internal.Types
build-depends:
- , base >=4 && <5.0
+ , base >=4 && <5.0
, bytestring
, megaparsec
+ , tahoe-capabilities
, tahoe-chk
, tahoe-ssk
, text
@@ -135,6 +136,7 @@ test-suite tahoe-directory-test
, bytestring
, hedgehog
, megaparsec
+ , tahoe-capabilities
, tahoe-directory
, tasty
, tasty-hedgehog
diff --git a/test/Spec.hs b/test/Spec.hs
index 5bb0aa0..5caab95 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -4,8 +4,8 @@ import qualified Data.ByteString as B
import Generators (directories)
import Hedgehog (forAll, property, tripping)
import System.IO (hSetEncoding, stderr, stdout, utf8)
+import Tahoe.Capability (confidentiallyShow)
import qualified Tahoe.Directory as Directory
-import Tahoe.Directory.Internal.Capability (ConfidentialShowable (confidentiallyShow), pReadCHK, pVerifyCHK)
import Test.Tasty (TestTree, defaultMain, testGroup)
import Test.Tasty.HUnit (assertEqual, testCase)
import Test.Tasty.Hedgehog (testProperty)
@@ -25,18 +25,36 @@ tests =
property $ do
directory <- forAll directories
tripping directory Directory.serialize Directory.parse
- , testCase "well-known directory CHK read capability round-trip through parseCapability . confidentiallyShow" $ do
+ , testCase "well-known directory CHK read capability round-trips through parseCapability . confidentiallyShow" $ do
-- ❯ curl -XPOST http://localhost:3456/uri?t=mkdir-immutable --data '{"foo": ["filenode", {}], "bar": ["filenode", {}], "baz": ["filenode", {}]}'
let original = "URI:DIR2-CHK:46y5edbbxojwg5ez4lelafu5jy:fbgn7ijfxarstdxmr363et4de522n7eslnqxavymfqkoax4lc65q:3:10:63"
- let parsed = parse pReadCHK "" original
+ let parsed = parse Directory.pReadCHK "" original
let serialized = confidentiallyShow <$> parsed
assertEqual "original /= serialized" (Right original) serialized
- , testCase "well-known directory CHK verify capability round-trip through parseCapability . confidentiallyShow" $ do
+ , testCase "well-known directory CHK verify capability round-trips through parseCapability . confidentiallyShow" $ do
-- `tahoe ls --json <read cap>` to produce verifier
let original = "URI:DIR2-CHK-Verifier:ni4pjcqflws33ikhifsxqwvmya:fbgn7ijfxarstdxmr363et4de522n7eslnqxavymfqkoax4lc65q:3:10:63"
- let parsed = parse pVerifyCHK "" original
+ let parsed = parse Directory.pVerifyCHK "" original
let serialized = confidentiallyShow <$> parsed
assertEqual "original /= serialized" (Right original) serialized
+ , testCase "well-known directory SDMF write capability round-trips through parseCapability . confidentiallyShow" $ do
+ -- `tahoe mkdir` to produce directory writer
+ let original = "URI:DIR2:ez2k3glrx46svivnnrmh77uieq:c43fbv5274wmphdykpmpweq4moat5co53fvf42lg2z2xekkghm6a"
+ parsed = parse Directory.pWriteSDMF "" original
+ serialized = confidentiallyShow <$> parsed
+ assertEqual "original /= serialized" (Right original) serialized
+ , testCase "well-known directory SDMF read capability round-trips through parseCapability . confidentiallyShow" $ do
+ -- `tahoe ls --json <write cap>` to produce reader
+ let original = "URI:DIR2-RO:g3vdy2tlmpejr2tts7n6pyxbnu:c43fbv5274wmphdykpmpweq4moat5co53fvf42lg2z2xekkghm6a"
+ parsed = parse Directory.pReadSDMF "" original
+ serialized = confidentiallyShow <$> parsed
+ assertEqual "original /= serialized" (Right original) serialized
+ , testCase "well-known directory SDMF verify capability round-trips through parseCapability . confidentiallyShow" $ do
+ -- `tahoe ls --json <write cap>` to produce verifier
+ let original = "URI:DIR2-Verifier:aofaktmdrgegdvnq3vsxnccc7q:c43fbv5274wmphdykpmpweq4moat5co53fvf42lg2z2xekkghm6a"
+ parsed = parse Directory.pVerifySDMF "" original
+ serialized = confidentiallyShow <$> parsed
+ assertEqual "original /= serialized" (Right original) serialized
]
main :: IO ()
--
GitLab