diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -NanoID, lib & app, Copyright (c) 2021-2024, Michel Boucey +NanoID, lib & app, Copyright (c) 2021-2025, Michel Boucey All rights reserved. diff --git a/NanoID.cabal b/NanoID.cabal --- a/NanoID.cabal +++ b/NanoID.cabal @@ -1,44 +1,55 @@ name: NanoID -version: 3.4.0.2 +version: 3.4.1 synopsis: NanoID generator description: Library and CLI tool for NanoID generation license: BSD3 license-file: LICENSE author: Michel Boucey maintainer: michel.boucey@gmail.com -copyright: (c) 2021-2024 - Michel Boucey -category: Data +copyright: (c) 2021-2025 - Michel Boucey +category: Random, Data build-type: Simple cabal-version: >=1.10 extra-source-files: ReadMe.md -Tested-With: GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.5 || ==9.8.2 +Tested-With: + GHC ==8.8.4 + || ==8.10.7 + || ==9.0.2 + || ==9.2.8 + || ==9.4.8 + || ==9.6.7 + || ==9.8.4 + || ==9.10.2 + || ==9.12.2 source-repository head type: git location: https://github.com/MichelBoucey/NanoID.git library + hs-source-dirs: src + default-language: Haskell2010 exposed-modules: Data.NanoID build-depends: aeson >= 1.5.6 && < 1.6 || >= 2.0 && < 2.3 - , base >= 4.7 && < 4.20 + , base >= 4.7 && < 5 , bytestring >= 0.10 && < 0.13 , cereal >= 0.5.8 && < 0.5.9 - , extra >= 1.6 && < 1.8 - , mwc-random >= 0.13 && < 0.16 + , extra >= 1.6 && < 1.9 + , mwc-random > 0.15 && < 0.16 , text >= 1.2.3 && < 2.2 - hs-source-dirs: lib - default-language: Haskell2010 executable nanoid + hs-source-dirs: app main-is: Main.hs + default-language: Haskell2010 + GHC-Options: -Wall -O2 other-modules: Options Paths_NanoID - build-depends: base >= 4.7 && < 4.20 + build-depends: base >= 4.7 && < 5 , bytestring >= 0.10 && < 0.13 , mwc-random >= 0.13 && < 0.16 , NanoID , optparse-applicative >= 0.14 && < 0.19 - hs-source-dirs: app - default-language: Haskell2010 + , bytestring-encodings >= 0.2 && < 1 diff --git a/ReadMe.md b/ReadMe.md --- a/ReadMe.md +++ b/ReadMe.md @@ -1,8 +1,8 @@ -# NanoID generator, library and CLI tool ![CI](https://github.com/MichelBoucey/NanoID/actions/workflows/haskell-ci.yml/badge.svg) +# NanoID generator, library and CLI ![CI](https://github.com/MichelBoucey/NanoID/actions/workflows/haskell-ci.yml/badge.svg) [![Hackage](https://img.shields.io/hackage/v/NanoID.svg)](https://hackage.haskell.org/package/NanoID) ``` [user@box ~] $ nanoid -h -nanoid v3.4.0.2, (c) Michel Boucey 2022-2024 +nanoid v3.4.1, (c) Michel Boucey 2022-2025 Usage: nanoid [-a|--alphabet ARG] [-l|--length ARG] [-p|--password] [-q|--quantity ARG] [-n|--newline] [-v|--version] diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,15 +1,17 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE RecordWildCards #-} import Control.Monad #if !MIN_VERSION_base(4,11,0) -import Data.Monoid ((<>)) +import Data.Monoid ((<>)) #endif -import qualified Data.ByteString.Char8 as C -import Data.Either +import qualified Data.ByteString.Char8 as C +import Data.ByteString.Internal.Ascii import Options.Applicative +import Prelude hiding (length) import System.Exit import System.Random.MWC @@ -26,17 +28,19 @@ else if quantity < 1 then strFail "quantity" else do - let alphabet' = - if password - then specialPassword - else toAlphabet alphabet - replicateM_ quantity $ - createSystemRandom - >>= customNanoID alphabet' (toEnum length) - >>= putNanoID newline - exitSuccess + let mAlphabet = + if | password -> Just specialPassword + | alphabet == unAlphabet defaultAlphabet -> Just defaultAlphabet + | isAscii alphabet -> Just (Alphabet alphabet) + | otherwise -> Nothing + case mAlphabet of + Just a -> do + replicateM_ quantity $ + createSystemRandom >>= customNanoID a (toEnum length) >>= putNanoID newline + exitSuccess + Nothing -> strFail "alphabet that is not made of ascii chars only" where strFail m = putStrLn ("Bad " <> m <> ". See help (-h).") >> exitFailure putNanoID nl = put nl . unNanoID - where put nl = if nl then C.putStrLn else C.putStr + where put nl' = if nl' then C.putStrLn else C.putStr diff --git a/app/Options.hs b/app/Options.hs --- a/app/Options.hs +++ b/app/Options.hs @@ -15,7 +15,7 @@ data Options = Options - { alphabet :: String + { alphabet :: C.ByteString , length :: Int , password :: Bool , quantity :: Int @@ -29,7 +29,7 @@ <> progDesc "NanoID generator" <> header ( "nanoid " <> showVer - <> ", (c) Michel Boucey 2022-2023" ) ) + <> ", (c) Michel Boucey 2022-2025" ) ) options :: Parser Options options = @@ -39,7 +39,7 @@ ( short 'a' <> long "alphabet" <> help "Use an alternative alphabet (ascii chars only)" - <> value (C.unpack $ unAlphabet defaultAlphabet) ) + <> value (unAlphabet defaultAlphabet)) <*> option auto ( short 'l' diff --git a/lib/Data/NanoID.hs b/lib/Data/NanoID.hs deleted file mode 100644 --- a/lib/Data/NanoID.hs +++ /dev/null @@ -1,106 +0,0 @@ -{-# 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 = C.unpack . unNanoID - -instance Show Alphabet where - show = C.unpack . unAlphabet - -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 = C.unpack . unNanoID + +instance Show Alphabet where + show = C.unpack . unAlphabet + +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