base58string (empty) → 0.9.0
raw patch · 8 files changed
+274/−0 lines, 8 filesdep +aesondep +basedep +base58stringsetup-changed
Dependencies added: aeson, base, base58string, binary, bytestring, hspec, text
Files
- LICENSE +22/−0
- README.md +9/−0
- Setup.hs +3/−0
- base58string.cabal +58/−0
- src/Data/Base58String.hs +140/−0
- test/Data/Base58StringSpec.hs +33/−0
- test/Main.hs +8/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,22 @@+The MIT License (MIT) + +Copyright (c) 2015 Leon Mergen + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +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 OR COPYRIGHT HOLDERS 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. +
+ README.md view
@@ -0,0 +1,9 @@+haskell-hexstring +================= + +[](https://travis-ci.org/solatis/haskell-hexstring) +[](https://coveralls.io/r/solatis/haskell-hexstring?branch=master) +[](http://en.wikipedia.org/wiki/MIT_License) +[](http://haskell.org) + +Fast and safe representation of a hex string
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple + +main = defaultMain
+ base58string.cabal view
@@ -0,0 +1,58 @@+name: base58string +category: Data +version: 0.9.0 +license: MIT +license-file: LICENSE +copyright: (c) 2015 Leon Mergen +author: Leon Mergen +maintainer: leon@solatis.com +homepage: http://www.leonmergen.com/opensource.html +bug-reports: http://github.com/solatis/haskell-base58string/issues +stability: experimental +synopsis: Fast and safe representation of a Base-58 string +description: + Provides an interface for converting any object that has a 'Binary' instance + to and from a base-58 Text representation. + +build-type: Simple +data-files: LICENSE, README.md +cabal-version: >= 1.10 +tested-with: GHC == 7.6, GHC == 7.8, GHC == 7.10 + +library + hs-source-dirs: src + ghc-options: -Wall -ferror-spans + default-language: Haskell2010 + + exposed-modules: Data.Base58String + + build-depends: base >= 4.3 && < 5 + , binary + , text + , bytestring + , aeson + +test-suite test-suite + type: exitcode-stdio-1.0 + ghc-options: -Wall -ferror-spans -threaded -auto-all -caf-all -fno-warn-type-defaults + default-language: Haskell2010 + hs-source-dirs: test + main-is: Main.hs + + other-modules: Data.Base58StringSpec + Spec + Main + + build-depends: base >= 4.3 && < 5 + , hspec + , text + + , bytestring + , binary + + , base58string + +source-repository head + type: git + location: git://github.com/solatis/haskell-bitcoin-script.git + branch: master
+ src/Data/Base58String.hs view
@@ -0,0 +1,140 @@+module Data.Base58String ( Base58String + , b58String + , fromBinary + , toBinary + , fromBytes + , toBytes + , toText ) where + +import Control.Applicative ((<$>), pure) +import Control.Monad (liftM) + +import Data.Char (ord, chr) +import Data.Bits ((.|.), shiftL, shiftR) +import Data.List (unfoldr) + +import Data.Maybe (fromJust, isJust, listToMaybe, fromMaybe) + +import Data.Aeson +import Data.Word (Word8) +import Numeric (showIntAtBase, readInt) +import Data.String (fromString) + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS8 +import qualified Data.ByteString.Lazy as BSL + +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE + +import qualified Data.Binary as B (Binary, decode, encode) + +-- | Represents a Base58 string. Guarantees that all characters it contains +-- are valid base58 characters. +data Base58String = + Base58String BS.ByteString + deriving ( Show, Eq, Ord ) + +instance FromJSON Base58String where + parseJSON = withText "Base58tring" $ pure . b58String . TE.encodeUtf8 + +instance ToJSON Base58String where + toJSON = String . toText + +-- | Smart constructor which validates that all the text are actually +-- base-58 characters. +b58String :: BS.ByteString -> Base58String +b58String bs = + if BS.all isValidBase58 bs + then Base58String bs + else error ("Not a valid base58 string: " ++ show bs) + +-- | Converts a 'B.Binary' to a 'Base58String' value +fromBinary :: B.Binary a => a -> Base58String +fromBinary = b58String . b58Encode . BSL.toStrict . B.encode + +-- | Converts a 'Base58String' to a 'B.Binary' value +toBinary :: B.Binary a => Base58String -> a +toBinary (Base58String bs) = B.decode . BSL.fromStrict . fromMaybe (error "not a valid base58 input") $ b58Decode bs + +-- | Reads a 'BS.ByteString' as raw bytes and converts to base58 representation. We +-- cannot use the instance Binary of 'BS.ByteString' because it provides +-- a leading length, which is not what we want when dealing with raw bytes. +fromBytes :: BS.ByteString -> Base58String +fromBytes = b58String . b58Encode + +-- | Access to the raw bytes in a 'BS.ByteString' format. +toBytes :: Base58String -> BS.ByteString +toBytes (Base58String bs) = fromMaybe (error "not a valid base58 input") $ b58Decode bs + +-- | Access to a 'T.Text' representation of the 'Base58String' +toText :: Base58String -> T.Text +toText (Base58String bs) = TE.decodeUtf8 bs + +-- | Our mapping table from binary to base58, based on Bitcoin's table +bitcoinTable :: BS.ByteString +bitcoinTable = BS.pack + $ [49..57] + ++ [65..72] + ++ [74..78] + ++ [80..90] + ++ [97..107] + ++ [109..122] + +isValidBase58 :: Word8 -> Bool +isValidBase58 c = + BS.elem c bitcoinTable + +b58 :: Word8 -> Word8 +b58 i = BS.index bitcoinTable (fromIntegral i) + +b58' :: Word8 -> Maybe Word8 +b58' w = fromIntegral <$> BS.elemIndex w bitcoinTable + +b58EncodeInt :: Integer -> BS.ByteString +b58EncodeInt i = + fromString $ showIntAtBase (58 :: Integer) f (fromIntegral i) "" + where + f = chr . fromIntegral . b58 . fromIntegral + +b58DecodeInt :: BS.ByteString -> Maybe Integer +b58DecodeInt s = case go of + Just (r,[]) -> Just r + _ -> Nothing + where + c = b58' . fromIntegral . ord + p = isJust . c + f = fromIntegral . fromJust . c + go = listToMaybe $ readInt 58 p f (BS8.unpack s) + +b58Encode :: BS.ByteString -> BS.ByteString +b58Encode input = BS.append l r + where + (z,b) = BS.span (== 0) input + l = BS.map b58 z -- preserve leading 0's + r | BS.null b = BS.empty + | otherwise = b58EncodeInt $ bsToInteger b + +b58Decode :: BS.ByteString -> Maybe BS.ByteString +b58Decode input = liftM (BS.append prefix) r + where + (z,b) = BS.span (== b58 0) input + prefix = BS.map (fromJust . b58') z -- preserve leading 1's + r | BS.null b = Just BS.empty + | otherwise = integerToBS <$> b58DecodeInt b + +-- | 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)
+ test/Data/Base58StringSpec.hs view
@@ -0,0 +1,33 @@+module Data.Base58StringSpec where + +import Data.Base58String ( b58String + , fromBytes + , toBytes ) + +import qualified Data.ByteString.Char8 as BS8 + +import Test.Hspec + +spec :: Spec +spec = do + describe "when constructing a hex string" $ do + it "should accept strings that fall within a valid range" $ + b58String (BS8.pack "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz") `shouldBe` b58String (BS8.pack "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz") + + it "should reject strings outside the range" $ do + putStrLn (show (b58String (BS8.pack "0"))) `shouldThrow` anyErrorCall + putStrLn (show (b58String (BS8.pack ":"))) `shouldThrow` anyErrorCall + putStrLn (show (b58String (BS8.pack "`"))) `shouldThrow` anyErrorCall + putStrLn (show (b58String (BS8.pack "{"))) `shouldThrow` anyErrorCall + putStrLn (show (b58String (BS8.pack "I"))) `shouldThrow` anyErrorCall + putStrLn (show (b58String (BS8.pack "O"))) `shouldThrow` anyErrorCall + putStrLn (show (b58String (BS8.pack "l"))) `shouldThrow` anyErrorCall + + describe "when interpreting a hex string" $ do + it "should convert the hex string properly when interpreting as bytes" $ + toBytes (b58String (BS8.pack "15Q")) `shouldBe` BS8.pack "\0\255" + it "should convert bytes to the proper hex string" $ + fromBytes (BS8.pack "\0\255") `shouldBe` b58String (BS8.pack "15Q") + +-- ABCDEFGH JKLMN PQRSTUVWXYZabcdefghijk mnopqrstuvwxyz +-- abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
+ test/Main.hs view
@@ -0,0 +1,8 @@+module Main where + +import Test.Hspec.Runner +import qualified Spec + +main :: IO () +main = + hspecWith defaultConfig Spec.spec
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}