{-# LANGUAGE OverloadedStrings #-}

module Data.Locator.Hashes (
    toBase62,
    fromBase62,
    padWithZeros,
    hashStringToBase62,
) where

import Prelude hiding (toInteger)

import Crypto.Hash as Crypto
import qualified Data.ByteArray as B
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as S
import Data.Char (chr, isDigit, isLower, isUpper, ord)
import Data.Word
import Numeric (showIntAtBase)

--
-- Conversion between decimal and base 62
--

represent :: Int -> Char
represent :: Int -> Char
represent Int
x
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = Int -> Char
chr (Int
48 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x)
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
36 = Int -> Char
chr (Int
65 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10)
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
62 = Int -> Char
chr (Int
97 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
36)
    | Bool
otherwise = Char
'@'

toBase62 :: Integer -> String
toBase62 :: Integer -> String
toBase62 Integer
x =
    Integer -> (Int -> Char) -> Integer -> ShowS
forall a. Integral a => a -> (Int -> Char) -> a -> ShowS
showIntAtBase Integer
62 Int -> Char
represent Integer
x String
""

--

{- | Utility function to prepend \'0\' characters to a string representing a
 number. This allows you to ensure a fixed width for numbers that are less
 than the desired width in size. This comes up frequently when representing
 numbers in other bases greater than 10 as they are inevitably presented as
 text, and not having them evenly justified can (at best) be ugly and (at
 worst) actually lead to parsing and conversion bugs.
-}
padWithZeros :: Int -> String -> String
padWithZeros :: Int -> ShowS
padWithZeros Int
digits String
str =
    String
pad String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str
  where
    pad :: String
pad = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
len (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
digits Char
'0')
    len :: Int
len = Int
digits Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str

value :: Char -> Int
value :: Char -> Int
value Char
c
    | Char -> Bool
isDigit Char
c = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48
    | Char -> Bool
isUpper Char
c = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
65 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10
    | Char -> Bool
isLower Char
c = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
97 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
36
    | Bool
otherwise = Int
0

multiply :: Integer -> Char -> Integer
multiply :: Integer -> Char -> Integer
multiply Integer
acc Char
c =
    Integer
acc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
62 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Char -> Int
value Char
c)

fromBase62 :: String -> Integer
fromBase62 :: String -> Integer
fromBase62 String
ss =
    (Integer -> Char -> Integer) -> Integer -> String -> Integer
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Integer -> Char -> Integer
multiply Integer
0 String
ss

concatToInteger :: [Word8] -> Integer
concatToInteger :: [Word8] -> Integer
concatToInteger [Word8]
bytes =
    (Integer -> Word8 -> Integer) -> Integer -> [Word8] -> Integer
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Integer -> Word8 -> Integer
forall {a} {a}. (Integral a, Num a) => a -> a -> a
fn Integer
0 [Word8]
bytes
  where
    fn :: a -> a -> a
fn a
acc a
b = (a
acc a -> a -> a
forall a. Num a => a -> a -> a
* a
256) a -> a -> a
forall a. Num a => a -> a -> a
+ (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b)

digest :: String -> Integer
digest :: String -> Integer
digest String
ws =
    Integer
i
  where
    i :: Integer
i = [Word8] -> Integer
concatToInteger [Word8]
h
    h :: [Word8]
h = Digest SHA1 -> [Word8]
forall a. ByteArrayAccess a => a -> [Word8]
B.unpack Digest SHA1
h'
    h' :: Digest SHA1
h' = ByteString -> Digest SHA1
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Crypto.hash ByteString
x' :: Crypto.Digest Crypto.SHA1
    x' :: ByteString
x' = String -> ByteString
S.pack String
ws

--

{- | Take an arbitrary string, hash it, then pad it with zeros up to be a
 @digits@-long string in base 62.

 You may be interested to know that the 160-bit SHA1 hash used here can be
 expressed without loss as 27 digits of base 62, for example:

 >>> hashStringToBase62 27 "Hello World"
 1T8Sj4C5jVU6iQXCwCwJEPSWX6u
-}
hashStringToBase62 :: Int -> ByteString -> ByteString
hashStringToBase62 :: Int -> ByteString -> ByteString
hashStringToBase62 Int
digits ByteString
s' =
    ByteString
r'
  where
    s :: String
s = ByteString -> String
S.unpack ByteString
s'
    n :: Integer
n = String -> Integer
digest String
s -- SHA1 hash
    limit :: Integer
limit = Integer
62 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
digits
    x :: Integer
x = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
n Integer
limit -- trim to specified number base62 chars
    str :: String
str = Integer -> String
toBase62 Integer
x
    r :: String
r = Int -> ShowS
padWithZeros Int
digits String
str -- convert to String
    r' :: ByteString
r' = String -> ByteString
S.pack String
r