haskoin-util (empty) → 0.0.1
raw patch · 10 files changed
+654/−0 lines, 10 filesdep +HUnitdep +QuickCheckdep +basesetup-changed
Dependencies added: HUnit, QuickCheck, base, binary, bytestring, containers, either, mtl, test-framework, test-framework-hunit, test-framework-quickcheck2
Files
- Network/Haskoin/Util.hs +288/−0
- Network/Haskoin/Util/Arbitrary.hs +43/−0
- Network/Haskoin/Util/BuildMonad.hs +139/−0
- Network/Haskoin/Util/Network.hs +28/−0
- Network/Haskoin/Util/Network/Prodnet.hs +33/−0
- Network/Haskoin/Util/Network/Testnet.hs +33/−0
- Setup.hs +2/−0
- UNLICENSE +24/−0
- haskoin-util.cabal +56/−0
- tests/Main.hs +8/−0
+ Network/Haskoin/Util.hs view
@@ -0,0 +1,288 @@+{-|+ This module defines various utility functions used across the + Network.Haskoin modules.+-}+module 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++ -- * Various helpers+, updateIndex+, matchTemplate++) where++import Numeric (showHex, readHex)+import Control.Monad (liftM2)++import Data.Char (ord, chr)+import Data.Word (Word8)+import Data.Bits ((.|.), shiftL, shiftR)+import Data.List (unfoldr)+import Data.Binary + ( Binary+ , encode+ , decode+ , decodeOrFail+ )+import Data.Binary.Get+ ( Get+ , runGetOrFail+ , getByteString+ , ByteOffset+ , runGet+ )+import Data.Binary.Put (Put, runPut)++import qualified Data.ByteString.Lazy as BL + ( ByteString+ , toChunks+ , fromChunks+ )+import qualified Data.ByteString as BS + ( ByteString+ , concat+ , pack, unpack+ , append+ , length+ , cons+ , span+ , replicate+ , empty+ , null+ )++-- 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 s = BS.pack $ map (fromIntegral . ord) s++-- | Transform a strict bytestring to a string+bsToString :: BS.ByteString -> String+bsToString bs = map (chr . fromIntegral) (BS.unpack bs)++-- | 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 bs + | BS.null bs = ""+ | otherwise = bsToString $ z2 `BS.append` r2+ where + (z,r) = BS.span (== 0) bs+ z2 = BS.replicate (BS.length z * 2) 48+ r1 | BS.null r = BS.empty+ | otherwise = stringToBS $ showHex (bsToInteger r) ""+ r2 | odd (BS.length r1) = BS.cons 48 r1+ | otherwise = r1++-- | 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 str+ | null str = Just BS.empty+ | otherwise = liftM2 BS.append (Just z2) r2+ where + (z,r) = span (== '0') str+ z2 = BS.replicate (length z `div` 2) 0+ r1 = readHex r+ r2 | null r = Just BS.empty+ | null r1 = Nothing+ | otherwise = Just $ integerToBS $ fst $ head r1++-- 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++-- 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.+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+
+ Network/Haskoin/Util/Arbitrary.hs view
@@ -0,0 +1,43 @@+{-|+ QuickCheck Arbitrary instances for various utility data types+-}+module Network.Haskoin.Util.Arbitrary (nonEmptyBS) where++import Test.QuickCheck + ( Arbitrary+ , Gen+ , arbitrary+ , choose+ , oneof+ )+import qualified Data.ByteString as BS + ( ByteString+ , pack+ , drop+ , null+ )++import Control.Applicative++import Network.Haskoin.Util.BuildMonad (Build(..))++-- Arbitrary instance for strict ByteStrings+instance Arbitrary BS.ByteString where+ arbitrary = do+ bs <- BS.pack `fmap` arbitrary+ n <- choose (0, 2)+ return $ BS.drop n bs -- to give us some with non-0 offset++-- | Generate non-empty strict ByteStrings+nonEmptyBS :: Gen BS.ByteString+nonEmptyBS = do+ bs <- arbitrary+ return $ if BS.null bs then BS.pack [0] else bs++-- Arbitrary instance for the Build monad+instance Arbitrary a => Arbitrary (Build a) where+ arbitrary = oneof [ Complete <$> arbitrary+ , Partial <$> arbitrary+ , return $ Broken "Arbitrary: Broken"+ ]+
+ Network/Haskoin/Util/BuildMonad.hs view
@@ -0,0 +1,139 @@+{-|+ The Build type, and associated operations.+-}+module Network.Haskoin.Util.BuildMonad +( -- *Build monad+ Build(..)+, isComplete+, isPartial+, isBroken+, eitherToBuild+, buildToEither+, guardPartial++ -- *BuildT transformer monad+, BuildT(..)+, liftBuild+) where++import Control.Monad (liftM)+import Control.Monad.Trans + ( MonadTrans+ , MonadIO+ , lift+ , liftIO+ )++{-|+ The Build monad represents computations that can be in one of three states:+ + * Complete++ * Partial++ * Broken++ It extends the Either monad with an additional Partial value to describe a+ valid computation flagged with a Partial context. The Build monad is useful+ when you describe computations where parts of the computation are either+ complete, partially complete or broken. Combining only Complete computations+ will produce a Complete result. However, if one of the computations is+ Partial, the whole computation will be Partial as well. And if some+ computation is Broken, the whole computation will be broken as well.++ The Build monad is used by Haskoin to describe the state of the transaction+ signing computation. To sign a transaction, all input scripts need to be + signed. The whole transaction will be completely signed only if all the+ input scripts are completely signed. If any of the inputs is partially signed,+ then the whole transaction will be partially signed as well. And the whole+ transaction is broken if one of the inputs failed to parse or is broken.+-}+data Build a + -- | Describes a successful complete computation+ = Complete { runBuild :: a } + -- | Describes a successful but partial computation+ | Partial { runBuild :: a }+ -- | Describes a broken computation+ | Broken { runBroken :: String }+ deriving Eq++instance Show a => Show (Build a) where+ show (Complete a) = "Complete " ++ (show a)+ show (Partial a) = "Partial " ++ (show a)+ show (Broken str) = "Broken " ++ str++instance Functor Build where+ fmap f (Complete x) = Complete (f x)+ fmap f (Partial x) = Partial (f x)+ fmap _ (Broken s) = Broken s++instance Monad Build where+ return = Complete+ Complete x >>= f = f x+ Partial x >>= f = case f x of+ e@(Broken _) -> e+ a -> Partial $ runBuild a+ Broken s >>= _ = Broken s++-- | Returns True if the Build value is Complete+isComplete :: Build a -> Bool+isComplete (Complete _) = True+isComplete _ = False++-- | Returns True if the Build value is Partial+isPartial :: Build a -> Bool+isPartial (Partial _) = True+isPartial _ = False++-- | Return True if the Build value is Broken+isBroken :: Build a -> Bool+isBroken (Broken _) = True+isBroken _ = False++-- | Transforms an Either String value into a Build value. Right is mapped to+-- Complete and Left is mapped to Broken+eitherToBuild :: Either String a -> Build a+eitherToBuild m = case m of+ Left err -> Broken err + Right res -> Complete res++-- | Transforms a Build value into an Either String value. Complete and Partial+-- are mapped to Right and Broken is mapped to Left.+buildToEither :: Build a -> Either String a+buildToEither m = case m of+ Complete a -> Right a+ Partial a -> Right a+ Broken err -> Left err++-- | Binds a Partial value to the computation when the predicate is False.+guardPartial :: Bool -> Build ()+guardPartial True = Complete ()+guardPartial False = Partial ()++-- | BuildT transformer monad+newtype BuildT m a = BuildT { runBuildT :: m (Build a) }++mapBuildT :: (m (Build a) -> n (Build b)) -> BuildT m a -> BuildT n b+mapBuildT f = BuildT . f . runBuildT++instance Functor m => Functor (BuildT m) where+ fmap f = mapBuildT (fmap (fmap f))++instance Monad m => Monad (BuildT m) where+ return = lift . return+ x >>= f = BuildT $ do+ v <- runBuildT x+ case v of Complete a -> runBuildT (f a)+ Partial a -> runBuildT (f a)+ Broken str -> return $ Broken str++instance MonadTrans BuildT where+ lift = BuildT . liftM Complete++instance MonadIO m => MonadIO (BuildT m) where+ liftIO = lift . liftIO++-- | Lift a Build computation into the BuildT monad+liftBuild :: Monad m => Build a -> BuildT m a+liftBuild = BuildT . return+
+ Network/Haskoin/Util/Network.hs view
@@ -0,0 +1,28 @@+{-|+ Declaration of constant values that depend on the network type+ (for example: prodnet or testnet). The values exported from this modules+ are imported from a network-specific sub-module.+-}+module Network.Haskoin.Util.Network +( -- $doc+ addrPrefix+, scriptPrefix+, secretPrefix+, extPubKeyPrefix+, extSecretPrefix+, walletFile+) where++import Network.Haskoin.Util.Network.Prodnet+--import Network.Haskoin.Util.Network.Testnet++-- $doc+-- The network-specific values are defined in one of the sub-modules:+--+-- * @Network.Haskoin.Util.Network.Prodnet@ +--+-- * @Network.Haskoin.Util.Network.Testnet@+--+-- You must import the module for the network you are interested in and compile+-- the libraries against it.+
+ Network/Haskoin/Util/Network/Prodnet.hs view
@@ -0,0 +1,33 @@+{-|+ Declaration of constant values for Prodnet. This module is intended to be+ imported by Network.Haskoin.Util.Network module and not imported directly by+ other modules.+-}+module Network.Haskoin.Util.Network.Prodnet where++import Data.Word (Word8,Word32)++-- | Prefix for base58 PubKey hash address+addrPrefix :: Word8+addrPrefix = 0++-- | Prefix for base58 script hash address+scriptPrefix :: Word8+scriptPrefix = 5++-- | Prefix for private key WIF format+secretPrefix :: Word8+secretPrefix = 128++-- | Prefix for extended public keys (BIP32)+extPubKeyPrefix :: Word32+extPubKeyPrefix = 0x0488b21e++-- | Prefix for extended private keys (BIP32)+extSecretPrefix :: Word32+extSecretPrefix = 0x0488ade4++-- | Wallet database file name+walletFile :: String+walletFile = "walletdb"+
+ Network/Haskoin/Util/Network/Testnet.hs view
@@ -0,0 +1,33 @@+{-|+ Declaration of constant values for Testnet. This module is intended to be+ imported by Network.Haskoin.Util.Network module and not imported directly by+ other modules.+-}+module Network.Haskoin.Util.Network.Testnet where++import Data.Word (Word8,Word32)++-- | Prefix for base58 PubKey hash address+addrPrefix :: Word8+addrPrefix = 111++-- | Prefix for base58 script hash address+scriptPrefix :: Word8+scriptPrefix = 196++-- | Prefix for private key WIF format+secretPrefix :: Word8+secretPrefix = 239++-- | Prefix for extended public keys (BIP32)+extPubKeyPrefix :: Word32+extPubKeyPrefix = 0x043587cf++-- | Prefix for extended private keys (BIP32)+extSecretPrefix :: Word32+extSecretPrefix = 0x04358394++-- | Wallet database file name+walletFile :: String+walletFile = "testwalletdb"+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ UNLICENSE view
@@ -0,0 +1,24 @@+This is free and unencumbered software released into the public domain.++Anyone is free to copy, modify, publish, use, compile, sell, or+distribute this software, either in source code form or as a compiled+binary, for any purpose, commercial or non-commercial, and by any+means.++In jurisdictions that recognize copyright laws, the author or authors+of this software dedicate any and all copyright interest in the+software to the public domain. We make this dedication for the benefit+of the public at large and to the detriment of our heirs and+successors. We intend this dedication to be an overt act of+relinquishment in perpetuity of all present and future rights to this+software under copyright law.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.++For more information, please refer to <http://unlicense.org/>
+ haskoin-util.cabal view
@@ -0,0 +1,56 @@+name: haskoin-util+version: 0.0.1+synopsis: Utility functions for the Network.Haskoin project+description: + This package contains utility functions used across the Network.Haskoin+ modules such as ByteString and Data.Binary helpers. It also defines a Build+ monad describing computations that can be Complete, Partial or Broken.+ Additionally, this package defines constants tied to specific Bitcoin+ networks such as prodnet and testnet.+homepage: http://github.com/plaprade/haskoin-util+bug-reports: http://github.com/plaprade/haskoin-util/issues+stability: experimental+license: PublicDomain+license-file: UNLICENSE+author: Philippe Laprade+maintainer: plaprade+hackage@gmail.com+category: Bitcoin, Finance, Network+build-type: Simple+cabal-version: >= 1.9.2++source-repository head+ type: git+ location: git://github.com/plaprade/haskoin-util.git++library+ exposed-modules: Network.Haskoin.Util,+ Network.Haskoin.Util.Arbitrary,+ Network.Haskoin.Util.Network,+ Network.Haskoin.Util.BuildMonad+ other-modules: Network.Haskoin.Util.Network.Prodnet,+ Network.Haskoin.Util.Network.Testnet+ build-depends: base == 4.6.*,+ binary == 0.7.*,+ bytestring == 0.10.*,+ either == 4.0.*,+ mtl == 2.1.*,+ QuickCheck == 2.6.*+ ghc-options: -Wall -fno-warn-orphans++Test-Suite test-haskoin-util+ type: exitcode-stdio-1.0+ main-is: Main.hs+ build-depends: base == 4.6.*,+ binary == 0.7.*,+ bytestring == 0.10.*,+ either == 4.0.*,+ containers == 0.5.*,+ mtl == 2.1.*,+ QuickCheck == 2.6.*,+ HUnit == 1.2.*,+ test-framework == 0.8.*, + test-framework-quickcheck2 == 0.3.*, + test-framework-hunit == 0.3.* + hs-source-dirs: . tests+ ghc-options: -Wall -fno-warn-orphans+
+ tests/Main.hs view
@@ -0,0 +1,8 @@+module Main where++import Test.Framework (defaultMain)+import qualified Network.Haskoin.Util.Tests (tests)++main :: IO ()+main = defaultMain ( Network.Haskoin.Util.Tests.tests )+