packages feed

pvss (empty) → 0.1

raw patch · 9 files changed

+905/−0 lines, 9 filesdep +basedep +binarydep +bytestringsetup-changed

Dependencies added: base, binary, bytestring, cryptonite, cryptonite-openssl, deepseq, hourglass, integer-gmp, memory, pvss, tasty, tasty-quickcheck

Files

+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2016 IOHK++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies+of the Software, and to permit persons to whom the Software is furnished to+do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE BangPatterns #-}+module Main where++import           System.Environment+import           Control.Monad+import           Control.DeepSeq+import           Crypto.Random+import qualified Crypto.PVSS as PVSS+import           Data.Hourglass+import           Time.Types+import           Time.System++timing f = do+    t1 <- timeCurrentP+    a  <- f+    t2 <- a `deepseq` timeCurrentP+    return (a, t2 `timeDiffP` t1)++timingP n f = do+    (a, t) <- timing f+    putStrLn (n ++ ": " ++ show t)+    return a++chunk _ [] = []+chunk n l =+    let (l1,l2) = splitAt n l+     in l1 : chunk n l2++go t n = do+    participants <- replicateM n $ PVSS.keyPairGenerate++    !e <- timingP "escrow-new" $ PVSS.escrowNew t++    !commitments <- timingP "commitments" $ return $ PVSS.createCommitments e++    !esharesChunks <- timingP "shares" $ forM (chunk 200 $ zip [1..] (map PVSS.toPublicKey participants)) $ \c ->+        timingP ("chunk-" ++ show (fst $ head c)) $ forM c $ uncurry (PVSS.shareCreate e commitments)+    let eshares = mconcat esharesChunks+++    validated <- timingP "validating" $ forM (chunk 200 $ zip eshares (map PVSS.toPublicKey participants)) $ \c ->+        timingP ("vchunk") $ forM c $ return . PVSS.verifyEncryptedShare (PVSS.escrowExtraGen e) commitments++    !decryptedShares <- timingP "decrypting" $ mapM (\(kp,eshare) -> do+            p <- PVSS.shareDecrypt kp eshare+            return $! p+        ) (zip participants eshares)++    !verifiedShares <- timingP "verifying" $ return $+        PVSS.getValidRecoveryShares t (zip3 eshares (map PVSS.toPublicKey participants) decryptedShares)++    recovered <- timingP "recovering" $ return $ PVSS.recover $ take (fromIntegral t+1) $ decryptedShares+    putStrLn $ show recovered++main :: IO ()+main = do+    args <- getArgs+    case args of+        [tS, nS] -> go (read tS) (read nS)+        _        -> error "error: pvss <threshold> <number>"
+ pvss.cabal view
@@ -0,0 +1,58 @@+name:                pvss+Version:             0.1+synopsis:            Public Verifiable Secret Sharing+description:         Please see README.md+homepage:            https://github.com/input-output-hk/pvss-haskell#readme+license:             BSD3+license-file:        LICENSE+author:              Vincent Hanquez+maintainer:          vincent.hanquez@iohk.io+copyright:           2016 IOHK+category:            Crypto+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Crypto.PVSS+  other-modules:       Crypto.PVSS.ECC+                       Crypto.PVSS.DLEQ+                       Crypto.PVSS.Polynomial+  build-depends:       base >= 4.7 && < 5+                     , memory+                     , deepseq+                     , binary+                     , bytestring+                     , cryptonite+                     , cryptonite-openssl >= 0.3+                     , integer-gmp+  default-language:    Haskell2010++executable pvss-exe+  hs-source-dirs:      app+  main-is:             Main.hs+  ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N+  build-depends:       base+                     , deepseq+                     , memory+                     , hourglass+                     , cryptonite+                     , pvss+  default-language:    Haskell2010++test-suite pvss-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , cryptonite+                     , pvss+                     , tasty+                     , tasty-quickcheck+  ghc-options:        -Wall -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/input-output-hk/pvss-haskell
+ src/Crypto/PVSS.hs view
@@ -0,0 +1,311 @@+-- Implementation of the Public Verifiable Secret Scheme based on Berry Schoenmakers's paper:+--+--	<http://www.win.tue.nl/~berry/papers/crypto99.pdf>+{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++{-# OPTIONS -Wno-unused-top-binds #-}+{-# OPTIONS -Wno-name-shadowing   #-}+{-# OPTIONS -Wno-unused-matches   #-}++module Crypto.PVSS+    (+    -- * Simple alias+      Threshold+    , ShareId+    , ExtraGen+    , Point+    , DLEQ.Proof+    , Scalar+    , Secret+    , PublicKey(..)+    , PrivateKey(..)+    , KeyPair(..)+    , DhSecret(..)+    -- * Types+    , Escrow(..)+    , Commitment+    , EncryptedShare(..)+    , DecryptedShare(..)+    -- * method+    , escrow+    , escrowWith+    , escrowNew+    , createCommitments+    , sharesCreate+    , shareCreate+    , shareDecrypt+    , verifyEncryptedShare+    , verifyDecryptedShare+    , verifySecret+    , getValidRecoveryShares+    , recover+    , secretToDhSecret+    -- * temporary export to get testing+    , keyPairGenerate+    ) where++import           Control.DeepSeq+import           Control.Monad++import           GHC.Generics++import           Data.Binary+import           Data.Binary.Get        (getWord32le)+import           Data.Binary.Put        (putWord32le)+import           Data.List              (foldl')++import qualified Crypto.PVSS.DLEQ       as DLEQ+import           Crypto.PVSS.ECC+import           Crypto.PVSS.Polynomial (Polynomial (..))+import qualified Crypto.PVSS.Polynomial as Polynomial+import           Crypto.Random++newtype Commitment = Commitment { unCommitment :: Point }+    deriving (Show,Eq,NFData,Binary)++-- | The number of shares needed to reconstitute the secret+type Threshold = Integer++-- | The number of parties in the scheme+type Participants = Integer++-- | The ID associated with a share+type ShareId = Integer++-- | Extra generator+newtype ExtraGen = ExtraGen Point+    deriving (Show,Eq,NFData,Binary)++-- | Secret+newtype Secret = Secret Point+    deriving (Show,Eq,NFData,Binary)++-- | Transform a secret into a usable random value+secretToDhSecret :: Secret -> DhSecret+secretToDhSecret (Secret p) = pointToDhSecret p++-- | An encrypted share associated to a party's key.+data EncryptedShare = EncryptedShare+    { shareID           :: !ShareId+    , shareEncryptedVal :: !Point      -- ^ encrypted by participant public key+    , shareValidProof   :: !DLEQ.Proof -- ^ proof it's a valid share+    } deriving (Show,Eq,Generic)++instance NFData EncryptedShare+instance Binary EncryptedShare where+    get = EncryptedShare <$> (fromIntegral <$> getWord32le) <*> get <*> get+    put (EncryptedShare sid val proof) = putWord32le (fromIntegral sid) >> put val >> put proof++-- | An decrypted share decrypted by a party's key and+data DecryptedShare = DecryptedShare+    { decryptedShareID    :: !ShareId+    , shareDecryptedVal   :: !Point      -- ^ decrypted share+    , decryptedValidProof :: !DLEQ.Proof -- ^ proof the decryption is valid+    } deriving (Show,Eq,Generic)++instance NFData DecryptedShare+instance Binary DecryptedShare where+    get = DecryptedShare <$> (fromIntegral <$> getWord32le) <*> get <*> get+    put (DecryptedShare sid val proof) = putWord32le (fromIntegral sid) >> put val >> put proof++data Escrow = Escrow+    { escrowExtraGen   :: !ExtraGen+    , escrowPolynomial :: !Polynomial+    , escrowSecret     :: !Secret+    , escrowProof      :: !DLEQ.Proof+    } deriving (Show,Eq,Generic)++instance NFData Escrow++-- | Prepare a new escrowing context+--+-- The only needed parameter is the threshold+-- do not re-use an escrow context for different context.+escrowNew :: MonadRandom randomly+          => Threshold+          -> randomly Escrow+escrowNew threshold = do+    poly <- Polynomial.generate (fromIntegral threshold)+    gen  <- pointFromSecret <$> keyGenerate++    let secret = Polynomial.atZero poly+        gS     = pointFromSecret secret+    challenge <- keyGenerate+    let dleq  = DLEQ.DLEQ { DLEQ.dleq_g1 = curveGenerator, DLEQ.dleq_h1 = gS, DLEQ.dleq_g2 = gen, DLEQ.dleq_h2 = gen .* secret }+        proof = DLEQ.generate challenge secret dleq++    return $ Escrow+        { escrowExtraGen   = ExtraGen gen+        , escrowPolynomial = poly+        , escrowSecret     = Secret gS+        , escrowProof      = proof+        }++-- | Prepare a secret into public encrypted shares for distributions using the PVSS scheme+--+-- returns:+--  * the encrypted secret which is locked symmetrically to the DH-secret (g^random)+--  * the list of public commitments (Cj) to the scheme+--  * The encrypted shares that should be distributed to each partipants.+escrow :: MonadRandom randomly+       => Threshold        -- ^ PVSS scheme configuration n/t threshold+       -> [PublicKey]      -- ^ Participants public keys+       -> randomly (ExtraGen, Secret, DLEQ.Proof, [Commitment], [EncryptedShare])+escrow t pubs = do+    e <- escrowNew t+    (commitments, eshares) <- escrowWith e pubs+    return (escrowExtraGen e, escrowSecret e, escrowProof e, commitments, eshares)++-- | Escrow with a given polynomial+escrowWith :: MonadRandom randomly+           => Escrow+           -> [PublicKey]    -- ^ Participants public keys+           -> randomly ([Commitment], [EncryptedShare])+escrowWith escrow pubs = do+    let commitments = createCommitments escrow++    -- create the encrypted shares Yi + proof+    encryptedShares <- sharesCreate escrow commitments pubs++    return (commitments, encryptedShares)++-- | Create all the commitments+--+-- there is <threshold> commitments in the list+createCommitments :: Escrow -> [Commitment]+createCommitments escrow =+    -- create commitments Cj = g ^ aj+    map (\c -> Commitment (g .* c)) polyCoeffs+  where+    Polynomial polyCoeffs = escrowPolynomial escrow+    ExtraGen g = escrowExtraGen escrow++-- | Create all the encrypted share associated with specific public key+sharesCreate :: MonadRandom randomly+             => Escrow+             -> [Commitment]+             -> [PublicKey]+             -> randomly [EncryptedShare]+sharesCreate escrow commitments pubs = forM (zip [1..] pubs) $ uncurry (shareCreate escrow commitments)++-- | Create a specific share given a public key and the overall parameters+shareCreate :: MonadRandom randomly+            => Escrow+            -> [Commitment]+            -> ShareId+            -> PublicKey+            -> randomly EncryptedShare+shareCreate e commitments shareId (PublicKey pub) = do+    let pEvaled_i = Polynomial.evaluate poly (keyFromNum $ shareId)+        yi        = pub .* pEvaled_i+        xi        = g .* pEvaled_i -- createXi shareId commitments+    challenge <- keyGenerate+    let dleq  = DLEQ.DLEQ { DLEQ.dleq_g1 = g, DLEQ.dleq_h1 = xi, DLEQ.dleq_g2 = pub, DLEQ.dleq_h2 = yi }+        proof = DLEQ.generate challenge pEvaled_i dleq++    return $ EncryptedShare shareId yi proof+  where+    ExtraGen g = escrowExtraGen e+    poly = escrowPolynomial e++-- | Decrypt an Encrypted share using the party's key pair.+-- Doesn't verify if an encrypted share is valid, for this+-- you need to use 'verifyEncryptedShare'+--+-- 1) compute Si = Yi ^ (1/xi) = G^(p(i))+-- 2) create a proof of the valid decryption+shareDecrypt :: MonadRandom randomly+             => KeyPair+             -> EncryptedShare+             -> randomly DecryptedShare+shareDecrypt (KeyPair (PrivateKey xi) (PublicKey yi)) (EncryptedShare sid _Yi _) = do+    challenge <- keyGenerate+    let dleq  = DLEQ.DLEQ curveGenerator yi si _Yi+        proof = DLEQ.generate challenge xi dleq+    return $ DecryptedShare sid si proof+  where xiInv = keyInverse xi+        si    = _Yi .* xiInv++-- | Verify an encrypted share+--+-- anyone can do that given the extra generator and the commitments+verifyEncryptedShare :: ExtraGen+                     -> [Commitment]+                     -> (EncryptedShare, PublicKey) -- ^ the encrypted and the associated public key+                     -> Bool+verifyEncryptedShare (ExtraGen g) commitments (share,PublicKey pub) =+    DLEQ.verify dleq (shareValidProof share)+  where dleq = DLEQ.DLEQ+                { DLEQ.dleq_g1 = g+                , DLEQ.dleq_h1 = xi+                , DLEQ.dleq_g2 = pub+                , DLEQ.dleq_h2 = shareEncryptedVal share+                }+        xi = createXi (fromIntegral $ shareID share) commitments++-- | Verify a decrypted share against the public key and the encrypted share+verifyDecryptedShare :: (EncryptedShare, PublicKey, DecryptedShare)+                     -> Bool+verifyDecryptedShare (eshare,PublicKey pub,share) =+    DLEQ.verify dleq (decryptedValidProof share)+  where dleq = DLEQ.DLEQ curveGenerator pub (shareDecryptedVal share) (shareEncryptedVal eshare)++-- | Verify that a secret recovered is the one escrow+verifySecret :: ExtraGen+             -> [Commitment]+             -> Secret+             -> DLEQ.Proof+             -> Bool+verifySecret (ExtraGen gen) commitments (Secret secret) proof =+    DLEQ.verify dleq proof+  where dleq = DLEQ.DLEQ+            { DLEQ.dleq_g1 = curveGenerator+            , DLEQ.dleq_h1 = secret+            , DLEQ.dleq_g2 = gen+            , DLEQ.dleq_h2 = unCommitment (commitments !! 0)+            }++-- | Recover the DhSecret used+--+-- Need to pass the correct amount of shares (threshold),+-- preferably from a 'getValidRecoveryShares' call+recover :: [DecryptedShare]+        -> Secret+recover shares =+    Secret $ foldl' interpolate pointIdentity (zip shares [0..])+  where+    t = fromIntegral $ length shares++    interpolate :: Point -> (DecryptedShare, ShareId) -> Point+    interpolate !result (share, sid) = result .+ (shareDecryptedVal share .* value)+      where+        value = calc 0 (keyFromNum 1)+        calc :: Integer -> Scalar -> Scalar+        calc !j acc+            | j == t       = acc+            | j == sid     = calc (j+1) acc+            | otherwise    =+                let sj   = decryptedShareID (shares !! fromIntegral j)+                    si   = decryptedShareID (shares !! fromIntegral sid)+                    dinv = keyInverse (keyFromNum sj #- keyFromNum si)+                    e    = keyFromNum sj #* dinv+                 in calc (j+1) (acc #* e)++-- | Get #Threshold decrypted share that are deemed valid+getValidRecoveryShares :: Threshold+                       -> [(EncryptedShare, PublicKey, DecryptedShare)]+                       -> [DecryptedShare]+getValidRecoveryShares threshold shares =+    map thd . take (fromIntegral threshold) . filter verifyDecryptedShare $ shares+  where thd (_,_,ds) = ds++-- | Sum all commitment multiplied by the share id raised at the power of i+--+-- C_0 * 1 + C_1 * shareid + C_2 * shareid^2 + C_3 * shareid^3 ... + C_n * shareid^n+createXi :: ShareId      -- ^ index i+         -> [Commitment] -- ^ all commitments+         -> Point+createXi i commitments =+    mulPowerAndSum (map unCommitment commitments) (fromIntegral i)
+ src/Crypto/PVSS/DLEQ.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Crypto.PVSS.DLEQ+    ( DLEQ(..)+    , Proof(..)+    , generate+    , verify+    ) where++import           Control.DeepSeq+import           Crypto.PVSS.ECC+import           Data.Binary+import           Data.Binary.Get (getByteString)+import           Data.Binary.Put (putByteString)+import           Data.ByteString (ByteString)+import           GHC.Generics++data DLEQ = DLEQ+    { dleq_g1 :: !Point -- ^ g1 parameter+    , dleq_h1 :: !Point -- ^ h1 parameter where h1 = g1^a+    , dleq_g2 :: !Point -- ^ g2 parameter+    , dleq_h2 :: !Point -- ^ h2 parameter where h2 = g2^a+    } deriving (Show,Eq,Generic)++instance NFData DLEQ++newtype Challenge = Challenge ByteString+    deriving (Show,Eq,NFData)+instance Binary Challenge where+    put (Challenge c) = putByteString c+    get = Challenge <$> getByteString 32++-- | The generated proof+data Proof = Proof+    { proof_c :: !Challenge+    , proof_z :: !Scalar+    } deriving (Show,Eq,Generic)++instance Binary Proof+instance NFData Proof++-- | Generate a proof+generate :: Scalar -- ^ random value+         -> Scalar -- ^ a+         -> DLEQ   -- ^ DLEQ parameters to generate from+         -> Proof+generate w a (DLEQ g1 h1 g2 h2) = Proof (Challenge c) r+  where+    a1     = g1 .* w+    a2     = g2 .* w+    c      = hashPoints [h1,h2,a1,a2]+    r      = w #+ (a #* keyFromBytes c)++-- | Verify a proof+verify :: DLEQ  -- ^ DLEQ parameter used to verify+       -> Proof -- ^ the proof to verify+       -> Bool+verify (DLEQ g1 h1 g2 h2) (Proof (Challenge ch) r) = ch == hashPoints [h1,h2,a1,a2]+  where+    r1 = g1 .* r+    r2 = g2 .* r+    c = keyFromBytes ch+    a1 = r1 .- (h1 .* c)+    a2 = r2 .- (h2 .* c)
+ src/Crypto/PVSS/ECC.hs view
@@ -0,0 +1,269 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Crypto.PVSS.ECC+    ( Point(..)+    , Scalar(..)+    , PublicKey(..)+    , PrivateKey(..)+    , KeyPair(..)+    , DhSecret(..)+    , curveGenerator+    , pointToDhSecret+    , pointFromSecret+    , pointIdentity+    , keyPairGenerate+    , keyGenerate+    , keyFromBytes+    , keyFromNum+    , keyInverse+    , (#+)+    , (#-)+    , (#*)+    , (#^)+    , (.+)+    , (.-)+    , (.*)+    , (*.)+    , mulPowerAndSum+    , hashPoints+    , hashPointsToKey+    ) where++#define OPENSSL++import           Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteArray as B (convert)+import           Data.Bits+import           Data.Binary+import           Data.Binary.Get (getByteString)+import           Data.Binary.Put (putByteString)++import           GHC.Generics+import           Control.DeepSeq+import           Crypto.Hash (hash, SHA256, Digest)+import           Crypto.Number.Serialize+import           Crypto.Number.ModArithmetic (expFast)+import           Crypto.Random++#ifdef OPENSSL+import qualified Crypto.OpenSSL.ECC as SSL+import GHC.Integer.GMP.Internals (recipModInteger)+import Crypto.Number.Generate+#else+import qualified Crypto.PubKey.ECC.P256 as P256+#endif++data KeyPair = KeyPair+    { toPrivateKey :: PrivateKey+    , toPublicKey  :: PublicKey+    }+    deriving (Show,Eq,Generic)++instance Binary KeyPair where+    put (KeyPair priv pub) = put priv >> put pub+    get = KeyPair <$> get <*> get++instance NFData KeyPair++newtype DhSecret = DhSecret ByteString+    deriving (Show,Eq,NFData,Binary)++keyFromBytes :: ByteString -> Scalar+keyFromBytes = keyFromNum . os2ip'+  where os2ip' :: ByteString -> Integer+        os2ip' = B.foldl' (\a b -> (256 * a) .|. (fromIntegral b)) 0++-- | Private Key+newtype PrivateKey = PrivateKey Scalar+    deriving (Show,Eq,NFData,Binary)++-- | Public Key+newtype PublicKey = PublicKey Point+    deriving (Show,Eq,NFData,Binary)++#ifdef OPENSSL++p256 :: SSL.EcGroup+p256 = maybe (error "p256 curve") id $ SSL.ecGroupFromCurveOID "1.2.840.10045.3.1.7"++newtype Point = Point { unPoint :: SSL.EcPoint }+    deriving (Generic)++instance NFData Point where+    rnf (Point p) = p `seq` ()++instance Show Point where+    show (Point p) =+        let (x,y) = SSL.ecPointToAffineGFp p256 p+         in ("Point " ++ show x ++ " " ++ show y)+instance Eq Point where+    (Point a) == (Point b) = SSL.ecPointEq p256 a b+instance Binary Point where+    put = putByteString+        . flip (SSL.ecPointToOct p256) SSL.PointConversion_Compressed+        . unPoint+    get = either fail (return . Point) . SSL.ecPointFromOct p256 =<< getByteString 33++newtype Scalar = Scalar { unScalar :: Integer }+    deriving (Show,Eq,Generic,NFData)+instance Binary Scalar where+    put (Scalar i) = putByteString $ i2ospOf_ 32 i+    get = keyFromBytes <$> getByteString 32++keyFromNum :: Integer -> Scalar+keyFromNum n = Scalar (n `mod` SSL.ecGroupGetOrder p256)++keyInverse :: Scalar -> Scalar+keyInverse (Scalar 0) = Scalar 0+keyInverse (Scalar a) = Scalar $ recipModInteger a order+  where+    order = SSL.ecGroupGetOrder p256++keyGenerate :: MonadRandom randomly => randomly Scalar+keyGenerate = Scalar <$> generateMax order+  where+    order = SSL.ecGroupGetOrder p256++keyPairGenerate :: MonadRandom randomly => randomly KeyPair+keyPairGenerate = do+    k <- keyGenerate+    return $ KeyPair (PrivateKey k) (PublicKey $ pointFromSecret k)++pointToDhSecret :: Point -> DhSecret+pointToDhSecret (Point p) =+    let (x, _) = SSL.ecPointToAffineGFp p256 p+     in DhSecret $ B.convert $ hashSHA256 $ i2ospOf_ 32 x++pointFromSecret :: Scalar -> Point+pointFromSecret (Scalar s) = Point $ SSL.ecPointGeneratorMul p256 s++pointIdentity :: Point+pointIdentity = Point $ SSL.ecPointInfinity p256++hashPoints :: [Point] -> ByteString+hashPoints elements =+    B.convert $ hashSHA256 $ mconcat+              $ fmap (flip (SSL.ecPointToOct p256) SSL.PointConversion_Compressed . unPoint) elements++hashPointsToKey :: [Point] -> Scalar+hashPointsToKey elements =+    keyFromBytes $ B.convert $ hashSHA256 $ mconcat+                 $ fmap (flip (SSL.ecPointToOct p256) SSL.PointConversion_Compressed . unPoint) elements++curveGenerator :: Point+curveGenerator = Point $ SSL.ecGroupGetGenerator p256++-- | Point adding+(.+) :: Point -> Point -> Point+(.+) (Point a) (Point b) = Point (SSL.ecPointAdd p256 a b)++-- | Point subtraction+(.-) :: Point -> Point -> Point+(.-) (Point a) (Point b) = Point (SSL.ecPointAdd p256 a $ SSL.ecPointInvert p256 b)++-- | Point scaling+(.*) :: Point -> Scalar -> Point+(.*) (Point a) (Scalar s) = Point (SSL.ecPointMul p256 a s)++-- | Point scaling, flip (*.)+(*.) :: Scalar -> Point -> Point+(*.) (Scalar s) (Point a) = Point (SSL.ecPointMul p256 a s)++(#+) :: Scalar -> Scalar -> Scalar+(#+) (Scalar a) (Scalar b) = keyFromNum (a + b)++(#-) :: Scalar -> Scalar -> Scalar+(#-) (Scalar a) (Scalar b) = keyFromNum (a - b)++(#*) :: Scalar -> Scalar -> Scalar+(#*) (Scalar a) (Scalar b) = keyFromNum (a * b)++(#^) :: Scalar -> Integer -> Scalar+(#^) (Scalar a) n =+    Scalar $ expFast a n order+  where+    order = SSL.ecGroupGetOrder p256++mulPowerAndSum :: [Point] -> Integer -> Point+mulPowerAndSum l n = Point $ SSL.ecPointsMulOfPowerAndSum p256 (map unPoint l) n++#else+newtype Point = Point { unPoint :: P256.Point }+    deriving (Show,Eq)++newtype Scalar = Scalar P256.Scalar+    deriving (Eq)++instance Show Scalar where+    show (Scalar p) = show (P256.scalarToInteger p)++p256Mod :: Integer+p256Mod = 0xffffffff00000000ffffffffffffffffbce6faada7179e84f3b9cac2fc632551++curveGenerator :: Point+curveGenerator = pointIdentity++pointFromSecret :: Scalar -> Point+pointFromSecret (Scalar s) = Point $ P256.toPoint s++pointToDhSecret :: Point -> DhSecret+pointToDhSecret (Point p) = DhSecret $ B.convert $ hashSHA256 $ P256.pointToBinary p++-- | Point adding+(.+) :: Point -> Point -> Point+(.+) (Point a) (Point b) = Point (P256.pointAdd a b)++-- | Point scaling+(.*) :: Point -> Scalar -> Point+(.*) (Point a) (Scalar s) = Point (P256.pointMul s a)++-- | Point scaling, flip (*.)+(*.) :: Scalar -> Point -> Point+(*.) (Scalar s) (Point a) = Point (P256.pointMul s a)++(#+) :: Scalar -> Scalar -> Scalar+(#+) (Scalar a) (Scalar b) = Scalar (P256.scalarAdd a b)++(#-) :: Scalar -> Scalar -> Scalar+(#-) (Scalar a) (Scalar b) = Scalar (P256.scalarSub a b)++(#*) :: Scalar -> Scalar -> Scalar+(#*) (Scalar a) (Scalar b) =+    Scalar $ throwCryptoError $ P256.scalarFromInteger ((an * bn) `mod` p256Mod)+  where+    an = P256.scalarToInteger a+    bn = P256.scalarToInteger b++(#^) :: Scalar -> Integer -> Scalar+(#^) (Scalar a) n =+    Scalar $ throwCryptoError+           $ P256.scalarFromInteger+           $ expSafe (P256.scalarToInteger a) n p256Mod++pointIdentity :: Point+pointIdentity = Point $ P256.pointFromIntegers 0 0++keyFromNum :: Integer -> Scalar+keyFromNum = Scalar . throwCryptoError . P256.scalarFromInteger++keyInverse :: Scalar -> Scalar+keyInverse (Scalar s) = Scalar (P256.scalarInv s)++keyGenerate :: MonadRandom randomly => randomly Scalar+keyGenerate = Scalar <$> P256.scalarGenerate++keyPairGenerate :: MonadRandom randomly => randomly KeyPair+keyPairGenerate = do+    k <- keyGenerate+    return $ KeyPair k (pointFromSecret k)++hashPointsToKey :: [Point] -> Scalar+hashPointsToKey elements =+    keyFromBytes $ B.convert $ hashSHA256 $ mconcat $ fmap (P256.pointToBinary . unPoint) elements++#endif++hashSHA256 :: ByteString -> Digest SHA256+hashSHA256 m = hash m
+ src/Crypto/PVSS/Polynomial.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Crypto.PVSS.Polynomial+    ( Polynomial(..)+    , generate+    , evaluate+    , atZero+    ) where++import Crypto.PVSS.ECC+import Crypto.Random+import Control.Monad+import Control.DeepSeq+import Data.List++-- | a group of coefficient starting from the+-- smallest degree.+newtype Polynomial = Polynomial [Scalar]+    deriving (Show,Eq,NFData)++generate :: MonadRandom randomly => Int -> randomly Polynomial+generate i+    | i <= 0    = error ("invalid polynomial degree: " ++ show i)+    | otherwise = Polynomial <$> replicateM i keyGenerate++evaluate :: Polynomial -> Scalar -> Scalar+evaluate (Polynomial a) v =+    foldl' (#+) (keyFromNum 0) $ zipWith (#*) a es+  where+    es = [ (v #^ degree) | degree <- [0..] ]++atZero :: Polynomial -> Scalar+atZero (Polynomial coeffs) = coeffs !! 0
+ test/Spec.hs view
@@ -0,0 +1,90 @@+module Main where++import           Control.Monad+import           Crypto.Random+import qualified Crypto.PVSS as PVSS+import           Test.Tasty+import           Test.Tasty.QuickCheck++newtype Threshold = Threshold PVSS.Threshold+    deriving (Show,Eq)++newtype Participants = Participants Integer+    deriving (Show,Eq)++instance Arbitrary Threshold where+    arbitrary = Threshold <$> choose (2,5)+instance Arbitrary Participants where+    arbitrary = Participants <$> choose (3,10)+instance Show ChaChaDRG where+    show _ = "chachaDRG"+instance Arbitrary ChaChaDRG where+    arbitrary = arbitrary >>= \n -> return $ drgNewTest (0,0,0,0,n)++toPk :: PVSS.KeyPair -> PVSS.PublicKey+toPk = PVSS.toPublicKey++testEncryptVerify :: Threshold -> Participants -> ChaChaDRG -> Property+testEncryptVerify (Threshold threshold) (Participants nOrig) rng =+    map (PVSS.verifyEncryptedShare egen commitments) (zip eshares (map toPk participants)) === map (const True) eshares+  where+    n :: Integer+    n = max (threshold) nOrig++    (participants, rng2) = withDRG rng $ replicateM (fromIntegral n) PVSS.keyPairGenerate++    ((egen, sec, _, commitments, eshares), rng3) = withDRG rng2 $+        PVSS.escrow threshold (map toPk participants)++testDecryptVerify :: Threshold -> Participants -> ChaChaDRG -> Property+testDecryptVerify (Threshold threshold) (Participants nOrig) rng =+        map (PVSS.verifyDecryptedShare) (zip3 eshares (map toPk participants) decryptedShares)+    === map (const True) eshares+  where+    n :: Integer+    n = max (threshold) nOrig++    (participants, rng2) = withDRG rng $ replicateM (fromIntegral n) PVSS.keyPairGenerate++    ((egen, sec, _, commitments, eshares), rng3) = withDRG rng2 $+        PVSS.escrow threshold (map toPk participants)++    (decryptedShares, _) = withDRG rng3 $ do+        mapM (\(kp,eshare) -> PVSS.shareDecrypt kp eshare) (zip participants eshares)++testSecretVerify :: Threshold -> Participants -> ChaChaDRG -> Property+testSecretVerify (Threshold threshold) (Participants nOrig) rng =+    PVSS.verifySecret egen commitments sec secProof === True+  where+    n :: Integer+    n = max (threshold) nOrig++    (participants, rng2) = withDRG rng $ replicateM (fromIntegral n) PVSS.keyPairGenerate++    ((egen, sec, secProof, commitments, _), rng3) = withDRG rng2 $+        PVSS.escrow threshold (map toPk participants)++testRecovery :: Threshold -> Participants -> ChaChaDRG -> Property+testRecovery (Threshold threshold) (Participants nOrig) rng =++    let recovered = PVSS.recover $ take (fromIntegral (threshold+1)) $ decryptedShares+     in recovered === sec++  where+    n :: Integer+    n = max (threshold) nOrig++    (participants, rng2) = withDRG rng $ replicateM (fromIntegral n) PVSS.keyPairGenerate++    ((egen, sec, _, commitments, eshares), rng3) = withDRG rng2 $+        PVSS.escrow threshold (map toPk participants)++    (decryptedShares, _) = withDRG rng3 $ do+        mapM (\(kp,eshare) -> PVSS.shareDecrypt kp eshare) (zip participants eshares)++main :: IO ()+main = defaultMain $ testGroup "PVSS"+    [ testProperty "encrypted-verified" testEncryptVerify+    , testProperty "decrypted-verified" testDecryptVerify+    , testProperty "secret-verified" testSecretVerify+    , testProperty "recovery" testRecovery ]