secret-sharing 1.0.0.3 → 1.0.1.0
raw patch · 2 files changed
+65/−47 lines, 2 filesdep +secret-sharingdep −polynomialdep ~binarydep ~dice-entropy-conduitdep ~finite-field
Dependencies added: secret-sharing
Dependencies removed: polynomial
Dependency ranges changed: binary, dice-entropy-conduit, finite-field, vector
Files
- secret-sharing.cabal +16/−12
- src/Crypto/SecretSharing/Internal.hs +49/−35
secret-sharing.cabal view
@@ -1,9 +1,9 @@ name: secret-sharing-version: 1.0.0.3-synopsis: Information-theoretic secure secret sharing +version: 1.0.1.0+synopsis: Information-theoretic secure secret sharing description: Implementation of an (@m@,@n@)-threshold secret sharing scheme.- A given ByteString @b@ (the secret) is split into @n@ shares, + A given ByteString @b@ (the secret) is split into @n@ shares, and any @m@ shares are sufficient to reconstruct @b@. The scheme preserves information-theoretic perfect secrecy in the sense that the knowledge of up to @m-1@ shares does not reveal any information about the secret @b@.@@ -21,8 +21,8 @@ > (3,"~\238%\192\174\206\\\f\214\173\162\148\&3\139_\183\193\235") > (4,"Z\b0\188\DC2\f\247\f,\136\&6S\209\&5\n\FS,\223") > (5,"x\EM\CAN\DELI*<\193q7d\192!/\183v\DC3T")- >> let shares' = Prelude.drop 2 shares - >> decode shares' + >> let shares' = Prelude.drop 2 shares+ >> decode shares' > "my secret message!" . The mathematics behind the secret sharing scheme is described in:@@ -33,12 +33,16 @@ author: Peter Robinson <peter.robinson@monoid.at> maintainer: peter.robinson@monoid.at copyright: Peter Robinson 2014-category: Cryptography +category: Cryptography build-type: Simple cabal-version: >=1.8-homepage: http://monoid.at/code+homepage: https://github.com/pwrobinson/secret-sharing stability: experimental +source-repository head+ type: git+ location: https://github.com/pwrobinson/secret-sharing+ library hs-source-dirs: src exposed-modules: Crypto.SecretSharing@@ -49,18 +53,18 @@ dice-entropy-conduit >= 1.0.0.0, binary >=0.5.1.1, vector >=0.10.11.0,- finite-field >=0.8.0,- polynomial >= 0.7.1- ghc-options: -Wall + finite-field >=0.8.0+ ghc-options: -Wall test-suite Main type: exitcode-stdio-1.0 x-uses-tf: true build-depends: base >= 4 && < 5,+ bytestring ==0.10.*, QuickCheck >= 2.4,+ secret-sharing, test-framework >= 0.4.1, test-framework-quickcheck2- hs-source-dirs: src, tests+ hs-source-dirs: tests main-is: Tests.hs-
src/Crypto/SecretSharing/Internal.hs view
@@ -1,19 +1,18 @@-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, GeneralizedNewtypeDeriving, TemplateHaskell #-} +{-# LANGUAGE DataKinds, DeriveDataTypeable, DeriveGeneric, GeneralizedNewtypeDeriving, TemplateHaskell #-} ----------------------------------------------------------------------------- -- | -- Module : Crypto.SecretSharing.Internal -- Copyright : Peter Robinson 2014 -- License : LGPL--- +-- -- Maintainer : Peter Robinson <peter.robinson@monoid.at> -- Stability : experimental -- Portability : portable--- +-- ----------------------------------------------------------------------------- module Crypto.SecretSharing.Internal where-import Math.Polynomial.Interpolation import Data.ByteString.Lazy( ByteString ) import qualified Data.ByteString.Lazy as BL@@ -31,23 +30,38 @@ import Data.FiniteField.Base(FiniteField,order) import System.Random.Dice +-- | Evaluate a Lagrange interpolation polynomial+-- passing through the specified set of points.+polyInterp :: Fractional a => [(a, a)] -> a -> a+polyInterp xys x = sum $ map evalBasisPoly $ slidingFocus xys+ where+ evalBasisPoly (left, (xj, yj), right) =+ yj * product (map (\(xm, _) -> (x - xm) / (xj - xm)) (left ++ right)) +-- [1,2,3] -> [([], 1, [2,3]), ([1], 2, [3]), ([2,1], 3, [])]+slidingFocus :: [a] -> [([a], a, [a])]+slidingFocus [] = []+slidingFocus (x : xs) = go [] x xs+ where+ go left focus right = (left, focus, right) : case right of+ [] -> []+ focus' : right' -> go (focus : left) focus' right' --- | A share of an encoded byte. -data ByteShare = ByteShare - { shareId :: !Int -- ^ the index of this share - , reconstructionThreshold :: !Int -- ^ number of shares required for +-- | A share of an encoded byte.+data ByteShare = ByteShare+ { shareId :: !Int -- ^ the index of this share+ , reconstructionThreshold :: !Int -- ^ number of shares required for -- reconstruction- , shareValue :: !Int -- ^ the value of p(shareId) where p(x) is the + , shareValue :: !Int -- ^ the value of p(shareId) where p(x) is the -- generated (secret) polynomial } deriving(Typeable,Eq,Generic) instance Show ByteShare where- show = show . shareValue + show = show . shareValue -- | A share of the encoded secret.-data Share = Share +data Share = Share { theShare :: ![ByteShare] } deriving(Typeable,Eq,Generic) @@ -60,44 +74,44 @@ -- | Encodes a 'ByteString' as a list of n shares, m of which are required for -- reconstruction. -- Lives in the 'IO' to access a random source.-encode :: Int -- ^ m +encode :: Int -- ^ m -> Int -- ^ n -> ByteString -- ^ the secret that we want to share- -> IO [Share] -- a list of n-shares (per byte) -encode m n bstr - | n >= prime || m > n = throw $ AssertionFailed $ + -> IO [Share] -- a list of n-shares (per byte)+encode m n bstr+ | n >= prime || m > n = throw $ AssertionFailed $ "encode: require n < " ++ show prime ++ " and m<=n." | BL.null bstr = return [] | otherwise = do let len = max 1 ((fromIntegral $ BL.length bstr) * (m-1))- coeffs <- (groupInto (m-1) . map fromIntegral . take len ) + coeffs <- (groupInto (m-1) . map fromIntegral . take len ) `liftM` (getDiceRolls prime len) let byteVecs = zipWith (encodeByte m n) coeffs $- map fromIntegral $ BL.unpack bstr + map fromIntegral $ BL.unpack bstr return [ Share $ map (V.! (i-1)) byteVecs | i <- [1..n] ] --- | Reconstructs a (secret) bytestring from a list of (at least @m@) shares. +-- | Reconstructs a (secret) bytestring from a list of (at least @m@) shares. -- Throws 'AssertionFailed' if the number of shares is too small. decode :: [Share] -- ^ list of at least @m@ shares -> ByteString -- ^ reconstructed secret decode [] = BL.pack []-decode shares@((Share s):_) - | length shares < reconstructionThreshold (head s) = throw $ AssertionFailed +decode shares@((Share s):_)+ | length shares < reconstructionThreshold (head s) = throw $ AssertionFailed "decode: not enough shares for reconstruction." | otherwise = let origLength = length s in let byteVecs = map (V.fromList . theShare) shares in let byteShares = [ map ((V.! (i-1))) byteVecs | i <- [1..origLength] ] in- BL.pack . map (fromInteger . PF.toInteger . number) + BL.pack . map (fromInteger . PF.toInteger . number) . map decodeByte $ byteShares- + encodeByte :: Int -> Int -> Polyn -> FField -> Vector ByteShare-encodeByte m n coeffs secret = - V.fromList[ ByteShare i m $ fromInteger . PF.toInteger . number $ - evalPolynomial (secret:coeffs) (fromIntegral i::FField) - | i <- [1..n] +encodeByte m n coeffs secret =+ V.fromList[ ByteShare i m $ fromInteger . PF.toInteger . number $+ evalPolynomial (secret:coeffs) (fromIntegral i::FField)+ | i <- [1..n] ] @@ -107,9 +121,9 @@ if length ss < m then throw $ AssertionFailed "decodeByte: insufficient number of shares for reconstruction!" else- let shares = take m ss - pts = map (\s -> (fromIntegral $ shareId s,fromIntegral $ shareValue s)) - shares + let shares = take m ss+ pts = map (\s -> (fromIntegral $ shareId s,fromIntegral $ shareValue s))+ shares in polyInterp pts 0 @@ -118,30 +132,30 @@ groupInto :: Int -> [a] -> [[a]] groupInto num as | num < 0 = throw $ AssertionFailed "groupInto: Need positive number as argument."- | otherwise = + | otherwise = let (fs,ss) = L.splitAt num as in- if L.null ss + if L.null ss then [fs]- else fs : groupInto num ss + else fs : groupInto num ss -- | A finite prime field. All computations are performed in this field. newtype FField = FField { number :: $(primeField $ fromIntegral 1021) } deriving(Show,Read,Ord,Eq,Num,Fractional,Generic,Typeable,FiniteField)- + -- | The size of the finite field prime :: Int prime = fromInteger $ order (0 :: FField) -- | A polynomial over the finite field given as a list of coefficients.-type Polyn = [FField] +type Polyn = [FField] -- | Evaluates the polynomial at a given point. evalPolynomial :: Polyn -> FField -> FField evalPolynomial coeffs x = foldr (\c res -> c + (x * res)) 0 coeffs--- let clist = zipWith (\pow c -> (\x -> c * (x^pow))) [0..] coeffs +-- let clist = zipWith (\pow c -> (\x -> c * (x^pow))) [0..] coeffs -- in L.foldl' (+) 0 [ c x | c <- clist ]