summaryrefslogtreecommitdiff
path: root/Base58.hs
blob: 8adf60d95b9dac31e3d5164204550da8a823f16e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
module Base58 where

import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.ByteString      as S
import Data.Maybe
import Data.List
import Data.Word ( Word8 )
import Control.Monad

base58chars = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"

base58digits :: [Char] -> Maybe [Int]
base58digits str = sequence mbs
 where
    mbs = map (flip elemIndex base58chars) str
    
-- 5HueCGU8rMjxEXxiPuD5BDku4MkFqeZyd4dZ1jvhTVqvbTLvyTJ
base58_decode :: [Char] -> Maybe (Word8,[Word8])
base58_decode str = do
    ds <- base58digits str
    let n = foldl' (\a b-> a*58 + b) 0 $ ( map fromIntegral ds :: [Integer] )
        rbytes = unfoldr getbyte n
        getbyte d = do
            guard (d/=0)
            let (q,b) = d `divMod` 256
            return (fromIntegral b,q)
    
    let (rcksum,rpayload) = splitAt 4 $ rbytes
        a_payload = reverse rpayload
        hash_result = S.take 4 . SHA256.hash . SHA256.hash . S.pack $ a_payload
        expected_hash = S.pack $ reverse rcksum
        (network_id,payload) = splitAt 1 a_payload
    
    network_id <- listToMaybe network_id
    guard (hash_result==expected_hash)
    return (network_id,payload)

base58_encode :: S.ByteString -> String
base58_encode hash = replicate zcount '1' ++ map (base58chars !!) (reverse rdigits)
  where
    zcount = S.length . S.takeWhile (==0) $ hash
    cksum = S.take 4 . SHA256.hash . SHA256.hash $ hash
    n = foldl' (\a b->a*256+b) 0 . map asInteger $ concatMap S.unpack [hash, cksum]
    asInteger x = fromIntegral x :: Integer
    rdigits = unfoldr getdigit n
     where
        getdigit d = do
            guard (d/=0)
            let (q,b) = d `divMod` 58
            return (fromIntegral b,q)