-- | Running the script test module Bitcoin.Test.Script.RunTests where -------------------------------------------------------------------------------- import Test.Tasty import Test.Tasty.HUnit import Data.Word import Data.Char ( isDigit ) import qualified Data.ByteString as B import Bitcoin.Script.Base import Bitcoin.Script.Run import Bitcoin.Script.Serialize import Bitcoin.Misc.HexString import Bitcoin.Misc.OctetStream import Bitcoin.Protocol.Hash import Bitcoin.BlockChain.Base import Bitcoin.Test.Script.Valid import Bitcoin.Test.Script.Invalid import Bitcoin.Test.Script.Parser -------------------------------------------------------------------------------- testgroup_Script :: TestTree testgroup_Script = testGroup "Script" [ testgroup_Valid , testgroup_Invalid ] testgroup_Valid :: TestTree testgroup_Valid = testGroup "valid scripts" [ testCase ("valid script #" ++ show i) (assertOK $ runTestCase scr) | (i,scr) <- zip [1..] valid_testcases ] testgroup_Invalid :: TestTree testgroup_Invalid = testGroup "invalid scripts" [ testCase ("invalid script #" ++ show i) (assertNotOK $ runTestCase scr) | (i,scr) <- zip [1..] invalid_testcases ] assertOK :: (Bool,String) -> Assertion assertOK (b,msg) = case b of False -> assertFailure msg True -> return () assertNotOK :: (Bool,String) -> Assertion assertNotOK (b,msg) = assertOK (not b, msg) -------------------------------------------------------------------------------- -- | test cases which should pass valid_testcases :: [TestCase] valid_testcases = map parseInner valid_json -- | test cases which should not pass invalid_testcases :: [TestCase] invalid_testcases = map parseInner invalid_json -------------------------------------------------------------------------------- -- | True if passed, False if failed, -- and possibly an explanation if failed (including the testcase comment if exists) runTestCase :: TestCase -> (Bool, String) runTestCase (TestCase eiSig eiPk mbcomment) = result where sig = eiToRawScript eiSig :: RawScript pk = eiToRawScript eiPk :: RawScript prevTx = Tx 0 [] [TxOutput 666 pk] LockImmed zeroHash256 :: Tx RawScript RawScript inExt = TxInput zeroHash256 0 (prevTx,sig) 0 :: TxInput (Tx RawScript RawScript, RawScript) fakeTx = Tx 0 [inExt] [TxOutput 666 sig] LockImmed zeroHash256 :: Tx (Tx RawScript RawScript, RawScript) RawScript result = case checkTransaction fakeTx of Left err -> (False , err ++ " | " ++ maybe "" id mbcomment) Right b -> (b , " | " ++ maybe "" id mbcomment) -------------------------------------------------------------------------------- {- runValid = mapM_ print $ map runTestCase valid_testcases runInvalid = mapM_ print $ map runTestCase invalid_testcases -------------------------------------------------------------------------------- -- | for testing the hacked-together parser for Gavin's custom test format... -- and also manually checking the cases runAndSaveTestCases = do writeFile "_valid.txt" $ unlines $ map show valid_testcases writeFile "_invalid.txt" $ unlines $ map show invalid_testcases writeFile "_valid_run.txt" $ unlines $ map show $ map runTestCase valid_testcases writeFile "_invalid_run.txt" $ unlines $ map show $ map runTestCase invalid_testcases -} --------------------------------------------------------------------------------