signable 0.2 → 0.3
raw patch · 6 files changed
+95/−67 lines, 6 filesdep ~secp256k1-haskell
Dependency ranges changed: secp256k1-haskell
Files
- ChangeLog.md +10/−0
- signable.cabal +4/−4
- src/Data/Signable/Class.hs +37/−26
- test/Proto/SignableOrphan.hs +2/−0
- test/SignableSpec.hs +3/−11
- test/TestCaseSpec.hs +39/−26
ChangeLog.md view
@@ -1,3 +1,13 @@+# Version 0.3++- Support of `secp256k1-haskell-0.5`++- Removed `toSha256` and `Sha256` redundant exports++- Moved `sign` and `verify` out of the `Signable` class++- Function `sign` output is `Sig` instead of `Maybe Sig`+ # Version 0.2 - Field indexes of any unset field (message/repeated/oneof) are ignored in serialized payload to make possible rolling upgrades **BREAKING CHANGE**
signable.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 96e4ab3b538617261b6805fe5eadfa87a8bffa2b67f0f684e7942568405df0e8+-- hash: d2dec01d6000877a395f9d10ab73143cd8321afc169632f2e8756c037b851444 name: signable-version: 0.2+version: 0.3 synopsis: Deterministic serialisation and signatures with proto-lens support description: You can find documentation at <https://hackage.haskell.org/package/signable/docs/Data-Signable.html hackage> category: Data, Cryptography@@ -52,7 +52,7 @@ , pem >=0.2.4 && <0.3 , proto-lens >=0.7.0 && <0.8 , proto-lens-runtime >=0.7.0 && <0.8- , secp256k1-haskell >=0.4 && <0.5+ , secp256k1-haskell >=0.4 && <0.6 , text >=1.2.3 && <1.3 , universum >=1.5.0 && <1.6 default-language: Haskell2010@@ -106,7 +106,7 @@ , proto-lens-arbitrary >=0.1.2 && <0.2 , proto-lens-runtime >=0.7.0 && <0.8 , quickcheck-instances >=0.3.22 && <0.4- , secp256k1-haskell >=0.4 && <0.5+ , secp256k1-haskell >=0.4 && <0.6 , signable , text >=1.2.3 && <1.3 , universum >=1.5.0 && <1.6
src/Data/Signable/Class.hs view
@@ -16,17 +16,21 @@ exportPrvKeyRaw, newRandomPrvKey, - -- * Sha256- Sha256 (..),- -- * Signature Sig,+ sign,+ verify, importSigDer, exportSigDer, -- * Class Signable (..), + -- * Util+ pubKey2Alg,+ prvKey2Alg,+ sig2Alg,+ -- * Misc Alg (..), SignableError (..),@@ -81,10 +85,15 @@ instance Show Sig where show = const "SECRET" ------ TODO : add KeyKind argument later--- when we will have more algorithms---+pubKey2Alg :: PubKey -> Alg+pubKey2Alg (PubKeySecp256k1 _) = AlgSecp256k1++prvKey2Alg :: PrvKey -> Alg+prvKey2Alg (PrvKeySecp256k1 _) = AlgSecp256k1++sig2Alg :: Sig -> Alg+sig2Alg (SigSecp256k1 _) = AlgSecp256k1+ importPubKeyDer :: Alg -> ByteString -> Maybe PubKey importPubKeyDer AlgSecp256k1 = (PubKeySecp256k1 <$>) . C.importPubKey @@ -157,25 +166,27 @@ class Signable a where toBinary :: a -> BL.ByteString- toSha256 :: a -> Sha256- toSha256 =- Sha256- . BS.pack- . BA.unpack- . (hashlazy :: BL.ByteString -> Digest SHA256)- . toBinary- sign :: PrvKey -> a -> Maybe Sig- sign (PrvKeySecp256k1 k) =- (SigSecp256k1 . C.signMsg k <$>)- . C.msg- . coerce- . toSha256- verify :: PubKey -> Sig -> a -> Bool- verify (PubKeySecp256k1 k) (SigSecp256k1 s) =- maybe False (C.verifySig k s)- . C.msg- . coerce- . toSha256++toSha256 :: Signable a => a -> Sha256+toSha256 =+ Sha256+ . BS.pack+ . BA.unpack+ . (hashlazy :: BL.ByteString -> Digest SHA256)+ . toBinary++sign :: Signable a => PrvKey -> a -> Sig+sign (PrvKeySecp256k1 k) x0 =+ case C.msg . coerce $ toSha256 x0 of+ Just x -> SigSecp256k1 $ C.signMsg k x+ Nothing -> error "SECP256K1_MSG_CONS_IMPOSSIBLE_FAILURE"++verify :: Signable a => PubKey -> Sig -> a -> Bool+verify (PubKeySecp256k1 k) (SigSecp256k1 s) =+ maybe False (C.verifySig k s)+ . C.msg+ . coerce+ . toSha256 instance Signable ByteString where toBinary = BL.drop 8 . B.encode
test/Proto/SignableOrphan.hs view
@@ -1,6 +1,8 @@ {- This file was auto-generated by the signable-haskell-protoc program. -} {-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-} module Proto.SignableOrphan ( ) where
test/SignableSpec.hs view
@@ -19,21 +19,13 @@ it "is able to sign proto message" $ \k -> property $ \x0 -> sign k (unArbitraryMessage x0 :: Payload)- `shouldSatisfy` isJust+ `shouldSatisfy` const True it "is able to verify valid proto message signature" $ \k -> property $ \x0 -> do let x :: Payload = unArbitraryMessage x0- maybe- False- (\s -> verify (derivePubKey k) s x)- (sign k x)- `shouldBe` True+ verify (derivePubKey k) (sign k x) x `shouldBe` True it "is able to discard invalid proto message signature" $ \k -> property $ \x0 -> do let x :: Payload = unArbitraryMessage x0 let y = x & (amount . amount) +~ 1- maybe- False- (\s -> verify (derivePubKey k) s y)- (sign k x)- `shouldBe` False+ verify (derivePubKey k) (sign k x) y `shouldBe` False
test/TestCaseSpec.hs view
@@ -50,34 +50,47 @@ ( \tc -> do let t = tcProtoType tc let x = coerce $ tcProtoBin tc- s <- case importSigDer AlgSecp256k1 . coerce $ tcSignatureBin tc of+ s <- case importSigDer AlgSecp256k1 . coerce $+ tcSignatureBin tc of Just s0 -> return s0 Nothing -> fail "INVALID_SIG" --putStrLn $ tcDescription tc (BL.unpack <$> serializer t x)- `shouldBe` (Right . BL.unpack . coerce $ tcSignableBin tc)+ `shouldBe` ( Right+ . BL.unpack+ . coerce+ $ tcSignableBin tc+ ) verifier pub s t x `shouldBe` Right True ) $ envTCS env serializer = \case Basic'Payload ->- ((toBinary :: Proto.Basic.Payload -> BL.ByteString) <$>) . decodeMessage+ ((toBinary :: Proto.Basic.Payload -> BL.ByteString) <$>)+ . decodeMessage Text'Payload ->- ((toBinary :: Proto.Text.Payload -> BL.ByteString) <$>) . decodeMessage+ ((toBinary :: Proto.Text.Payload -> BL.ByteString) <$>)+ . decodeMessage Number'Payload ->- ((toBinary :: Proto.Number.Payload -> BL.ByteString) <$>) . decodeMessage+ ((toBinary :: Proto.Number.Payload -> BL.ByteString) <$>)+ . decodeMessage Coins'Request ->- ((toBinary :: Proto.Coins.Request -> BL.ByteString) <$>) . decodeMessage+ ((toBinary :: Proto.Coins.Request -> BL.ByteString) <$>)+ . decodeMessage verifier pub s = \case Basic'Payload ->- ((verify pub s :: Proto.Basic.Payload -> Bool) <$>) . decodeMessage+ ((verify pub s :: Proto.Basic.Payload -> Bool) <$>)+ . decodeMessage Text'Payload ->- ((verify pub s :: Proto.Text.Payload -> Bool) <$>) . decodeMessage+ ((verify pub s :: Proto.Text.Payload -> Bool) <$>)+ . decodeMessage Number'Payload ->- ((verify pub s :: Proto.Number.Payload -> Bool) <$>) . decodeMessage+ ((verify pub s :: Proto.Number.Payload -> Bool) <$>)+ . decodeMessage Coins'Request ->- ((verify pub s :: Proto.Coins.Request -> Bool) <$>) . decodeMessage+ ((verify pub s :: Proto.Coins.Request -> Bool) <$>)+ . decodeMessage genTestCase :: PrvKey -> Int -> ProtoType -> Gen TestCase genTestCase prv i t =@@ -85,12 +98,12 @@ Basic'Payload -> do x <- unArbitraryMessage- <$> (arbitrary :: Gen (ArbitraryMessage Proto.Basic.Payload))+ <$> ( arbitrary ::+ Gen (ArbitraryMessage Proto.Basic.Payload)+ ) let pb = encodeMessage x let sb = toBinary x- sig <- case exportSigDer <$> sign prv x of- Nothing -> error "SIGNATURE_FAILURE"- Just s -> return s+ let sig = exportSigDer $ sign prv x return $ TestCase { tcProtoType = t,@@ -102,12 +115,12 @@ Text'Payload -> do x <- unArbitraryMessage- <$> (arbitrary :: Gen (ArbitraryMessage Proto.Text.Payload))+ <$> ( arbitrary ::+ Gen (ArbitraryMessage Proto.Text.Payload)+ ) let pb = encodeMessage x let sb = toBinary x- sig <- case exportSigDer <$> sign prv x of- Nothing -> error "SIGNATURE_FAILURE"- Just s -> return s+ let sig = exportSigDer $ sign prv x return $ TestCase { tcProtoType = t,@@ -119,12 +132,12 @@ Number'Payload -> do x <- unArbitraryMessage- <$> (arbitrary :: Gen (ArbitraryMessage Proto.Number.Payload))+ <$> ( arbitrary ::+ Gen (ArbitraryMessage Proto.Number.Payload)+ ) let pb = encodeMessage x let sb = toBinary x- sig <- case exportSigDer <$> sign prv x of- Nothing -> error "SIGNATURE_FAILURE"- Just s -> return s+ let sig = exportSigDer $ sign prv x return $ TestCase { tcProtoType = t,@@ -136,12 +149,12 @@ Coins'Request -> do x <- unArbitraryMessage- <$> (arbitrary :: Gen (ArbitraryMessage Proto.Coins.Request))+ <$> ( arbitrary ::+ Gen (ArbitraryMessage Proto.Coins.Request)+ ) let pb = encodeMessage x let sb = toBinary x- sig <- case exportSigDer <$> sign prv x of- Nothing -> error "SIGNATURE_FAILURE"- Just s -> return s+ let sig = exportSigDer $ sign prv x return $ TestCase { tcProtoType = t,