Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

parser is complete

  • Loading branch information...
commit f4246555833ab38a3d768a9813c601e8ff0b5498 1 parent 4efee62
Alexander Bernauer authored
View
25 src/Language/Bitcoin/Parser.hs
@@ -9,7 +9,7 @@ module Language.Bitcoin.Parser
import Language.Bitcoin.Types
import Numeric (readHex)
import Text.ParserCombinators.Parsec
-import Control.Monad (liftM)
+import Control.Monad (liftM, when)
-- run_parser :: String -> Code -> Either String Script {{{1
run_parser :: String -> Code -> Either String Script
@@ -42,16 +42,31 @@ opcode :: String -> Parser Command
opcode x = liftM CmdOpcode $ liftReadS reads x
push :: Parser Command
-push = undefined
+push = do
+ spaces
+ value <- hex
+ when (value < 1 || value > 0x75) $
+ fail "illegal value for PUSH operation (allowed [0x01,0x75])"
+ return $ CmdOpcode $ PUSH value
push1 :: Parser Command
-push1 = undefined
+push1 = pushN 0xff "OP_PUSHDATA1" "exactly one byte" OP_PUSHDATA1
push2 :: Parser Command
-push2 = undefined
+push2 = pushN 0xffff "OP_PUSHDATA2" "at most two bytes" OP_PUSHDATA2
push4 :: Parser Command
-push4 = undefined
+push4 = pushN 0xffffffff "OP_PUSHDATA4" "at most four bytes" OP_PUSHDATA4
+
+pushN :: Num a => Integer -> String -> String -> (a -> Integer -> Opcode) -> Parser Command
+pushN maxSize opcodeString errorString createOpcode = do
+ size <- spaces >> hex
+ when (size > maxSize) $
+ fail $ "size parameter for " ++ opcodeString ++ " must be " ++ errorString
+ value <- spaces >> hex
+ when (value > 2 ^ (8*size)) $
+ fail $ "data is more than " ++ show size ++ " byte(s)"
+ return $ CmdOpcode $ createOpcode (fromIntegral size) value
hex :: Parser Integer
hex = many alphaNum >>= liftReadS readHex
View
2  src/Language/Bitcoin/Types.hs
@@ -155,7 +155,7 @@ data Opcode =
| OP_NOP8
| OP_NOP9
| OP_NOP10
--- data
+-- data {{{2
| PUSH Integer
| OP_PUSHDATA1 Word8 Integer
| OP_PUSHDATA2 Word16 Integer
View
24 test/Language/Bitcoin/Test/Parser.hs
@@ -8,7 +8,9 @@ import Language.Bitcoin.Parser (run_parser)
import Language.Bitcoin.Types
import Test.HUnit
import qualified Data.ByteString.Lazy as B
+import qualified Data.List as List
+import Debug.Trace (trace)
tests = TestLabel "Parser" $ TestList $ good ++ bad
goodCases = [
@@ -17,11 +19,22 @@ goodCases = [
, (" OP_FALSE;", [CmdOpcode OP_FALSE])
, ("OP_FALSE;OP_TRUE;", [CmdOpcode OP_FALSE, CmdOpcode OP_TRUE])
, ("OP_FALSE\nOP_TRUE;", [CmdOpcode OP_FALSE, CmdOpcode OP_TRUE])
- , ("DATA 23;", [DATA 0x23])
+ , ("PUSH 23;", [CmdOpcode $ PUSH 0x23])
+ , ("OP_PUSHDATA1 6 040815162342;", [CmdOpcode $ OP_PUSHDATA1 6 0x40815162342])
+ , ("OP_PUSHDATA2 6 040815162342;", [CmdOpcode $ OP_PUSHDATA2 6 0x40815162342])
+ , ("OP_PUSHDATA4 6 040815162342;", [CmdOpcode $ OP_PUSHDATA4 6 0x40815162342])
+ , ("DATA 040815162342;", [DATA 0x40815162342])
+ , ("KEY 1;", [KEY 1])
+ , ("SIG 1;", [SIG 1])
]
badCases = [
- "OP_DOESNOTEXIST;", "foo\n"
+ "foo;",
+ "OP_DOESNOTEXIST;",
+ "PUSH 0;",
+ "PUSH 76;",
+ "OP_PUSHDATA1 100 1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111;",
+ "OP_PUSHDATA1 1 2342"
]
good :: [Test]
@@ -38,5 +51,10 @@ bad = map runTest badCases
where
runTest code = TestCase $
case run_parser "<<test>>" code of
- Left _ -> return ()
+ Left err -> putStrLn $ infoString code err
Right _ -> assertString "Parser should have failed"
+
+infoString :: String -> String -> String
+infoString code err =
+ "'" ++ code ++ "' -> " ++ (List.reverse $ takeWhile (/= '\n') $ List.reverse err)
+
Please sign in to comment.
Something went wrong with that request. Please try again.