diff --git a/ethereum-analyzer-deps.cabal b/ethereum-analyzer-deps.cabal --- a/ethereum-analyzer-deps.cabal +++ b/ethereum-analyzer-deps.cabal @@ -1,5 +1,5 @@ name: ethereum-analyzer-deps -version: 1.3.0 +version: 2.0.0 cabal-version: >=1.10 build-type: Simple author: Jamshid @@ -15,7 +15,7 @@ type: git location: https://github.com/zchn/ethereum-analyzer branch: master - tag: v1.3.0 + tag: v2.0.0 library default-language: Haskell98 diff --git a/src/Blockchain/Colors.hs b/src/Blockchain/Colors.hs --- a/src/Blockchain/Colors.hs +++ b/src/Blockchain/Colors.hs @@ -51,5 +51,4 @@ white2 string = "\ESC[38m" ++ string ++ "\ESC[0m" setTitle :: String -> IO () -setTitle value = do - putStr $ "\ESC]0;" ++ value ++ "\007" +setTitle value = putStr $ "\ESC]0;" ++ value ++ "\007" diff --git a/src/Blockchain/Data/RLP.hs b/src/Blockchain/Data/RLP.hs --- a/src/Blockchain/Data/RLP.hs +++ b/src/Blockchain/Data/RLP.hs @@ -19,16 +19,16 @@ import qualified Data.ByteString.Char8 as BC import Data.ByteString.Internal import Data.Word -import Text.PrettyPrint.ANSI.Leijen hiding ((<$>)) import Numeric +import Text.PrettyPrint.ANSI.Leijen hiding ((<$>)) 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. +-- 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 @@ -36,7 +36,7 @@ deriving (Show, Eq, Ord) -- | Converts objects to and from 'RLPObject's. -class RLPSerializable a where +class RLPSerializable a where rlpDecode :: RLPObject -> a rlpEncode :: a -> RLPObject @@ -56,7 +56,8 @@ getLength :: Int -> B.ByteString -> (Integer, B.ByteString) getLength sizeOfLength bytes = - (bytes2Integer $ B.unpack $ B.take sizeOfLength bytes, B.drop sizeOfLength bytes) + ( bytes2Integer $ B.unpack $ B.take sizeOfLength bytes + , B.drop sizeOfLength bytes) rlpSplit :: B.ByteString -> (RLPObject, B.ByteString) rlpSplit input = @@ -70,7 +71,8 @@ | x >= 0xF8 && x <= 0xFF -> let (arrLength, restAfterLen) = getLength (fromIntegral x - 0xF7) $ B.tail input - (arrayData, nextRest) = splitAtWithError (fromIntegral arrLength) restAfterLen + (arrayData, nextRest) = + splitAtWithError (fromIntegral arrLength) restAfterLen in (RLPArray $ getRLPObjects arrayData, nextRest) x | x >= 128 && x <= 128 + 55 -> @@ -81,7 +83,8 @@ | x >= 0xB8 && x <= 0xBF -> let (strLength, restAfterLen) = getLength (fromIntegral x - 0xB7) $ B.tail input - (strList, nextRest) = splitAtWithError (fromIntegral strLength) restAfterLen + (strList, nextRest) = + splitAtWithError (fromIntegral strLength) restAfterLen in (RLPString strList, nextRest) x | x < 128 -> (RLPScalar x, B.tail input) diff --git a/src/Blockchain/Format.hs b/src/Blockchain/Format.hs --- a/src/Blockchain/Format.hs +++ b/src/Blockchain/Format.hs @@ -5,12 +5,12 @@ ) where import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Base16 as B16 +import qualified Data.ByteString.Char8 as BC import Blockchain.ExtWord -class Format a where +class Format a where format :: a -> String instance Format B.ByteString where diff --git a/src/Blockchain/Output.hs b/src/Blockchain/Output.hs --- a/src/Blockchain/Output.hs +++ b/src/Blockchain/Output.hs @@ -7,10 +7,9 @@ printLogMsg :: Loc -> LogSource -> LogLevel -> LogStr -> IO () --printLogMsg loc logSource level msg = do -printLogMsg _ _ _ msg = do - lock $ putStrLn $ BC.unpack $ fromLogStr msg +printLogMsg _ _ _ msg = lock $ putStrLn $ BC.unpack $ fromLogStr msg printToFile :: FilePath -> Loc -> LogSource -> LogLevel -> LogStr -> IO () --printLogMsg loc logSource level msg = do -printToFile path _ _ _ msg = do +printToFile path _ _ _ msg = lock $ appendFile path $ BC.unpack (fromLogStr msg) ++ "\n" diff --git a/src/Blockchain/Util.hs b/src/Blockchain/Util.hs --- a/src/Blockchain/Util.hs +++ b/src/Blockchain/Util.hs @@ -4,7 +4,6 @@ import qualified Data.ByteString as B import Data.ByteString.Internal import Data.Char -import Data.List import Data.Word import Numeric @@ -15,7 +14,7 @@ where rawOutput = showHex i "" -showHexU :: Integer -> [Char] +showHexU :: Integer -> String showHexU = map toUpper . flip showHex "" --I hate this, it is an ugly way to create an Integer from its component bytes. @@ -84,8 +83,7 @@ showMem p x = padZeros 4 (showHex p "") ++ " " ++ - (showWord8 <$> x) ++ - " " ++ intercalate " " (padZeros 2 <$> flip showHex "" <$> x) + (showWord8 <$> x) ++ " " ++ unwords (padZeros 2 . flip showHex "" <$> x) safeTake :: Word256 -> B.ByteString -> B.ByteString safeTake i _ diff --git a/src/Blockchain/VM/Code.hs b/src/Blockchain/VM/Code.hs --- a/src/Blockchain/VM/Code.hs +++ b/src/Blockchain/VM/Code.hs @@ -6,9 +6,9 @@ import Numeric import Text.PrettyPrint.ANSI.Leijen -import Blockchain.ExtWord import qualified Blockchain.Colors as CL import Blockchain.Data.Code +import Blockchain.ExtWord import Blockchain.Format import Blockchain.Util import Blockchain.VM.Opcodes diff --git a/src/Blockchain/VM/Opcodes.hs b/src/Blockchain/VM/Opcodes.hs --- a/src/Blockchain/VM/Opcodes.hs +++ b/src/Blockchain/VM/Opcodes.hs @@ -287,7 +287,8 @@ op2CodeMap = M.fromList $ (\(OPData code op _ _ _) -> (op, code)) <$> opDatas code2OpMap :: M.Map Word8 Operation -code2OpMap = M.fromList $ (\(OPData opcode op _ _ _) -> (opcode, op)) <$> opDatas +code2OpMap = + M.fromList $ (\(OPData opcode op _ _ _) -> (opcode, op)) <$> opDatas op2OpCode :: Operation -> [Word8] op2OpCode (PUSH theList) @@ -316,5 +317,7 @@ B.unpack $ safeTake (fromIntegral $ opcode - 0x5F) $ B.tail rom , fromIntegral $ opcode - 0x5E) -- let op = fromMaybe (error $ "code is missing in code2OpMap: 0x" ++ showHex (B.head rom) "") - else let op = fromMaybe (MalformedOpcode opcode) $ M.lookup opcode code2OpMap + else let op = + fromMaybe (MalformedOpcode opcode) $ + M.lookup opcode code2OpMap in (op, 1) diff --git a/src/Legacy/Haskoin/V0102/Network/Haskoin/Crypto/BigWord.hs b/src/Legacy/Haskoin/V0102/Network/Haskoin/Crypto/BigWord.hs --- a/src/Legacy/Haskoin/V0102/Network/Haskoin/Crypto/BigWord.hs +++ b/src/Legacy/Haskoin/V0102/Network/Haskoin/Crypto/BigWord.hs @@ -22,23 +22,24 @@ , decodeBlockHashLE ) where +import Control.DeepSeq (NFData, rnf) +import Control.Monad (unless, guard) +import Data.Aeson + (Value(String), FromJSON, ToJSON, parseJSON, toJSON, withText) +import Data.Binary (Binary, get, put) +import Data.Binary.Get + (getWord64be, getWord32be, getWord8, getByteString, Get) +import Data.Binary.Put + (putWord64be, putWord32be, putWord8, putByteString) + -- Useful type aliases -- Data types -- Functions 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 Data.Ratio (numerator, denominator) import qualified Data.ByteString as BS (head, length, reverse) +import Data.Ratio (numerator, denominator) import qualified Data.Text as T (pack, unpack) import Legacy.Haskoin.V0102.Network.Haskoin.Crypto.Curve @@ -102,7 +103,7 @@ inverseN :: FieldN -> FieldN inverseN (BigWord i) = fromInteger $ mulInverse i curveN -class BigWordMod a where +class BigWordMod a where rFromInteger :: Integer -> BigWord a rBitSize :: BigWord a -> Int @@ -162,7 +163,7 @@ instance BigWordMod n => Bounded (BigWord n) where - minBound = fromInteger 0 + minBound = 0 maxBound = fromInteger (-1) instance BigWordMod n => @@ -223,8 +224,8 @@ b <- fromIntegral <$> (get :: Get Word256) return $ (a `shiftL` 256) + b put (BigWord i) = do - put $ (fromIntegral (i `shiftR` 256) :: Word256) - put $ (fromIntegral i :: Word256) + put (fromIntegral (i `shiftR` 256) :: Word256) + put (fromIntegral i :: Word256) instance Binary (BigWord Mod256) where get = do @@ -292,10 +293,10 @@ t <- getWord8 unless (t == 0x02) - (fail $ "Bad DER identifier byte " ++ (show t) ++ ". Expecting 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) + 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 @@ -306,8 +307,7 @@ then do putWord8 (l + 1) putWord8 0x00 - else do - putWord8 l + else putWord8 l putByteString b instance Binary (BigWord ModP) @@ -315,7 +315,7 @@ where get = do (BigWord i) <- get :: Get Word256 - unless (i < curveP) (fail $ "Get: Integer not in FieldP: " ++ (show i)) + 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) @@ -325,8 +325,7 @@ instance FromJSON (BigWord Mod256Tx) where parseJSON = - withText "TxHash not a string: " $ - \a -> do + withText "TxHash not a string: " $ \a -> do let s = T.unpack a maybe (fail $ "Not a TxHash: " ++ s) return $ decodeTxHashLE s @@ -335,15 +334,14 @@ instance FromJSON (BigWord Mod256) where parseJSON = - withText "Word256 not a string: " $ - \a -> do + 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)] +quadraticResidue x = guard (y ^ (2 :: Int) == x) >> [y, -y] where q = (curveP + 1) `div` 4 y = x ^ q diff --git a/src/Legacy/Haskoin/V0102/Network/Haskoin/Crypto/Curve.hs b/src/Legacy/Haskoin/V0102/Network/Haskoin/Crypto/Curve.hs --- a/src/Legacy/Haskoin/V0102/Network/Haskoin/Crypto/Curve.hs +++ b/src/Legacy/Haskoin/V0102/Network/Haskoin/Crypto/Curve.hs @@ -9,7 +9,8 @@ -- SECP256k1 curve parameters pairG :: (Integer, Integer) pairG = - (0x79be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798, 0X483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8) + ( 0x79be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798 + , 0X483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8) curveP :: Integer curveP = 0xfffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc2f diff --git a/src/Legacy/Haskoin/V0102/Network/Haskoin/Util.hs b/src/Legacy/Haskoin/V0102/Network/Haskoin/Util.hs --- a/src/Legacy/Haskoin/V0102/Network/Haskoin/Util.hs +++ b/src/Legacy/Haskoin/V0102/Network/Haskoin/Util.hs @@ -24,44 +24,24 @@ , isolate ) where --- -- * ByteString helpers --- * Data.Binary helpers --- -- * Maybe and Either monad helpers --- , isLeft --- , isRight --- , fromRight --- , fromLeft --- , eitherToMaybe --- , maybeToEither --- -- , liftEither --- -- , liftMaybe --- -- * Various helpers --- , updateIndex --- , matchTemplate --- -- Triples --- , fst3 --- , snd3 --- , lst3 -import Numeric (readHex) 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 Numeric (readHex) + import Data.Binary (Binary, encode, decode, decodeOrFail) import Data.Binary.Get (Get, runGetOrFail, getByteString, ByteOffset, runGet) +import Data.Binary.Put (Put, runPut) +import Data.Bits ((.|.), shiftL, shiftR) +import Data.List (unfoldr) +import Data.List.Split (chunksOf) -import qualified Data.ByteString.Lazy as BL - (ByteString, toChunks, fromChunks) +import Data.Word (Word8) + 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) +import qualified Data.ByteString.Char8 as C +import qualified Data.ByteString.Lazy as BL -- ByteString helpers -- | Transforms a lazy bytestring into a strict bytestring @@ -82,9 +62,9 @@ -- | Decode a big endian Integer from a bytestring bsToInteger :: BS.ByteString -> Integer -bsToInteger = (foldr f 0) . reverse . BS.unpack +bsToInteger = foldr f 0 . reverse . BS.unpack where - f w n = (toInteger w) .|. shiftL n 8 + f w n = toInteger w .|. shiftL n 8 -- | Encode an Integer to a bytestring as big endian integerToBS :: Integer -> BS.ByteString @@ -94,7 +74,7 @@ | otherwise = error "integerToBS not defined for negative values" where f 0 = Nothing - f x = Just $ (fromInteger x :: Word8, x `shiftR` 8) + f x = Just (fromInteger x :: Word8, x `shiftR` 8) -- | Encode a bytestring to a base16 (HEX) representation bsToHex :: BS.ByteString -> String @@ -130,7 +110,7 @@ runGet' :: Binary a => Get a -> BS.ByteString -> a -runGet' m = (runGet m) . toLazyBS +runGet' m = runGet m . toLazyBS -- | Strict version of @Data.Binary.runPut@ runPut' :: Put -> BS.ByteString @@ -214,69 +194,3 @@ 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