{-# LANGUAGE OverloadedStrings #-}
module Haskoin.Address.Base58
(
Base58
, encodeBase58
, decodeBase58
, encodeBase58Check
, decodeBase58Check
) where
import Control.Monad
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Maybe (fromMaybe, isJust, listToMaybe)
import Data.String.Conversions (cs)
import Data.Text (Text)
import qualified Data.Text as T
import Haskoin.Crypto.Hash
import Haskoin.Util
import Numeric (readInt, showIntAtBase)
type Base58 = Text
b58Data :: ByteString
b58Data :: ByteString
b58Data = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
b58 :: Int -> Char
b58 :: Int -> Char
b58 = ByteString -> Int -> Char
C.index ByteString
b58Data
b58' :: Char -> Maybe Int
b58' :: Char -> Maybe Int
b58' = (Char -> ByteString -> Maybe Int)
-> ByteString -> Char -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> ByteString -> Maybe Int
C.elemIndex ByteString
b58Data
encodeBase58I :: Integer -> Base58
encodeBase58I :: Integer -> Base58
encodeBase58I i :: Integer
i = String -> Base58
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Base58) -> String -> Base58
forall a b. (a -> b) -> a -> b
$ Integer -> (Int -> Char) -> Integer -> ShowS
forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
showIntAtBase 58 Int -> Char
b58 Integer
i ""
decodeBase58I :: Base58 -> Maybe Integer
decodeBase58I :: Base58 -> Maybe Integer
decodeBase58I s :: Base58
s =
case Maybe (Integer, String)
go of
Just (r :: Integer
r,[]) -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
r
_ -> Maybe Integer
forall a. Maybe a
Nothing
where
p :: Char -> Bool
p = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> (Char -> Maybe Int) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Int
b58'
f :: Char -> Int
f = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
forall a. a
e (Maybe Int -> Int) -> (Char -> Maybe Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Int
b58'
go :: Maybe (Integer, String)
go = [(Integer, String)] -> Maybe (Integer, String)
forall a. [a] -> Maybe a
listToMaybe ([(Integer, String)] -> Maybe (Integer, String))
-> [(Integer, String)] -> Maybe (Integer, String)
forall a b. (a -> b) -> a -> b
$ Integer -> (Char -> Bool) -> (Char -> Int) -> ReadS Integer
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
readInt 58 Char -> Bool
p Char -> Int
f (Base58 -> String
forall a b. ConvertibleStrings a b => a -> b
cs Base58
s)
e :: a
e = String -> a
forall a. HasCallStack => String -> a
error "Could not decode base58"
encodeBase58 :: ByteString -> Base58
encodeBase58 :: ByteString -> Base58
encodeBase58 bs :: ByteString
bs =
Base58
l Base58 -> Base58 -> Base58
forall a. Monoid a => a -> a -> a
`mappend` Base58
r
where
(z :: ByteString
z, b :: ByteString
b) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0) ByteString
bs
l :: Base58
l = ByteString -> Base58
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> Base58) -> ByteString -> Base58
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
BS.replicate (ByteString -> Int
BS.length ByteString
z) (ByteString -> Int -> Word8
BS.index ByteString
b58Data 0)
r :: Base58
r | ByteString -> Bool
BS.null ByteString
b = Base58
T.empty
| Bool
otherwise = Integer -> Base58
encodeBase58I (Integer -> Base58) -> Integer -> Base58
forall a b. (a -> b) -> a -> b
$ ByteString -> Integer
bsToInteger ByteString
b
decodeBase58 :: Base58 -> Maybe ByteString
decodeBase58 :: Base58 -> Maybe ByteString
decodeBase58 t :: Base58
t =
ByteString -> ByteString -> ByteString
BS.append ByteString
prefix (ByteString -> ByteString) -> Maybe ByteString -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
r
where
(z :: ByteString
z, b :: ByteString
b) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int -> Word8
BS.index ByteString
b58Data 0) (Base58 -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Base58
t)
prefix :: ByteString
prefix = Int -> Word8 -> ByteString
BS.replicate (ByteString -> Int
BS.length ByteString
z) 0
r :: Maybe ByteString
r | ByteString -> Bool
BS.null ByteString
b = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
BS.empty
| Bool
otherwise = Integer -> ByteString
integerToBS (Integer -> ByteString) -> Maybe Integer -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Base58 -> Maybe Integer
decodeBase58I (ByteString -> Base58
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
b)
encodeBase58Check :: ByteString -> Base58
encodeBase58Check :: ByteString -> Base58
encodeBase58Check bs :: ByteString
bs =
ByteString -> Base58
encodeBase58 (ByteString -> Base58) -> ByteString -> Base58
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
BS.append ByteString
bs (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ CheckSum32 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (CheckSum32 -> Put) -> CheckSum32 -> Put
forall a b. (a -> b) -> a -> b
$ ByteString -> CheckSum32
forall b. ByteArrayAccess b => b -> CheckSum32
checkSum32 ByteString
bs
decodeBase58Check :: Base58 -> Maybe ByteString
decodeBase58Check :: Base58 -> Maybe ByteString
decodeBase58Check bs :: Base58
bs = do
ByteString
rs <- Base58 -> Maybe ByteString
decodeBase58 Base58
bs
let (res :: ByteString
res, chk :: ByteString
chk) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (ByteString -> Int
BS.length ByteString
rs Int -> Int -> Int
forall a. Num a => a -> a -> a
- 4) ByteString
rs
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ByteString
chk ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Put -> ByteString
runPutS (CheckSum32 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (ByteString -> CheckSum32
forall b. ByteArrayAccess b => b -> CheckSum32
checkSum32 ByteString
res))
ByteString -> Maybe ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
res