hscuid (empty) → 1.0.0

raw patch · 5 files changed

+210/−0 lines, 5 filesdep +Win32dep +basedep +containerssetup-changed

Dependencies added: Win32, base, containers, formatting, hostname, hscuid, random, text, time, transformers, unix

Files

LICENSE +21/−0
Setup.hs +2/−0
hscuid.cabal +43/−0
lib/Web/Cuid.hs +116/−0
test/Test.hs +28/−0

+ LICENSE view

@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2015 Daniel Buckmaster++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ hscuid.cabal view

@@ -0,0 +1,43 @@+-- Initial hscuid.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                hscuid+version:             1.0.0+synopsis:            Collision-resistant IDs+description:         CUIDs are designed for horizontal scalability and collision+                     resistance. Read more about them at <https://usecuid.org>.+homepage:            https://github.com/eightyeight/hscuid+license:             MIT+license-file:        LICENSE+author:              Daniel Buckmaster+maintainer:          dan.buckmaster@gmail.com+-- copyright:           +category:            Web+build-type:          Simple+cabal-version:       >=1.8++library+  hs-source-dirs:      lib+  exposed-modules:     Web.Cuid+  build-depends:       base ==4.*,+                       formatting ==6.*,+                       time ==1.*,+                       random ==1.*,+                       transformers ==0.4.*,+                       hostname ==1.*,+                       text ==1.*+  if os(windows)+    build-depends:     Win32 ==2.*+    extra-libraries:   kernel32+  else+    build-depends:     unix ==2.*+  ghc-options:         -Wall++test-suite hscuid-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Test.hs+  build-depends:       base ==4.*,+                       containers ==0.5.*,+                       hscuid+  ghc-options:         -Wall -rtsopts -O2

+ lib/Web/Cuid.hs view

@@ -0,0 +1,116 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}++{-|+Stability: stable+Portability: portable++You can generate a new CUID inside any IO-enabled monad using this module's+one exported function:++>>> cuid <- newCuid+>>> print cuid+"ciaafthr00000qhpm0jp81gry"+-}+module Web.Cuid (+    Cuid, newCuid+) where++import Control.Monad (liftM)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Char (ord)+import Data.Monoid (mconcat, (<>))+import Data.IORef (IORef, newIORef, atomicModifyIORef')+import Data.String (fromString)+import Data.Text (Text)+import Data.Time.Clock.POSIX (getPOSIXTime)+import Formatting (Format, base, fitRight, sformat, left, (%.))+import Network.HostName (getHostName)+import System.IO.Unsafe (unsafePerformIO)+import System.Random (randomRIO)++#if defined(mingw32_HOST_OS)+import System.Win32 (ProcessId, failIfZero)+#else+import System.Posix.Process (getProcessID)+#endif++-- | Convenience type so that you don't have to import Text downstream. Note that+-- this is strict Text.+type Cuid = Text++-- | Generate a new random CUID.+newCuid :: MonadIO m => m Cuid+newCuid = concatM [c, time, count, fingerprint, random, random] where+    -- The CUID starts with a letter so it's usable in HTML element IDs.+    c = return (fromString "c")++    -- 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 . millis) getPOSIXTime++    -- To avoid collisions on the same machine, add a global counter to each ID.+    count = liftM (sformat numberPadded) (postIncrement counter)++    -- To avoid collisions between separate machines, generate a 'fingerprint'+    -- from details which are hopefully unique to this machine - PID and hostname.+    fingerprint = do+        pid <- getPid+        hostname <- getHostName+        let hostSum = 36 + length hostname + sum (map ord hostname)+            twoOfNum = sformat (fitRight 2 %. number)+        return (twoOfNum pid <> twoOfNum hostSum)++    -- And some randomness for good measure. Note that System.Random is not a+    -- source of crypto-strength randomness.+    random = liftM (sformat numberPadded) (randomRIO (0, maxValue))++    -- Evaluate IO actions and concatenate their results.+    concatM actions = liftM mconcat (liftIO $ sequence actions)++    -- POSIX time library gives the result in fractional seconds.+    millis posix = round (posix * 1000)++-- 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 #-}++-- Increment the counter, and return the value before it was incremented.+postIncrement :: MonadIO m => IORef Int -> m Int+postIncrement c = liftIO (atomicModifyIORef' c incrementAndWrap) where+    incrementAndWrap count = (succ count `mod` maxValue, count)++-- These constants are to do with number formatting.+formatBase, blockSize, maxValue :: Int+formatBase = 36+blockSize = 4+maxValue = formatBase ^ blockSize++-- Number formatters for converting to the correct base and padding.+number, numberPadded :: Format Text (Int -> Text)+(number, numberPadded) = (toBase, toBlockSize %. toBase) where+    toBlockSize = left blockSize '0'+    toBase = base formatBase++-- Get the ID of the current process. This function has a platform-specific+-- implementation. Fun times.+getPid :: MonadIO m => m Int++#if defined(mingw32_HOST_OS)++foreign import stdcall unsafe "windows.h GetCurrentProcessId"+    c_GetCurrentProcessId :: IO ProcessId++getCurrentProcessId :: IO ProcessId+getCurrentProcessId = failIfZero "GetCurrentProcessId" c_GetCurrentProcessId++getPid = liftM fromIntegral (liftIO getCurrentProcessId)++#else++getPid = liftM fromIntegral (liftIO getProcessID)++#endif

+ test/Test.hs view

@@ -0,0 +1,28 @@+module Main where++import Data.Set (empty, insert, size)+import Control.Monad (foldM)+import System.Exit (ExitCode(..), exitWith)++import Web.Cuid (newCuid)++main :: IO ()+main = do+    result <- runCollisionTest 1200000+    case result of+        Nothing -> exitWith ExitSuccess+        Just n -> do+            print ("Number of collisions: " ++ show n)+            exitWith (ExitFailure 1)++runCollisionTest :: Int -> IO (Maybe Int)+runCollisionTest numberOfCuids = do+    let accumulate set _i = do+            cuid <- newCuid+            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 $ if size set == numberOfCuids+        then Nothing+        else Just (numberOfCuids - size set)