diff --git a/Network/CryptoConditions/Json.hs b/Network/CryptoConditions/Json.hs --- a/Network/CryptoConditions/Json.hs +++ b/Network/CryptoConditions/Json.hs @@ -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 diff --git a/cryptoconditions.cabal b/cryptoconditions.cabal --- a/cryptoconditions.cabal +++ b/cryptoconditions.cabal @@ -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 diff --git a/test/TestStandard.hs b/test/TestStandard.hs new file mode 100644 --- /dev/null +++ b/test/TestStandard.hs @@ -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 diff --git a/test/TestSupport.hs b/test/TestSupport.hs new file mode 100644 --- /dev/null +++ b/test/TestSupport.hs @@ -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 diff --git a/test/TestUnits.hs b/test/TestUnits.hs new file mode 100644 --- /dev/null +++ b/test/TestUnits.hs @@ -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 diff --git a/test/TestVectors.hs b/test/TestVectors.hs new file mode 100644 --- /dev/null +++ b/test/TestVectors.hs @@ -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