1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
{-# LANGUAGE OverloadedStrings, MultiParamTypeClasses #-}
{- Copyright 2016 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Share where
import Types
import Tunables
import ExpensiveHash
import Cost
import qualified Crypto.SecretSharing.Internal as SS
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Raaz.Core.Encode as Raaz
import qualified Raaz.Hash.Sha256 as Raaz
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.Set as S
import Data.Monoid
data ShareIdents = ShareIdents
{ identsStream :: [S.Set StorableObjectIdent]
-- ^ Each item in the infinite list is the idents to
-- use for the shares of a chunk of data.
, identsCreationCost :: Cost CreationOp
, identsBruteForceCalc :: CostCalc BruteForceOp UnknownName
}
nextShareIdents :: ShareIdents -> (S.Set StorableObjectIdent, ShareIdents)
nextShareIdents sis =
let (s:rest) = identsStream sis
in (s, sis { identsStream = rest })
instance HasCreationCost ShareIdents where
getCreationCost = identsCreationCost
instance Bruteforceable ShareIdents UnknownName where
getBruteCostCalc = identsBruteForceCalc
-- | Generates identifiers to use for storing shares.
--
-- This is an expensive operation, to make it difficult for an attacker
-- to brute force known/guessed names and find matching shares.
-- The keyid or filename is used as a salt, to avoid collisions
-- when the same name is chosen for multiple keys.
shareIdents :: Tunables -> Name -> SecretKeySource -> ShareIdents
shareIdents tunables (Name name) keyid =
ShareIdents (segmentbyshare idents) creationcost bruteforcecalc
where
(ExpensiveHash creationcost basename) =
expensiveHash hashtunables (Salt keyid) name
mk n = StorableObjectIdent $ Raaz.toByteString $ mksha $
E.encodeUtf8 $ basename <> T.pack (show n)
mksha :: B.ByteString -> Raaz.Base16
mksha = Raaz.encode . Raaz.sha256
bruteforcecalc = bruteForceLinearSearch creationcost
hashtunables = nameGenerationHash $ nameGenerationTunable tunables
idents = map mk ([1..] :: [Integer])
m = totalObjects (shareParams tunables)
segmentbyshare l =
let (shareis, l') = splitAt m l
in S.fromList shareis : segmentbyshare l'
-- | Generates shares of an EncryptedSecretKey.
-- Each chunk of the key creates its own set of shares.
genShares :: EncryptedSecretKey -> Tunables -> IO [S.Set Share]
genShares (EncryptedSecretKey cs _) tunables = do
shares <- mapM encode cs
return $ map (S.fromList . map (uncurry Share) . zip [1..]) shares
where
encode :: B.ByteString -> IO [StorableObject]
encode b = map (StorableObject . encodeShare)
<$> SS.encode
(neededObjects $ shareParams tunables)
(totalObjects $ shareParams tunables)
(BL.fromStrict b)
-- | If not enough sets of shares are provided, the EncryptedSecretKey may
-- be incomplete, only containing some chunks of the key
combineShares :: Tunables -> [S.Set Share] -> Either String EncryptedSecretKey
combineShares tunables shares
| null shares || any null shares || any (\l -> length l < sharesneeded) shares =
Left "Not enough shares are currently available to reconstruct your data."
| otherwise = Right $ mk $
map (BL.toStrict . SS.decode . map decodeshare . S.toList) shares
where
mk cs = EncryptedSecretKey cs unknownCostCalc
decodeshare (Share sharenum so) = decodeShare sharenum sharesneeded $
fromStorableObject so
sharesneeded = neededObjects (shareParams tunables)
-- | This efficient encoding relies on the share using a finite field of
-- size 256, so it maps directly to bytes.
--
-- Note that this does not include the share number in the encoded
-- bytestring. This prevents an attacker from partitioning their shares
-- by share number.
encodeShare :: SS.Share -> B.ByteString
encodeShare = B.pack . map (fromIntegral . SS.shareValue) . SS.theShare
decodeShare :: Int -> Int -> B.ByteString -> SS.Share
decodeShare sharenum sharesneeded = SS.Share . map mk . B.unpack
where
mk w = SS.ByteShare
{ SS.shareId = sharenum
, SS.reconstructionThreshold = sharesneeded
, SS.shareValue = fromIntegral w
}
|
