cryptoconditions 0.2.2.1 → 0.2.2.2
raw patch · 6 files changed
+230/−5 lines, 6 filesPVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
API changes (from Hackage documentation)
+ Network.CryptoConditions.Json: fromB64 :: Text -> Parser ByteString
+ Network.CryptoConditions.Json: toB64 :: ByteString -> Value
Files
- Network/CryptoConditions/Json.hs +6/−4
- cryptoconditions.cabal +5/−1
- test/TestStandard.hs +67/−0
- test/TestSupport.hs +55/−0
- test/TestUnits.hs +31/−0
- test/TestVectors.hs +66/−0
Network/CryptoConditions/Json.hs view
@@ -9,6 +9,8 @@ , toJsonPrefix , toJsonThreshold , toJsonEd25519+ , fromB64+ , toB64 ) where @@ -56,13 +58,13 @@ -- toJsonPreimage :: ByteString -> Value-toJsonPreimage img = object ["type" .= String "preimage-sha-256", "preimage" .= binToJson img]+toJsonPreimage img = object ["type" .= String "preimage-sha-256", "preimage" .= toB64 img] toJsonPrefix :: (IsCondition c, ToJSON c) => ByteString -> Int -> c -> Value toJsonPrefix pre mml sub = object [ "type".= String "prefix-sha-256"- , "prefix" .= binToJson pre+ , "prefix" .= toB64 pre , "subfulfillment" .= sub ] @@ -98,5 +100,5 @@ keyToJson = String . decodeUtf8 . b64EncodeStripped . BS.pack . BA.unpack -binToJson :: ByteString -> Value-binToJson = String . decodeUtf8 . b64EncodeStripped+toB64 :: ByteString -> Value+toB64 = String . decodeUtf8 . b64EncodeStripped
cryptoconditions.cabal view
@@ -1,5 +1,5 @@ name: cryptoconditions-version: 0.2.2.1+version: 0.2.2.2 synopsis: Interledger Crypto-Conditions description: Please see README.md homepage: https://github.com/libscott/cryptoconditions-hs@@ -36,6 +36,10 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Tests.hs+ other-modules: TestStandard+ , TestSupport+ , TestUnits+ , TestVectors build-depends: base , cryptoconditions , aeson
+ test/TestStandard.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE OverloadedStrings #-}++module TestStandard+ ( standardTests+ ) where++import Test.Tasty+import Test.Tasty.HUnit++import Network.CryptoConditions++import TestSupport+++standardTests :: TestTree+standardTests = testGroup "testStandard"+ [ testFulfill "Test ed25519" ed2Alice+ + , testFulfill "Test 1 of 1" $+ Threshold 1 [ed2Alice]++ , testFulfill "Test 1 of 2" $+ Threshold 1 [ed2Alice, ed2Bob]++ , testFulfill "Test 2 of 2" $+ Threshold 2 [ed2Alice, ed2BobF]++ , testFulfill "Test 2 of 3" $+ Threshold 2 [ed2Alice, ed2BobF, ed2Eve]++ , testFulfill "Test 3 of 3" $+ Threshold 3 [ed2Alice, ed2BobF, ed2EveF]++ , testFulfill "Test nested" $+ let subcond = Threshold 2 [ed2Alice, preimageCondition "a", ed2Eve]+ in Threshold 2 [ed2BobF, subcond]++ , testFulfill "Test prefixed" $+ Prefix "a" 20 ed2Alice+ + , testCase "Test read fulfillment empty signatures" $+ let (Just ffillBin) = getFulfillment ed2Alice+ (Right cond') = readFulfillment ffillBin+ in assertEqual "Can decode unfulfilled fulfillment" ed2Alice cond'++ ]+++-- | Takes a condition which just requires Alice to sign in+-- order to validate+testFulfill :: String -> Condition -> TestTree+testFulfill name cond = testCase name $ do+ let msg = umsg+ uri = getConditionURI cond+ badFfill = fulfillEd25519 pkAlice skEve umsg cond+ (Just ffillBin) = getFulfillment badFfill+ goodFfill = fulfillEd25519 pkAlice skAlice umsg cond+ assertBool "can get fulfillment payload without signature" $ + Nothing /= getFulfillment cond+ assertEqual "get uri from bad fulfillment"+ (Right uri) $ getConditionURI <$> readStandardFulfillment ffillBin+ assertBool "wrong sig right message does not validate" $+ not $ validate uri badFfill msg+ assertBool "wrong msg right sig does not validate" $+ not $ validate uri goodFfill "b"+ assertBool "right sig right message does validate" $+ validate uri goodFfill msg
+ test/TestSupport.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE OverloadedStrings #-}++module TestSupport where++import Crypto.Error+import Crypto.PubKey.Ed25519++import Network.CryptoConditions++import Data.ByteString+++umsg :: ByteString+umsg = "\240\159\141\186\\uD83C\\uDF7A"+++ed2Alice, ed2Bob, ed2Eve :: Condition+ed2Alice = ed25519Condition pkAlice+ed2Bob = ed25519Condition pkBob+ed2Eve = ed25519Condition pkEve+++ed2BobF, ed2EveF :: Condition+ed2BobF = fulfillEd25519 pkBob skBob umsg ed2Bob+ed2EveF = fulfillEd25519 pkEve skEve umsg ed2Eve+++pkAlice, pkBob :: PublicKey+pkAlice = toPublic skAlice+pkBob = toPublic skBob+pkEve = toPublic skEve+++skAlice, skBob, skEve :: SecretKey+skAlice = toSecret "B\SOH\NAK 6P\151\165|\156\144of-B\174\245h\166\188\135\158\SO\195\b)\253\168\f\221\205\RS"+skBob = toSecret "C\SOH\NAK 6P\151\165|\156\144of-B\174\245h\166\188\135\158\SO\195\b)\253\168\f\221\205\RS"+skEve = toSecret "D\SOH\NAK 6P\151\165|\156\144of-B\174\245h\166\188\135\158\SO\195\b)\253\168\f\221\205\RS"+++toSecret :: ByteString -> SecretKey+toSecret = throwCryptoError . secretKey+++sigAlice, sigBob, sigEve :: Signature+sigAlice = sign skAlice pkAlice umsg+sigBob = sign skBob pkBob umsg+sigEve = sign skEve pkEve umsg+++toPub :: ByteString -> PublicKey+toPub = throwCryptoError . publicKey+++toSig :: ByteString -> Signature+toSig = throwCryptoError . signature
+ test/TestUnits.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}++module TestUnits+ ( unitTests+ ) where++import Data.Set as Set++import Test.Tasty+import Test.Tasty.HUnit++import Network.CryptoConditions.Encoding++import TestSupport+++unitTests :: TestTree+unitTests = testGroup "testUnits"+ [ testBitStrings+ ]+++testBitStrings :: TestTree+testBitStrings = testGroup "bitString" $+ let sets = [ [0]+ , [1]+ , [0, 1]+ , [2, 7]+ ]+ test set = assertEqual "bit string equal" set (fromBitString $ toBitString set)+ in (\s -> testCase (show s) (test $ Set.fromList s)) <$> sets
+ test/TestVectors.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedStrings #-}++module TestVectors+ ( vectorSuite+ ) where+++import Test.Tasty+import Test.Tasty.HUnit++import Data.ASN1.Encoding+import Data.ASN1.BinaryEncoding+import Data.Aeson+import Data.Aeson.Types+import Data.Aeson.Quick+import Data.Maybe+import Data.Monoid+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as B16+import qualified Data.Text as T+import Data.Text.Encoding (encodeUtf8)++import System.IO.Unsafe++import Network.CryptoConditions+import Network.CryptoConditions.Encoding++import TestSupport+++vectorSuite :: TestTree+vectorSuite = testGroup "fiveBells"+ [ testVectors "0000_test-minimal-preimage.json"+ , testVectors "0001_test-minimal-prefix.json"+ , testVectors "0002_test-minimal-threshold.json"+ , testVectors "0004_test-minimal-ed25519.json"+ , testVectors "0006_test-basic-prefix.json"+ , testVectors "0012_test-basic-threshold-schroedinger.json"+ , testVectors "0017_test-advanced-notarized-receipt-multiple-notaries.json"+ ]+++testVectors :: String -> TestTree+testVectors file = testGroup file+ [ testCase "encodeCondition" $ encodeCondition cond @?= condBin+ , testCase "getFulfillment" $ getFulfillment cond @?= Just ffillBin+ , testCase "getConditionURI" $ getConditionURI cond @?= condUri+ , testCase "validate" $ validate condUri cond msg @?= True+ , testCase "readCondition" $+ let econd = readCondition condBin :: Either String Condition+ in (getConditionURI <$> econd) @?= Right condUri+ ]+ where+ val = unsafePerformIO $ do+ let path = "ext/crypto-conditions/test-vectors/valid/" <> file+ fromJust . decodeStrict <$> BS.readFile path+ cond = val .! "{json}" :: Condition+ condBin = fromB16 $ val .! "{conditionBinary}"+ ffillBin = fromB16 $ val .! "{fulfillment}"+ condUri = val .! "{conditionUri}"+ msg = encodeUtf8 $ val .! "{message}"+++fromB16 :: T.Text -> BS.ByteString+fromB16 t = let (r,"") = B16.decode $ encodeUtf8 t+ in r