module Network.Haskoin.Crypto.Base58
( Address(..)
, addrToBase58
, base58ToAddr
, encodeBase58
, decodeBase58
, encodeBase58Check
, decodeBase58Check
) where
import Control.DeepSeq (NFData, rnf)
import Control.Monad (guard, mzero)
import Data.Aeson (FromJSON, ToJSON, Value (String),
parseJSON, toJSON, withText)
import Data.Binary (Binary, get, put)
import Data.Binary.Get (getByteString, getWord8)
import Data.Binary.Put (putByteString, putWord8)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust, fromMaybe, isJust,
listToMaybe)
import Data.String (IsString, fromString)
import Data.String.Conversions (cs)
import Network.Haskoin.Constants
import Network.Haskoin.Crypto.Hash
import Network.Haskoin.Util
import Numeric (readInt, showIntAtBase)
import Text.Read (lexP, parens, pfail, readPrec)
import qualified Text.Read as Read (Lexeme (Ident, String))
b58Data :: ByteString
b58Data = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
b58 :: Int -> Char
b58 = C.index b58Data
b58' :: Char -> Maybe Int
b58' = flip C.elemIndex b58Data
encodeBase58I :: Integer -> ByteString
encodeBase58I i = cs $ showIntAtBase 58 b58 i ""
decodeBase58I :: ByteString -> Maybe Integer
decodeBase58I s =
case go of
Just (r,[]) -> Just r
_ -> Nothing
where
p = isJust . b58'
f = fromMaybe e . b58'
go = listToMaybe $ readInt 58 p f (cs s)
e = error "Could not decode base58"
encodeBase58 :: ByteString -> ByteString
encodeBase58 bs =
l `mappend` r
where
(z, b) = BS.span (== 0) bs
l = BS.replicate (BS.length z) (BS.index b58Data 0)
r | BS.null b = BS.empty
| otherwise = encodeBase58I $ bsToInteger b
decodeBase58 :: ByteString -> Maybe ByteString
decodeBase58 t =
BS.append prefix <$> r
where
(z, b) = BS.span (== BS.index b58Data 0) t
prefix = BS.replicate (BS.length z) 0
r | BS.null b = Just BS.empty
| otherwise = integerToBS <$> decodeBase58I b
encodeBase58Check :: ByteString -> ByteString
encodeBase58Check bs = encodeBase58 $ BS.append bs (encode' $ checkSum32 bs)
decodeBase58Check :: ByteString -> Maybe ByteString
decodeBase58Check bs = do
rs <- decodeBase58 bs
let (res, chk) = BS.splitAt (BS.length rs 4) rs
guard $ chk == encode' (checkSum32 res)
return res
data Address
= PubKeyAddress { getAddrHash :: !Hash160 }
| ScriptAddress { getAddrHash :: !Hash160 }
deriving (Eq, Ord)
instance Binary Address where
get = do
pfx <- getWord8
bs <- getByteString 20
let addr = fromJust (bsToHash160 bs)
f pfx addr
where
f x a | x == addrPrefix = return (PubKeyAddress a)
| x == scriptPrefix = return (ScriptAddress a)
| otherwise = fail "Does not recognize address prefix"
put (PubKeyAddress h) = do
putWord8 addrPrefix
putByteString (getHash160 h)
put (ScriptAddress h) = do
putWord8 scriptPrefix
putByteString (getHash160 h)
instance Show Address where
showsPrec d a = showParen (d > 10) $
showString "Address " . shows (addrToBase58 a)
instance Read Address where
readPrec = parens $ do
Read.Ident "Address" <- lexP
Read.String str <- lexP
maybe pfail return $ base58ToAddr $ cs str
instance IsString Address where
fromString =
fromMaybe e . base58ToAddr . cs
where
e = error "Could not decode bitcoin address"
instance NFData Address where
rnf (PubKeyAddress h) = rnf h
rnf (ScriptAddress h) = rnf h
instance FromJSON Address where
parseJSON = withText "Address" $
maybe mzero return . base58ToAddr . cs
instance ToJSON Address where
toJSON = String . cs . addrToBase58
addrToBase58 :: Address -> ByteString
addrToBase58 = encodeBase58Check . encode'
base58ToAddr :: ByteString -> Maybe Address
base58ToAddr str = do
val <- decodeBase58Check str
decodeToMaybe val