From b2719f6e84c0c1f49ac6ab9b60846a899563961c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 11 Aug 2016 16:33:26 -0400 Subject: inline slightly modified version of secret-sharing Needed for efficient serialization of shares, unless upstream takes my suggestion to make the finite field be size 256. --- Cost.hs | 5 ++ Crypto/SecretSharing.hs | 36 +++++++++ Crypto/SecretSharing/Internal.hs | 152 ++++++++++++++++++++++++++++++++++++ Encryption.hs | 5 ++ Entropy.hs | 5 ++ ExpensiveHash.hs | 5 ++ LGPL | 165 +++++++++++++++++++++++++++++++++++++++ Serialization.hs | 9 +++ Shard.hs | 38 +++++++-- Tunables.hs | 5 ++ Types.hs | 8 +- Types/Cost.hs | 5 ++ keysafe.cabal | 9 ++- keysafe.hs | 20 ++++- 14 files changed, 456 insertions(+), 11 deletions(-) create mode 100644 Crypto/SecretSharing.hs create mode 100644 Crypto/SecretSharing/Internal.hs create mode 100644 LGPL diff --git a/Cost.hs b/Cost.hs index 4a90310..c7ab9dd 100644 --- a/Cost.hs +++ b/Cost.hs @@ -1,5 +1,10 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + module Cost ( module Cost, module Types.Cost diff --git a/Crypto/SecretSharing.hs b/Crypto/SecretSharing.hs new file mode 100644 index 0000000..a2a4f07 --- /dev/null +++ b/Crypto/SecretSharing.hs @@ -0,0 +1,36 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Crypto.SecretSharing +-- Copyright : Peter Robinson 2014 +-- License : LGPL +-- +-- Maintainer : Peter Robinson +-- Stability : experimental +-- Portability : portable +-- +-- Implementation of an (@m@,@n@)-threshold secret sharing scheme. +-- A given ByteString @b@ (the secret) is split into @n@ shares, +-- and any @m@ shares are sufficient to reconstruct @b@. +-- The scheme preserves perfect secrecy in the sense that the knowledge of up +-- to @m-1@ shares does not reveal any information about the secret @b@. +-- +-- Typically, there are @n@ parties and we would like to give the @i@-th party +-- the @i@-share of each byte. +-- For example, to encode a bytestring @secret@ as @10@ shares, any @5@ of which +-- are sufficient for reconstruction we could write: +-- +-- > shares <- encode 5 10 secret +-- +-- Note that each byte is encoded separately using a fresh set of random +-- coefficients. +-- +-- The mathematics behind the secret sharing scheme is described in: +-- \"How to share a secret.\" by Shamir, Adi. +-- In Communications of the ACM 22 (11): 612–613, 1979. +-- +-- +----------------------------------------------------------------------------- + +module Crypto.SecretSharing( encode, decode, Share ) +where +import Crypto.SecretSharing.Internal diff --git a/Crypto/SecretSharing/Internal.hs b/Crypto/SecretSharing/Internal.hs new file mode 100644 index 0000000..5fff416 --- /dev/null +++ b/Crypto/SecretSharing/Internal.hs @@ -0,0 +1,152 @@ +{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, GeneralizedNewtypeDeriving, TemplateHaskell #-} +----------------------------------------------------------------------------- +-- | +-- Module : Crypto.SecretSharing.Internal +-- Copyright : Peter Robinson 2014 +-- License : LGPL +-- +-- Maintainer : Peter Robinson +-- 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 +import qualified Data.ByteString.Lazy.Char8 as BLC +import qualified Data.List as L +import Data.Char +import Data.Vector( Vector ) +import qualified Data.Vector as V +import Data.Typeable +import Control.Exception +import Control.Monad +import Data.Binary( Binary ) +import GHC.Generics +import Data.FiniteField.PrimeField as PF +import Data.FiniteField.Base(FiniteField,order) +import System.Random.Dice + + + +-- | 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 + -- generated (secret) polynomial + } + deriving(Typeable,Eq,Generic) + +instance Show ByteShare where + show = show . shareValue + +-- | A share of the encoded secret. +data Share = Share + { theShare :: ![ByteShare] } + deriving(Typeable,Eq,Generic) + +instance Show Share where + show s = show (shareId $ head $ theShare s,BLC.pack $ map (chr . shareValue) $ theShare s) + +instance Binary ByteShare +instance Binary Share + +-- | 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 + -> 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 $ + "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 ) + `liftM` (getDiceRolls prime len) + let byteVecs = zipWith (encodeByte m n) coeffs $ + 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. +-- 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: 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) + . 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] + ] + + +decodeByte :: [ByteShare] -> FField +decodeByte ss = + let m = reconstructionThreshold $ head ss in + 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 + in + polyInterp pts 0 + + +-- | Groups a list into blocks of certain size. Running time: /O(n)/ +groupInto :: Int -> [a] -> [[a]] +groupInto num as + | num < 0 = throw $ AssertionFailed "groupInto: Need positive number as argument." + | otherwise = + let (fs,ss) = L.splitAt num as in + if L.null ss + then [fs] + else fs : groupInto num ss + + +-- | A finite prime field. All computations are performed in this field. +-- +-- This is modified from the secret-sharing library to use 256 +-- instead of 1021. That allows values in the field to be efficiently +-- packed into bytes. It's beleived that the finite field can be a power of +-- a prime number (in this case, 2). +newtype FField = FField { number :: $(primeField $ fromIntegral (256 :: Integer)) } + 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] + +-- | 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 +-- in L.foldl' (+) 0 [ c x | c <- clist ] + diff --git a/Encryption.hs b/Encryption.hs index 8040f5f..29935ac 100644 --- a/Encryption.hs +++ b/Encryption.hs @@ -1,5 +1,10 @@ {-# LANGUAGE OverloadedStrings, MultiParamTypeClasses, DataKinds #-} +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + module Encryption where import Types diff --git a/Entropy.hs b/Entropy.hs index d6779fe..7a62c68 100644 --- a/Entropy.hs +++ b/Entropy.hs @@ -1,5 +1,10 @@ {-# LANGUAGE FlexibleInstances #-} +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + module Entropy where import Data.List diff --git a/ExpensiveHash.hs b/ExpensiveHash.hs index 48acba2..226fac7 100644 --- a/ExpensiveHash.hs +++ b/ExpensiveHash.hs @@ -1,5 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + module ExpensiveHash where import Types diff --git a/LGPL b/LGPL new file mode 100644 index 0000000..65c5ca8 --- /dev/null +++ b/LGPL @@ -0,0 +1,165 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + + This version of the GNU Lesser General Public License incorporates +the terms and conditions of version 3 of the GNU General Public +License, supplemented by the additional permissions listed below. + + 0. Additional Definitions. + + As used herein, "this License" refers to version 3 of the GNU Lesser +General Public License, and the "GNU GPL" refers to version 3 of the GNU +General Public License. + + "The Library" refers to a covered work governed by this License, +other than an Application or a Combined Work as defined below. + + An "Application" is any work that makes use of an interface provided +by the Library, but which is not otherwise based on the Library. +Defining a subclass of a class defined by the Library is deemed a mode +of using an interface provided by the Library. + + A "Combined Work" is a work produced by combining or linking an +Application with the Library. The particular version of the Library +with which the Combined Work was made is also called the "Linked +Version". + + The "Minimal Corresponding Source" for a Combined Work means the +Corresponding Source for the Combined Work, excluding any source code +for portions of the Combined Work that, considered in isolation, are +based on the Application, and not on the Linked Version. + + The "Corresponding Application Code" for a Combined Work means the +object code and/or source code for the Application, including any data +and utility programs needed for reproducing the Combined Work from the +Application, but excluding the System Libraries of the Combined Work. + + 1. Exception to Section 3 of the GNU GPL. + + You may convey a covered work under sections 3 and 4 of this License +without being bound by section 3 of the GNU GPL. + + 2. Conveying Modified Versions. + + If you modify a copy of the Library, and, in your modifications, a +facility refers to a function or data to be supplied by an Application +that uses the facility (other than as an argument passed when the +facility is invoked), then you may convey a copy of the modified +version: + + a) under this License, provided that you make a good faith effort to + ensure that, in the event an Application does not supply the + function or data, the facility still operates, and performs + whatever part of its purpose remains meaningful, or + + b) under the GNU GPL, with none of the additional permissions of + this License applicable to that copy. + + 3. Object Code Incorporating Material from Library Header Files. + + The object code form of an Application may incorporate material from +a header file that is part of the Library. You may convey such object +code under terms of your choice, provided that, if the incorporated +material is not limited to numerical parameters, data structure +layouts and accessors, or small macros, inline functions and templates +(ten or fewer lines in length), you do both of the following: + + a) Give prominent notice with each copy of the object code that the + Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the object code with a copy of the GNU GPL and this license + document. + + 4. Combined Works. + + You may convey a Combined Work under terms of your choice that, +taken together, effectively do not restrict modification of the +portions of the Library contained in the Combined Work and reverse +engineering for debugging such modifications, if you also do each of +the following: + + a) Give prominent notice with each copy of the Combined Work that + the Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the Combined Work with a copy of the GNU GPL and this license + document. + + c) For a Combined Work that displays copyright notices during + execution, include the copyright notice for the Library among + these notices, as well as a reference directing the user to the + copies of the GNU GPL and this license document. + + d) Do one of the following: + + 0) Convey the Minimal Corresponding Source under the terms of this + License, and the Corresponding Application Code in a form + suitable for, and under terms that permit, the user to + recombine or relink the Application with a modified version of + the Linked Version to produce a modified Combined Work, in the + manner specified by section 6 of the GNU GPL for conveying + Corresponding Source. + + 1) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (a) uses at run time + a copy of the Library already present on the user's computer + system, and (b) will operate properly with a modified version + of the Library that is interface-compatible with the Linked + Version. + + e) Provide Installation Information, but only if you would otherwise + be required to provide such information under section 6 of the + GNU GPL, and only to the extent that such information is + necessary to install and execute a modified version of the + Combined Work produced by recombining or relinking the + Application with a modified version of the Linked Version. (If + you use option 4d0, the Installation Information must accompany + the Minimal Corresponding Source and Corresponding Application + Code. If you use option 4d1, you must provide the Installation + Information in the manner specified by section 6 of the GNU GPL + for conveying Corresponding Source.) + + 5. Combined Libraries. + + You may place library facilities that are a work based on the +Library side by side in a single library together with other library +facilities that are not Applications and are not covered by this +License, and convey such a combined library under terms of your +choice, if you do both of the following: + + a) Accompany the combined library with a copy of the same work based + on the Library, uncombined with any other library facilities, + conveyed under the terms of this License. + + b) Give prominent notice with the combined library that part of it + is a work based on the Library, and explaining where to find the + accompanying uncombined form of the same work. + + 6. Revised Versions of the GNU Lesser General Public License. + + The Free Software Foundation may publish revised and/or new versions +of the GNU Lesser General Public License from time to time. Such new +versions will be similar in spirit to the present version, but may +differ in detail to address new problems or concerns. + + Each version is given a distinguishing version number. If the +Library as you received it specifies that a certain numbered version +of the GNU Lesser General Public License "or any later version" +applies to it, you have the option of following the terms and +conditions either of that published version or of any later version +published by the Free Software Foundation. If the Library as you +received it does not specify a version number of the GNU Lesser +General Public License, you may choose any version of the GNU Lesser +General Public License ever published by the Free Software Foundation. + + If the Library as you received it specifies that a proxy can decide +whether future versions of the GNU Lesser General Public License shall +apply, that proxy's public statement of acceptance of any version is +permanent authorization for you to choose that version for the +Library. diff --git a/Serialization.hs b/Serialization.hs index 224d67a..15f8881 100644 --- a/Serialization.hs +++ b/Serialization.hs @@ -1,6 +1,11 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE OverloadedStrings #-} +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + module Serialization where import Types @@ -24,5 +29,9 @@ instance Encodable Name where toByteString (Name n) = n fromByteString = Just . Name +instance Encodable StorableObjectIdent where + toByteString (StorableObjectIdent i) = i + fromByteString = Just . StorableObjectIdent + sepChar :: Word8 sepChar = 32 diff --git a/Shard.hs b/Shard.hs index a6043fd..5ec58be 100644 --- a/Shard.hs +++ b/Shard.hs @@ -1,19 +1,23 @@ {-# LANGUAGE OverloadedStrings, MultiParamTypeClasses #-} +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + module Shard where import Types import Tunables import ExpensiveHash import Cost -import qualified Crypto.SecretSharing as SS +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 Data.Binary import Data.Monoid data ShardIdents = ShardIdents @@ -47,14 +51,34 @@ shardIdents tunables (Name name) keyid = genShards :: EncryptedSecretKey -> Tunables -> IO [StorableObject] genShards (EncryptedSecretKey esk _) tunables = - map (StorableObject . encode) <$> SS.encode + map (StorableObject . encodeShare) <$> SS.encode (neededObjects $ head $ shardParams tunables) (totalObjects $ head $ shardParams tunables) (BL.fromStrict esk) -- Throws AssertionFailed if the number of shares is too small. -combineShards :: [StorableObject] -> EncryptedSecretKey -combineShards = mk . BL.toStrict . SS.decode . map conv +combineShards :: Tunables -> [StorableObject] -> EncryptedSecretKey +combineShards tunables = mk . SS.decode + . map ds . zip [1..] . map fromStorableObject + where + mk b = EncryptedSecretKey (BL.toStrict b) unknownCostCalc + ds (sharenum, b) = decodeShare sharenum sharesneeded b + sharesneeded = neededObjects $ head $ shardParams 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 shards +-- 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 - conv = decode . fromStorableObject - mk b = EncryptedSecretKey b unknownCostCalc + mk w = SS.ByteShare + { SS.shareId = sharenum + , SS.reconstructionThreshold = sharesneeded + , SS.shareValue = fromIntegral w + } diff --git a/Tunables.hs b/Tunables.hs index 7a646d3..763f0bf 100644 --- a/Tunables.hs +++ b/Tunables.hs @@ -1,5 +1,10 @@ {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + module Tunables where import Cost diff --git a/Types.hs b/Types.hs index 085f321..44c38a2 100644 --- a/Types.hs +++ b/Types.hs @@ -1,11 +1,15 @@ {-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleInstances #-} +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + module Types where import Types.Cost import Entropy import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as BL import Data.String -- | keysafe stores secret keys. @@ -19,7 +23,7 @@ instance Bruteforceable EncryptedSecretKey UnknownPassword where -- | Objects stored on a keysafe server are (probably) a shard of an -- encrypted secret key. -newtype StorableObject = StorableObject { fromStorableObject :: BL.ByteString } +newtype StorableObject = StorableObject { fromStorableObject :: B.ByteString } deriving (Show) -- | An identifier for a StorableObject diff --git a/Types/Cost.hs b/Types/Cost.hs index 45cf813..de091b8 100644 --- a/Types/Cost.hs +++ b/Types/Cost.hs @@ -1,5 +1,10 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, EmptyDataDecls #-} +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + module Types.Cost where import Utility.HumanTime diff --git a/keysafe.cabal b/keysafe.cabal index 084f682..a9ae1da 100644 --- a/keysafe.cabal +++ b/keysafe.cabal @@ -22,7 +22,6 @@ Executable keysafe , bytestring == 0.10.* , deepseq == 1.4.* , random == 1.1.* - , secret-sharing == 1.0.* , raaz == 0.0.2 , argon2 == 1.1.* , QuickCheck == 2.8.* @@ -31,6 +30,14 @@ Executable keysafe , binary == 0.7.* , text == 1.2.* , utf8-string == 1.0.* + , unix == 2.7.* + + -- secret-sharing == 1.0.* + , 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 source-repository head type: git diff --git a/keysafe.hs b/keysafe.hs index 15deb79..f1d87fa 100644 --- a/keysafe.hs +++ b/keysafe.hs @@ -1,11 +1,20 @@ {-# LANGUAGE OverloadedStrings #-} +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + module Main where import Types import Tunables import Encryption import Shard +import Raaz.Core.Encode +import System.IO +import System.Posix.ByteString +import qualified Data.ByteString as B main :: IO () main = do @@ -13,10 +22,19 @@ main = do let esk = encrypt kek secretkey let sis = shardIdents tunables name keyid shards <- genShards esk tunables - print $ zip (getIdents sis) shards + mapM_ (uncurry store) (zip (getIdents sis) shards) where password = Password "foo" name = Name "bar" tunables = testModeTunables -- defaultTunables keyid = KeyId gpgKey "foobar" secretkey = SecretKey "this is a gpg private key" + +store :: StorableObjectIdent -> StorableObject -> IO () +store i o = do + print $ toByteString i + fd <- openFd (toByteString i) WriteOnly (Just 0o666) + (defaultFileFlags { exclusive = True } ) + h <- fdToHandle fd + B.hPut h (fromStorableObject o) + hClose h -- cgit v1.2.3