diff --git a/src/Tahoe/Directory/Internal/Capability.hs b/src/Tahoe/Directory/Internal/Capability.hs new file mode 100644 index 0000000000000000000000000000000000000000..efdc0d30bf0c5ce793334178cd7ab2755d235663 --- /dev/null +++ b/src/Tahoe/Directory/Internal/Capability.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE FlexibleInstances #-} + +module Tahoe.Directory.Internal.Capability where + +import qualified Data.Text as T +import Data.Void (Void) +import qualified Tahoe.CHK.Capability as CHK +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. +-} +newtype DirectoryCapability a = DirectoryCapability a + +instance ConfidentialShowable (DirectoryCapability CHK.Verifier) where + confidentiallyShow (DirectoryCapability a) = + T.replace "URI:CHK-Verifier:" "URI:DIR2-CHK-Verifier:" (CHK.dangerRealShow (CHK.CHKVerifier a)) + +instance ConfidentialShowable (DirectoryCapability CHK.Reader) where + confidentiallyShow (DirectoryCapability a) = + T.replace "URI:CHK:" "URI:DIR2-CHK:" (CHK.dangerRealShow (CHK.CHKReader a)) + +type Parser = Parsec Void T.Text + +{- | Parse a CHK verifier directory capability. + + The implementation is a cheesy hack that does string substitution on the + input before applying the original CHK verifier parser. +-} +pVerifyCHK :: Parser (DirectoryCapability CHK.Verifier) +pVerifyCHK = do + s <- getInput + setInput $ T.replace "URI:DIR2-CHK-Verifier:" "URI:CHK-Verifier:" s + v <- CHK.pVerifier + pure $ DirectoryCapability v + +{- | Parse a CHK reader directory capability. + + The implementation is a cheesy hack that does string substitution on the + input before applying the original CHK reader parser. +-} +pReadCHK :: Parser (DirectoryCapability CHK.Reader) +pReadCHK = do + s <- getInput + setInput $ T.replace "URI:DIR2-CHK:" "URI:CHK:" s + v <- CHK.pReader + pure $ DirectoryCapability v diff --git a/tahoe-directory.cabal b/tahoe-directory.cabal index fad8cfd975977dd00e4c5ef0a71bec7e1a352f60..066745fb774527f14e74f21f65bbea0c202e89f4 100644 --- a/tahoe-directory.cabal +++ b/tahoe-directory.cabal @@ -90,6 +90,7 @@ library hs-source-dirs: src exposed-modules: Tahoe.Directory + Tahoe.Directory.Internal.Capability Tahoe.Directory.Internal.Parsing Tahoe.Directory.Internal.Types @@ -97,6 +98,8 @@ library , base >=4 && <5.0 , bytestring , megaparsec + , tahoe-chk + , tahoe-ssk , text test-suite tahoe-directory-test @@ -131,6 +134,7 @@ test-suite tahoe-directory-test , base , bytestring , hedgehog + , megaparsec , tahoe-directory , tasty , tasty-hedgehog diff --git a/test/Spec.hs b/test/Spec.hs index ca23fb82884a3afcc25418e037a9cb329d898d74..5bb0aa0dad4033358137290b1b5cdc465d45be39 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -5,9 +5,11 @@ import Generators (directories) import Hedgehog (forAll, property, tripping) import System.IO (hSetEncoding, stderr, stdout, utf8) 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) +import Text.Megaparsec (parse) tests :: TestTree tests = @@ -23,6 +25,18 @@ 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 + -- ❯ 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 serialized = confidentiallyShow <$> parsed + assertEqual "original /= serialized" (Right original) serialized + , testCase "well-known directory CHK verify capability round-trip 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 serialized = confidentiallyShow <$> parsed + assertEqual "original /= serialized" (Right original) serialized ] main :: IO ()