{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
module Data.NanoID where
import Control.Monad
import Data.Aeson
import qualified Data.ByteString.Char8 as C
import Data.Maybe
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Data.Serialize (Serialize)
import Data.Text.Encoding
import GHC.Generics
import Numeric.Natural
import System.Random.MWC
newtype NanoID =
NanoID { NanoID -> ByteString
unNanoID :: C.ByteString }
deriving (NanoID -> NanoID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NanoID -> NanoID -> Bool
$c/= :: NanoID -> NanoID -> Bool
== :: NanoID -> NanoID -> Bool
$c== :: NanoID -> NanoID -> Bool
Eq, forall x. Rep NanoID x -> NanoID
forall x. NanoID -> Rep NanoID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NanoID x -> NanoID
$cfrom :: forall x. NanoID -> Rep NanoID x
Generic)
newtype Alphabet =
Alphabet { Alphabet -> ByteString
unAlphabet :: C.ByteString }
deriving (Alphabet -> Alphabet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Alphabet -> Alphabet -> Bool
$c/= :: Alphabet -> Alphabet -> Bool
== :: Alphabet -> Alphabet -> Bool
$c== :: Alphabet -> Alphabet -> Bool
Eq)
type Length = Natural
instance Show NanoID where
show :: NanoID -> String
show NanoID
n = ByteString -> String
C.unpack (NanoID -> ByteString
unNanoID NanoID
n)
instance Show Alphabet where
show :: Alphabet -> String
show Alphabet
a = ByteString -> String
C.unpack (Alphabet -> ByteString
unAlphabet Alphabet
a)
instance ToJSON NanoID where
toJSON :: NanoID -> Value
toJSON NanoID
n = Text -> Value
String (ByteString -> Text
decodeUtf8 forall a b. (a -> b) -> a -> b
$ NanoID -> ByteString
unNanoID NanoID
n)
instance FromJSON NanoID where
parseJSON :: Value -> Parser NanoID
parseJSON (String Text
s) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> NanoID
NanoID forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
s)
parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"A JSON String is expected to convert to NanoID"
instance Serialize NanoID
toAlphabet :: String -> Alphabet
toAlphabet :: String -> Alphabet
toAlphabet = ByteString -> Alphabet
Alphabet forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
C.pack
nanoID :: GenIO -> IO NanoID
nanoID :: GenIO -> IO NanoID
nanoID = Alphabet -> Length -> GenIO -> IO NanoID
customNanoID Alphabet
defaultAlphabet Length
21
customNanoID
:: Alphabet
-> Length
-> GenIO
-> IO NanoID
customNanoID :: Alphabet -> Length -> GenIO -> IO NanoID
customNanoID Alphabet
a Length
l GenIO
g =
let
ua :: ByteString
ua = Alphabet -> ByteString
unAlphabet Alphabet
a
al :: Int
al = ByteString -> Int
C.length ByteString
ua
l' :: Int
l' = forall a. Enum a => a -> Int
fromEnum Length
l
in
ByteString -> NanoID
NanoID forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
C.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
l' ((\Int
r -> ByteString -> Int -> Char
C.index ByteString
ua (Int
rforall a. Num a => a -> a -> a
-Int
1)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
(a, a) -> Gen (PrimState m) -> m a
uniformR (Int
1,Int
al) GenIO
g)
defaultAlphabet :: Alphabet
defaultAlphabet :: Alphabet
defaultAlphabet = String -> Alphabet
toAlphabet String
"ABCDEFGHIJKLMNOPKRSTUVWXYZ_1234567890-abcdefghijklmnopqrstuvwxyz"
numbers :: Alphabet
numbers :: Alphabet
numbers = String -> Alphabet
toAlphabet String
"1234567890"
hexadecimalLowercase :: Alphabet
hexadecimalLowercase :: Alphabet
hexadecimalLowercase = String -> Alphabet
toAlphabet String
"0123456789abcdef"
hexadecimalUppercase :: Alphabet
hexadecimalUppercase :: Alphabet
hexadecimalUppercase = String -> Alphabet
toAlphabet String
"0123456789ABCDEF"
lowercase :: Alphabet
lowercase :: Alphabet
lowercase = String -> Alphabet
toAlphabet String
"abcdefghijklmnopqrstuvwxyz"
uppercase :: Alphabet
uppercase :: Alphabet
uppercase = String -> Alphabet
toAlphabet String
"ABCDEFGHIJKLMNOPQRSTUVWXYZ"
alphanumeric :: Alphabet
alphanumeric :: Alphabet
alphanumeric = String -> Alphabet
toAlphabet String
"ABCDEFGHIJKLMNOPKRSTUVWXYZ1234567890abcdefghijklmnopqrstuvwxyz"
nolookalikes :: Alphabet
nolookalikes :: Alphabet
nolookalikes = String -> Alphabet
toAlphabet String
"346789ABCDEFGHJKLMNPQRTUVWXYabcdefghijkmnpqrtwxyz"
nolookalikesSafe :: Alphabet
nolookalikesSafe :: Alphabet
nolookalikesSafe = String -> Alphabet
toAlphabet String
"6789ABCDEFGHJKLMNPQRTUWYabcdefghijkmnpqrtwyz"
specialPassword :: Alphabet
specialPassword :: Alphabet
specialPassword = String -> Alphabet
toAlphabet String
"67{8_9A!B>CDEF)GH=JKL(MNPQ%RTU]W.Ya@bc%def&g[hij}k<m#-npq:r+twyz"