From dca9a15b797e30b095f306955310a40f2d1013b5 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 11 Aug 2016 17:06:47 -0400
Subject: Shard data type

---
 Serialization.hs | 10 ++++++++++
 Shard.hs         | 18 ++++++++++--------
 Types.hs         |  3 +++
 keysafe.hs       | 18 +++++++++---------
 4 files changed, 32 insertions(+), 17 deletions(-)

diff --git a/Serialization.hs b/Serialization.hs
index 15f8881..4d6a671 100644
--- a/Serialization.hs
+++ b/Serialization.hs
@@ -33,5 +33,15 @@ instance Encodable StorableObjectIdent where
 	toByteString (StorableObjectIdent i) = i
 	fromByteString = Just . StorableObjectIdent
 
+instance Encodable StorableObject where
+	 toByteString (StorableObject b) = b
+	 fromByteString = Just . StorableObject
+
+-- | A shard is serialized without its shard number. This prevents
+-- an attacker from partitioning their shards by shard number.
+instance Encodable Shard where
+	toByteString (Shard _n o) = toByteString o
+	fromByteString _ = Nothing
+
 sepChar :: Word8
 sepChar = 32
diff --git a/Shard.hs b/Shard.hs
index 5ec58be..2af2947 100644
--- a/Shard.hs
+++ b/Shard.hs
@@ -49,20 +49,22 @@ shardIdents tunables (Name name) keyid =
 	idents = map mk [1..totalObjects (head (shardParams tunables))]
 	bruteforcecalc = bruteForceLinearSearch creationcost
 
-genShards :: EncryptedSecretKey -> Tunables -> IO [StorableObject]
-genShards (EncryptedSecretKey esk _) tunables = 
-	map (StorableObject . encodeShare) <$> SS.encode
+genShards :: EncryptedSecretKey -> Tunables -> IO [Shard]
+genShards (EncryptedSecretKey esk _) tunables = do 
+	shares <- SS.encode
 		(neededObjects $ head $ shardParams tunables)
 		(totalObjects $ head $ shardParams tunables)
 		(BL.fromStrict esk)
+	return $ map (\(n, share) -> Shard n (StorableObject $ encodeShare share))
+		(zip [1..] shares)
 
---  Throws AssertionFailed if the number of shares is too small.
-combineShards :: Tunables -> [StorableObject] -> EncryptedSecretKey
-combineShards tunables = mk . SS.decode
-	. map ds . zip [1..] . map fromStorableObject
+-- Throws AssertionFailed if the number of shares is too small.
+combineShards :: Tunables -> [Shard] -> EncryptedSecretKey
+combineShards tunables = mk . SS.decode . map decodeshard
   where
 	mk b = EncryptedSecretKey (BL.toStrict b) unknownCostCalc
-	ds (sharenum, b) = decodeShare sharenum sharesneeded b
+	decodeshard (Shard sharenum so) = decodeShare sharenum sharesneeded $
+		fromStorableObject so
 	sharesneeded = neededObjects $ head $ shardParams tunables
 
 -- | This efficient encoding relies on the share using a finite field of
diff --git a/Types.hs b/Types.hs
index e8bd8c0..06bfbe2 100644
--- a/Types.hs
+++ b/Types.hs
@@ -33,6 +33,9 @@ newtype StorableObject = StorableObject { fromStorableObject :: B.ByteString }
 newtype StorableObjectIdent = StorableObjectIdent B.ByteString
 	deriving (Show)
 
+-- | A shard, with a known number (N of M).
+data Shard = Shard Int StorableObject
+
 -- | A password used to encrypt a key stored in keysafe.
 newtype Password = Password B.ByteString
 	deriving (IsString)
diff --git a/keysafe.hs b/keysafe.hs
index bedca7f..32361ab 100644
--- a/keysafe.hs
+++ b/keysafe.hs
@@ -39,9 +39,9 @@ storedemo = do
 retrievedemo :: IO ()
 retrievedemo = do
 	let sis = shardIdents tunables name keyid
-	shards <- mapM retrieveShard (drop 1 $ getIdents sis)
-	-- TODO: need to try all orders of shards until one works,
-	-- because the shard numbers are not preserved
+	-- we drop 1 to simulate not getting all shards from the servers
+	let l = drop 1 $ zip [1..] (getIdents sis)
+	shards <- mapM (uncurry retrieveShard) l
 	let esk = combineShards tunables shards
 	kek <- genKeyEncryptionKey tunables name password
 	-- TODO: need to solve the encryption puzzle
@@ -54,19 +54,19 @@ retrievedemo = do
 	tunables = testModeTunables -- defaultTunables
 	keyid = KeyId gpgKey "foobar"
 
-storeShard :: StorableObjectIdent -> StorableObject -> IO ()
-storeShard i o = do
+storeShard :: StorableObjectIdent -> Shard -> IO ()
+storeShard i s = do
 	print $ toByteString i
 	fd <- openFd (toByteString i) WriteOnly (Just 0o666)
 		(defaultFileFlags { exclusive = True } )
 	h <- fdToHandle fd
-	B.hPut h (fromStorableObject o)
+	B.hPut h (toByteString s)
 	hClose h
 
-retrieveShard :: StorableObjectIdent -> IO StorableObject
-retrieveShard i = do
+retrieveShard :: Int -> StorableObjectIdent -> IO Shard
+retrieveShard n i = do
 	fd <- openFd (toByteString i) ReadOnly Nothing defaultFileFlags
 	h <- fdToHandle fd
 	b <- B.hGetContents h
 	b `deepseq` hClose h
-	return (StorableObject b)
+	return (Shard n (StorableObject b))
-- 
cgit v1.2.3