module LSAG
( sign
, verify
, genNPubKeys
) where
import Control.Monad.State
import Control.Monad.Fail
import Crypto.Hash
import Crypto.Number.Serialize (os2ip)
import Crypto.Number.Generate (generateBetween)
import qualified Crypto.PubKey.ECC.Generate as ECC
import qualified Crypto.PubKey.ECC.Prim as ECC
import qualified Crypto.PubKey.ECC.Types as ECC
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import Crypto.Random.Types (MonadRandom)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import Data.Monoid
import Data.List
import Protolude hiding (hash, head)
sign
:: (MonadRandom m, MonadFail m)
=> [ECDSA.PublicKey]
-> (ECDSA.PublicKey, ECDSA.PrivateKey)
-> ByteString
-> m (Integer, [Integer], ECC.Point)
sign pubKeys (pubKey, privKey) msg =
case pubKey `elemIndex` pubKeys of
Nothing -> panic "Signer's public key is not among public keys"
Just k -> do
(sK1:sK2ToPrevSK) <- replicateM (participants - 1) $ generateBetween 1 (n - 1)
u <- generateBetween 1 (n - 1)
let chK1 = genChallenge curve pubKeys y msg (gu u) (hu u)
let reversedChKToChK1 = runChallenges k sK1 chK1 sK2ToPrevSK u y h
chK = head reversedChKToChK1
let sK = (u - ECDSA.private_d privKey * chK) `mod` n
let orderedChallenges = orderChallenges k (reverse reversedChKToChK1)
let orderedSS = orderSS k (sK : sK1 : sK2ToPrevSK)
ch0 = head orderedChallenges
pure (ch0, orderedSS, y)
where
curve = ECDSA.public_curve pubKey
h = ECC.pointBaseMul curve (hashPubKeys curve pubKeys)
y = ECC.pointMul curve (ECDSA.private_d privKey) h
n = ECC.ecc_n (ECC.common_curve curve)
g = ECC.ecc_g (ECC.common_curve curve)
gu u = ECC.pointMul curve u g
hu u = ECC.pointMul curve u h
participants = length pubKeys
runChallenges k sK1 chK1 sK2ToPrevSK u y h = evalState
(genChallenges pubKeys y msg sK2ToPrevSK)
(initState k sK1 chK1)
initState k sK1 chK1 =
(((k + 1) `mod` participants, sK1, chK1), [chK1])
orderChallenges k ch =
drop (participants - (k + 1)) ch <>
take (participants - (k + 1)) ch
orderSS k sKToPrevSK =
drop (participants - k) sKToPrevSK <>
take (participants - k) sKToPrevSK
verify
:: [ECDSA.PublicKey]
-> (Integer, [Integer], ECC.Point)
-> ByteString
-> Bool
verify pubKeys (ch0, [], y) msg = panic "Invalid input"
verify pubKeys (ch0, [s], y) msg = panic "Invalid input"
verify pubKeys (ch0, s0:s1:s2ToEnd, y) msg = ch0 == ch0'
where
curve0 = ECDSA.public_curve $ head pubKeys
h = ECC.pointBaseMul curve0 (hashPubKeys curve0 pubKeys)
y0 = ECDSA.public_q $ head pubKeys
z0' = ECC.pointAdd curve0
(ECC.pointMul curve0 s0 g)
(ECC.pointMul curve0 ch0 y0)
z0'' = ECC.pointAdd curve0
(ECC.pointMul curve0 s0 h)
(ECC.pointMul curve0 ch0 y)
g = ECC.ecc_g (ECC.common_curve curve0)
participants = length pubKeys
ch1 = genChallenge curve0 pubKeys y msg z0' z0''
challenges = evalState
(genChallenges pubKeys y msg s2ToEnd)
((1 `mod` participants, s1, ch1), [ch1])
ch0' = head challenges
genChallenges
:: [ECDSA.PublicKey]
-> ECC.Point
-> BS.ByteString
-> [Integer]
-> State ((Int, Integer, Integer), [Integer]) [Integer]
genChallenges pubKeys y msg ss = do
((prevK, prevS, prevCh), challenges) <- get
let curve = ECDSA.public_curve $ pubKeys !! prevK
let ch = challenge curve prevK prevS prevCh
case ss of
[] -> pure $ ch : challenges
(s:ss) -> do
put (((prevK + 1) `mod` participants, s, ch)
, ch : challenges
)
genChallenges pubKeys y msg ss
where
g curve = ECC.ecc_g (ECC.common_curve curve)
h curve = ECC.pointBaseMul curve (hashPubKeys curve pubKeys)
gs curve prevK prevS prevCh =
ECC.pointAdd curve
(ECC.pointMul curve prevS (g curve))
(ECC.pointMul curve prevCh (ECDSA.public_q $ pubKeys !! prevK))
hs curve prevK prevS prevCh =
ECC.pointAdd curve
(ECC.pointMul curve prevS (h curve))
(ECC.pointMul curve prevCh y)
challenge curve prevK prevS prevCh =
genChallenge curve pubKeys y msg
(gs curve prevK prevS prevCh)
(hs curve prevK prevS prevCh)
participants = length pubKeys
genChallenge
:: ECC.Curve
-> [ECDSA.PublicKey]
-> ECC.Point
-> BS.ByteString
-> ECC.Point
-> ECC.Point
-> Integer
genChallenge c pubKeys y msg g h =
oracle c (pubKeys' <> y' <> msg <> g' <> h')
where
pubKeys' = pubKeysToBS pubKeys
y' = pointToBS y
g' = pointToBS g
h' = pointToBS h
genNPubKeys :: MonadRandom m => ECC.Curve -> Int -> m [ECDSA.PublicKey]
genNPubKeys curve n = replicateM n (fst <$> ECC.generate curve)
pointToBS :: ECC.Point -> BS.ByteString
pointToBS ECC.PointO = ""
pointToBS (ECC.Point x y) = show x <> show y
pubKeysToBS :: [ECDSA.PublicKey] -> BS.ByteString
pubKeysToBS = foldMap (pointToBS . ECDSA.public_q)
hashPubKeys :: ECC.Curve -> [ECDSA.PublicKey] -> Integer
hashPubKeys c = oracle c . pubKeysToBS
oracle :: ECC.Curve -> BS.ByteString -> Integer
oracle curve x = os2ip (sha256 x) `mod` n
where
n = ECC.ecc_n (ECC.common_curve curve)
sha256 :: BS.ByteString -> BS.ByteString
sha256 bs = BA.convert (hash bs :: Digest SHA3_256)