diff --git a/cabal.project b/cabal.project
index b216db5dffaa26749cae2f6bce4530a0d9e41498..78fa3af55a5c1c65dc617f30e2ced0b5e78c37f6 100644
--- a/cabal.project
+++ b/cabal.project
@@ -1,4 +1,8 @@
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-chk/-/archive/0.1.0.1/tahoe-chk-0.1.0.1.tar.gz
tests: True
diff --git a/src/Tahoe/Directory/Internal/Capability.hs b/src/Tahoe/Directory/Internal/Capability.hs
new file mode 100644
index 0000000000000000000000000000000000000000..e1637b44bbcd22dcf47fde1614f678e6782f9b3a
--- /dev/null
+++ b/src/Tahoe/Directory/Internal/Capability.hs
@@ -0,0 +1,126 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+
+module Tahoe.Directory.Internal.Capability where
+
+import Control.Monad.IO.Class (MonadIO)
+import Crypto.Cipher.AES128 (AESKey128)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as LB
+import qualified Data.Text as T
+import Data.Void (Void)
+import qualified Tahoe.CHK as CHK
+import qualified Tahoe.CHK.Capability as CHK
+import qualified Tahoe.CHK.Encrypt as CHK
+import qualified Tahoe.CHK.Share as CHK
+import qualified Tahoe.CHK.Types as CHK
+import qualified Text.Megaparsec
+
+{- | 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
+
+{- | From "capability-based security", a communicable, unforgeable token of
+ authority.
+
+ In our case, a short cryptographically derived string which may allow us to
+ interact with some plaintext previously stored.
+
+ It is expected that an instances of Show and ConfidentialShowable will also
+ be provided for any type c.
+-}
+class Capability c where
+ -- | Interpret a textual representation of the capability into a
+ -- structured representation of the same, if possible.
+ parse :: Text.Megaparsec.Parsec Void T.Text c
+
+{- | A capability which can have some of its authority removed to produce a
+ new, weaker capability.
+-}
+class Diminishable stronger weaker | stronger -> weaker where
+ -- | Perform the diminution.
+ diminish :: stronger -> weaker
+
+{- | A capability which allows "shares" of data to be located and their
+ integrity verified but does not allow the data to be read or re-written.
+-}
+class (MonadIO m, Capability v) => VerifyCapability m v where
+ -- | Perform the verification. True if the data passes all verification
+ -- checks, False otherwise. XXX Replace Bool with a more expressive type
+ -- so we can learn the details of the failure.
+ verify :: v -> m Bool
+
+{- | A capability which allows "shares" of data to be read but does not allow
+ data to be re-written. Typically, a ReadCapability can also be diminished to
+ a VerifyCapability.
+
+ The typeclass includes encryption and encoding methods because even though
+ the capability does not allow *re-writing* it must still support writing
+ shares the first time.
+
+ Each instance must use its own secret key type so that the key type can
+ uniquely determine the type of capability in use.
+-}
+class (MonadIO m, Capability read) => ReadCapability m params key share read | read -> m params key share, key -> m params share read where
+ -- | Encrypt plaintext to ciphertext.
+ encrypt :: LB.ByteString -> (LB.ByteString, key)
+
+ -- | Recover plaintext by decrypting ciphertext.
+ decrypt :: key -> LB.ByteString -> LB.ByteString
+
+ -- | Encode some ciphertext into "shares", creating a ReadCapability at
+ -- the same time.
+ encode ::
+ -- | The encoding parameters for this operation.
+ params ->
+ -- | The ciphertext and the secret key which can decrypt it.
+ (LB.ByteString, key) ->
+ -- | The read capability and the encoded shares.
+ m ([share], read)
+
+ -- | If possible, decode the shares to the original ciphertext.
+ decodeMaybe ::
+ read ->
+ -- | The shares to decode.
+ [(Int, share)] ->
+ m (Maybe LB.ByteString)
+
+-- | A capability which allows "shares" of data to re-written.
+class (MonadIO m, Capability write) => WriteCapability m params write | write -> m params where
+ -- | Write new shares which completely replace the old data with the new data.
+ rewrite :: params -> write -> LB.ByteString -> m [LB.ByteString]
+
+data Reader = forall m params key share read. (ReadCapability m params key share read, Show read, ConfidentialShowable read) => Reader read
+
+instance Eq Reader
+instance Show Reader
+instance ConfidentialShowable Reader where
+ confidentiallyShow (Reader r) = confidentiallyShow r
+
+instance ConfidentialShowable CHK.Verifier where
+ confidentiallyShow = CHK.dangerRealShow . CHK.CHKVerifier
+
+instance Capability CHK.Verifier where
+ parse = CHK.pVerifier
+
+instance MonadIO m => VerifyCapability m CHK.Verifier where
+ verify = error "chk verification is unimplemented"
+
+instance ConfidentialShowable CHK.Reader where
+ confidentiallyShow = CHK.dangerRealShow . CHK.CHKReader
+
+instance Capability CHK.Reader where
+ parse = CHK.pReader
+
+instance ReadCapability IO CHK.Parameters AESKey128 CHK.Share CHK.Reader where
+ encrypt = error "tahoe-chk library doesn't have quite the right shape to make this easy yet"
+ decrypt = CHK.decrypt
+
+ encode params (ciphertext, key) = CHK.encode key params ciphertext
+ decodeMaybe = CHK.decode
diff --git a/src/Tahoe/Directory/Internal/Parsing.hs b/src/Tahoe/Directory/Internal/Parsing.hs
index 889c22e7c893b6331686ba1f5471bd783c21d7ed..299e12cb80def7e6f2a5bf4447426699d45cd7cb 100644
--- a/src/Tahoe/Directory/Internal/Parsing.hs
+++ b/src/Tahoe/Directory/Internal/Parsing.hs
@@ -1,5 +1,4 @@
{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE FunctionalDependencies #-}
-- | Parsing and serialization for directories and their entries.
module Tahoe.Directory.Internal.Parsing where
@@ -10,8 +9,10 @@ import qualified Data.ByteString.Char8 as C8
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8', encodeUtf8)
import Data.Void (Void)
+import qualified Tahoe.CHK.Capability as CHK
+import Tahoe.Directory.Internal.Capability (Capability (parse), ConfidentialShowable (confidentiallyShow), Reader (..))
import Tahoe.Directory.Internal.Types (Directory (..), Entry (..))
-import Text.Megaparsec (MonadParsec (eof, label, takeP), ParseErrorBundle, Parsec, many, parse)
+import Text.Megaparsec (MonadParsec (eof, label, takeP), ParseErrorBundle, Parsec, failure, many, parse)
import Text.Megaparsec.Byte (string)
import Text.Megaparsec.Byte.Lexer (decimal)
@@ -57,10 +58,19 @@ pEntry =
pNetstring $ \_ ->
Entry
<$> label "name" (pNetstring pUTF8)
- <*> label "ro_uri" (pNetstring (takeP Nothing))
+ <*> label "ro_uri" (pNetstring parseCap)
<*> label "rw_uri" (pNetstring (takeP Nothing))
<*> label "metadata" (pNetstring (takeP Nothing))
+parseCap :: Int -> Parser Reader
+parseCap n = do
+ bs <- takeP Nothing n
+ case decodeUtf8' bs of
+ Left _ -> Text.Megaparsec.failure Nothing mempty
+ Right txt -> case Text.Megaparsec.parse (Tahoe.Directory.Internal.Capability.parse :: Parsec Void T.Text CHK.Reader) "" txt of
+ Left err -> failure Nothing mempty
+ Right cap -> pure $ Tahoe.Directory.Internal.Capability.Reader cap
+
pUTF8 :: Int -> Parser T.Text
pUTF8 n = do
bs <- takeP Nothing n
@@ -77,7 +87,7 @@ serializeEntry Entry{..} =
-- constructor?
netstring . B.concat $
[ netstring . encodeUtf8 $ entryName
- , netstring entryReader
+ , netstring . encodeUtf8 . confidentiallyShow $ entryReader
, netstring entryEncryptedWriter
, netstring entryMetadata
]
@@ -91,11 +101,3 @@ netstring xs =
, xs
, ","
]
-
-class ReadCapability c s m | c -> s where
- read :: c -> [s] -> m B.ByteString
-
-data CapabilityParser = forall c. CapabilityParser (Parser c)
-
-parserWithCapabilities :: ReadCapability c s m => [Parser c] -> Parser (Directory c s (m a))
-parserWithCapabilities parsers = undefined
diff --git a/src/Tahoe/Directory/Internal/Types.hs b/src/Tahoe/Directory/Internal/Types.hs
index ff4b7c619d657f647b4d1382b431738baf4eca20..0b8bfbd440ce408ee239d5774170d9c22519de4b 100644
--- a/src/Tahoe/Directory/Internal/Types.hs
+++ b/src/Tahoe/Directory/Internal/Types.hs
@@ -3,18 +3,20 @@ module Tahoe.Directory.Internal.Types where
import qualified Data.ByteString as B
import qualified Data.Text as T
+import Tahoe.Directory.Internal.Capability (Reader)
+
-- | A collection of references to other objects.
-newtype Directory c s m = Directory
- { directoryChildren :: [Entry c s m]
+newtype Directory = Directory
+ { directoryChildren :: [Entry]
}
deriving (Eq, Show)
-- | A reference to an object of any kind.
-data Entry c s m = Entry
+data Entry = Entry
{ -- | The name of this entry in its containing directory. XXX What if UTF-8 decoding fails?
entryName :: T.Text
, -- | A capability for reading the contents of this entry. XXX Structured cap instead
- entryReader :: c
+ entryReader :: Reader
, -- | An encrypted capability for performing writes to this entry. XXX
-- Document the encryption scheme.
entryEncryptedWriter :: B.ByteString
diff --git a/tahoe-directory.cabal b/tahoe-directory.cabal
index fad8cfd975977dd00e4c5ef0a71bec7e1a352f60..83caa7514aab4711cbb3bbb8d127a7f7d1030cd0 100644
--- a/tahoe-directory.cabal
+++ b/tahoe-directory.cabal
@@ -90,13 +90,16 @@ library
hs-source-dirs: src
exposed-modules:
Tahoe.Directory
+ Tahoe.Directory.Internal.Capability
Tahoe.Directory.Internal.Parsing
Tahoe.Directory.Internal.Types
build-depends:
- , base >=4 && <5.0
+ , base >=4 && <5.0
, bytestring
+ , cipher-aes128
, megaparsec
+ , tahoe-chk
, text
test-suite tahoe-directory-test