packages feed

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 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