base58address (empty) → 0.1

raw patch · 8 files changed

+235/−0 lines, 8 filesdep +QuickCheckdep +basedep +bytestringsetup-changed

Dependencies added: QuickCheck, base, bytestring, containers, cryptohash, test-framework, test-framework-quickcheck2

Files

COPYING +13/−0
Data/Base58Address.hs +85/−0
Data/Base58Address/Alphabet.hs +34/−0
Data/Base58Address/BaseConvert.hs +14/−0
README +2/−0
Setup.hs +3/−0
base58address.cabal +54/−0
tests/suite.hs +30/−0

+ COPYING view

@@ -0,0 +1,13 @@+Copyright © 2013, Stephen Paul Weber <singpolyma.net>++Permission to use, copy, modify, and/or distribute this software for any+purpose with or without fee is hereby granted, provided that the above+copyright notice and this permission notice appear in all copies.++THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR+ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF+OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

+ Data/Base58Address.hs view

@@ -0,0 +1,85 @@+{-# LANGUAGE CPP #-}+--module Data.Base58Address (BitcoinAddress, RippleAddress) where+module Data.Base58Address where++import Control.Arrow ((***))+import Data.Word+import qualified Crypto.Hash.SHA256 as SHA256+import qualified Data.ByteString as BS++import Data.Base58Address.BaseConvert+import Data.Base58Address.Alphabet++#ifdef TESTS+import Test.QuickCheck++instance Arbitrary Base58Address where+	arbitrary = do+		ver <- arbitrary+		adr <- arbitrary `suchThat` (>0)+		return $ Base58Address ver adr++instance Arbitrary BitcoinAddress where+	arbitrary = do+		adr <- arbitrary+		return $ BitcoinAddress adr++instance Arbitrary RippleAddress where+	arbitrary = do+		adr <- arbitrary+		return $ RippleAddress adr+#endif++newtype BitcoinAddress = BitcoinAddress Base58Address+	deriving (Ord, Eq)++bitcoinAlphabet :: Alphabet+bitcoinAlphabet = read "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"++instance Show BitcoinAddress where+	show (BitcoinAddress adr) = showB58 bitcoinAlphabet adr++instance Read BitcoinAddress where+	readsPrec _ s = case decodeB58 bitcoinAlphabet s of+		Just x -> [(BitcoinAddress x,"")]+		Nothing -> []++newtype RippleAddress = RippleAddress Base58Address+	deriving (Ord, Eq)++rippleAlphabet :: Alphabet+rippleAlphabet = read "rpshnaf39wBUDNEGHJKLM4PQRST7VWXYZ2bcdeCg65jkm8oFqi1tuvAxyz"++instance Show RippleAddress where+	show (RippleAddress adr) = showB58 rippleAlphabet adr++instance Read RippleAddress where+	readsPrec _ s = case decodeB58 rippleAlphabet s of+		Just x -> [(RippleAddress x,"")]+		Nothing -> []++data Base58Address = Base58Address !Word8 !Integer+	deriving (Ord, Eq)++showB58 :: Alphabet -> Base58Address -> String+showB58 alphabet (Base58Address version addr) = prefix +++	toString alphabet 58 (fromBase 256 (bytes' ++ mkChk bytes') :: Integer)+	where+	prefix | version == 0 = toString alphabet 58 0+	       | otherwise = ""+	bytes' = version : replicate (20 - length bytes) 0 ++ bytes+	bytes = toBase 256 addr++decodeB58 :: Alphabet -> String -> Maybe Base58Address+decodeB58 alphabet s = do+	(chk,bytes) <- fmap (splitChk . toBase 256)+		(toIntegral alphabet 58 s :: Maybe Integer)+	let bytes' = replicate (21 - length bytes) 0 ++ bytes+	if mkChk bytes' /= chk then Nothing else+		Just $! Base58Address (head bytes') (fromBase 256 (tail bytes'))++splitChk :: [a] -> ([a], [a])+splitChk = (reverse *** reverse) . splitAt 4 . reverse++mkChk :: [Word8] -> [Word8]+mkChk = BS.unpack . BS.take 4 . SHA256.hash . SHA256.hash . BS.pack

+ Data/Base58Address/Alphabet.hs view

@@ -0,0 +1,34 @@+module Data.Base58Address.Alphabet where++import Data.IntMap (IntMap)+import qualified Data.IntMap as IntMap+import Data.Map (Map)+import qualified Data.Map as Map++import Data.Base58Address.BaseConvert++data Alphabet = Alphabet !(IntMap Char) !(Map Char Int)+	deriving (Eq)++instance Show Alphabet where+	show (Alphabet a _) = map snd $ IntMap.toAscList a++instance Read Alphabet where+	readsPrec _ alphabet = [(+			Alphabet+			(IntMap.fromAscList $ zip [0..] alphabet)+			(Map.fromList $ zip alphabet [0..]),+		"")]++toAlphaDigit :: Alphabet -> Int -> Maybe Char+toAlphaDigit (Alphabet letters _) i = IntMap.lookup i letters++toString :: (Integral a) => Alphabet -> a -> a -> String+toString a b v = let Just x = mapM (toAlphaDigit a) (toBase b v) in x++fromAlphaDigit :: Alphabet -> Char -> Maybe Int+fromAlphaDigit (Alphabet _ indices) v = Map.lookup v indices++toIntegral :: (Integral a) => Alphabet -> a -> String -> Maybe a+toIntegral a b = fmap (fromBase b) .+	mapM (fmap toInteger . fromAlphaDigit a)

+ Data/Base58Address/BaseConvert.hs view

@@ -0,0 +1,14 @@+module Data.Base58Address.BaseConvert (toBase, fromBase) where++import Data.Sequence (unfoldl)+import Data.Foldable (toList)++toBase :: (Integral a, Integral b) => a -> a -> [b]+toBase _ 0 = [0]+toBase b v+	| v < 0 = error "Data.Base58Address.BaseConvert.toBase v < 0"+	| otherwise = map fromIntegral $ toList $+		unfoldl (\n -> if n == 0 then Nothing else Just $! (n `divMod` b)) v++fromBase :: (Integral a, Integral b) => b -> [a] -> b+fromBase b = foldl (\n k -> n * b + fromIntegral k) 0

+ README view

@@ -0,0 +1,2 @@+Datatypes with show and read instances that match the spec for Bitcoin+and Ripple addresses.

+ Setup.hs view

@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain

+ base58address.cabal view

@@ -0,0 +1,54 @@+name:            base58address+version:         0.1+cabal-version:   >= 1.8+license:         OtherLicense+license-file:    COPYING+category:        Web+copyright:       © 2013 Stephen Paul Weber+author:          Stephen Paul Weber <singpolyma@singpolyma.net>+maintainer:      Stephen Paul Weber <singpolyma@singpolyma.net>+stability:       experimental+tested-with:     GHC == 7.4.1+synopsis:        Parsing and serialization for Base58 addresses (Bitcoin and Ripple)+homepage:        https://github.com/singpolyma/base58address+bug-reports:     https://github.com/singpolyma/base58address/issues+build-type:      Simple+description:+        Datatypes with show and read instances that match the spec for Bitcoin+        and Ripple addresses.++extra-source-files:+        README++library+        exposed-modules:+                Data.Base58Address++        other-modules:+                Data.Base58Address.BaseConvert+                Data.Base58Address.Alphabet++        build-depends:+                base == 4.*,+                containers,+                bytestring,+                cryptohash++test-suite tests+        type:       exitcode-stdio-1.0+        main-is:    tests/suite.hs++        cpp-options: -DTESTS++        build-depends:+                base == 4.*,+                containers,+                bytestring,+                cryptohash,+                QuickCheck >= 2.4.1.1,+                test-framework,+                test-framework-quickcheck2++source-repository head+        type:     git+        location: git://github.com/singpolyma/base58address.git

+ tests/suite.hs view

@@ -0,0 +1,30 @@+module Main (main) where++import Test.Framework (defaultMain, testGroup, Test)+import Test.Framework.Providers.QuickCheck2++import Data.Base58Address++prop_read_show_bitcoin :: BitcoinAddress -> Bool+prop_read_show_bitcoin adr = (read $! str) == adr+	where+	str = show $! adr+	{-# NOINLINE str #-}++prop_read_show_ripple :: RippleAddress -> Bool+prop_read_show_ripple adr = (read $! str) == adr+	where+	str = show $! adr+	{-# NOINLINE str #-}++tests :: [Test]+tests =+	[+		testGroup "Encode/decode loop" [+			testProperty "BitcoinAddress" prop_read_show_bitcoin,+			testProperty "RippleAddress" prop_read_show_ripple+		]+	]++main :: IO ()+main = defaultMain tests