diff options
Diffstat (limited to 'lib/Base58.hs')
-rw-r--r-- | lib/Base58.hs | 70 |
1 files changed, 70 insertions, 0 deletions
diff --git a/lib/Base58.hs b/lib/Base58.hs new file mode 100644 index 0000000..3c1a113 --- /dev/null +++ b/lib/Base58.hs | |||
@@ -0,0 +1,70 @@ | |||
1 | {-# LANGUAGE CPP #-} | ||
2 | module Base58 where | ||
3 | |||
4 | #if !defined(VERSION_cryptonite) | ||
5 | import qualified Crypto.Hash.SHA256 as SHA256 | ||
6 | #else | ||
7 | import Crypto.Hash | ||
8 | import Data.ByteArray (convert) | ||
9 | #endif | ||
10 | import qualified Data.ByteString as S | ||
11 | import Data.Maybe | ||
12 | import Data.List | ||
13 | import Data.Word ( Word8 ) | ||
14 | import Control.Monad | ||
15 | |||
16 | base58chars :: [Char] | ||
17 | base58chars = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz" | ||
18 | |||
19 | base58digits :: [Char] -> Maybe [Int] | ||
20 | base58digits str = sequence mbs | ||
21 | where | ||
22 | mbs = map (flip elemIndex base58chars) str | ||
23 | |||
24 | -- 5HueCGU8rMjxEXxiPuD5BDku4MkFqeZyd4dZ1jvhTVqvbTLvyTJ | ||
25 | base58_decode :: [Char] -> Maybe (Word8,[Word8]) | ||
26 | base58_decode str = do | ||
27 | ds <- base58digits str | ||
28 | let n = foldl' (\a b-> a*58 + b) 0 $ ( map fromIntegral ds :: [Integer] ) | ||
29 | rbytes = unfoldr getbyte n | ||
30 | getbyte d = do | ||
31 | guard (d/=0) | ||
32 | let (q,b) = d `divMod` 256 | ||
33 | return (fromIntegral b,q) | ||
34 | |||
35 | let (rcksum,rpayload) = splitAt 4 $ rbytes | ||
36 | a_payload = reverse rpayload | ||
37 | #if !defined(VERSION_cryptonite) | ||
38 | hash_result = S.take 4 . SHA256.hash . SHA256.hash . S.pack $ a_payload | ||
39 | #else | ||
40 | hash_result = S.take 4 . convert $ digest | ||
41 | where digest = hash (S.pack a_payload) :: Digest SHA256 | ||
42 | #endif | ||
43 | expected_hash = S.pack $ reverse rcksum | ||
44 | (network_id,payload) = splitAt 1 a_payload | ||
45 | |||
46 | network_id <- listToMaybe network_id | ||
47 | guard (hash_result==expected_hash) | ||
48 | return (network_id,payload) | ||
49 | |||
50 | base58_encode :: S.ByteString -> String | ||
51 | base58_encode hsh = replicate zcount '1' ++ map (base58chars !!) (reverse rdigits) | ||
52 | where | ||
53 | zcount = S.length . S.takeWhile (==0) $ hsh | ||
54 | #if !defined(VERSION_cryptonite) | ||
55 | cksum = S.take 4 . SHA256.hash . SHA256.hash $ hsh | ||
56 | #else | ||
57 | cksum = S.take 4 (convert digest2 :: S.ByteString) | ||
58 | where digest2 = hash ( convert digest1 :: S.ByteString) :: Digest SHA256 | ||
59 | digest1 = hash hsh :: Digest SHA256 | ||
60 | #endif | ||
61 | n = foldl' (\a b->a*256+b) 0 . map asInteger $ concatMap S.unpack [hsh, cksum] | ||
62 | asInteger x = fromIntegral x :: Integer | ||
63 | rdigits = unfoldr getdigit n | ||
64 | where | ||
65 | getdigit d = do | ||
66 | guard (d/=0) | ||
67 | let (q,b) = d `divMod` 58 | ||
68 | return (fromIntegral b,q) | ||
69 | |||
70 | |||