{-# 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
|> :: 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 ((Word8 -> Bool) -> ByteString -> [ByteString])
-> (ByteString -> Word8 -> Bool)
-> ByteString
-> ByteString
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> ByteString -> Bool) -> ByteString -> Word8 -> Bool
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 -> String
(Int -> HashidsContext -> ShowS)
-> (HashidsContext -> String)
-> ([HashidsContext] -> ShowS)
-> Show HashidsContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HashidsContext] -> ShowS
$cshowList :: [HashidsContext] -> ShowS
show :: HashidsContext -> String
$cshow :: HashidsContext -> String
showsPrec :: Int -> HashidsContext -> ShowS
$cshowsPrec :: Int -> HashidsContext -> ShowS
Show)
version :: String
version :: String
version = String
"1.0.2"
createHashidsContext :: ByteString
-> Int
-> String
-> HashidsContext
createHashidsContext :: ByteString -> Int -> String -> HashidsContext
createHashidsContext ByteString
salt Int
minHashLen String
alphabet
| String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
uniqueAlphabet Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minAlphabetLength
= String -> HashidsContext
forall a. HasCallStack => String -> a
error (String -> HashidsContext) -> String -> HashidsContext
forall a b. (a -> b) -> a -> b
$ String
"alphabet must contain at least " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
minAlphabetLength String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" unique characters"
| Char
' ' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
uniqueAlphabet
= String -> HashidsContext
forall a. HasCallStack => String -> a
error String
"alphabet cannot contain spaces"
| ByteString -> Bool
BS.null ByteString
seps'' Bool -> Bool -> Bool
|| Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
alphabet') Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
seps'') Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
sepDiv
= case Int
sepsLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
seps'' of
Int
diff | Int
diff Int -> Int -> Bool
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 = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
shuffled) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
guardDiv)
context :: HashidsContext
context = Context :: ByteString
-> ByteString -> ByteString -> Int -> ByteString -> HashidsContext
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 Int -> Int -> Bool
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' = String -> ByteString
C8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
uniqueAlphabet String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
`intersect` String
seps
seps'' :: ByteString
seps'' = ByteString -> ByteString -> ByteString
consistentShuffle ByteString
seps' ByteString
salt
sepsLength :: Int
sepsLength =
case Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
alphabet') Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sepDiv) of
Int
1 -> Int
2
Int
n -> Int
n
uniqueAlphabet :: String
uniqueAlphabet = ShowS
forall a. Eq a => [a] -> [a]
nub String
alphabet
alphabet' :: ByteString
alphabet' = String -> ByteString
C8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
uniqueAlphabet String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
\\ String
seps
minAlphabetLength :: Int
minAlphabetLength = Int
16
sepDiv :: Double
sepDiv = Double
3.5 :: Double
guardDiv :: Double
guardDiv = Double
12 :: Double
seps :: String
seps = String
"cfhistuCFHISTU"
defaultAlphabet :: String
defaultAlphabet :: String
defaultAlphabet = [Char
'a'..Char
'z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'A'..Char
'Z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"1234567890"
hashidsSimple :: ByteString
-> HashidsContext
hashidsSimple :: ByteString -> HashidsContext
hashidsSimple ByteString
salt = ByteString -> Int -> String -> HashidsContext
createHashidsContext ByteString
salt Int
0 String
defaultAlphabet
hashidsMinimum :: ByteString
-> Int
-> HashidsContext
hashidsMinimum :: ByteString -> Int -> HashidsContext
hashidsMinimum ByteString
salt Int
minimum = ByteString -> Int -> String -> HashidsContext
createHashidsContext ByteString
salt Int
minimum String
defaultAlphabet
decodeHex :: HashidsContext
-> ByteString
-> String
decodeHex :: HashidsContext -> ByteString -> String
decodeHex HashidsContext
context ByteString
hashDigest = (Int -> String) -> [Int] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> ShowS) -> String -> Int -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex String
"") [Int]
numbers
where
numbers :: [Int]
numbers = HashidsContext -> ByteString -> [Int]
decode HashidsContext
context ByteString
hashDigest
encodeHex :: HashidsContext
-> String
-> ByteString
encodeHex :: HashidsContext -> String -> ByteString
encodeHex HashidsContext
context String
hexStr
| Bool -> Bool
not ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
hexChar String
hexStr) = ByteString
""
| Bool
otherwise = HashidsContext -> [Int] -> ByteString
encodeList HashidsContext
context ([Int] -> ByteString) -> [Int] -> ByteString
forall a b. (a -> b) -> a -> b
$ (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall a. (Eq a, Num a) => String -> a
go ([String] -> [Int]) -> [String] -> [Int]
forall a b. (a -> b) -> a -> b
$ Int -> String -> [String]
forall e. Int -> [e] -> [[e]]
chunksOf Int
12 String
hexStr
where
go :: String -> a
go String
str = let [(a
a,String
_)] = ReadS a
forall a. (Eq a, Num a) => ReadS a
readHex (Char
'1'Char -> ShowS
forall a. a -> [a] -> [a]
:String
str) in a
a
hexChar :: Char -> Bool
hexChar Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"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 [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [] = []
| (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) [Int]
res = []
| HashidsContext -> [Int] -> ByteString
encodeList HashidsContext
ctx [Int]
res ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
hashDigest = []
| Bool
otherwise = [Int]
res
where
res :: [Int]
res = [Int] -> Maybe [Int] -> [Int]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Int] -> [Int]) -> Maybe [Int] -> [Int]
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' <- (([Int], ByteString) -> ByteString -> Maybe ([Int], ByteString))
-> ([Int], ByteString) -> [ByteString] -> Maybe ([Int], ByteString)
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)
[Int] -> Maybe [Int]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> Maybe [Int]) -> [Int] -> Maybe [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ ([Int], ByteString) -> [Int]
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 (ByteString -> Maybe (Word8, ByteString))
-> ByteString -> Maybe (Word8, ByteString)
forall a b. (a -> b) -> a -> b
$ [ByteString]
hashArray [ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!! case [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
hashArray of
Int
0 -> String -> Int
forall a. HasCallStack => String -> a
error String
"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'
([Int], ByteString) -> Maybe ([Int], ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
unhInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs, ByteString
ab')
numbersHashInt :: [Int] -> Int
numbersHashInt :: [Int] -> Int
numbersHashInt [Int]
xs = ((Int, Int) -> Int -> Int) -> Int -> [(Int, Int)] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> Int)
-> ((Int, Int) -> Int) -> (Int, Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int) -> (Int, Int) -> Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod) Int
0 ([(Int, Int)] -> Int) -> [(Int, Int)] -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [(Int, Int)]
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
_ [] = String -> ByteString
forall a. HasCallStack => String -> a
error String
"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 ByteString -> (ByteString -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
|> Bool -> ByteString -> ByteString
expand Bool
False ByteString -> (ByteString -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
|> ByteString -> ByteString
BS.reverse
ByteString -> (ByteString -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
|> Bool -> ByteString -> ByteString
expand Bool
True ByteString -> (ByteString -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
|> ByteString -> ByteString
BS.reverse
ByteString -> (ByteString -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
|> ByteString -> ByteString -> ByteString
expand' ByteString
alphabet'
where
(ByteString
res, ByteString
alphabet') = ((ByteString, ByteString)
-> (Int, Int) -> (ByteString, ByteString))
-> (ByteString, ByteString)
-> [(Int, Int)]
-> (ByteString, ByteString)
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) ([Int] -> [Int] -> [(Int, Int)]
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minHashLength
= let ix :: Int
ix = if Bool
rep then ByteString -> Int
BS.length ByteString
str Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3 else Int
0
jx :: Int
jx = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.index ByteString
str Int
ix) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hashInt
in ByteString -> Int -> Word8
BS.index ByteString
guards (Int
jx Int -> Int -> Int
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 Int -> Int -> Bool
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' (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ case ByteString -> Int
BS.length ByteString
str' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
minHashLength of
Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
-> Int -> ByteString -> ByteString
BS.take Int
minHashLength (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop (Int -> Int -> Int
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 ByteString -> Int -> Word8
`BS.index` (Int
hashInt Int -> Int -> Int
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 = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
numbers Int -> Int -> Int
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 = Int -> Int -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> (ByteString, ByteString)
forall a. HasCallStack => String -> a
error String
"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 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Word8
BS.head ByteString
last) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` ByteString -> Int
BS.length ByteString
seps
suffix :: ByteString
suffix = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
numLast
then Word8 -> ByteString
BS.singleton (ByteString
seps 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 :: Int -> Int -> Seq a -> Seq a
exchange Int
i Int
j Seq a
seq = Int
i Int -> Int -> Seq a -> Seq a
<--> Int
j (Seq a -> Seq a) -> Seq a -> Seq a
forall a b. (a -> b) -> a -> b
$ Int
j Int -> Int -> Seq a -> Seq a
<--> Int
i (Seq a -> Seq a) -> Seq a -> Seq a
forall a b. (a -> b) -> a -> b
$ Seq a
seq
where
Int
a <--> :: Int -> Int -> Seq a -> Seq a
<--> Int
b = Int -> a -> Seq a -> Seq a
forall a. Int -> a -> Seq a -> Seq a
Seq.update Int
a (a -> Seq a -> Seq a) -> a -> Seq a -> Seq a
forall a b. (a -> b) -> a -> b
$ Seq a -> Int -> a
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
saltLength = ByteString
alphabet
| Bool
otherwise = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ Seq Word8 -> [Word8]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Word8
x
where
(Int
_,Seq Word8
x) = [Int] -> [Int] -> [Int] -> [(Int, Int, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
len, Int -> Int
forall a. Enum a => a -> a
pred Int
len .. Int
1] [Int]
xs [Int]
ys [(Int, Int, Int)]
-> ([(Int, Int, Int)] -> (Int, Seq Word8)) -> (Int, Seq Word8)
forall a b. a -> (a -> b) -> b
|> ((Int, Seq Word8) -> (Int, Int, Int) -> (Int, Seq Word8))
-> (Int, Seq Word8) -> [(Int, Int, Int)] -> (Int, Seq Word8)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, Seq Word8) -> (Int, Int, Int) -> (Int, Seq Word8)
forall a. (Int, Seq a) -> (Int, Int, Int) -> (Int, Seq a)
go (Int
0, ByteString -> Seq Word8
toSeq ByteString
alphabet)
xs :: [Int]
xs = [Int] -> [Int]
forall a. [a] -> [a]
cycle [Int
0 .. Int
saltLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
ys :: [Int]
ys = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> (Int -> Word8) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
saltLookup) [Int]
xs
saltLookup :: Int -> Word8
saltLookup Int
ix = ByteString -> Int -> Word8
BS.index ByteString
salt (Int
ix Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
saltLength)
saltLength :: Int
saltLength = ByteString -> Int
BS.length ByteString
salt
toSeq :: ByteString -> Seq Word8
toSeq = (Seq Word8 -> Word8 -> Seq Word8)
-> Seq Word8 -> ByteString -> Seq Word8
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' Seq Word8 -> Word8 -> Seq Word8
forall a. Seq a -> a -> Seq a
(Seq.|>) Seq Word8
forall a. Seq a
Seq.empty
len :: Int
len = ByteString -> Int
BS.length ByteString
alphabet Int -> Int -> Int
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 = Int -> Int -> Seq a -> Seq a
forall a. Int -> Int -> Seq a -> Seq a
exchange Int
i Int
j Seq a
ab
p' :: Int
p' = Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ch
j :: Int
j = Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod (Int
ch Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
v Int -> Int -> Int
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 = (Maybe Int -> Word8 -> Maybe Int)
-> Maybe Int -> ByteString -> Maybe Int
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' Maybe Int -> Word8 -> Maybe Int
go (Int -> Maybe Int
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
_ = Maybe Int
forall a. Maybe a
Nothing
go (Just Int
carry) Word8
item = do
Int
index <- Word8 -> ByteString -> Maybe Int
BS.elemIndex Word8
item ByteString
alphabet
Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
carry Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
alphabetLength Int -> Int -> Int
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
input = Int -> ByteString -> ByteString
BS.take Int
1 ByteString
alphabet
| Bool
otherwise = ByteString -> ByteString
BS.reverse (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Int -> Maybe (Word8, Int)) -> Int -> ByteString
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 = Maybe (Word8, Int)
forall a. Maybe a
Nothing
go Int
i = (Word8, Int) -> Maybe (Word8, Int)
forall a. a -> Maybe a
Just (ByteString
alphabet ByteString -> Int -> Word8
`BS.index` (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
len), Int -> Int -> Int
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 (HashidsContext -> Int -> ByteString)
-> (ByteString -> HashidsContext)
-> ByteString
-> Int
-> ByteString
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 (HashidsContext -> [Int] -> ByteString)
-> (ByteString -> HashidsContext)
-> ByteString
-> [Int]
-> ByteString
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 (HashidsContext -> ByteString -> [Int])
-> (ByteString -> HashidsContext)
-> ByteString
-> ByteString
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HashidsContext
hashidsSimple
encodeHexUsingSalt :: ByteString
-> String
-> ByteString
encodeHexUsingSalt :: ByteString -> String -> ByteString
encodeHexUsingSalt = HashidsContext -> String -> ByteString
encodeHex (HashidsContext -> String -> ByteString)
-> (ByteString -> HashidsContext)
-> ByteString
-> String
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HashidsContext
hashidsSimple
decodeHexUsingSalt :: ByteString
-> ByteString
-> String
decodeHexUsingSalt :: ByteString -> ByteString -> String
decodeHexUsingSalt = HashidsContext -> ByteString -> String
decodeHex (HashidsContext -> ByteString -> String)
-> (ByteString -> HashidsContext)
-> ByteString
-> ByteString
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HashidsContext
hashidsSimple