hscuid 1.2.0.0 → 1.2.0.1
raw patch · 7 files changed
+225/−61 lines, 7 filesdep +criteriondep +mwc-randomdep −formattingnew-component:exe:perf-test
Dependencies added: criterion, mwc-random
Dependencies removed: formatting
Files
- README.md +28/−2
- hscuid.cabal +29/−7
- lib/Web/Cuid.hs +10/−16
- lib/Web/Cuid/Internal.hs +32/−22
- lib/Web/Cuid/Internal/Formatting.hs +88/−0
- test/Perf.hs +8/−0
- test/Test.hs +30/−14
README.md view
@@ -1,12 +1,15 @@-# hscuid [](https://travis-ci.org/eightyeight/hscuid)+# hscuid +[](https://travis-ci.org/crabmusket/hscuid)+[](https://hackage.haskell.org/package/hscuid)+ A Haskell port of the [JavaScript library][cuid] for collision-resistant identifiers. To install, [`cabal install hscuid`][hscuid]. ## What is a CUID? CUIDs are short random strings designed so that you can generate a lot of them over many different machines and not get collisions.-They are designed to be usable in many situations, such as HTML element IDs.+They are intended to be usable in situations from HTML element IDs to database keys. You can read more about them at [usecuid.org][]. ## How do I use this library?@@ -19,7 +22,30 @@ "y900001wmf" ``` +## Developing++I am currently developing with [stack][].+To install dependencies and compile the library and test suites:++```sh+stack build+```++To run the collision test suite (which generates 1.2M IDs and makes sure they're all unique):++```sh+stack test+```++To test performance with [criterion][]:++```sh+stack exec perf-test -- --regress allocated:iters +RTS -T+```+ [cuid]: https://github.com/ericelliott/cuid [hscuid]: https://hackage.haskell.org/package/hscuid [semver]: http://semver.org [usecuid.org]: https://usecuid.org+[criterion]: https://hackage.haskell.org/package/criterion+[stack]: https://haskellstack.org
hscuid.cabal view
@@ -2,37 +2,44 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: hscuid-version: 1.2.0.0+version: 1.2.0.1 synopsis: Collision-resistant IDs description: See README (link below).-homepage: https://github.com/eightyeight/hscuid+homepage: https://github.com/crabmusket/hscuid license: BSD3 license-file: LICENSE author: Daniel Buckmaster maintainer: dan.buckmaster@gmail.com--- copyright: category: Web build-type: Simple-cabal-version: >=1.8+cabal-version: >= 1.8 extra-source-files: README.md+tested-with: GHC == 7.6.3+ , GHC == 7.8.4+ , GHC == 7.10.1+ , GHC == 8.0.2 +source-repository head+ type: git+ location: git://github.com/crabmusket/hscuid.git+ library hs-source-dirs: lib exposed-modules: Web.Cuid- other-modules: Web.Cuid.Internal+ other-modules: Web.Cuid.Internal Web.Cuid.Internal.Formatting build-depends: base >= 4.6 && < 5,- formatting >= 6.2, time >= 1.4, random >= 1.0, transformers >= 0.4, hostname >= 1.0,+ mwc-random >= 0.13, text >= 1.2 if os(windows) build-depends: Win32 >= 2.3 extra-libraries: kernel32 else build-depends: unix >= 2.6- ghc-options: -Wall+ ghc-options: -Wall -O2 test-suite hscuid-test type: exitcode-stdio-1.0@@ -40,5 +47,20 @@ main-is: Test.hs build-depends: base >= 4.6 && < 5, containers ==0.5.*,+ text >= 1.2, hscuid+ ghc-options: -Wall -rtsopts -O2++executable perf-test+ hs-source-dirs: test+ main-is: Perf.hs+ build-depends: base >= 4.6 && < 5,+ hscuid+ if impl(ghc < 7.8)+ -- We cannot use criterion >= 1.1.1 with GHC 7.6 because of its dependency+ -- on js-jquery, which requires Cabal library >= 1.18.+ -- See https://github.com/crabmusket/hscuid/pull/5#issuecomment-294654898+ build-depends: criterion >= 1.1 && < 1.1.1+ else+ build-depends: criterion >= 1.1 ghc-options: -Wall -rtsopts -O2
lib/Web/Cuid.hs view
@@ -16,11 +16,9 @@ import Control.Monad.IO.Class (MonadIO, liftIO) import Data.String (fromString) import Data.Text (Text)-import Formatting (sformat) -import Data.Monoid (Monoid, (<>)) #if !MIN_VERSION_base(4,8,0)-import Data.Monoid (mconcat)+import Data.Monoid (Monoid, mconcat) #endif import Web.Cuid.Internal@@ -37,19 +35,17 @@ -- The second chunk is the timestamp. Note that this means it is possible -- to determine the time a particular CUID was created.- time = liftM (sformat number) getTimestamp+ time = liftM formatNumber getTimestamp - -- To avoid collisions on the same machine, add a global counter to each ID.- count = liftM (sformat numberPadded) getNextCount+ -- To avoid collisions in the same process, add a global counter to each ID.+ count = liftM formatPadded getNextCount -- To avoid collisions between separate machines, generate a 'fingerprint' -- from details which are hopefully unique to this machine - PID and hostname.- fingerprint = do- (pid, host) <- getFingerprint- return (sformat twoOfNum pid <> sformat twoOfNum host)+ fingerprint = return myFingerprint -- And some actual randomness for good measure.- random = liftM (sformat numberPadded) getRandomValue+ random = liftM formatPadded getRandomValue -- | A Slug is not a Cuid. But it is also a strict Text. type Slug = Text@@ -58,12 +54,10 @@ -- techniques as CUIDs. newSlug :: MonadIO m => m Slug newSlug = concatResults [time, count, fingerprint, random] where- time = liftM (sformat twoOfNum) getTimestamp- count = liftM (sformat numberPadded) getNextCount- random = liftM (sformat twoOfNum) getRandomValue- fingerprint = do- (pid, host) <- getFingerprint- return (sformat firstOfNum pid <> sformat lastOfNum host)+ time = liftM formatShort getTimestamp+ count = liftM formatPadded getNextCount+ random = liftM formatShort getRandomValue+ fingerprint = return myFingerprint -- Evaluate IO actions and concatenate their results. concatResults :: (MonadIO m, Monoid a) => [IO a] -> m a
lib/Web/Cuid/Internal.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, ForeignFunctionInterface #-}+{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns #-} {-| Stability: unstable@@ -6,18 +6,22 @@ Contains internal implementation details for CUIDs. -}-module Web.Cuid.Internal where+module Web.Cuid.Internal (+ formatNumber, formatPadded, formatShort,+ getNextCount, getRandomValue, getTimestamp, myFingerprint+) where import Control.Monad (liftM) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Char (ord) import Data.IORef (IORef, newIORef, atomicModifyIORef')-import Data.Text (Text)+import Data.Text (Text, append) import Data.Time.Clock.POSIX (getPOSIXTime)-import Formatting (Format, base, fitLeft, fitRight, left, (%.)) import Network.HostName (getHostName) import System.IO.Unsafe (unsafePerformIO)-import System.Random (randomRIO)+import System.Random.MWC (GenIO)+import qualified System.Random.MWC as MWC+import Web.Cuid.Internal.Formatting #if defined(mingw32_HOST_OS) import System.Win32 (ProcessId, failIfZero)@@ -25,6 +29,11 @@ import System.Posix.Process (getProcessID) #endif +-- | maxCount is derived from the output format and defines the maximum random+-- number we should generate.+maxCount :: Int+maxCount = formatBase ^ blockSize+ -- | A machine's fingerprint is derived from its PID and hostname. We do some -- maths on the hostname's contents to boil it down to a single integer instead -- of exposing a string.@@ -35,16 +44,31 @@ let hostSum = 36 + length hostname + sum (map ord hostname) return (pid, hostSum) --- | Just get a random integer. Not referentially transparent.+-- | For efficiency, calculate the fingerptint and format it once.+myFingerprint :: Text+myFingerprint = unsafePerformIO $ do+ (pid, host) <- getFingerprint+ return (formatShort pid `append` formatShort host)+-- This ensures the action should only be evaluated once, rather than being+-- inlined and potentially evaluated inside another call.+{-# NOINLINE myFingerprint #-}++-- | Global random number generator.+generator :: GenIO+generator = unsafePerformIO MWC.create+-- Don't want two different generators being created because of inlining.+-- For more info: https://wiki.haskell.org/Top_level_mutable_state+{-# NOINLINE generator #-}++-- | Just get a random integer. getRandomValue :: IO Int-getRandomValue = randomRIO (0, maxCount)+getRandomValue = MWC.uniformR (0, maxCount) generator -- | CUID calls for a globally incrementing counter per machine. This is ugly, -- but it satisfies the requirement. counter :: IORef Int counter = unsafePerformIO (newIORef 0) -- Don't want two different counters being created because of inlining.--- For more info: https://wiki.haskell.org/Top_level_mutable_state {-# NOINLINE counter #-} -- | Get the next value of the global counter required for CUID.@@ -55,20 +79,6 @@ postIncrement :: MonadIO m => IORef Int -> m Int postIncrement c = liftIO (atomicModifyIORef' c incrementAndWrap) where incrementAndWrap count = (succ count `mod` maxCount, count)---- | These constants are to do with number formatting.-formatBase, blockSize, maxCount :: Int-formatBase = 36-blockSize = 4-maxCount = formatBase ^ blockSize---- | Number formatters for converting to the correct base and padding.-number, numberPadded, twoOfNum, firstOfNum, lastOfNum :: Format Text (Int -> Text)-number = base formatBase-numberPadded = left blockSize '0' %. number-twoOfNum = fitRight 2 %. number-lastOfNum = fitRight 1 %. number-firstOfNum = fitLeft 1 %. number -- | Get the current UNIX time in milliseconds. getTimestamp :: IO Int
+ lib/Web/Cuid/Internal/Formatting.hs view
@@ -0,0 +1,88 @@+{-|+Stability: unstable+Portability: portable++Contains low-level number-formatting functions for CUIDs.+-}+module Web.Cuid.Internal.Formatting (+ blockSize, formatBase,+ formatNumber, formatPadded, formatShort+) where++import Data.Text (Text)+import qualified Data.Text as T++-- | These constants are to do with the desired output formatting of numbers in+-- the CUID.+formatBase, blockSize :: Int+formatBase = 36+blockSize = 4++-- | Expresses the given number as a list of digits in the given base. The+-- "digits" are just integers. The first element of the list is the most+-- significant digit and the last element is the least significant.+--+-- > digitsInBase 10 1234 = [1, 2, 3, 4]+-- > digitsInBase 16 1234 = [4, 13, 2] -- "0x4D2" in the usual notation+digitsInBase :: Integral a => a -> a -> [a]+digitsInBase base' n' = go base' n' []+ where go base n accum+ | n == 0 = if null accum then [0] else accum+ | n < base = [n] ++ accum+ | otherwise = go base q ([r] ++ accum)+ where (q, r) = quotRem n base++-- | Converts a single integer to a textual digit. The integer can be any value+-- between 0 and 35, inclusive; the numbers 10 through 35 are converted to the+-- lowercase letters "a" through "z".+numberToDigit :: Integral a => a -> Char+numberToDigit n_+ | n < 0 = error "numberToDigit: input is negative"+ | n < 10 = toEnum (n + 48)+ | n < 36 = toEnum (n + 97 - 10)+ | otherwise = error "numberToDigit: input is too large"+ where n = fromIntegral n_++-- | Returns the textual representation of the given integer in the given base.+--+-- > formatInBase 10 999 = "999"+-- > formatInBase 16 999 = "3e7"+-- > formatInBase 36 999 = "rr"+formatInBase :: Integral a => a -> a -> Text+formatInBase base n = T.pack $ map numberToDigit $ digitsInBase base n++-- | Returns the textual representation of the given integer in the given base,+-- padded on the left with zeroes so that the string is /at least/ the given+-- number of digits long.+--+-- > formatPaddedInBase 10 3 1 = "001"+-- > formatPaddedInBase 10 3 12 = "012"+-- > formatPaddedInBase 10 3 123 = "123"+-- > formatPaddedInBase 10 3 1234 = "1234"+formatPaddedInBase :: Integral a => a -> a -> a -> Text+formatPaddedInBase base d n = T.justifyRight digits '0' $ formatInBase base n+ where digits = fromIntegral d++-- | Returns the textual representation of the first (i.e. most significant) two+-- digits of the given integer in the given base. If the number is only one+-- digit long then the resulting Text will be only one character long.+--+-- > formatShortInBase 10 8 = "8"+-- > formatShortInBase 10 86 = "86"+-- > formatShortInBase 10 867 = "86"+formatShortInBase :: Integral a => a -> a -> Text+formatShortInBase base n = T.take 2 $ formatInBase base n++-- | 'formatInBase' specialized to use the application's value of 'formatBase'.+formatNumber :: Int -> Text+formatNumber = formatInBase formatBase++-- | 'formatPaddedInBase' specialized to use the application's values of+-- 'formatBase' and 'blockSize'.+formatPadded :: Int -> Text+formatPadded = formatPaddedInBase formatBase blockSize++-- | 'formatShortInBase' specialized to use the application's value of+-- 'formatBase'.+formatShort :: Int -> Text+formatShort = formatShortInBase formatBase
+ test/Perf.hs view
@@ -0,0 +1,8 @@+import qualified Criterion.Main as C+import Web.Cuid (newCuid, newSlug)++main :: IO ()+main = C.defaultMain+ [ C.bench "newCuid" $ C.nfIO newCuid+ , C.bench "newSlug" $ C.nfIO newSlug+ ]
test/Test.hs view
@@ -1,28 +1,44 @@+{-# LANGUAGE OverloadedStrings #-}+ module Main where import Control.Monad (foldM, when) import Data.Set (empty, insert, size)+import Data.Text (Text, append)+import qualified Data.Text.IO import System.Exit (ExitCode(..), exitWith) import Web.Cuid (Cuid, newCuid, newSlug) main :: IO () main = do- nCuid <- runCollisionTest newCuid 1200000- nSlug <- runCollisionTest newSlug 1200000- case (nCuid, nSlug) of- (0, 0) -> exitWith ExitSuccess+ putStrLn ""+ putTxtLn . (append "example cuid: ") =<< newCuid+ putTxtLn . (append "example slug: ") =<< newSlug+ putStrLn "Running collision test..."+ cuidCollisions <- runCollisionTest newCuid 1200000+ slugCollisions <- runCollisionTest newSlug 1200000+ case (cuidCollisions, slugCollisions) of+ (0, 0) -> do+ putStrLn "Collision test passed"+ exitWith ExitSuccess _otherwise -> do- when (nCuid /= 0) $ print ("cuid collisions: " ++ show nCuid)- when (nSlug /= 0) $ print ("slug collisions: " ++ show nSlug)+ putStrLn "Collision test failed"+ when (cuidCollisions /= 0) $ print ("cuid collisions: " ++ show cuidCollisions)+ when (slugCollisions /= 0) $ print ("slug collisions: " ++ show slugCollisions) exitWith (ExitFailure 1) +-- We test the CUID generator by generating a lot of ids and putting them into+-- a huge set. Since sets retain only unique elements, the size of the set will+-- equal the number of CUIDs generated iff they were all unique. runCollisionTest :: IO Cuid -> Int -> IO Int-runCollisionTest action numberOfCuids = do- let accumulate set _i = do- cuid <- action- return $! insert cuid set- -- Generate a set containing a bunch of generated CUIDs.- set <- foldM accumulate empty [0 .. numberOfCuids - 1]- -- If every element was unique, the set will have the same size as the input.- return (numberOfCuids - size set)+runCollisionTest generator inputSize = do+ set <- foldM build empty [0 .. inputSize - 1]+ return (inputSize - size set)+ where+ build set _i = do+ cid <- generator+ return $! insert cid set++putTxtLn :: Text -> IO ()+putTxtLn = Data.Text.IO.putStrLn