{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Web.Hashids
( HashidsContext
, version
, createHashidsContext
, hashidsSimple
, hashidsMinimum
, encodeHex
, decodeHex
, encode
, encodeList
, decode
, encodeUsingSalt
, encodeListUsingSalt
, decodeUsingSalt
, encodeHexUsingSalt
, decodeHexUsingSalt
) where
import Prelude hiding (last, minimum, seq, tail)
import Control.Monad (foldM)
import Data.ByteString (ByteString)
import Data.Foldable (toList)
import Data.List (foldl', intersect, nub, (\\))
import Data.List.Split (chunksOf)
import Data.Maybe (fromMaybe)
import Data.Sequence (Seq)
import Data.Word (Word8)
import Numeric (readHex, showHex)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C8
import qualified Data.Sequence as Seq
{-# INLINE (|>) #-}
(|>) :: a -> (a -> b) -> b
|> :: forall a b. a -> (a -> b) -> b
(|>) a
a a -> b
f = a -> b
f a
a
{-# INLINE splitOn #-}
splitOn :: ByteString -> ByteString -> [ByteString]
splitOn :: ByteString -> ByteString -> [ByteString]
splitOn = (Word8 -> Bool) -> ByteString -> [ByteString]
BS.splitWith forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip Word8 -> ByteString -> Bool
BS.elem
data HashidsContext = Context
{ HashidsContext -> ByteString
guards :: !ByteString
, HashidsContext -> ByteString
seps :: !ByteString
, HashidsContext -> ByteString
salt :: !ByteString
, HashidsContext -> Int
minHashLength :: !Int
, HashidsContext -> ByteString
alphabet :: !ByteString
} deriving (Int -> HashidsContext -> ShowS
[HashidsContext] -> ShowS
HashidsContext -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HashidsContext] -> ShowS
$cshowList :: [HashidsContext] -> ShowS
show :: HashidsContext -> [Char]
$cshow :: HashidsContext -> [Char]
showsPrec :: Int -> HashidsContext -> ShowS
$cshowsPrec :: Int -> HashidsContext -> ShowS
Show)
version :: String
version :: [Char]
version = [Char]
"1.0.2"
createHashidsContext :: ByteString
-> Int
-> String
-> HashidsContext
createHashidsContext :: ByteString -> Int -> [Char] -> HashidsContext
createHashidsContext ByteString
salt Int
minHashLen [Char]
alphabet
| forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
uniqueAlphabet forall a. Ord a => a -> a -> Bool
< Int
minAlphabetLength
= forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"alphabet must contain at least " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
minAlphabetLength forall a. [a] -> [a] -> [a]
++ [Char]
" unique characters"
| Char
' ' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
uniqueAlphabet
= forall a. HasCallStack => [Char] -> a
error [Char]
"alphabet cannot contain spaces"
| ByteString -> Bool
BS.null ByteString
seps'' Bool -> Bool -> Bool
|| forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
alphabet') forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
seps'') forall a. Ord a => a -> a -> Bool
> Double
sepDiv
= case Int
sepsLength forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
seps'' of
Int
diff | Int
diff forall a. Ord a => a -> a -> Bool
> Int
0
-> ByteString -> ByteString -> HashidsContext
res (Int -> ByteString -> ByteString
BS.drop Int
diff ByteString
alphabet') (ByteString
seps'' ByteString -> ByteString -> ByteString
`BS.append` Int -> ByteString -> ByteString
BS.take Int
diff ByteString
alphabet')
Int
_ -> ByteString -> ByteString -> HashidsContext
res ByteString
alphabet' (Int -> ByteString -> ByteString
BS.take Int
sepsLength ByteString
seps'')
| Bool
otherwise = ByteString -> ByteString -> HashidsContext
res ByteString
alphabet' ByteString
seps''
where
res :: ByteString -> ByteString -> HashidsContext
res ByteString
ab ByteString
_seps =
let shuffled :: ByteString
shuffled = ByteString -> ByteString -> ByteString
consistentShuffle ByteString
ab ByteString
salt
guardCount :: Int
guardCount = forall a b. (RealFrac a, Integral b) => a -> b
ceiling (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
shuffled) forall a. Fractional a => a -> a -> a
/ Double
guardDiv)
context :: HashidsContext
context = Context
{ guards :: ByteString
guards = Int -> ByteString -> ByteString
BS.take Int
guardCount ByteString
_seps
, seps :: ByteString
seps = Int -> ByteString -> ByteString
BS.drop Int
guardCount ByteString
_seps
, salt :: ByteString
salt = ByteString
salt
, minHashLength :: Int
minHashLength = Int
minHashLen
, alphabet :: ByteString
alphabet = ByteString
shuffled }
in if ByteString -> Int
BS.length ByteString
shuffled forall a. Ord a => a -> a -> Bool
< Int
3
then HashidsContext
context
else HashidsContext
context{ guards :: ByteString
guards = Int -> ByteString -> ByteString
BS.take Int
guardCount ByteString
shuffled
, seps :: ByteString
seps = ByteString
_seps
, alphabet :: ByteString
alphabet = Int -> ByteString -> ByteString
BS.drop Int
guardCount ByteString
shuffled }
seps' :: ByteString
seps' = [Char] -> ByteString
C8.pack forall a b. (a -> b) -> a -> b
$ [Char]
uniqueAlphabet forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Char]
seps
seps'' :: ByteString
seps'' = ByteString -> ByteString -> ByteString
consistentShuffle ByteString
seps' ByteString
salt
sepsLength :: Int
sepsLength =
case forall a b. (RealFrac a, Integral b) => a -> b
ceiling (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
alphabet') forall a. Fractional a => a -> a -> a
/ Double
sepDiv) of
Int
1 -> Int
2
Int
n -> Int
n
uniqueAlphabet :: [Char]
uniqueAlphabet = forall a. Eq a => [a] -> [a]
nub [Char]
alphabet
alphabet' :: ByteString
alphabet' = [Char] -> ByteString
C8.pack forall a b. (a -> b) -> a -> b
$ [Char]
uniqueAlphabet forall a. Eq a => [a] -> [a] -> [a]
\\ [Char]
seps
minAlphabetLength :: Int
minAlphabetLength = Int
16
sepDiv :: Double
sepDiv = Double
3.5 :: Double
guardDiv :: Double
guardDiv = Double
12 :: Double
seps :: [Char]
seps = [Char]
"cfhistuCFHISTU"
defaultAlphabet :: String
defaultAlphabet :: [Char]
defaultAlphabet = [Char
'a'..Char
'z'] forall a. [a] -> [a] -> [a]
++ [Char
'A'..Char
'Z'] forall a. [a] -> [a] -> [a]
++ [Char]
"1234567890"
hashidsSimple :: ByteString
-> HashidsContext
hashidsSimple :: ByteString -> HashidsContext
hashidsSimple ByteString
salt = ByteString -> Int -> [Char] -> HashidsContext
createHashidsContext ByteString
salt Int
0 [Char]
defaultAlphabet
hashidsMinimum :: ByteString
-> Int
-> HashidsContext
hashidsMinimum :: ByteString -> Int -> HashidsContext
hashidsMinimum ByteString
salt Int
minimum = ByteString -> Int -> [Char] -> HashidsContext
createHashidsContext ByteString
salt Int
minimum [Char]
defaultAlphabet
decodeHex :: HashidsContext
-> ByteString
-> String
decodeHex :: HashidsContext -> ByteString -> [Char]
decodeHex HashidsContext
context ByteString
hashDigest = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (Integral a, Show a) => a -> ShowS
showHex [Char]
"") [Int]
numbers
where
numbers :: [Int]
numbers = HashidsContext -> ByteString -> [Int]
decode HashidsContext
context ByteString
hashDigest
encodeHex :: HashidsContext
-> String
-> ByteString
encodeHex :: HashidsContext -> [Char] -> ByteString
encodeHex HashidsContext
context [Char]
hexStr
| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
hexChar [Char]
hexStr) = ByteString
""
| Bool
otherwise = HashidsContext -> [Int] -> ByteString
encodeList HashidsContext
context forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Eq a, Num a) => [Char] -> a
go forall a b. (a -> b) -> a -> b
$ forall e. Int -> [e] -> [[e]]
chunksOf Int
12 [Char]
hexStr
where
go :: [Char] -> a
go [Char]
str = let [(a
a,[Char]
_)] = forall a. (Eq a, Num a) => ReadS a
readHex (Char
'1'forall a. a -> [a] -> [a]
:[Char]
str) in a
a
hexChar :: Char -> Bool
hexChar Char
c = Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"0123456789abcdefABCDEF" :: String)
decode :: HashidsContext
-> ByteString
-> [Int]
decode :: HashidsContext -> ByteString -> [Int]
decode ctx :: HashidsContext
ctx@Context{Int
ByteString
alphabet :: ByteString
minHashLength :: Int
salt :: ByteString
seps :: ByteString
guards :: ByteString
alphabet :: HashidsContext -> ByteString
minHashLength :: HashidsContext -> Int
salt :: HashidsContext -> ByteString
seps :: HashidsContext -> ByteString
guards :: HashidsContext -> ByteString
..} ByteString
hashDigest
| ByteString -> Bool
BS.null ByteString
hashDigest = []
| [Int]
res forall a. Eq a => a -> a -> Bool
== [] = []
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Ord a => a -> a -> Bool
< Int
0) [Int]
res = []
| HashidsContext -> [Int] -> ByteString
encodeList HashidsContext
ctx [Int]
res forall a. Eq a => a -> a -> Bool
/= ByteString
hashDigest = []
| Bool
otherwise = [Int]
res
where
res :: [Int]
res = forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ do
(Word8
lottery, ByteString
tail) <- Maybe (Word8, ByteString)
mLotteryAndTail
let prefix :: ByteString
prefix = Word8 -> ByteString -> ByteString
BS.cons Word8
lottery ByteString
salt
([Int], ByteString)
res' <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (ByteString
-> ([Int], ByteString) -> ByteString -> Maybe ([Int], ByteString)
go ByteString
prefix) ([], ByteString
alphabet) (ByteString -> ByteString -> [ByteString]
splitOn ByteString
seps ByteString
tail)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst ([Int], ByteString)
res'
hashArray :: [ByteString]
hashArray = ByteString -> ByteString -> [ByteString]
splitOn ByteString
guards ByteString
hashDigest
mLotteryAndTail :: Maybe (Word8, ByteString)
mLotteryAndTail =
ByteString -> Maybe (Word8, ByteString)
BS.uncons forall a b. (a -> b) -> a -> b
$ [ByteString]
hashArray forall a. [a] -> Int -> a
!! case forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
hashArray of
Int
0 -> forall a. HasCallStack => [Char] -> a
error [Char]
"Internal error."
Int
2 -> Int
1
Int
3 -> Int
1
Int
_ -> Int
0
go :: ByteString
-> ([Int], ByteString)
-> ByteString
-> Maybe ([Int], ByteString)
go :: ByteString
-> ([Int], ByteString) -> ByteString -> Maybe ([Int], ByteString)
go ByteString
prefix ([Int]
xs, ByteString
ab) ByteString
ssh = do
let buffer :: ByteString
buffer = ByteString
prefix ByteString -> ByteString -> ByteString
`BS.append` ByteString
ab
ab' :: ByteString
ab' = ByteString -> ByteString -> ByteString
consistentShuffle ByteString
ab ByteString
buffer
Int
unh <- ByteString -> ByteString -> Maybe Int
unhash ByteString
ssh ByteString
ab'
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
unhforall a. a -> [a] -> [a]
:[Int]
xs, ByteString
ab')
numbersHashInt :: [Int] -> Int
numbersHashInt :: [Int] -> Int
numbersHashInt [Int]
xs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Num a => a -> a -> a
(+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Integral a => a -> a -> a
mod) Int
0 forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
xs [Int
100 .. ]
encode :: HashidsContext
-> Int
-> ByteString
encode :: HashidsContext -> Int -> ByteString
encode HashidsContext
context Int
n = HashidsContext -> [Int] -> ByteString
encodeList HashidsContext
context [Int
n]
encodeList :: HashidsContext
-> [Int]
-> ByteString
encodeList :: HashidsContext -> [Int] -> ByteString
encodeList HashidsContext
_ [] = forall a. HasCallStack => [Char] -> a
error [Char]
"encodeList: empty list"
encodeList Context{Int
ByteString
alphabet :: ByteString
minHashLength :: Int
salt :: ByteString
seps :: ByteString
guards :: ByteString
alphabet :: HashidsContext -> ByteString
minHashLength :: HashidsContext -> Int
salt :: HashidsContext -> ByteString
seps :: HashidsContext -> ByteString
guards :: HashidsContext -> ByteString
..} [Int]
numbers =
ByteString
res forall a b. a -> (a -> b) -> b
|> Bool -> ByteString -> ByteString
expand Bool
False forall a b. a -> (a -> b) -> b
|> ByteString -> ByteString
BS.reverse
forall a b. a -> (a -> b) -> b
|> Bool -> ByteString -> ByteString
expand Bool
True forall a b. a -> (a -> b) -> b
|> ByteString -> ByteString
BS.reverse
forall a b. a -> (a -> b) -> b
|> ByteString -> ByteString -> ByteString
expand' ByteString
alphabet'
where
(ByteString
res, ByteString
alphabet') = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (ByteString, ByteString) -> (Int, Int) -> (ByteString, ByteString)
go (Word8 -> ByteString
BS.singleton Word8
lottery, ByteString
alphabet) (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 .. ] [Int]
numbers)
expand :: Bool -> ByteString -> ByteString
expand Bool
rep ByteString
str
| ByteString -> Int
BS.length ByteString
str forall a. Ord a => a -> a -> Bool
< Int
minHashLength
= let ix :: Int
ix = if Bool
rep then ByteString -> Int
BS.length ByteString
str forall a. Num a => a -> a -> a
- Int
3 else Int
0
jx :: Int
jx = forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
BS.index ByteString
str Int
ix) forall a. Num a => a -> a -> a
+ Int
hashInt
in HasCallStack => ByteString -> Int -> Word8
BS.index ByteString
guards (Int
jx forall a. Integral a => a -> a -> a
`mod` Int
guardsLength) Word8 -> ByteString -> ByteString
`BS.cons` ByteString
str
| Bool
otherwise = ByteString
str
expand' :: ByteString -> ByteString -> ByteString
expand' ByteString
ab ByteString
str
| ByteString -> Int
BS.length ByteString
str forall a. Ord a => a -> a -> Bool
< Int
minHashLength
= let ab' :: ByteString
ab' = ByteString -> ByteString -> ByteString
consistentShuffle ByteString
ab ByteString
ab
str' :: ByteString
str' = [ByteString] -> ByteString
BS.concat [Int -> ByteString -> ByteString
BS.drop Int
halfLength ByteString
ab', ByteString
str, Int -> ByteString -> ByteString
BS.take Int
halfLength ByteString
ab']
in ByteString -> ByteString -> ByteString
expand' ByteString
ab' forall a b. (a -> b) -> a -> b
$ case ByteString -> Int
BS.length ByteString
str' forall a. Num a => a -> a -> a
- Int
minHashLength of
Int
n | Int
n forall a. Ord a => a -> a -> Bool
> Int
0
-> Int -> ByteString -> ByteString
BS.take Int
minHashLength forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop (forall a. Integral a => a -> a -> a
div Int
n Int
2) ByteString
str'
Int
_ -> ByteString
str'
| Bool
otherwise = ByteString
str
hashInt :: Int
hashInt = [Int] -> Int
numbersHashInt [Int]
numbers
lottery :: Word8
lottery = ByteString
alphabet HasCallStack => ByteString -> Int -> Word8
`BS.index` (Int
hashInt forall a. Integral a => a -> a -> a
`mod` Int
alphabetLength)
prefix :: ByteString
prefix = Word8 -> ByteString -> ByteString
BS.cons Word8
lottery ByteString
salt
numLast :: Int
numLast = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
numbers forall a. Num a => a -> a -> a
- Int
1
guardsLength :: Int
guardsLength = ByteString -> Int
BS.length ByteString
guards
alphabetLength :: Int
alphabetLength = ByteString -> Int
BS.length ByteString
alphabet
halfLength :: Int
halfLength = forall a. Integral a => a -> a -> a
div Int
alphabetLength Int
2
go :: (ByteString, ByteString) -> (Int, Int) -> (ByteString, ByteString)
go (ByteString
r, ByteString
ab) (Int
i, Int
number)
| Int
number forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. HasCallStack => [Char] -> a
error [Char]
"all numbers must be non-negative"
| Bool
otherwise =
let shuffled :: ByteString
shuffled = ByteString -> ByteString -> ByteString
consistentShuffle ByteString
ab (ByteString -> ByteString -> ByteString
BS.append ByteString
prefix ByteString
ab)
last :: ByteString
last = Int -> ByteString -> ByteString
hash Int
number ByteString
shuffled
n :: Int
n = Int
number forall a. Integral a => a -> a -> a
`mod` (forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Word8
BS.head ByteString
last) forall a. Num a => a -> a -> a
+ Int
i) forall a. Integral a => a -> a -> a
`mod` ByteString -> Int
BS.length ByteString
seps
suffix :: ByteString
suffix = if Int
i forall a. Ord a => a -> a -> Bool
< Int
numLast
then Word8 -> ByteString
BS.singleton (ByteString
seps HasCallStack => ByteString -> Int -> Word8
`BS.index` Int
n)
else ByteString
BS.empty
in ([ByteString] -> ByteString
BS.concat [ByteString
r,ByteString
last,ByteString
suffix], ByteString
shuffled)
exchange :: Int -> Int -> Seq a -> Seq a
exchange :: forall a. Int -> Int -> Seq a -> Seq a
exchange Int
i Int
j Seq a
seq = Int
i Int -> Int -> Seq a -> Seq a
<--> Int
j forall a b. (a -> b) -> a -> b
$ Int
j Int -> Int -> Seq a -> Seq a
<--> Int
i forall a b. (a -> b) -> a -> b
$ Seq a
seq
where
Int
a <--> :: Int -> Int -> Seq a -> Seq a
<--> Int
b = forall a. Int -> a -> Seq a -> Seq a
Seq.update Int
a forall a b. (a -> b) -> a -> b
$ forall a. Seq a -> Int -> a
Seq.index Seq a
seq Int
b
consistentShuffle :: ByteString -> ByteString -> ByteString
consistentShuffle :: ByteString -> ByteString -> ByteString
consistentShuffle ByteString
alphabet ByteString
salt
| Int
0 forall a. Eq a => a -> a -> Bool
== Int
saltLength = ByteString
alphabet
| Bool
otherwise = [Word8] -> ByteString
BS.pack forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Word8
x
where
(Int
_,Seq Word8
x) = forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
len, forall a. Enum a => a -> a
pred Int
len .. Int
1] [Int]
xs [Int]
ys forall a b. a -> (a -> b) -> b
|> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a}. (Int, Seq a) -> (Int, Int, Int) -> (Int, Seq a)
go (Int
0, ByteString -> Seq Word8
toSeq ByteString
alphabet)
xs :: [Int]
xs = forall a. [a] -> [a]
cycle [Int
0 .. Int
saltLength forall a. Num a => a -> a -> a
- Int
1]
ys :: [Int]
ys = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
saltLookup) [Int]
xs
saltLookup :: Int -> Word8
saltLookup Int
ix = HasCallStack => ByteString -> Int -> Word8
BS.index ByteString
salt (Int
ix forall a. Integral a => a -> a -> a
`mod` Int
saltLength)
saltLength :: Int
saltLength = ByteString -> Int
BS.length ByteString
salt
toSeq :: ByteString -> Seq Word8
toSeq = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' forall a. Seq a -> a -> Seq a
(Seq.|>) forall a. Seq a
Seq.empty
len :: Int
len = ByteString -> Int
BS.length ByteString
alphabet forall a. Num a => a -> a -> a
- Int
1
go :: (Int, Seq a) -> (Int, Int, Int) -> (Int, Seq a)
go (Int
p, Seq a
ab) (Int
i, Int
v, Int
ch) =
let shuffled :: Seq a
shuffled = forall a. Int -> Int -> Seq a -> Seq a
exchange Int
i Int
j Seq a
ab
p' :: Int
p' = Int
p forall a. Num a => a -> a -> a
+ Int
ch
j :: Int
j = forall a. Integral a => a -> a -> a
mod (Int
ch forall a. Num a => a -> a -> a
+ Int
v forall a. Num a => a -> a -> a
+ Int
p') Int
i
in (Int
p', Seq a
shuffled)
unhash :: ByteString -> ByteString -> Maybe Int
unhash :: ByteString -> ByteString -> Maybe Int
unhash ByteString
input ByteString
alphabet = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' Maybe Int -> Word8 -> Maybe Int
go (forall a. a -> Maybe a
Just Int
0) ByteString
input
where
go :: Maybe Int -> Word8 -> Maybe Int
go :: Maybe Int -> Word8 -> Maybe Int
go Maybe Int
Nothing Word8
_ = forall a. Maybe a
Nothing
go (Just Int
carry) Word8
item = do
Int
index <- Word8 -> ByteString -> Maybe Int
BS.elemIndex Word8
item ByteString
alphabet
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int
carry forall a. Num a => a -> a -> a
* Int
alphabetLength forall a. Num a => a -> a -> a
+ Int
index
alphabetLength :: Int
alphabetLength = ByteString -> Int
BS.length ByteString
alphabet
hash :: Int -> ByteString -> ByteString
hash :: Int -> ByteString -> ByteString
hash Int
input ByteString
alphabet
| Int
0 forall a. Eq a => a -> a -> Bool
== Int
input = Int -> ByteString -> ByteString
BS.take Int
1 ByteString
alphabet
| Bool
otherwise = ByteString -> ByteString
BS.reverse forall a b. (a -> b) -> a -> b
$ forall a. (a -> Maybe (Word8, a)) -> a -> ByteString
BS.unfoldr Int -> Maybe (Word8, Int)
go Int
input
where
len :: Int
len = ByteString -> Int
BS.length ByteString
alphabet
go :: Int -> Maybe (Word8, Int)
go Int
0 = forall a. Maybe a
Nothing
go Int
i = forall a. a -> Maybe a
Just (ByteString
alphabet HasCallStack => ByteString -> Int -> Word8
`BS.index` (Int
i forall a. Integral a => a -> a -> a
`mod` Int
len), forall a. Integral a => a -> a -> a
div Int
i Int
len)
encodeUsingSalt :: ByteString
-> Int
-> ByteString
encodeUsingSalt :: ByteString -> Int -> ByteString
encodeUsingSalt = HashidsContext -> Int -> ByteString
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HashidsContext
hashidsSimple
encodeListUsingSalt :: ByteString
-> [Int]
-> ByteString
encodeListUsingSalt :: ByteString -> [Int] -> ByteString
encodeListUsingSalt = HashidsContext -> [Int] -> ByteString
encodeList forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HashidsContext
hashidsSimple
decodeUsingSalt :: ByteString
-> ByteString
-> [Int]
decodeUsingSalt :: ByteString -> ByteString -> [Int]
decodeUsingSalt = HashidsContext -> ByteString -> [Int]
decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HashidsContext
hashidsSimple
encodeHexUsingSalt :: ByteString
-> String
-> ByteString
encodeHexUsingSalt :: ByteString -> [Char] -> ByteString
encodeHexUsingSalt = HashidsContext -> [Char] -> ByteString
encodeHex forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HashidsContext
hashidsSimple
decodeHexUsingSalt :: ByteString
-> ByteString
-> String
decodeHexUsingSalt :: ByteString -> ByteString -> [Char]
decodeHexUsingSalt = HashidsContext -> ByteString -> [Char]
decodeHex forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HashidsContext
hashidsSimple