packages feed

hscuid 1.0.0 → 1.1.0

raw patch · 5 files changed

+191/−113 lines, 5 files

Files

LICENSE view
@@ -1,21 +1,28 @@-The MIT License (MIT)+Copyright (c) 2015, Daniel Buckmaster. -Copyright (c) 2015 Daniel Buckmaster+All rights reserved. -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:+Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met: -The above copyright notice and this permission notice shall be included in all-copies or substantial portions of the Software.+ 1. Redistributions of source code must retain the above copyright notice, this+    list of conditions and the following disclaimer. -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.+ 2. Redistributions in binary form must reproduce the above copyright notice,+    this list of conditions and the following disclaimer in the documentation+    and/or other materials provided with the distribution.++ 3. Neither the name of the copyright holder nor the names of its contributors+    may be used to endorse or promote products derived from this software+	 without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
hscuid.cabal view
@@ -2,12 +2,32 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                hscuid-version:             1.0.0+version:             1.1.0 synopsis:            Collision-resistant IDs description:         CUIDs are designed for horizontal scalability and collision-                     resistance. Read more about them at <https://usecuid.org>.+                     resistance.+                     Read more about them at <https://usecuid.org usecuid.org>.+                     Here's everything you need to know:+                     .+                     >>> import Web.Cuid (newCuid, newSlug)+                     >>> newCuid+                     "cib3c3tcu0000zwowx9ho2gh4"+                     >>> newSlug+                     "c900001wmf"+                     .+                     This module does not use crypto-strength sources of+                     randomness.+                     Use at your own peril!+                     .+                     For better or worse, this module uses semantic versioning+                     (see <http://semver.org/ semver.org>).+                     That is, if you want to depend upon, for example, version 1+                     of the API, you should add @hscuid ==1.*@ to your Cabal+                     file. No breaking changes will be (deliberately) introduced+                     under that version number.+ homepage:            https://github.com/eightyeight/hscuid-license:             MIT+license:             BSD3 license-file:        LICENSE author:              Daniel Buckmaster maintainer:          dan.buckmaster@gmail.com@@ -19,6 +39,7 @@ library   hs-source-dirs:      lib   exposed-modules:     Web.Cuid+  other-modules:       Web.Cuid.Internal   build-depends:       base ==4.*,                        formatting ==6.*,                        time ==1.*,
lib/Web/Cuid.hs view
@@ -1,116 +1,70 @@-{-# LANGUAGE CPP, ForeignFunctionInterface #-}+{-# LANGUAGE CPP #-}  {-| 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"+You can generate a new CUID or slug inside any IO-enabled monad using 'newCuid'+and 'newSlug'. -} module Web.Cuid (-    Cuid, newCuid+    Cuid, newCuid,+    Slug, newSlug ) 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)+import Formatting (sformat) -#if defined(mingw32_HOST_OS)-import System.Win32 (ProcessId, failIfZero)-#else-import System.Posix.Process (getProcessID)+import Data.Monoid (Monoid, (<>))+#if !MIN_VERSION_base(4,8,0)+import Data.Monoid (mconcat) #endif +import Web.Cuid.Internal+ -- | 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+newCuid = concatResults [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+    time = liftM (sformat number) getTimestamp      -- To avoid collisions on the same machine, add a global counter to each ID.-    count = liftM (sformat numberPadded) (postIncrement counter)+    count = liftM (sformat numberPadded) 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 <- 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+        (pid, host) <- getFingerprint+        return (sformat twoOfNum pid <> sformat twoOfNum host) -getPid = liftM fromIntegral (liftIO getCurrentProcessId)+    -- And some actual randomness for good measure.+    random = liftM (sformat numberPadded) getRandomValue -#else+-- | A Slug is not a Cuid. But it is also a strict Text.+type Slug = Text -getPid = liftM fromIntegral (liftIO getProcessID)+-- | A slug is a shorter piece of text generated using some of the same+-- 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) -#endif+-- Evaluate IO actions and concatenate their results.+concatResults :: (MonadIO m, Monoid a) => [IO a] -> m a+concatResults actions = liftM mconcat (liftIO $ sequence actions)
+ lib/Web/Cuid/Internal.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}++{-|+Stability: unstable+Portability: portable++Contains internal implementation details for CUIDs.+-}+module Web.Cuid.Internal 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.Time.Clock.POSIX (getPOSIXTime)+import Formatting (Format, base, fitLeft, fitRight, 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++-- | 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.+getFingerprint :: IO (Int, Int)+getFingerprint = do+    pid <- getPid+    hostname <- getHostName+    let hostSum = 36 + length hostname + sum (map ord hostname)+    return (pid, hostSum)++-- | Just get a random integer. Not referentially transparent.+getRandomValue :: IO Int+getRandomValue = randomRIO (0, maxCount)++-- | 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.+getNextCount :: IO Int+getNextCount = postIncrement 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` 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+getTimestamp = liftM toMillis getPOSIXTime where+    toMillis posix = round (posix * 1000)++-- | 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
@@ -1,28 +1,28 @@ module Main where +import Control.Monad (foldM, when) import Data.Set (empty, insert, size)-import Control.Monad (foldM) import System.Exit (ExitCode(..), exitWith) -import Web.Cuid (newCuid)+import Web.Cuid (Cuid, newCuid, newSlug)  main :: IO () main = do-    result <- runCollisionTest 1200000-    case result of-        Nothing -> exitWith ExitSuccess-        Just n -> do-            print ("Number of collisions: " ++ show n)+    nCuid <- runCollisionTest newCuid 1200000+    nSlug <- runCollisionTest newSlug 1200000+    case (nCuid, nSlug) of+        (0, 0) -> exitWith ExitSuccess+        _otherwise -> do+            when (nCuid /= 0) $ print ("cuid collisions: " ++ show nCuid)+            when (nSlug /= 0) $ print ("slug collisions: " ++ show nSlug)             exitWith (ExitFailure 1) -runCollisionTest :: Int -> IO (Maybe Int)-runCollisionTest numberOfCuids = do+runCollisionTest :: IO Cuid -> Int -> IO Int+runCollisionTest action numberOfCuids = do     let accumulate set _i = do-            cuid <- newCuid+            cuid <- action             return $! insert cuid set     -- Generate a set containing a bunch of generated CUIDs.-    set <- foldM accumulate empty [0..numberOfCuids-1]+    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)+    return (numberOfCuids - size set)