packages feed

ethereum-analyzer-deps (empty) → 0.0.1

raw patch · 17 files changed

+1519/−0 lines, 17 filesdep +aesondep +ansi-wl-pprintdep +basesetup-changed

Dependencies added: aeson, ansi-wl-pprint, base, base16-bytestring, binary, bytestring, containers, deepseq, fast-logger, global-lock, monad-logger, nibblestring, split, text

Files

+ LICENSE view
@@ -0,0 +1,13 @@+Copyright 2016 BlockApps, Inc++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++    http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.
+ Setup.hs view
@@ -0,0 +1,8 @@++module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain+
+ ethereum-analyzer-deps.cabal view
@@ -0,0 +1,54 @@+name: ethereum-analyzer-deps+version: 0.0.1+cabal-version: >=1.10+build-type: Simple+author: Jamshid+license-file:  LICENSE+maintainer:    k_@berkeley.edu+synopsis: Stripped dependencies of ethereum-analyzer.+category:            Ethereum, Static Analysis+license: Apache-2.0+description:  +    Stripped dependencies of ethereum-analyzer.++source-repository this+  type:     git+  location: https://github.com/zchn/ethereum-analyzer+  branch:   master+  tag:      v0.0.1++library+    default-language: Haskell98+    build-depends: +                   base >= 4 && < 5+                 , aeson+                 , ansi-wl-pprint+                 , base16-bytestring+                 , binary+                 , bytestring+                 , containers+                 , deepseq+                 , fast-logger+                 , global-lock+                 , monad-logger+                 , nibblestring+                 , split+                 , text+    exposed-modules: Blockchain.Data.Code+                   , Blockchain.Data.RLP+                   , Blockchain.Data.Util+                   , Blockchain.VM.Code+                   , Blockchain.VM.Opcodes+                   , Blockchain.ExtWord+                   , Blockchain.Format+                   , Blockchain.Util+                   , Blockchain.Output+                   , Blockchain.Colors+                   , Legacy.Haskoin.V0102.Network.Haskoin.Crypto.BigWord+                   , Legacy.Haskoin.V0102.Network.Haskoin.Crypto.Curve+                   , Legacy.Haskoin.V0102.Network.Haskoin.Crypto.NumberTheory+                   , Legacy.Haskoin.V0102.Network.Haskoin.Util+    ghc-options: -Wall -O2+    buildable: True+    hs-source-dirs: src+
+ src/Blockchain/Colors.hs view
@@ -0,0 +1,33 @@+{-# OPTIONS_GHC  -fno-warn-missing-signatures -fno-warn-type-defaults #-}++module Blockchain.Colors (+    red, green, yellow, blue,+    magenta, cyan, white2, white, black,+    bright, dim, underline, blink, Blockchain.Colors.reverse, hidden,+    setTitle+) where+++bright string = "\ESC[1m" ++ string ++ "\ESC[0m"+dim string = "\ESC[2m" ++ string ++ "\ESC[0m"+underline string = "\ESC[4m" ++ string ++ "\ESC[0m"+blink string = "\ESC[5m" ++ string ++ "\ESC[0m"+reverse string = "\ESC[7m" ++ string ++ "\ESC[0m"+hidden string = "\ESC[8m" ++ string ++ "\ESC[0m"+++black string = "\ESC[30m" ++ string ++ "\ESC[0m"+red string = "\ESC[31m" ++ string ++ "\ESC[0m"+green string = "\ESC[32m" ++ string ++ "\ESC[0m"+yellow string = "\ESC[33m" ++ string ++ "\ESC[0m"+blue string = "\ESC[34m" ++ string ++ "\ESC[0m"+magenta string = "\ESC[35m" ++ string ++ "\ESC[0m" --AKA purple+cyan string = "\ESC[36m" ++ string ++ "\ESC[0m" --AKA aqua+white string = "\ESC[37m" ++ string ++ "\ESC[0m"+white2 string = "\ESC[38m" ++ string ++ "\ESC[0m"+++setTitle::String->IO()+setTitle value = do+  putStr $ "\ESC]0;" ++ value ++ "\007"+
+ src/Blockchain/Data/Code.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE DeriveGeneric #-}++module Blockchain.Data.Code where++import qualified Data.ByteString as B+import GHC.Generics++import Blockchain.Data.RLP++data Code =+  Code{codeBytes::B.ByteString}+  | PrecompiledCode Int deriving (Show, Eq, Read, Ord, Generic)++instance RLPSerializable Code where+    rlpEncode (Code bytes) = rlpEncode bytes+    rlpEncode (PrecompiledCode _) = error "Error in call to rlpEncode for Code: Precompiled contracts can not be serialized."+    rlpDecode = Code . rlpDecode++-- instance Format Code where+--    format Code {codeBytes=c} = B.unpack c
+ src/Blockchain/Data/RLP.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE FlexibleInstances #-}++-- | The RLP module provides a framework within which serializers can be built, described in the Ethereum Yellowpaper (<http://gavwood.com/paper.pdf>).+--+-- The 'RLPObject' is an intermediate data container, whose serialization rules are well defined.  By creating code that converts from a+-- given type to an 'RLPObject', full serialization will be specified.  The 'RLPSerializable' class provides functions to do this conversion.++module Blockchain.Data.RLP (+  RLPObject(..),+  formatRLPObject,+  RLPSerializable(..),+  rlpSplit,+  rlpSerialize,+  rlpDeserialize+  ) where++import Data.Bits+import qualified Data.ByteString as B+import qualified Data.ByteString.Base16 as B16+import qualified Data.ByteString.Char8 as BC+import Data.ByteString.Internal+import Data.Word+import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))+import Numeric++import Blockchain.Data.Util++-- | An internal representation of generic data, with no type information.+--+-- End users will not need to directly create objects of this type (an 'RLPObject' can be created using 'rlpEncode'),+-- however the designer of a new type will need to create conversion code by making their type an instance +-- of the RLPSerializable class. +data RLPObject = RLPScalar Word8 | RLPString B.ByteString | RLPArray [RLPObject] deriving (Show, Eq, Ord)++-- | Converts objects to and from 'RLPObject's.+class RLPSerializable a where+  rlpDecode::RLPObject->a+  rlpEncode::a->RLPObject+++instance Pretty RLPObject where+  pretty (RLPArray objects) =+    encloseSep (text "[") (text "]") (text ", ") $ pretty <$> objects+  pretty (RLPScalar n) = text $ "0x" ++ showHex n ""+  pretty (RLPString s) = text $ "0x" ++ BC.unpack (B16.encode s)++formatRLPObject::RLPObject->String+formatRLPObject = show . pretty++splitAtWithError::Int->B.ByteString->(B.ByteString, B.ByteString)+splitAtWithError i s | i > B.length s = error "splitAtWithError called with n > length arr"+splitAtWithError i s = B.splitAt i s++getLength::Int->B.ByteString->(Integer, B.ByteString)+getLength sizeOfLength bytes =+  (bytes2Integer $ B.unpack $ B.take sizeOfLength bytes, B.drop sizeOfLength bytes)++rlpSplit::B.ByteString->(RLPObject, B.ByteString)+rlpSplit input =+  case B.head input of+    x | x >= 192 && x <= 192+55 ->+      let (arrayData, nextRest) =+            splitAtWithError (fromIntegral x - 192) $ B.tail input+      in (RLPArray $ getRLPObjects arrayData, nextRest)++    x | x >= 0xF8 && x <= 0xFF ->+      let +        (arrLength, restAfterLen) = getLength (fromIntegral x - 0xF7) $ B.tail input+        (arrayData, nextRest) = splitAtWithError (fromIntegral arrLength) restAfterLen+      in (RLPArray $ getRLPObjects arrayData, nextRest)++    x | x >= 128 && x <= 128+55 ->+      let+        (strList, nextRest) = splitAtWithError (fromIntegral $ x - 128) $ B.tail input+      in +       (RLPString strList, nextRest)++    x | x >= 0xB8 && x <= 0xBF ->+      let +        (strLength, restAfterLen) = getLength (fromIntegral x - 0xB7) $ B.tail input+        (strList, nextRest) = splitAtWithError (fromIntegral strLength) restAfterLen+      in+       (RLPString strList, nextRest)++    x | x < 128 -> (RLPScalar x, B.tail input)+            +    x -> error ("Missing case in rlpSplit: " ++ show x)++    +getRLPObjects::ByteString->[RLPObject]+getRLPObjects x | B.null x = []+getRLPObjects theData = obj:getRLPObjects rest+  where+    (obj, rest) = rlpSplit theData++int2Bytes::Int->[Word8]+int2Bytes val | val < 0x100 = map (fromIntegral . (val `shiftR`)) [0]+int2Bytes val | val < 0x10000 = map (fromIntegral . (val `shiftR`)) [8, 0]+int2Bytes val | val < 0x1000000 = map (fromIntegral . (val `shiftR`)) [16,  8, 0]+int2Bytes val | val < 0x100000000 = map (fromIntegral . (val `shiftR`)) [24, 16..0]+int2Bytes val | val < 0x10000000000 = map (fromIntegral . (val `shiftR`)) [32, 24..0]+int2Bytes _ = error "int2Bytes not defined for val >= 0x10000000000."++rlp2Bytes::RLPObject->[Word8]+rlp2Bytes (RLPScalar val) = [fromIntegral val]+rlp2Bytes (RLPString s) | B.length s <= 55 = 0x80 + fromIntegral (B.length s):B.unpack s+rlp2Bytes (RLPString s) =+  [0xB7 + fromIntegral (length lengthAsBytes)] ++ lengthAsBytes ++ B.unpack s+  where+    lengthAsBytes = int2Bytes $ B.length s+rlp2Bytes (RLPArray innerObjects) =+  if length innerBytes <= 55+  then 0xC0 + fromIntegral (length innerBytes):innerBytes+  else let lenBytes = int2Bytes $ length innerBytes+       in [0xF7 + fromIntegral (length lenBytes)] ++ lenBytes ++ innerBytes+  where+    innerBytes = concat $ rlp2Bytes <$> innerObjects++--TODO- Probably should just use Data.Binary's 'Binary' class for this++-- | Converts bytes to 'RLPObject's.+--+-- Full deserialization of an object can be obtained using @rlpDecode . rlpDeserialize@.+rlpDeserialize::B.ByteString->RLPObject+rlpDeserialize s = +  case rlpSplit s of+    (o, x) | B.null x -> o+    _ -> error ("parse error converting ByteString to an RLP Object: " ++ show (B.unpack s))+++-- | Converts 'RLPObject's to bytes.+--+-- Full serialization of an object can be obtained using @rlpSerialize . rlpEncode@.+rlpSerialize::RLPObject->B.ByteString+rlpSerialize o = B.pack $ rlp2Bytes o+++instance RLPSerializable Integer where+  rlpEncode 0 = RLPString B.empty+  rlpEncode x | x < 128 = RLPScalar $ fromIntegral x+  rlpEncode x = RLPString $ B.pack $ integer2Bytes x+  rlpDecode (RLPScalar x) = fromIntegral x+  rlpDecode (RLPString s) = byteString2Integer s+  rlpDecode (RLPArray _) = error "rlpDecode called for Integer for array"++instance RLPSerializable String where+  rlpEncode s = rlpEncode $ BC.pack s++  rlpDecode (RLPString s) = BC.unpack s+  rlpDecode (RLPScalar n) = [w2c $ fromIntegral n]+  rlpDecode (RLPArray x) = error $ "Malformed RLP in call to rlpDecode for String: RLPObject is an array: " ++ show (pretty x)++instance RLPSerializable B.ByteString where+    rlpEncode x | B.length x == 1 && B.head x < 128 = RLPScalar $ B.head x+    rlpEncode s = RLPString s+      +    rlpDecode (RLPScalar x) = B.singleton x+    rlpDecode (RLPString s) = s+    rlpDecode x = error ("rlpDecode for ByteString not defined for: " ++ show x)
+ src/Blockchain/Data/Util.hs view
@@ -0,0 +1,24 @@++module Blockchain.Data.Util (+  byteString2Integer,+  bytes2Integer,+  integer2Bytes+  ) where++import Data.Bits+import qualified Data.ByteString as B+import Data.Word++--I hate this, it is an ugly way to create an Integer from its component bytes.+--There should be an easier way....+--See http://stackoverflow.com/questions/25854311/efficient-packing-bytes-into-integers+byteString2Integer::B.ByteString->Integer+byteString2Integer x = bytes2Integer $ B.unpack x++bytes2Integer::[Word8]->Integer+bytes2Integer [] = 0+bytes2Integer (byte:rest) = fromIntegral byte `shift` (8 * length rest) + bytes2Integer rest++integer2Bytes::Integer->[Word8]+integer2Bytes 0 = []+integer2Bytes x = integer2Bytes (x `shiftR` 8) ++ [fromInteger (x .&. 255)]
+ src/Blockchain/ExtWord.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Blockchain.ExtWord (+  Word128,+  Word160,+  Word256,+  Word512,+  word64ToBytes,+  bytesToWord64,+  word128ToBytes,+  bytesToWord128,+  word160ToBytes,+  bytesToWord160,+  word256ToBytes,+  bytesToWord256+  ) where++import Data.Binary+import Data.Bits+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Legacy.Haskoin.V0102.Network.Haskoin.Crypto.BigWord (Word128, Word160, Word256, Word512)++import Data.Ix++import Blockchain.Data.RLP+++instance Ix Word256 where+    range (x, y) | x == y = [x]+    range (x, y) = x:range (x+1, y)+    index (x, y) z | z < x || z > y = error $ "Ix{Word256}.index: Index (" ++ show z ++ ") out of range ((" ++ show x ++ "," ++ show y ++ "))"+    index (x, _) z = fromIntegral $ z - x+    inRange (x, y) z | z >= x && z <= y = True+    inRange _ _ = False++instance RLPSerializable Word512 where+    rlpEncode val = RLPString $ BL.toStrict $ encode val++    rlpDecode (RLPString s) | B.length s == 64 = decode $ BL.fromStrict s+    rlpDecode x = error ("Missing case in rlp2Word512: " ++ show x)++word64ToBytes::Word64->[Word8]+word64ToBytes word = map (fromIntegral . (word `shiftR`)) [64-8, 64-16..0]++bytesToWord64::[Word8]->Word64+bytesToWord64 bytes | length bytes == 8 =+  sum $ map (\(shiftBits, byte) -> fromIntegral byte `shiftL` shiftBits) $ zip [64-8,64-16..0] bytes+bytesToWord64 _ = error "bytesToWord64 was called with the wrong number of bytes"++word128ToBytes::Word128->[Word8]+word128ToBytes word = map (fromIntegral . (word `shiftR`)) [128-8, 128-16..0]++bytesToWord128::[Word8]->Word128+bytesToWord128 bytes | length bytes == 16 =+  sum $ map (\(shiftBits, byte) -> fromIntegral byte `shiftL` shiftBits) $ zip [128-8,128-16..0] bytes+bytesToWord128 _ = error "bytesToWord128 was called with the wrong number of bytes"++word160ToBytes::Word160->[Word8]+word160ToBytes word = map (fromIntegral . (word `shiftR`)) [160-8, 160-16..0]++bytesToWord160::[Word8]->Word160+bytesToWord160 bytes | length bytes == 20 =+  sum $ map (\(shiftBits, byte) -> fromIntegral byte `shiftL` shiftBits) $ zip [160-8,160-16..0] bytes+bytesToWord160 _ = error "bytesToWord128 was called with the wrong number of bytes"++word256ToBytes::Word256->[Word8]+word256ToBytes word = map (fromIntegral . (word `shiftR`)) [256-8, 256-16..0]++instance RLPSerializable Word128 where+    rlpEncode val = RLPString $ BL.toStrict $ encode val++    rlpDecode (RLPString s) | B.null s = 0+    rlpDecode (RLPString s) | B.length s <= 16 = decode $ BL.fromStrict s+    rlpDecode x = error ("Missing case in rlp2Word128: " ++ show x)+++instance RLPSerializable Word32 where+    rlpEncode val = RLPString $ BL.toStrict $ encode val++    rlpDecode (RLPString s) | B.null s = 0+    rlpDecode (RLPString s) | B.length s <= 4 = decode $ BL.fromStrict s+    rlpDecode x = error ("Missing case in rlp2Word32: " ++ show x)++instance RLPSerializable Word16 where+    rlpEncode val = RLPString $ BL.toStrict $ encode val++    rlpDecode (RLPString s) | B.null s = 0+    rlpDecode (RLPString s) | B.length s <= 2 = decode $ BL.fromStrict s+    rlpDecode x = error ("Missing case in rlp2Word16: " ++ show x)++++bytesToWord256::[Word8]->Word256+bytesToWord256 bytes | length bytes == 32 =+  sum $ map (\(shiftBits, byte) -> fromIntegral byte `shiftL` shiftBits) $ zip [256-8,256-16..0] bytes+bytesToWord256 _ = error "bytesToWord256 was called with the wrong number of bytes"
+ src/Blockchain/Format.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}++module Blockchain.Format (+  Format(..)+  ) where++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Base16 as B16++import Blockchain.ExtWord++class Format a where+  format::a->String++instance Format B.ByteString where+  format x = BC.unpack (B16.encode x)++instance Format Word256 where+  format x = BC.unpack $ B16.encode $ B.pack $ word256ToBytes x+
+ src/Blockchain/Output.hs view
@@ -0,0 +1,18 @@++module Blockchain.Output where++import Control.Monad.Logger+import qualified Data.ByteString.Char8 as BC+import System.GlobalLock+import System.Log.FastLogger++printLogMsg::Loc->LogSource->LogLevel->LogStr->IO ()+--printLogMsg loc logSource level msg = do+printLogMsg _ _ _ msg = do+  lock $ putStrLn $ BC.unpack $ fromLogStr msg++printToFile::FilePath->Loc->LogSource->LogLevel->LogStr->IO ()+--printLogMsg loc logSource level msg = do+printToFile path _ _ _ msg = do+  lock $ appendFile path $ BC.unpack (fromLogStr msg) ++ "\n"+
+ src/Blockchain/Util.hs view
@@ -0,0 +1,88 @@++module Blockchain.Util where++import Data.Bits+import qualified Data.ByteString as B+import qualified Data.NibbleString as N+import Data.ByteString.Internal+import Data.Char+import Data.List+import Data.Word+import Numeric++import Blockchain.ExtWord++showHex4::Word256->String+showHex4 i = replicate (4 - length rawOutput) '0' ++ rawOutput+    where rawOutput = showHex i ""++showHexU::Integer->[Char]+showHexU = map toUpper . flip showHex ""++nibbleString2ByteString::N.NibbleString->B.ByteString+nibbleString2ByteString (N.EvenNibbleString s) = s+nibbleString2ByteString (N.OddNibbleString c s) = c `B.cons` s++byteString2NibbleString::B.ByteString->N.NibbleString+byteString2NibbleString = N.EvenNibbleString++--I hate this, it is an ugly way to create an Integer from its component bytes.+--There should be an easier way....+--See http://stackoverflow.com/questions/25854311/efficient-packing-bytes-into-integers+byteString2Integer::B.ByteString->Integer+byteString2Integer x = bytes2Integer $ B.unpack x++bytes2Integer::[Word8]->Integer+bytes2Integer [] = 0+bytes2Integer (byte:rest) = fromIntegral byte `shift` (8 * length rest) + bytes2Integer rest++integer2Bytes::Integer->[Word8]+integer2Bytes 0 = []+integer2Bytes x = integer2Bytes (x `shiftR` 8) ++ [fromInteger (x .&. 255)]++--integer2Bytes1 is integer2Bytes, but with the extra condition that the output be of length 1 or more.+integer2Bytes1::Integer->[Word8]+integer2Bytes1 0 = [0]+integer2Bytes1 x = integer2Bytes x++padZeros::Int->String->String+padZeros n s = replicate (n - length s) '0' ++ s++tab::String->String+tab [] = []+tab ('\n':rest) = '\n':' ':' ':' ':' ':tab rest+tab (c:rest) = c:tab rest++showWord8::Word8->Char+showWord8 c | c >= 32 && c < 127 = w2c c+showWord8 _ = '?'++showMem::Int->[Word8]->String+showMem _ x | length x > 1000 = " mem size greater than 1000 bytes"+showMem _ [] = "" +showMem p (v1:v2:v3:v4:v5:v6:v7:v8:rest) = +    padZeros 4 (showHex p "") ++ " " +             ++ [showWord8 v1] ++ [showWord8 v2] ++ [showWord8 v3] ++ [showWord8 v4]+             ++ [showWord8 v5] ++ [showWord8 v6] ++ [showWord8 v7] ++ [showWord8 v8] ++ " "+             ++ padZeros 2 (showHex v1 "") ++ " " ++ padZeros 2 (showHex v2 "") ++ " " ++ padZeros 2 (showHex v3 "") ++ " " ++ padZeros 2 (showHex v4 "") ++ " "+             ++ padZeros 2 (showHex v5 "") ++ " " ++ padZeros 2 (showHex v6 "") ++ " " ++ padZeros 2 (showHex v7 "") ++ " " ++ padZeros 2 (showHex v8 "") ++ "\n"+             ++ showMem (p+8) rest+showMem p x = padZeros 4 (showHex p "") ++ " " ++ (showWord8 <$> x) ++ " " ++ intercalate " " (padZeros 2 <$> flip showHex "" <$> x)+++safeTake::Word256->B.ByteString->B.ByteString+safeTake i _ | i > 0x7fffffffffffffff = error "error in call to safeTake: string too long"+safeTake i s | i > fromIntegral (B.length s) = s `B.append` B.replicate (fromIntegral i - B.length s) 0+safeTake i s = B.take (fromIntegral i) s++safeDrop::Word256->B.ByteString->B.ByteString+safeDrop i s | i > fromIntegral (B.length s) = B.empty+safeDrop i _ | i > 0x7fffffffffffffff = error "error in call to safeDrop: string too long"+safeDrop i s = B.drop (fromIntegral i) s+++isContiguous::(Eq a, Num a)=>[a]->Bool+isContiguous [] = True+isContiguous [_] = True+isContiguous (x:y:rest) | y == x + 1 = isContiguous $ y:rest+isContiguous _ = False
+ src/Blockchain/VM/Code.hs view
@@ -0,0 +1,52 @@+module Blockchain.VM.Code where++import qualified Data.ByteString as B+-- import Legacy.Haskoin.V0102.Network.Haskoin.Internals+import Numeric+import Text.PrettyPrint.ANSI.Leijen++import Blockchain.ExtWord+import qualified Blockchain.Colors as CL+import Blockchain.Data.Code+import Blockchain.Format+import Blockchain.Util+import Blockchain.VM.Opcodes+++getOperationAt::Code->Word256->(Operation, Word256)+getOperationAt (Code bytes) p = getOperationAt' bytes p+getOperationAt (PrecompiledCode _) _ = error "getOperationAt called for precompilded code"++getOperationAt'::B.ByteString->Word256->(Operation, Word256)+getOperationAt' rom p = opCode2Op $ safeDrop p rom++showCode::Word256->Code->String+showCode _ (Code bytes) | B.null bytes = ""+showCode _ (PrecompiledCode x) = CL.blue $ "<PrecompiledCode:" ++ show x ++">"+showCode lineNumber c@(Code rom) = showHex lineNumber "" ++ " " ++ format (B.pack $ op2OpCode op) ++ " " ++ show (pretty op) ++ "\n" ++  showCode (lineNumber + nextP) (Code (safeDrop nextP rom))+        where+          (op, nextP) = getOperationAt c 0++formatCode::Code->String+formatCode = showCode 0++getValidJUMPDESTs::Code->[Word256]+getValidJUMPDESTs (Code bytes) =+  map fst $ filter ((== JUMPDEST) . snd) $ getOps bytes 0+  where+    getOps::B.ByteString->Word256->[(Word256, Operation)]+    getOps bytes' p | p > fromIntegral (B.length bytes') = []+    getOps code p = (p, op):getOps code (p+len)+      where+        (op, len) = getOperationAt' code p+getValidJUMPDESTs (PrecompiledCode _) = error "getValidJUMPDESTs called on precompiled code"+++codeLength::Code->Int+codeLength (Code bytes) = B.length bytes+codeLength (PrecompiledCode _) = error "codeLength called on precompiled code"++compile::[Operation]->Code+compile x = Code bytes+  where+    bytes = B.pack $ op2OpCode =<< x
+ src/Blockchain/VM/Opcodes.hs view
@@ -0,0 +1,195 @@+module Blockchain.VM.Opcodes where++import Prelude hiding (LT, GT, EQ)++import Data.Binary+import qualified Data.ByteString as B+import qualified Data.Map as M+import Data.Maybe+import Legacy.Haskoin.V0102.Network.Haskoin.Crypto.BigWord+import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))++import Blockchain.Util++--import Debug.Trace++data Operation =+    STOP | ADD | MUL | SUB | DIV | SDIV | MOD | SMOD | ADDMOD | MULMOD | EXP | SIGNEXTEND | NEG | LT | GT | SLT | SGT | EQ | ISZERO | NOT | AND | OR | XOR | BYTE | SHA3 |+    ADDRESS | BALANCE | ORIGIN | CALLER | CALLVALUE | CALLDATALOAD | CALLDATASIZE | CALLDATACOPY | CODESIZE | CODECOPY | GASPRICE | EXTCODESIZE | EXTCODECOPY |+    BLOCKHASH | COINBASE | TIMESTAMP | NUMBER | DIFFICULTY | GASLIMIT | POP | MLOAD | MSTORE | MSTORE8 | SLOAD | SSTORE |+    JUMP | JUMPI | PC | MSIZE | GAS | JUMPDEST |+    PUSH [Word8] |+    DUP1 | DUP2 | DUP3 | DUP4 |+    DUP5 | DUP6 | DUP7 | DUP8 |+    DUP9 | DUP10 | DUP11 | DUP12 |+    DUP13 | DUP14 | DUP15 | DUP16 |+    SWAP1 | SWAP2 | SWAP3 | SWAP4 |+    SWAP5 | SWAP6 | SWAP7 | SWAP8 |+    SWAP9 | SWAP10 | SWAP11 | SWAP12 |+    SWAP13 | SWAP14 | SWAP15 | SWAP16 |+    LOG0 | LOG1 | LOG2 | LOG3 | LOG4 |+    CREATE | CALL | CALLCODE | RETURN | DELEGATECALL | INVALID | SUICIDE |+    --Pseudo Opcodes+    LABEL String | PUSHLABEL String |+    PUSHDIFF String String | DATA B.ByteString |+    MalformedOpcode Word8 deriving (Show, Eq, Ord)++instance Pretty Operation where+  pretty x@JUMPDEST = text $ "------" ++ show x+  pretty x@(PUSH vals) = text $ show x ++ " --" ++ show (bytes2Integer vals)+  pretty x = text $ show x++data OPData = OPData Word8 Operation Int Int String++type EthCode = [Operation]++singleOp::Operation->([Word8]->Operation, Int)+singleOp o = (const o, 1)++opDatas::[OPData]+opDatas =+  [+    OPData 0x00 STOP 0 0 "Halts execution.",+    OPData 0x01 ADD 2 1 "Addition operation.",+    OPData 0x02 MUL 2 1 "Multiplication operation.",+    OPData 0x03 SUB 2 1 "Subtraction operation.",+    OPData 0x04 DIV 2 1 "Integer division operation.",+    OPData 0x05 SDIV 2 1 "Signed integer division operation.",+    OPData 0x06 MOD 2 1 "Modulo remainder operation.",+    OPData 0x07 SMOD 2 1 "Signed modulo remainder operation.",+    OPData 0x08 ADDMOD 2 1 "unsigned modular addition",+    OPData 0x09 MULMOD 2 1 "unsigned modular multiplication",+    OPData 0x0a EXP 2 1 "Exponential operation.",+    OPData 0x0b SIGNEXTEND 2 1 "Extend length of two’s complement signed integer.",++    OPData 0x10 LT 2 1 "Less-than comparision.",+    OPData 0x11 GT 2 1 "Greater-than comparision.",+    OPData 0x12 SLT 2 1 "Signed less-than comparision.",+    OPData 0x13 SGT 2 1 "Signed greater-than comparision.",+    OPData 0x14 EQ 2 1 "Equality comparision.",+    OPData 0x15 ISZERO 1 1 "Simple not operator.",+    OPData 0x16 AND 2 1 "Bitwise AND operation.",+    OPData 0x17 OR 2 1 "Bitwise OR operation.",+    OPData 0x18 XOR 2 1 "Bitwise XOR operation.",+    OPData 0x19 NOT 1 1 "Bitwise not operator.",+    OPData 0x1a BYTE 2 1 "Retrieve single byte from word.",++    OPData 0x20 SHA3 2 1 "Compute SHA3-256 hash.",++    OPData 0x30 ADDRESS 0 1 "Get address of currently executing account.",+    OPData 0x31 BALANCE 1 1 "Get balance of the given account.",+    OPData 0x32 ORIGIN 0 1 "Get execution origination address.",+    OPData 0x33 CALLER 0 1 "Get caller address.",+    OPData 0x34 CALLVALUE 0 1 "Get deposited value by the instruction/transaction responsible for this execution.",+    OPData 0x35 CALLDATALOAD 1 1 "Get input data of current environment.",+    OPData 0x36 CALLDATASIZE 0 1 "Get size of input data in current environment.",+    OPData 0x37 CALLDATACOPY 3 0 "Copy input data in current environment to memory.",+    OPData 0x38 CODESIZE 0 1 "Get size of code running in current environment.",+    OPData 0x39 CODECOPY 3 0 "Copy code running in current environment to memory.",+    OPData 0x3a GASPRICE 0 1 "Get price of gas in current environment.",+    OPData 0x3b EXTCODESIZE 0 1 "Get size of an account's code.",+    OPData 0x3c EXTCODECOPY 0 4 "Copy an account’s code to memory",++    OPData 0x40 BLOCKHASH 0 1 "Get hash of most recent complete block.",+    OPData 0x41 COINBASE 0 1 "Get the block’s coinbase address.",+    OPData 0x42 TIMESTAMP 0 1 "Get the block’s timestamp.",+    OPData 0x43 NUMBER 0 1 "Get the block’s number.",+    OPData 0x44 DIFFICULTY 0 1 "Get the block’s difficulty.",+    OPData 0x45 GASLIMIT 0 1 "Get the block’s gas limit.",++    OPData 0x50 POP 1 0 "Remove item from stack.",+    OPData 0x51 MLOAD 1 1 "Load word from memory.",+    OPData 0x52 MSTORE 2 0 "Save word to memory.",+    OPData 0x53 MSTORE8 2 0 "Save byte to memory.",+    OPData 0x54 SLOAD 1 1 "Load word from storage.",+    OPData 0x55 SSTORE 2 0 "Save word to storage.",+    OPData 0x56 JUMP 1 0 "Alter the program counter.",+    OPData 0x57 JUMPI 2 0 "Conditionally alter the program counter.",+    OPData 0x58 PC 0 1 "Get the program counter.",+    OPData 0x59 MSIZE 0 1 "Get the size of active memory in bytes.",+    OPData 0x5a GAS 0 1 "Get the amount of available gas.",+    OPData 0x5b JUMPDEST 0 0 "set a potential jump destination",++    OPData 0x80 DUP1 1 2 "Duplicate 1st stack item.",+    OPData 0x81 DUP2 2 3 "Duplicate 2nd stack item.",+    OPData 0x82 DUP3 3 4 "Duplicate 3rd stack item.",+    OPData 0x83 DUP4 4 5 "Duplicate 4th stack item.",+    OPData 0x84 DUP5 5 6 "Duplicate 5th stack item.",+    OPData 0x85 DUP6 6 7 "Duplicate 6th stack item.",+    OPData 0x86 DUP7 7 8 "Duplicate 7th stack item.",+    OPData 0x87 DUP8 8 9 "Duplicate 8th stack item.",+    OPData 0x88 DUP9 9 10 "Duplicate 9th stack item.",+    OPData 0x89 DUP10 10 11 "Duplicate 10th stack item.",+    OPData 0x8a DUP11 11 12 "Duplicate 11th stack item.",+    OPData 0x8b DUP12 12 13 "Duplicate 12th stack item.",+    OPData 0x8c DUP13 13 14 "Duplicate 13th stack item.",+    OPData 0x8d DUP14 14 15 "Duplicate 14th stack item.",+    OPData 0x8e DUP15 15 16 "Duplicate 15th stack item.",+    OPData 0x8f DUP16 16 17 "Duplicate 16th stack item.",++    OPData 0x90 SWAP1 2 2 "Exchange 1st and 2nd stack items.",+    OPData 0x91 SWAP2 3 3 "Exchange 1st and 3nd stack items.",+    OPData 0x92 SWAP3 4 4 "Exchange 1st and 4nd stack items.",+    OPData 0x93 SWAP4 5 5 "Exchange 1st and 5nd stack items.",+    OPData 0x94 SWAP5 6 6 "Exchange 1st and 6nd stack items.",+    OPData 0x95 SWAP6 7 7 "Exchange 1st and 7nd stack items.",+    OPData 0x96 SWAP7 8 8 "Exchange 1st and 8nd stack items.",+    OPData 0x97 SWAP8 9 9 "Exchange 1st and 9nd stack items.",+    OPData 0x98 SWAP9 10 10 "Exchange 1st and 10nd stack items.",+    OPData 0x99 SWAP10 11 11 "Exchange 1st and 11nd stack items.",+    OPData 0x9a SWAP11 12 12 "Exchange 1st and 12nd stack items.",+    OPData 0x9b SWAP12 13 13 "Exchange 1st and 13nd stack items.",+    OPData 0x9c SWAP13 14 14 "Exchange 1st and 14nd stack items.",+    OPData 0x9d SWAP14 15 15 "Exchange 1st and 15nd stack items.",+    OPData 0x9e SWAP15 16 16 "Exchange 1st and 16nd stack items.",+    OPData 0x9f SWAP16 17 17 "Exchange 1st and 17nd stack items.",++    OPData 0xa0 LOG0 2 0 "Append log record with no topics.",+    OPData 0xa1 LOG1 3 0 "Append log record with one topic.",+    OPData 0xa2 LOG2 4 0 "Append log record with two topics.",+    OPData 0xa3 LOG3 5 0 "Append log record with three topics.",+    OPData 0xa4 LOG4 6 0 "Append log record with four topics.",++    OPData 0xf0 CREATE 3 1 "Create a new account with associated code.",+    OPData 0xf1 CALL 7 1 "Message-call into an account.",+    OPData 0xf2 CALLCODE 7 1 "Message-call into this account with alternate account's code.",+    OPData 0xf3 RETURN 2 0 "Halt execution returning output data.",+    OPData 0xf4 DELEGATECALL 7 1 "Message-call into this account with an alternative account’s code, but persisting the current values for sender and value.",+    OPData 0xfe INVALID 0 0 "Designated invalid instruction.",+    OPData 0xff SUICIDE 1 0 "Halt execution and register account for later deletion."+  ]+++op2CodeMap::M.Map Operation Word8+op2CodeMap=M.fromList $ (\(OPData code op _ _ _) -> (op, code)) <$> opDatas++code2OpMap::M.Map Word8 Operation+code2OpMap=M.fromList $ (\(OPData opcode op _ _ _) -> (opcode, op)) <$> opDatas++op2OpCode::Operation->[Word8]+op2OpCode (PUSH theList) | length theList <= 32 && not (null theList) =+  0x5F + fromIntegral (length theList):theList+op2OpCode (PUSH []) = error "PUSH needs at least one word"+op2OpCode (PUSH x) = error $ "PUSH can only take up to 32 words: " ++ show x+op2OpCode (DATA bytes) = B.unpack bytes+op2OpCode (MalformedOpcode byte) = [byte]+op2OpCode op =+  case M.lookup op op2CodeMap of+    Just x -> [x]+    Nothing -> error $ "op is missing in op2CodeMap: " ++ show op++opLen::Operation->Int+opLen (PUSH x) = 1 + length x+opLen _ = 1++opCode2Op::B.ByteString->(Operation, Word256)+opCode2Op rom | B.null rom = (STOP, 1) --according to the yellowpaper, should return STOP if outside of the code bytestring+opCode2Op rom =+  let opcode = B.head rom in --head OK, null weeded out above+  if opcode >= 0x60 && opcode <= 0x7f+  then (PUSH $ B.unpack $ safeTake (fromIntegral $ opcode-0x5F) $ B.tail rom, fromIntegral $ opcode - 0x5E)+  else+--    let op = fromMaybe (error $ "code is missing in code2OpMap: 0x" ++ showHex (B.head rom) "")+    let op = fromMaybe (MalformedOpcode opcode)+             $ M.lookup opcode code2OpMap in+    (op, 1)
+ src/Legacy/Haskoin/V0102/Network/Haskoin/Crypto/BigWord.hs view
@@ -0,0 +1,377 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE EmptyDataDecls #-}+module Legacy.Haskoin.V0102.Network.Haskoin.Crypto.BigWord+(+-- Useful type aliases+  TxHash+  , BlockHash+  , Word512+, Word256+, Word160+, Word128+, FieldP+, FieldN++-- Data types+, BigWord(..)+, BigWordMod(..)++-- Functions+, inverseP+, inverseN+, quadraticResidue+, isIntegerValidKey+, encodeTxHashLE+, decodeTxHashLE+, encodeBlockHashLE+, decodeBlockHashLE+) where++import Data.Bits+    ( Bits+    , (.&.), (.|.), xor+    , complement+    , shift, shiftL, shiftR+    , bit, testBit, bitSize+    , popCount, isSigned+    )+import Data.Binary (Binary, get, put)+import Data.Binary.Get+    ( getWord64be+    , getWord32be+    , getWord8+    , getByteString+    , Get+    )+import Data.Binary.Put+    ( putWord64be+    , putWord32be+    , putWord8+    , putByteString+    )+import Data.Aeson+    ( Value (String)+    , FromJSON+    , ToJSON+    , parseJSON+    , toJSON+    , withText+    )+import Control.DeepSeq (NFData, rnf)+import Control.Monad (unless, guard)+import Control.Applicative ((<$>))+import Data.Ratio (numerator, denominator)+import qualified Data.ByteString as BS (head, length, reverse)+import qualified Data.Text as T (pack, unpack)++import Legacy.Haskoin.V0102.Network.Haskoin.Crypto.Curve+import Legacy.Haskoin.V0102.Network.Haskoin.Crypto.NumberTheory+import Legacy.Haskoin.V0102.Network.Haskoin.Util++-- | Type representing a transaction hash.+type TxHash  = BigWord Mod256Tx+-- | Type representing a block hash.+type BlockHash = BigWord Mod256Block+-- | Data type representing a 512 bit unsigned integer.+-- It is implemented as an Integer modulo 2^512.+type Word512 = BigWord Mod512+-- | Data type representing a 256 bit unsigned integer.+-- It is implemented as an Integer modulo 2^256.+type Word256 = BigWord Mod256+-- | Data type representing a 160 bit unsigned integer.+-- It is implemented as an Integer modulo 2^160.+type Word160 = BigWord Mod160+-- | Data type representing a 128 bit unsigned integer.+-- It is implemented as an Integer modulo 2^128.+type Word128 = BigWord Mod128+-- | Data type representing an Integer modulo coordinate field order P.+type FieldP  = BigWord ModP+-- | Data type representing an Integer modulo curve order N.+type FieldN  = BigWord ModN++data Mod512+data Mod256+data Mod256Tx+data Mod256Block+data Mod160+data Mod128+data ModP+data ModN++newtype BigWord n = BigWord { getBigWordInteger :: Integer }+    deriving (Eq, Ord, Read, Show)++instance NFData (BigWord n) where+    rnf (BigWord n) = rnf n++inverseP :: FieldP -> FieldP+inverseP (BigWord i) = fromInteger $ mulInverse i curveP++inverseN :: FieldN -> FieldN+inverseN (BigWord i) = fromInteger $ mulInverse i curveN++class BigWordMod a where+    rFromInteger :: Integer -> BigWord a+    rBitSize     :: BigWord a -> Int++instance BigWordMod Mod512 where+    rFromInteger i = BigWord $ i `mod` 2 ^ (512 :: Int)+    rBitSize     _ = 512++instance BigWordMod Mod256 where+    rFromInteger i = BigWord $ i `mod` 2 ^ (256 :: Int)+    rBitSize     _ = 256++instance BigWordMod Mod256Tx where+    rFromInteger i = BigWord $ i `mod` 2 ^ (256 :: Int)+    rBitSize     _ = 256++instance BigWordMod Mod256Block where+    rFromInteger i = BigWord $ i `mod` 2 ^ (256 :: Int)+    rBitSize     _ = 256++instance BigWordMod Mod160 where+    rFromInteger i = BigWord $ i `mod` 2 ^ (160 :: Int)+    rBitSize     _ = 160++instance BigWordMod Mod128 where+    rFromInteger i = BigWord $ i `mod` 2 ^ (128 :: Int)+    rBitSize     _ = 128++instance BigWordMod ModP where+    rFromInteger i = BigWord $ i `mod` curveP+    rBitSize     _ = 256++instance BigWordMod ModN where+    rFromInteger i = BigWord $ i `mod` curveN+    rBitSize     _ = 256++instance BigWordMod n => Num (BigWord n) where+    fromInteger = rFromInteger+    (BigWord i1) + (BigWord i2) = fromInteger $ i1 + i2+    (BigWord i1) * (BigWord i2) = fromInteger $ i1 * i2+    negate (BigWord i) = fromInteger $ negate i+    abs r = r+    signum (BigWord i) = fromInteger $ signum i++instance BigWordMod n => Bits (BigWord n) where+    (BigWord i1) .&. (BigWord i2) = fromInteger $ i1 .&. i2+    (BigWord i1) .|. (BigWord i2) = fromInteger $ i1 .|. i2+    (BigWord i1) `xor` (BigWord i2) = fromInteger $ i1 `xor` i2+    complement (BigWord i) = fromInteger $ complement i+    shift (BigWord i) j = fromInteger $ shift i j+    bitSize = rBitSize+    testBit (BigWord i) = testBit i+    bit n = fromInteger $ bit n+    popCount (BigWord i) = popCount i+    isSigned _ = False++instance BigWordMod n => Bounded (BigWord n) where+    minBound = fromInteger 0+    maxBound = fromInteger (-1)++instance BigWordMod n => Real (BigWord n) where+    toRational (BigWord i) = toRational i++instance BigWordMod n => Enum (BigWord n) where+    succ r@(BigWord i)+        | r == maxBound = error "BigWord: tried to take succ of maxBound"+        | otherwise = fromInteger $ succ i+    pred r@(BigWord i)+        | r == minBound = error "BigWord: tried to take pred of minBound"+        | otherwise = fromInteger $ pred i+    toEnum i+        | toInteger i >= toInteger (minFrom r) &&+          toInteger i <= toInteger (maxFrom r) = r+        | otherwise = error "BigWord: toEnum is outside of bounds"+      where+        r = fromInteger $ toEnum i+        minFrom :: BigWordMod a => BigWord a -> BigWord a+        minFrom _ = minBound+        maxFrom :: BigWordMod a => BigWord a -> BigWord a+        maxFrom _ = maxBound+    fromEnum (BigWord i) = fromEnum i++instance BigWordMod n => Integral (BigWord n) where+    (BigWord i1) `quot` (BigWord i2) = fromInteger $ i1 `quot` i2+    (BigWord i1) `rem` (BigWord i2) = fromInteger $ i1 `rem` i2+    (BigWord i1) `div` (BigWord i2) = fromInteger $ i1 `div` i2+    (BigWord i1) `mod` (BigWord i2) = fromInteger $ i1 `mod` i2+    (BigWord i1) `quotRem` (BigWord i2) = (fromInteger a, fromInteger b)+      where+        (a,b) = i1 `quotRem` i2+    (BigWord i1) `divMod` (BigWord i2) = (fromInteger a, fromInteger b)+      where+        (a,b) = i1 `divMod` i2+    toInteger (BigWord i) = i++{- Fractional is only defined for prime orders -}++instance Fractional (BigWord ModP) where+    recip = inverseP+    fromRational r = fromInteger (numerator r) / fromInteger (denominator r)++instance Fractional (BigWord ModN) where+    recip = inverseN+    fromRational r = fromInteger (numerator r) / fromInteger (denominator r)++{- Binary instances for serialization / deserialization -}++instance Binary (BigWord Mod512) where+    get = do+        a <- fromIntegral <$> (get :: Get Word256)+        b <- fromIntegral <$> (get :: Get Word256)+        return $ (a `shiftL` 256) + b++    put (BigWord i) = do+        put $ (fromIntegral (i `shiftR` 256) :: Word256)+        put $ (fromIntegral i :: Word256)++instance Binary (BigWord Mod256) where+    get = do+        a <- fromIntegral <$> getWord64be+        b <- fromIntegral <$> getWord64be+        c <- fromIntegral <$> getWord64be+        d <- fromIntegral <$> getWord64be+        return $ (a `shiftL` 192) + (b `shiftL` 128) + (c `shiftL` 64) + d++    put (BigWord i) = do+        putWord64be $ fromIntegral (i `shiftR` 192)+        putWord64be $ fromIntegral (i `shiftR` 128)+        putWord64be $ fromIntegral (i `shiftR` 64)+        putWord64be $ fromIntegral i++instance Binary (BigWord Mod256Tx) where+    get = do+        a <- fromIntegral <$> getWord64be+        b <- fromIntegral <$> getWord64be+        c <- fromIntegral <$> getWord64be+        d <- fromIntegral <$> getWord64be+        return $ (a `shiftL` 192) + (b `shiftL` 128) + (c `shiftL` 64) + d++    put (BigWord i) = do+        putWord64be $ fromIntegral (i `shiftR` 192)+        putWord64be $ fromIntegral (i `shiftR` 128)+        putWord64be $ fromIntegral (i `shiftR` 64)+        putWord64be $ fromIntegral i++instance Binary (BigWord Mod256Block) where+    get = do+        a <- fromIntegral <$> getWord64be+        b <- fromIntegral <$> getWord64be+        c <- fromIntegral <$> getWord64be+        d <- fromIntegral <$> getWord64be+        return $ (a `shiftL` 192) + (b `shiftL` 128) + (c `shiftL` 64) + d++    put (BigWord i) = do+        putWord64be $ fromIntegral (i `shiftR` 192)+        putWord64be $ fromIntegral (i `shiftR` 128)+        putWord64be $ fromIntegral (i `shiftR` 64)+        putWord64be $ fromIntegral i++instance Binary (BigWord Mod160) where+    get = do+        a <- fromIntegral <$> getWord32be+        b <- fromIntegral <$> getWord64be+        c <- fromIntegral <$> getWord64be+        return $ (a `shiftL` 128) + (b `shiftL` 64) + c++    put (BigWord i) = do+        putWord32be $ fromIntegral (i `shiftR` 128)+        putWord64be $ fromIntegral (i `shiftR` 64)+        putWord64be $ fromIntegral i++instance Binary (BigWord Mod128) where+    get = do+        a <- fromIntegral <$> getWord64be+        b <- fromIntegral <$> getWord64be+        return $ (a `shiftL` 64) + b++    put (BigWord i) = do+        putWord64be $ fromIntegral (i `shiftR` 64)+        putWord64be $ fromIntegral i++-- DER encoding of a FieldN element as Integer+-- http://www.itu.int/ITU-T/studygroups/com17/languages/X.690-0207.pdf+instance Binary (BigWord ModN) where+    get = do+        t <- getWord8+        unless (t == 0x02) (fail $+            "Bad DER identifier byte " ++ (show t) ++ ". Expecting 0x02" )+        l <- getWord8+        i <- bsToInteger <$> getByteString (fromIntegral l)+        unless (isIntegerValidKey i) $ fail $+            "Invalid fieldN element: " ++ (show i)+        return $ fromInteger i++    put (BigWord 0) = error "0 is an invalid FieldN element to serialize"+    put (BigWord i) = do+        putWord8 0x02 -- Integer type+        let b = integerToBS i+            l = fromIntegral $ BS.length b+        if BS.head b >= 0x80+            then do+                putWord8 (l + 1)+                putWord8 0x00+            else do+                putWord8 l+        putByteString b++instance Binary (BigWord ModP) where++    -- Section 2.3.6 http://www.secg.org/download/aid-780/sec1-v2.pdf+    get = do+        (BigWord i) <- get :: Get Word256+        unless (i < curveP) (fail $ "Get: Integer not in FieldP: " ++ (show i))+        return $ fromInteger i++    -- Section 2.3.7 http://www.secg.org/download/aid-780/sec1-v2.pdf+    put r = put (fromIntegral r :: Word256)++instance ToJSON (BigWord Mod256Tx) where+    toJSON = String . T.pack . encodeTxHashLE++instance FromJSON (BigWord Mod256Tx) where+    parseJSON = withText "TxHash not a string: " $ \a -> do+        let s = T.unpack a+        maybe (fail $ "Not a TxHash: " ++ s) return $ decodeTxHashLE s++instance ToJSON (BigWord Mod256) where+    toJSON = String . T.pack . bsToHex . encode'++instance FromJSON (BigWord Mod256) where+    parseJSON = withText "Word256 not a string: " $ \a -> do+        let s = T.unpack a+        maybe (fail $ "Not a Word256: " ++ s) return $+            hexToBS s >>= decodeToMaybe++-- curveP = 3 (mod 4), thus Lagrange solutions apply+-- http://en.wikipedia.org/wiki/Quadratic_residue+quadraticResidue :: FieldP -> [FieldP]+quadraticResidue x = guard (y^(2 :: Int) == x) >> [y, (-y)]+  where+    q = (curveP + 1) `div` 4+    y = x^q++isIntegerValidKey :: Integer -> Bool+isIntegerValidKey i = i > 0 && i < curveN++-- | Encodes a 'TxHash' as little endian in HEX format. This is mostly used for+-- displaying transaction ids. Internally, these ids are handled as big endian+-- but are transformed to little endian when displaying them.+encodeTxHashLE :: TxHash -> String+encodeTxHashLE = bsToHex . BS.reverse .  encode'++-- | Decodes a little endian 'TxHash' in HEX format.+decodeTxHashLE :: String -> Maybe TxHash+decodeTxHashLE = (decodeToMaybe . BS.reverse =<<) . hexToBS++-- | Encodes a 'BlockHash' as little endian in HEX format. This is mostly used+-- for displaying Block hash ids. Internally, these ids are handled as big+-- endian but are transformed to little endian when displaying them.+encodeBlockHashLE :: BlockHash -> String+encodeBlockHashLE = bsToHex . BS.reverse .  encode'++-- | Decodes a little endian 'BlockHash' in HEX format.+decodeBlockHashLE :: String -> Maybe BlockHash+decodeBlockHashLE = (decodeToMaybe . BS.reverse =<<) . hexToBS
+ src/Legacy/Haskoin/V0102/Network/Haskoin/Crypto/Curve.hs view
@@ -0,0 +1,27 @@+module Legacy.Haskoin.V0102.Network.Haskoin.Crypto.Curve+(+  pairG+, curveP+, curveN+, integerB+, integerA+) where++-- SECP256k1 curve parameters++pairG :: (Integer, Integer)+pairG = ( 0x79be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798+        , 0X483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8+        )++curveP :: Integer+curveP = 0xfffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc2f++curveN :: Integer+curveN = 0xfffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141++integerB :: Integer+integerB = 7++integerA :: Integer+integerA = 0
+ src/Legacy/Haskoin/V0102/Network/Haskoin/Crypto/NumberTheory.hs view
@@ -0,0 +1,23 @@+module Legacy.Haskoin.V0102.Network.Haskoin.Crypto.NumberTheory+(+  extendedModGCD+, mulInverse+) where++-- Extended euclidean algorithm+-- Calculates the multiplicative inverse modulo p+extendedModGCD :: Integer -> Integer -> Integer -> (Integer, Integer)+extendedModGCD a b p+    | b == 0 = (1,0)+    | otherwise = (t, (s - q*t) `mod` p)+  where+    (q,r) = quotRem a b+    (s,t) = extendedModGCD b r p++-- Find multiplicative inverse of a : a*s = 1 (mod p)+mulInverse :: Integer -> Integer -> Integer+mulInverse a p+    | a*s `mod` p == 1 = s+    | otherwise = error "No multiplicative inverse (mod p) for a"+  where+    (s,_) = extendedModGCD a p p
+ src/Legacy/Haskoin/V0102/Network/Haskoin/Util.hs view
@@ -0,0 +1,309 @@+{-|+  This module defines various utility functions used across the+  Network.Haskoin modules.+-}+module Legacy.Haskoin.V0102.Network.Haskoin.Util+(+--   -- * ByteString helpers+  toStrictBS+  , toLazyBS+  , stringToBS+  , bsToString+, bsToInteger+, integerToBS+  , bsToHex+  , hexToBS++-- * Data.Binary helpers+, encode'+, decode'+, runPut'+, runGet'+, decodeOrFail'+, runGetOrFail'+, fromDecode+, fromRunGet+, decodeToEither+, decodeToMaybe+, isolate++--   -- * Maybe and Either monad helpers+-- , isLeft+-- , isRight+-- , fromRight+-- , fromLeft+-- , eitherToMaybe+-- , maybeToEither+-- -- , liftEither+-- -- , liftMaybe++--   -- * Various helpers+-- , updateIndex+-- , matchTemplate++--   -- Triples+-- , fst3+-- , snd3+-- , lst3++) where++import Numeric (readHex)+import Control.Applicative ((<$>))+import Control.Monad (guard)+-- -- import Control.Monad.Trans.Either (EitherT, hoistEither)++import Data.Word (Word8)+import Data.Bits ((.|.), shiftL, shiftR)+import Data.List (unfoldr)+import Data.List.Split (chunksOf)+import Data.Binary.Put (Put, runPut)+import Data.Binary+    ( Binary+    , encode+    , decode+    , decodeOrFail+    )+import Data.Binary.Get+    ( Get+    , runGetOrFail+    , getByteString+    , ByteOffset+    , runGet+    )++import qualified Data.ByteString.Lazy as BL+    ( ByteString+    , toChunks+    , fromChunks+    )+import qualified Data.ByteString as BS+    ( ByteString+    , concat+    , pack, unpack+    , null+    )+import qualified Data.ByteString.Builder as BSB+    ( toLazyByteString+    , byteStringHex+    )+import qualified Data.ByteString.Char8 as C+    ( pack+    , unpack+    )++-- ByteString helpers++-- | Transforms a lazy bytestring into a strict bytestring+toStrictBS :: BL.ByteString -> BS.ByteString+toStrictBS = BS.concat . BL.toChunks++-- | Transforms a strict bytestring into a lazy bytestring+toLazyBS :: BS.ByteString -> BL.ByteString+toLazyBS bs = BL.fromChunks [bs]++-- | Transforms a string into a strict bytestring+stringToBS :: String -> BS.ByteString+stringToBS = C.pack++-- | Transform a strict bytestring to a string+bsToString :: BS.ByteString -> String+bsToString = C.unpack++-- | Decode a big endian Integer from a bytestring+bsToInteger :: BS.ByteString -> Integer+bsToInteger = (foldr f 0) . reverse . BS.unpack+  where+    f w n = (toInteger w) .|. shiftL n 8++-- | Encode an Integer to a bytestring as big endian+integerToBS :: Integer -> BS.ByteString+integerToBS 0 = BS.pack [0]+integerToBS i+    | i > 0     = BS.pack $ reverse $ unfoldr f i+    | otherwise = error "integerToBS not defined for negative values"+  where+    f 0 = Nothing+    f x = Just $ (fromInteger x :: Word8, x `shiftR` 8)++-- | Encode a bytestring to a base16 (HEX) representation+bsToHex :: BS.ByteString -> String+bsToHex = bsToString . toStrictBS . BSB.toLazyByteString . BSB.byteStringHex++-- | Decode a base16 (HEX) string from a bytestring. This function can fail+-- if the string contains invalid HEX characters+hexToBS :: String -> Maybe BS.ByteString+hexToBS xs = BS.pack <$> mapM hexWord (chunksOf 2 xs)+  where+    hexWord x = do+        guard $ length x == 2+        let hs = readHex x+        guard $ not $ null hs+        let [(w, s)] = hs+        guard $ null s+        return w++-- Data.Binary helpers++-- | Strict version of @Data.Binary.encode@+encode' :: Binary a => a -> BS.ByteString+encode' = toStrictBS . encode++-- | Strict version of @Data.Binary.decode@+decode' :: Binary a => BS.ByteString -> a+decode' = decode . toLazyBS++-- | Strict version of @Data.Binary.runGet@+runGet' :: Binary a => Get a -> BS.ByteString -> a+runGet' m = (runGet m) . toLazyBS++-- | Strict version of @Data.Binary.runPut@+runPut' :: Put -> BS.ByteString+runPut' = toStrictBS . runPut++-- | Strict version of @Data.Binary.decodeOrFail@+decodeOrFail' ::+    Binary a =>+    BS.ByteString ->+    Either (BS.ByteString, ByteOffset, String) (BS.ByteString, ByteOffset, a)+decodeOrFail' bs = case decodeOrFail $ toLazyBS bs of+    Left  (lbs,o,err) -> Left  (toStrictBS lbs,o,err)+    Right (lbs,o,res) -> Right (toStrictBS lbs,o,res)++-- | Strict version of @Data.Binary.runGetOrFail@+runGetOrFail' ::+    Binary a => Get a -> BS.ByteString ->+    Either (BS.ByteString, ByteOffset, String) (BS.ByteString, ByteOffset, a)+runGetOrFail' m bs = case runGetOrFail m $ toLazyBS bs of+    Left  (lbs,o,err) -> Left  (toStrictBS lbs,o,err)+    Right (lbs,o,res) -> Right (toStrictBS lbs,o,res)++-- | Try to decode a Data.Binary value. If decoding succeeds, apply the function+-- to the result. Otherwise, return the default value.+fromDecode :: Binary a+           => BS.ByteString -- ^ The bytestring to decode+           -> b             -- ^ Default value to return when decoding fails+           -> (a -> b)      -- ^ Function to apply when decoding succeeds+           -> b             -- ^ Final result+fromDecode bs def f = either (const def) (f . lst) $ decodeOrFail' bs+  where+    lst (_,_,c) = c++-- | Try to run a Data.Binary.Get monad. If decoding succeeds, apply a function+-- to the result. Otherwise, return the default value.+fromRunGet :: Binary a+           => Get a         -- ^ The Get monad to run+           -> BS.ByteString -- ^ The bytestring to decode+           -> b             -- ^ Default value to return when decoding fails+           -> (a -> b)      -- ^ Function to apply when decoding succeeds+           -> b             -- ^ Final result+fromRunGet m bs def f = either (const def) (f . lst) $ runGetOrFail' m bs+  where+    lst (_,_,c) = c++-- | Decode a Data.Binary value into the Either monad. A Right value is returned+-- with the result upon success. Otherwise a Left value with the error message+-- is returned.+decodeToEither :: Binary a => BS.ByteString -> Either String a+decodeToEither bs = case decodeOrFail' bs of+    Left  (_,_,err) -> Left err+    Right (_,_,res) -> Right res++-- | Decode a Data.Binary value into the Maybe monad. A Just value is returned+-- with the result upon success. Otherwise, Nothing is returned.+decodeToMaybe :: Binary a => BS.ByteString -> Maybe a+decodeToMaybe bs = fromDecode bs Nothing Just++-- | Isolate a Data.Binary.Get monad for the next @Int@ bytes. Only the next+-- @Int@ bytes of the input bytestring will be available for the Get monad to+-- consume. This function will fail if the Get monad fails or some of the input+-- is not consumed.+isolate :: Binary a => Int -> Get a -> Get a+isolate i g = do+    bs <- getByteString i+    case runGetOrFail' g bs of+        Left (_, _, err) -> fail err+        Right (unconsumed, _, res)+            | BS.null unconsumed -> return res+            | otherwise          -> fail "Isolate: unconsumed input"++-- -- Maybe and Eithre monad helpers++-- -- | Returns True if the Either value is Right+-- isRight :: Either a b -> Bool+-- isRight (Right _) = True+-- isRight _         = False++-- -- | Returns True if the Either value is Left+-- isLeft :: Either a b -> Bool+-- isLeft = not . isRight++-- -- | Extract the Right value from an Either value. Fails if the value is Left+-- fromRight :: Either a b -> b+-- fromRight (Right b) = b+-- fromRight _ = error "Either.fromRight: Left"++-- -- | Extract the Left value from an Either value. Fails if the value is Right+-- fromLeft :: Either a b -> a+-- fromLeft (Left a) = a+-- fromLeft _ = error "Either.fromLeft: Right"++-- -- | Transforms an Either value into a Maybe value. Right is mapped to Just+-- -- and Left is mapped to Nothing. The value inside Left is lost.+-- eitherToMaybe :: Either a b -> Maybe b+-- eitherToMaybe (Right b) = Just b+-- eitherToMaybe _ = Nothing++-- -- | Transforms a Maybe value into an Either value. Just is mapped to Right and+-- -- Nothing is mapped to Left. You also pass in an error value in case Left is+-- -- returned.+-- maybeToEither :: b -> Maybe a -> Either b a+-- maybeToEither err m = maybe (Left err) Right m++-- -- -- | Lift a Either computation into the EitherT monad+-- -- liftEither :: Monad m => Either b a -> EitherT b m a+-- -- liftEither = hoistEither++-- -- -- | Lift a Maybe computation into the EitherT monad+-- -- liftMaybe :: Monad m => b -> Maybe a -> EitherT b m a+-- -- liftMaybe err = liftEither . (maybeToEither err)++-- -- Various helpers++-- -- | Applies a function to only one element of a list defined by it's index.+-- -- If the index is out of the bounds of the list, the original list is returned.+-- updateIndex :: Int      -- ^ The index of the element to change+--             -> [a]      -- ^ The list of elements+--             -> (a -> a) -- ^ The function to apply+--             -> [a]      -- ^ The result with one element changed+-- updateIndex i xs f+--     | i < 0 || i >= length xs = xs+--     | otherwise = l ++ (f h : r)+--   where+--     (l,h:r) = splitAt i xs++-- -- | Use the list [b] as a template and try to match the elements of [a]+-- -- against it. For each element of [b] return the (first) matching element of+-- -- [a], or Nothing. Output list has same size as [b] and contains results in+-- -- same order. Elements of [a] can only appear once.+-- matchTemplate :: [a]              -- ^ The input list+--               -> [b]              -- ^ The list to serve as a template+--               -> (a -> b -> Bool) -- ^ The comparison function+--               -> [Maybe a]        -- ^ Results of the template matching+-- matchTemplate [] bs _ = replicate (length bs) Nothing+-- matchTemplate _  [] _ = []+-- matchTemplate as (b:bs) f = case break (flip f b) as of+--     (l,(r:rs)) -> (Just r) : matchTemplate (l ++ rs) bs f+--     _          -> Nothing  : matchTemplate as bs f++-- -- | Returns the first value of a triple.+-- fst3 :: (a,b,c) -> a+-- fst3 (a,_,_) = a++-- -- | Returns the second value of a triple.+-- snd3 :: (a,b,c) -> b+-- snd3 (_,b,_) = b++-- -- | Returns the last value of a triple.+-- lst3 :: (a,b,c) -> c+-- lst3 (_,_,c) = c