diff --git a/Network/Haskoin/Crypto/ECDSA.hs b/Network/Haskoin/Crypto/ECDSA.hs --- a/Network/Haskoin/Crypto/ECDSA.hs +++ b/Network/Haskoin/Crypto/ECDSA.hs @@ -91,11 +91,11 @@ -- -- | Sign a message -signMsg :: Hash256 -> PrvKey -> Signature +signMsg :: Hash256 -> PrvKeyI c -> Signature signMsg h d = Signature $ EC.signMsg (prvKeySecKey d) (hashToMsg h) -- | Verify an ECDSA signature -verifySig :: Hash256 -> Signature -> PubKey -> Bool +verifySig :: Hash256 -> Signature -> PubKeyI c -> Bool verifySig h s q = EC.verifySig p g m where diff --git a/Network/Haskoin/Script/Evaluator.hs b/Network/Haskoin/Script/Evaluator.hs --- a/Network/Haskoin/Script/Evaluator.hs +++ b/Network/Haskoin/Script/Evaluator.hs @@ -19,6 +19,9 @@ -- * Helper functions , encodeInt , decodeInt +, decodeFullInt +, cltvEncodeInt +, cltvDecodeInt , encodeBool , decodeBool , runStack @@ -41,7 +44,7 @@ import Data.Maybe (isJust, mapMaybe) import Data.Serialize (decode, encode) import Data.String.Conversions (cs) -import Data.Word (Word64, Word8) +import Data.Word (Word64, Word32, Word8) import Network.Haskoin.Crypto import Network.Haskoin.Script.SigHash import Network.Haskoin.Script.Types @@ -156,6 +159,9 @@ -- | Encoding function for the stack value format of integers. Most -- significant bit defines sign. +-- Note that this function will encode any Int64 into a StackValue, +-- thus producing stack-encoded integers which are not valid numeric +-- opcodes, as they exceed 4 bytes in length. encodeInt :: Int64 -> StackValue encodeInt i = prefix $ encod (fromIntegral $ abs i) [] where encod :: Word64 -> StackValue -> StackValue @@ -167,16 +173,50 @@ | i < 0 = init xs ++ [setBit (last xs) 7] | otherwise = xs --- | Inverse of `encodeInt`. +-- | Decode an Int64 from the stack value integer format. +-- Inverse of `encodeInt`. +-- Note that only integers decoded by 'decodeInt' are valid +-- numeric opcodes (numeric opcodes can only be up to 4 bytes in size). +-- However, in the case of eg. CHECKLOCKTIMEVERIFY, we need to +-- be able to encode and decode stack integers up to +-- (maxBound :: Word32), which are 5 bytes. +decodeFullInt :: StackValue -> Maybe Int64 +decodeFullInt bytes + | length bytes > 8 = Nothing + | otherwise = Just $ sign' (decodeW bytes) + where decodeW [] = 0 + decodeW [x] = fromIntegral $ clearBit x 7 + decodeW (x:xs) = fromIntegral x + decodeW xs `shiftL` 8 + sign' i | null bytes = 0 + | testBit (last bytes) 7 = -i + | otherwise = i + +-- | Used for decoding numeric opcodes. Will not return +-- an integer that takes up more than +-- 4 bytes on the stack (the size limit for numeric opcodes). +-- The naming is kept for backwards compatibility. decodeInt :: StackValue -> Maybe Int64 decodeInt bytes | length bytes > 4 = Nothing - | otherwise = Just $ sign' (decodeW bytes) - where decodeW [] = 0 - decodeW [x] = fromIntegral $ clearBit x 7 - decodeW (x:xs) = fromIntegral x + decodeW xs `shiftL` 8 - sign' i | null bytes = 0 - | testBit (last bytes) 7 = -i - | otherwise = i + | otherwise = decodeFullInt bytes + +-- | Decode the integer argument to OP_CHECKLOCKTIMEVERIFY (CLTV) +-- from a stack value. +-- The full uint32 range is needed in order to represent timestamps +-- for use with CLTV. Reference: +-- https://github.com/bitcoin/bips/blob/master/bip-0065.mediawiki#Detailed_Specification +cltvDecodeInt :: StackValue -> Maybe Word32 +cltvDecodeInt bytes + | length bytes > 5 = Nothing + | otherwise = decodeFullInt bytes >>= uint32Bounds + where + uint32Bounds :: Int64 -> Maybe Word32 + uint32Bounds i64 + | i64 < 0 || i64 > fromIntegral (maxBound :: Word32) = Nothing + | otherwise = Just $ fromIntegral i64 + +-- | Helper function for encoding the argument to OP_CHECKLOCKTIMEVERIFY +cltvEncodeInt :: Word32 -> StackValue +cltvEncodeInt = encodeInt . fromIntegral -- | Conversion of StackValue to Bool (true if non-zero). decodeBool :: StackValue -> Bool diff --git a/Network/Haskoin/Script/Parser.hs b/Network/Haskoin/Script/Parser.hs --- a/Network/Haskoin/Script/Parser.hs +++ b/Network/Haskoin/Script/Parser.hs @@ -25,6 +25,7 @@ , isSpendPKHash , isSpendMulSig , isScriptHashInput +, isDataCarrier ) where import Control.Applicative ((<|>)) @@ -60,6 +61,8 @@ } -- | Pay to a script hash. | PayScriptHash { getOutputAddress :: !Address } + -- | Provably unspendable data carrier. + | DataCarrier { getOutputData :: !ByteString } deriving (Eq, Show, Read) instance FromJSON ScriptOutput where @@ -75,6 +78,7 @@ rnf (PayPKHash a) = rnf a rnf (PayMulSig k r) = rnf k `seq` rnf r rnf (PayScriptHash a) = rnf a + rnf (DataCarrier a) = rnf a -- | Returns True if the script is a pay to public key output. isPayPK :: ScriptOutput -> Bool @@ -96,6 +100,11 @@ isPayScriptHash (PayScriptHash _) = True isPayScriptHash _ = False +-- | Returns True if the script is an OP_RETURN "datacarrier" output +isDataCarrier :: ScriptOutput -> Bool +isDataCarrier (DataCarrier _) = True +isDataCarrier _ = False + -- | Computes a script address from a script output. This address can be used -- in a pay to script hash output. scriptAddr :: ScriptOutput -> Address @@ -141,6 +150,8 @@ ] (PubKeyAddress _) -> error "encodeOutput: PubKeyAddress is invalid in PayScriptHash" + -- Provably unspendable output + (DataCarrier d) -> [OP_RETURN, opPushData d] -- | Similar to 'encodeOutput' but encodes to a ByteString encodeOutputBS :: ScriptOutput -> ByteString @@ -158,6 +169,8 @@ -- Pay to Script Hash [OP_HASH160, OP_PUSHDATA bs _, OP_EQUAL] -> (PayScriptHash . ScriptAddress) <$> decode bs + -- Provably unspendable data carrier output + [OP_RETURN, OP_PUSHDATA bs _] -> Right $ DataCarrier bs -- Pay to MultiSig Keys _ -> matchPayMulSig s diff --git a/Network/Haskoin/Test/Script.hs b/Network/Haskoin/Test/Script.hs --- a/Network/Haskoin/Test/Script.hs +++ b/Network/Haskoin/Test/Script.hs @@ -257,10 +257,11 @@ , arbitrary >>= \(ArbitraryPKHashOutput o) -> return o , arbitrary >>= \(ArbitraryMSOutput o) -> return o , arbitrary >>= \(ArbitrarySHOutput o) -> return o + , arbitrary >>= \(ArbitraryDCOutput o) -> return o ] -- | Arbitrary ScriptOutput of type PayPK, PayPKHash or PayMS --- (Not PayScriptHash) +-- (Not PayScriptHash or DataCarrier) newtype ArbitrarySimpleOutput = ArbitrarySimpleOutput ScriptOutput deriving (Eq, Show, Read) @@ -321,6 +322,15 @@ arbitrary = do ArbitraryScriptAddress a <- arbitrary return $ ArbitrarySHOutput $ PayScriptHash a + +-- | Arbitrary ScriptOutput of type DataCarrier +newtype ArbitraryDCOutput = ArbitraryDCOutput ScriptOutput + deriving (Eq, Show, Read) + +instance Arbitrary ArbitraryDCOutput where + arbitrary = do + ArbitraryNotNullByteString bs <- arbitrary + return $ ArbitraryDCOutput $ DataCarrier bs -- | Arbitrary ScriptInput newtype ArbitraryScriptInput = ArbitraryScriptInput ScriptInput diff --git a/haskoin-core.cabal b/haskoin-core.cabal --- a/haskoin-core.cabal +++ b/haskoin-core.cabal @@ -1,5 +1,5 @@ name: haskoin-core -version: 0.4.0 +version: 0.4.1 synopsis: Implementation of the core Bitcoin protocol features. description: @@ -22,12 +22,12 @@ homepage: http://github.com/haskoin/haskoin bug-reports: http://github.com/haskoin/haskoin/issues -tested-with: GHC==7.10.3, GHC==7.10.2, GHC==7.10.1 +tested-with: GHC==8.0.2 stability: stable license: PublicDomain license-file: UNLICENSE author: Philippe Laprade, Jean-Pierre Rupp -maintainer: plaprade+hackage@gmail.com +maintainer: xenog@protonmail.com category: Bitcoin, Finance, Network build-type: Simple cabal-version: >= 1.9.2 @@ -82,7 +82,7 @@ DeriveDataTypeable GADTs - build-depends: aeson >= 0.7 && < 0.12 + build-depends: aeson >= 0.7 && < 1.1 , base >= 4.8 && < 5 , byteable >= 0.1 && < 0.2 , bytestring >= 0.10 && < 0.11 @@ -97,7 +97,7 @@ , murmur3 >= 1.0 && < 1.1 , network >= 2.6 && < 2.7 , pbkdf >= 1.1 && < 1.2 - , QuickCheck >= 2.6 && < 2.9 + , QuickCheck >= 2.6 && < 2.10 , split >= 0.2 && < 0.3 , text >= 0.11 && < 1.3 , time >= 1.4 && < 1.7 @@ -138,16 +138,17 @@ Network.Haskoin.Json.Tests Network.Haskoin.Cereal.Tests - build-depends: aeson >= 0.7 && < 0.12 + build-depends: aeson >= 0.7 && < 1.1 , base >= 4.8 && < 5 + , binary >= 0.8 && < 0.9 , bytestring >= 0.10 && < 0.11 , cereal >= 0.5 && < 0.6 , containers >= 0.5 && < 0.6 , haskoin-core , mtl >= 2.2 && < 2.3 , split >= 0.2 && < 0.3 - , HUnit >= 1.2 && < 1.4 - , QuickCheck >= 2.6 && < 2.9 + , HUnit >= 1.2 && < 1.6 + , QuickCheck >= 2.6 && < 2.10 , test-framework >= 0.8 && < 0.9 , test-framework-quickcheck2 >= 0.3 && < 0.4 , test-framework-hunit >= 0.3 && < 0.4 diff --git a/tests/Network/Haskoin/Crypto/Units.hs b/tests/Network/Haskoin/Crypto/Units.hs --- a/tests/Network/Haskoin/Crypto/Units.hs +++ b/tests/Network/Haskoin/Crypto/Units.hs @@ -10,8 +10,9 @@ import Data.Maybe (fromJust, isJust, isNothing) import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy as B +import qualified Data.Binary as Bin import qualified Data.ByteString.Char8 as C (pack) -import Data.Serialize (put, runPut) import qualified Crypto.Secp256k1 as EC (SecKey, exportCompactSig) @@ -244,4 +245,4 @@ msg' = hash256 msg prv' = makePrvKey prv compact = EC.exportCompactSig g - res = runPut $ put compact + res = B.toStrict $ Bin.encode compact diff --git a/tests/Network/Haskoin/Script/Tests.hs b/tests/Network/Haskoin/Script/Tests.hs --- a/tests/Network/Haskoin/Script/Tests.hs +++ b/tests/Network/Haskoin/Script/Tests.hs @@ -51,6 +51,8 @@ , dumpStack , decodeInt , encodeInt + , decodeFullInt + , cltvDecodeInt , decodeBool , encodeBool , execScript @@ -77,6 +79,8 @@ ] , testGroup "Integer Types" [ testProperty "decodeInt . encodeInt Int" testEncodeInt + , testProperty "decodeFullInt . encodeInt Int" testEncodeInt64 + , testProperty "cltvDecodeInt . encodeInt Int" testEncodeCltv , testProperty "decodeBool . encodeBool Bool" testEncodeBool ] , testFile "Canonical Valid Script Test Cases" @@ -166,6 +170,19 @@ | otherwise = i' == Just i where i' = decodeInt $ encodeInt i + +testEncodeCltv :: Int64 -> Bool +testEncodeCltv i + -- As 'cltvEncodeInt' is just a wrapper for 'encodeInt', + -- we use 'encodeInt' for encoding, to simultaneously + -- test the handling of out-of-range integers by 'cltvDecodeInt'. + | i < 0 || i > fromIntegral (maxBound :: Word32) = + isNothing $ cltvDecodeInt (encodeInt i) + | otherwise = + cltvDecodeInt (encodeInt i) == Just (fromIntegral i) + +testEncodeInt64 :: Int64 -> Bool +testEncodeInt64 i = decodeFullInt (encodeInt i) == Just i testEncodeBool :: Bool -> Bool testEncodeBool b = decodeBool (encodeBool b) == b