diff --git a/NanoID.cabal b/NanoID.cabal --- a/NanoID.cabal +++ b/NanoID.cabal @@ -1,5 +1,5 @@ name: NanoID -version: 3.3.0 +version: 3.4.0 synopsis: NanoID generator description: Library and CLI tool for NanoID generation license: BSD3 @@ -20,29 +20,31 @@ || == 8.8.4 || == 8.10.7 || == 9.0.2 - || == 9.2.5 + || == 9.2.6 + || == 9.4.5 + || == 9.6.1 source-repository head type: git - location: git://github.com/MichelBoucey/NanoID.git + location: https://github.com/MichelBoucey/NanoID.git library exposed-modules: Data.NanoID build-depends: aeson >= 1.5.6 && < 1.6 || >= 2.0 && < 2.2 - , base >= 4.7 && < 4.17 + , base >= 4.7 && < 4.19 , bytestring >= 0.10 && < 0.12 , cereal >= 0.5.8 && < 0.5.9 , extra >= 1.6 && < 1.8 , mwc-random >= 0.13 && < 0.16 , text >= 1.2.3 && < 1.3 || == 2.0.* - hs-source-dirs: src + hs-source-dirs: lib default-language: Haskell2010 executable nanoid main-is: Main.hs other-modules: Options Paths_NanoID - build-depends: base >= 4.7 && < 4.17 + build-depends: base >= 4.7 && < 4.19 , bytestring >= 0.10 && < 0.12 , mwc-random >= 0.13 && < 0.16 , NanoID diff --git a/ReadMe.md b/ReadMe.md --- a/ReadMe.md +++ b/ReadMe.md @@ -1,15 +1,17 @@ # NanoID generator, library and CLI tool ![CI](https://github.com/MichelBoucey/NanoID/actions/workflows/haskell-ci.yml/badge.svg) ``` [user@box ~] $ nanoid -h -nanoid v3.3.0, (c) Michel Boucey 2022-2023 +nanoid v3.4.0, (c) Michel Boucey 2022-2023 -Usage: nanoid [-a|--alphabet ARG] [-l|--length ARG] [-q|--quantity ARG] - [-n|--newline] +Usage: nanoid [-a|--alphabet ARG] [-l|--length ARG] [-p|--password] + [-q|--quantity ARG] [-n|--newline] [-v|--version] + NanoID generator Available options: -a,--alphabet ARG Use an alternative alphabet (ascii chars only) -l,--length ARG Get a shorter NanoID (Default length is 21 chars) + -p,--password Special password generation -q,--quantity ARG Quantity of NanoID to generate -n,--newline Do not output the trailing newline -v,--version Show version diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -20,15 +20,19 @@ main = do Options{..} <- execParser opts if showver - then putStrLn (showVer) >> exitFailure + then putStrLn showVer >> exitFailure else if length < 1 || length > 21 then strFail "nanoid length" else if quantity < 1 then strFail "quantity" else do + let alphabet' = + if password + then specialPassword + else toAlphabet alphabet replicateM_ quantity $ createSystemRandom - >>= customNanoID (toAlphabet alphabet) (toEnum length) + >>= customNanoID alphabet' (toEnum length) >>= putNanoID newline exitSuccess where diff --git a/app/Options.hs b/app/Options.hs --- a/app/Options.hs +++ b/app/Options.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE TemplateHaskell #-} module Options where @@ -18,6 +17,7 @@ Options { alphabet :: String , length :: Int + , password :: Bool , quantity :: Int , newline :: Bool , showver :: Bool @@ -46,6 +46,11 @@ <> long "length" <> help "Get a shorter NanoID (Default length is 21 chars)" <> value 21 ) + <*> + flag False True + ( short 'p' + <> long "password" + <> help "Special password generation" ) <*> option auto ( short 'q' diff --git a/lib/Data/NanoID.hs b/lib/Data/NanoID.hs new file mode 100644 --- /dev/null +++ b/lib/Data/NanoID.hs @@ -0,0 +1,106 @@ +{-# 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 { unNanoID :: C.ByteString } + deriving (Eq, Generic) + +newtype Alphabet = + Alphabet { unAlphabet :: C.ByteString } + deriving (Eq) + +type Length = Natural + +instance Show NanoID where + show n = C.unpack (unNanoID n) + +instance Show Alphabet where + show a = C.unpack (unAlphabet a) + +instance ToJSON NanoID where + toJSON n = String (decodeUtf8 $ unNanoID n) + +instance FromJSON NanoID where + parseJSON (String s) = pure (NanoID $ encodeUtf8 s) + parseJSON _ = fail "A JSON String is expected to convert to NanoID" + +instance Serialize NanoID + +-- | Create a new 'Alphabet' from a string of symbols of your choice +toAlphabet :: String -> Alphabet +toAlphabet = Alphabet . C.pack + +-- | Standard 'NanoID' generator function +-- +-- >λ: createSystemRandom >>= nanoID +-- >x2f8yFadIm-Vp14ByJ8R3 +-- +nanoID :: GenIO -> IO NanoID +nanoID = customNanoID defaultAlphabet 21 + +-- | Customable 'NanoID' generator function +customNanoID + :: Alphabet -- ^ An 'Alphabet' of your choice + -> Length -- ^ A 'NanoID' length (the standard length is 21 chars) + -> GenIO -- ^ The pseudo-random number generator state + -> IO NanoID +customNanoID a l g = + let + ua = unAlphabet a + al = C.length ua + l' = fromEnum l + in + NanoID . C.pack <$> replicateM l' ((\r -> C.index ua (r-1)) <$> uniformR (1,al) g) + +-- | The default 'Alphabet', made of URL-friendly symbols. +defaultAlphabet :: Alphabet +defaultAlphabet = toAlphabet "ABCDEFGHIJKLMNOPKRSTUVWXYZ_1234567890-abcdefghijklmnopqrstuvwxyz" + +-- * Some predefined 'Alphabet's, borrowed from https://github.com/CyberAP/nanoid-dictionary + +numbers :: Alphabet +numbers = toAlphabet "1234567890" + +hexadecimalLowercase :: Alphabet +hexadecimalLowercase = toAlphabet "0123456789abcdef" + +hexadecimalUppercase :: Alphabet +hexadecimalUppercase = toAlphabet "0123456789ABCDEF" + +lowercase :: Alphabet +lowercase = toAlphabet "abcdefghijklmnopqrstuvwxyz" + +uppercase :: Alphabet +uppercase = toAlphabet "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + +alphanumeric :: Alphabet +alphanumeric = toAlphabet "ABCDEFGHIJKLMNOPKRSTUVWXYZ1234567890abcdefghijklmnopqrstuvwxyz" + +nolookalikes :: Alphabet +nolookalikes = toAlphabet "346789ABCDEFGHJKLMNPQRTUVWXYabcdefghijkmnpqrtwxyz" + +nolookalikesSafe :: Alphabet +nolookalikesSafe = toAlphabet "6789ABCDEFGHJKLMNPQRTUWYabcdefghijkmnpqrtwyz" + +-- * Special password + +specialPassword :: Alphabet +specialPassword = toAlphabet "67{8_9A!B>CDEF)GH=JKL(MNPQ%RTU]W.Ya@bc%def&g[hij}k)) -#endif - -import Data.Serialize (Serialize) -import Data.Text.Encoding -import GHC.Generics -import Numeric.Natural -import System.Random.MWC - -newtype NanoID = - NanoID { unNanoID :: C.ByteString } - deriving (Eq, Generic) - -newtype Alphabet = - Alphabet { unAlphabet :: C.ByteString } - deriving (Eq) - -type Length = Natural - -instance Show NanoID where - show n = C.unpack (unNanoID n) - -instance Show Alphabet where - show a = C.unpack (unAlphabet a) - -instance ToJSON NanoID where - toJSON n = String (decodeUtf8 $ unNanoID n) - -instance FromJSON NanoID where - parseJSON (String s) = pure (NanoID $ encodeUtf8 s) - parseJSON _ = fail "A JSON String is expected to convert to NanoID" - -instance Serialize NanoID - --- | Create a new 'Alphabet' from a string of symbols of your choice -toAlphabet :: String -> Alphabet -toAlphabet = Alphabet . C.pack - --- | Standard 'NanoID' generator function --- --- >λ: createSystemRandom >>= nanoID --- >x2f8yFadIm-Vp14ByJ8R3 --- -nanoID :: GenIO -> IO NanoID -nanoID = customNanoID defaultAlphabet 21 - --- | Customable 'NanoID' generator function -customNanoID :: Alphabet -- ^ An 'Alphabet' of your choice - -> Length -- ^ A 'NanoID' length (the standard length is 21 chars) - -> GenIO -- ^ The pseudo-random number generator state - -> IO NanoID -customNanoID a l g = - NanoID . C.pack <$> replicateM (fromEnum l) ((\r -> C.index ua (r-1)) <$> uniformR (1,al) g) - where - ua = unAlphabet a - al = C.length ua - --- | The default 'Alphabet', made of URL-friendly symbols. -defaultAlphabet :: Alphabet -defaultAlphabet = toAlphabet "ABCDEFGHIJKLMNOPKRSTUVWXYZ_1234567890-abcdefghijklmnopqrstuvwxyz" - --- * Some predefined Alphabets, borrowed from https://github.com/CyberAP/nanoid-dictionary - -numbers :: Alphabet -numbers = toAlphabet "1234567890" - -hexadecimalLowercase :: Alphabet -hexadecimalLowercase = toAlphabet "0123456789abcdef" - -hexadecimalUppercase :: Alphabet -hexadecimalUppercase = toAlphabet "0123456789ABCDEF" - -lowercase :: Alphabet -lowercase = toAlphabet "abcdefghijklmnopqrstuvwxyz" - -uppercase :: Alphabet -uppercase = toAlphabet "ABCDEFGHIJKLMNOPQRSTUVWXYZ" - -alphanumeric :: Alphabet -alphanumeric = toAlphabet "ABCDEFGHIJKLMNOPKRSTUVWXYZ1234567890abcdefghijklmnopqrstuvwxyz" - -nolookalikes :: Alphabet -nolookalikes = toAlphabet "346789ABCDEFGHJKLMNPQRTUVWXYabcdefghijkmnpqrtwxyz" - -nolookalikesSafe :: Alphabet -nolookalikesSafe = toAlphabet "6789ABCDEFGHJKLMNPQRTUWYabcdefghijkmnpqrtwyz" -