uuid-1.3.15/0000755000000000000000000000000007346545000010740 5ustar0000000000000000uuid-1.3.15/CHANGES.md0000644000000000000000000001016307346545000012333 0ustar00000000000000001.3.15 - Add (Template Haskell) `Lift UUID` instance 1.3.14 - Use more compact heap object representation which saves 16 bytes on 64bit platforms. - Add `toWords64`/`fromWords64` functions 1.3.13 - Optimize `V4.nextRandom` (~3x speed increase) - Optimize UUID V3 & V5 generation (~2x speed increase) - Use `cryptohash-md5`/`cryptohash-sha1`/`entropy` instead of `memory`/`cryptonite` for better performance and stability, but GHCJS is now no longer supported. - Update cabal-spec to version 1.10 1.3.12 - Update package dependencies - Use `cryptonite` for crypto - The function `V4.nextRandom` is now implemented with functions from `Crypto.Random` in package `cryptonite`. This does slow-down random UUID generation but provides for far greater randomness. The `Random` instance for `UUID` can be used to re-gain the old behavior. 1.3.11 - Add `toText`/`fromText` 1.3.10 - Update dependencies in tests and benchmarks. 1.3.9 - Split definition of UUID data type into separate Cabal package to enable 3rd party libraries to avoid some of the larger dependencies. 1.3.8 - Allow building against newer `deepseq`. 1.3.7 - Allow building against newer `time`. 1.3.6 - Move to GitHub. 1.3.5 - Allow building against newer `random`. 1.3.4 - Allow building against newer `QuickCheck`. 1.3.3 - More complex version constraints on `hashable`, to avoid building against versions less than 1.1.1.0 or equal to 1.2.0.*. 1.3.2 - Fix for building against `bytestring` 0.9.* 1.3.1 - Allow building against `hashable` 1.1.* in addition to 1.2.* 1.3.0 - New functions for parsing and printing UUIDs to and from ASCII BytesStrings - New module `Data.UUID.Util`. This module includes the type `UnpackedUUID`, whose fields correspond to the UUID fields described in RFC 4122. - The `Storable` instance now stores a UUID in host byte-order instead of big endian. - There is now an instance for `Hashable UUID`. 1.2.13 Benchmark only changes: - Allow `criterion` 0.8.* 1.2.12 Test only changes: - Allow `QuickCheck` 2.6.* 1.2.11 - Allow `binary` 0.7.* 1.2.10 - Allow `cryptohash` version 0.9.* - Cleanup tests 1.2.9 - Bumped dependency on `cryptohash`. 1.2.8 - Bumped various dependencies and cleaned up dependencies in general. 1.2.7 - Added stricter constraints on `random` package. 1.2.6 - Add module `V4` to direct attention to our Random instance - In module `V1` seed the generator with a random number if the hardware MAC address could not be discovered. - Fix and cleanup various haddocks. - In module docs, warn about MD5 use in Data.UUID.V3 and encourage the reader to use Data.UUID.V5 instead. 1.2.5 - Use `cryptohash` package for MD5 and SHA1 instead of `Crypto` 1.2.4 - Unpack Word32 values into UUID constructor. - Update test suite to QuickCheck 2 - Bump other dependencies in tests/benchmarks 1.2.3 - The Read instance now drops leading spaces in the string to be parsed. Thanks to Marc Ziegert for reporting this bug. - The tests have moved over to the new Cabal test running framework. 1.2.2 - Add functions fromWords/toWords The goal was to have a total function that can be used to construct a UUID, primarily for use by uuid-th. 1.2.1 - Fix concurrency bug in Data.UUID.V1 (thanks to Neil Mitchell for reporting and a test case) 1.2.0 (Contributors: Antoine Latter & Mark Lentczner) - added functions toByteString and fromByteString - added `nil` UUID - added unit tests and benchmarks, built when configured -ftest - major speed up of to/from functions (as well as in general) - added version-3 generation (deterministic based on MD5) - major changes to internal representation - now uses four strict Word32 values - internal ByteSource classes for easy construction (see Builder.hs) - Storable instance now stores in memory as system libraries in C do: 16 bytes derived from the network order of the fields, no matter what the host native endianess is. - fixed bugs in V1 time and clock stepping, and V1 generated values - builds cleanly under GHC's -Wall - added CHANGES file 1.1.1 - no longer exporting `null` from the prelude - add `null` predicate on UUIDs - documentation fix (thanks Mark Lentczner) uuid-1.3.15/LICENSE0000644000000000000000000000266007346545000011751 0ustar0000000000000000Copyright (c) 2008, Antoine Latter All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * 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. * The names of the authors may not 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 OWNER 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. uuid-1.3.15/Setup.hs0000644000000000000000000000007507346545000012376 0ustar0000000000000000import Distribution.Simple main :: IO () main = defaultMain uuid-1.3.15/src/Data/0000755000000000000000000000000007346545000012400 5ustar0000000000000000uuid-1.3.15/src/Data/UUID.hs0000644000000000000000000000303207346545000013500 0ustar0000000000000000{- | Module : Data.UUID Copyright : (c) 2008,2012 Antoine Latter License : BSD-style Maintainer : aslatter@gmail.com Stability : experimental Portability : portable This library is useful for comparing, parsing and printing Universally Unique Identifiers. See for the general idea. See for the specification. * Use 'Data.UUID.V4.nextRandom' to generate secure random UUIDs, and your favorite instance of 'System.Random.Random' for faster but insecure generation of UUIDs. * We have an implementation of generating a UUID from the hardware MAC address and current system time in "Data.UUID.V1". * For name-based generation of UUIDs using SHA-1 hashing see "Data.UUID.V5". -} module Data.UUID(UUID ,toString ,fromString ,toText ,fromText ,toASCIIBytes ,fromASCIIBytes ,toLazyASCIIBytes ,fromLazyASCIIBytes ,toByteString ,fromByteString ,toWords ,fromWords ,toWords64 ,fromWords64 ,null ,nil ) where import Prelude () -- we need to hide Prelude.null import Data.UUID.Types -- We use explicit re-exports of everything from Data.UUID.Types in -- preference to just re-exporting the whole module. This is to avoid -- unforeseen transitive API breakage if the Data.UUID.Types module -- should change. uuid-1.3.15/src/Data/UUID/0000755000000000000000000000000007346545000013146 5ustar0000000000000000uuid-1.3.15/src/Data/UUID/Named.hs0000644000000000000000000000365507346545000014537 0ustar0000000000000000-- | -- Module : Data.UUID.Named -- Copyright : (c) 2008 Antoine Latter -- -- License : BSD-style -- -- Maintainer : aslatter@gmail.com -- Stability : experimental -- Portability : portable -- -- -- This module implements Version 3/5 UUIDs as specified -- in RFC 4122. -- -- These UUIDs identify an object within a namespace, -- and are deterministic. -- -- The namespace is identified by a UUID. Several sample -- namespaces are enclosed. module Data.UUID.Named (generateNamed ,namespaceDNS ,namespaceURL ,namespaceOID ,namespaceX500 ) where import Data.UUID.Types.Internal import Control.Applicative ((<*>),(<$>)) import Data.Binary.Get (runGet, getWord32be) import Data.Maybe import Data.Word (Word8) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL -- |Generate a 'UUID' within the specified namespace out of the given -- object. generateNamed :: (B.ByteString -> B.ByteString) -- ^Hash -> Word8 -- ^Version -> UUID -- ^Namespace -> [Word8] -- ^Object -> UUID generateNamed hash version namespace object = let chunk = B.pack $ toList namespace ++ object bytes = BL.fromChunks . (:[]) $ hash chunk w = getWord32be unpackBytes = runGet $ buildFromWords version <$> w <*> w <*> w <*> w in unpackBytes bytes unsafeFromString :: String -> UUID unsafeFromString = fromJust . fromString -- |The namespace for DNS addresses namespaceDNS :: UUID namespaceDNS = unsafeFromString "6ba7b810-9dad-11d1-80b4-00c04fd430c8" -- |The namespace for URLs namespaceURL :: UUID namespaceURL = unsafeFromString "6ba7b811-9dad-11d1-80b4-00c04fd430c8" -- |The namespace for ISO OIDs namespaceOID :: UUID namespaceOID = unsafeFromString "6ba7b812-9dad-11d1-80b4-00c04fd430c8" -- |The namespace for X.500 DNs namespaceX500 :: UUID namespaceX500 = unsafeFromString "6ba7b814-9dad-11d1-80b4-00c04fd430c8" uuid-1.3.15/src/Data/UUID/Util.hs0000644000000000000000000000305107346545000014416 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} module Data.UUID.Util ( UnpackedUUID(..) , unpack, pack , version , extractMac , extractTime , setTime ) where import Prelude hiding (null) import Data.Word import Data.Word.Util import Data.Bits import Data.UUID.Types.Internal import Network.Info import Data.Int (Int64) version :: UUID -> Int version uuid = fromEnum ((time_hi_and_version unpacked `shiftR` 12) .&. 0xF) where unpacked = unpack uuid -- Note UUID time is in 10^-7 seconds. setTime :: (Integral a, Bits a) => UUID -> a -> Maybe UUID setTime uuid t = if version uuid == 1 then Just $ pack $ (unpack uuid){time_low = new_low_bits, time_mid = new_mid_bits, time_hi_and_version = new_hi_and_version_bits} else Nothing where new_low_bits = fromIntegral $ t .&. 0xFFFFFFFF new_mid_bits = fromIntegral $ (t `shiftR` 32) .&. 0xFFFF new_hi_and_version_bits = fromIntegral $ 0x1000 .|. ((t `shiftR` 48) .&. 0x0FFF) extractTime :: UUID -> Maybe Int64 extractTime uuid = if version uuid == 1 then Just $ fromIntegral $ w32to64 (w16to32 (timeAndVersionToTime $ time_hi_and_version unpacked) $ time_mid unpacked) (time_low unpacked) else Nothing where unpacked = unpack uuid timeAndVersionToTime :: Word16 -> Word16 timeAndVersionToTime tv = tv .&. 0x0FFF extractMac :: UUID -> Maybe MAC extractMac uuid = if version uuid == 1 then Just $ MAC (node_0 unpacked) (node_1 unpacked) (node_2 unpacked) (node_3 unpacked) (node_4 unpacked) (node_5 unpacked) else Nothing where unpacked = unpack uuid uuid-1.3.15/src/Data/UUID/V1.hs0000644000000000000000000000707107346545000013775 0ustar0000000000000000{-# OPTIONS_GHC -fno-cse #-} {-# LANGUAGE TypeFamilies #-} {- | Module : Data.UUID.V1 Copyright : (c) 2008 Jason Dusek (c) 2009 Mark Lentczner (c) 2009-2010,2012 Antoine Latter License : BSD-style Maintainer : aslatter@gmail.com Stability : experimental Portability : portable RFC 4122 Version 1 UUID state machine. The generated UUID is based on the hardware MAC address and the system clock. If we cannot lookup the MAC address we seed the generator with a psuedo-random number. -} module Data.UUID.V1(nextUUID) where import Data.Bits import Data.Maybe import Data.Time import Data.Word import Control.Applicative ((<$>),(<*>)) import Control.Concurrent.MVar import System.IO.Unsafe import qualified System.Random as R import Network.Info import Data.UUID.Types.Internal.Builder import Data.UUID.Types.Internal -- | Returns a new UUID derived from the local hardware MAC -- address and the current system time. -- Is generated according to the Version 1 UUID specified in -- RFC 4122. -- -- Returns 'Nothing' if you request UUIDs too quickly. nextUUID :: IO (Maybe UUID) nextUUID = do res <- stepTime case res of Just (mac', c, t) -> return $ Just $ makeUUID t c mac' _ -> return Nothing makeUUID :: Word64 -> Word16 -> MAC -> UUID makeUUID time clock mac' = buildFromBytes 1 /-/ tLow /-/ tMid /-/ tHigh /-/ clock /-/ (MACSource mac') where tLow = (fromIntegral time) :: Word32 tMid = (fromIntegral (time `shiftR` 32)) :: Word16 tHigh = (fromIntegral (time `shiftR` 48)) :: Word16 newtype MACSource = MACSource MAC instance ByteSource MACSource where z /-/ (MACSource (MAC a b c d e f)) = z a b c d e f type instance ByteSink MACSource g = Takes3Bytes (Takes3Bytes g) -- |Approximates the clock algorithm in RFC 4122, section 4.2 -- Isn't system wide or thread safe, nor does it properly randomize -- the clock value on initialization. stepTime :: IO (Maybe (MAC, Word16, Word64)) stepTime = do h1 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime modifyMVar state $ \s@(State mac' c0 h0) -> if h1 > h0 then return (State mac' c0 h1, Just (mac', c0, h1)) else let c1 = succ c0 in if c1 <= 0x3fff -- when clock is initially randomized, -- then this test will need to change then return (State mac' c1 h1, Just (mac', c1, h1)) else return (s, Nothing) {-# NOINLINE state #-} state :: MVar State state = unsafePerformIO $ do h0 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime mac' <- getMac newMVar $ State mac' 0 h0 -- the 0 should be a random number -- SysMAC.mac can fail on some machines. -- In those cases we fake it with a random -- 6 bytes seed. getMac :: IO MAC getMac = getNetworkInterfaces >>= return . listToMaybe . filter (minBound /=) . map mac >>= \macM -> case macM of Just m -> return m Nothing -> randomMac randomMac :: IO MAC randomMac = -- I'm too lazy to thread through -- the random state ... MAC <$> (R.randomIO >>= return . (1 .|.)) -- We must set the multicast bit to True. See section 4.5 of the RFC. <*> R.randomIO <*> R.randomIO <*> R.randomIO <*> R.randomIO <*> R.randomIO data State = State {-# UNPACK #-} !MAC {-# UNPACK #-} !Word16 {-# UNPACK #-} !Word64 deriving (Show) hundredsOfNanosSinceGregorianReform :: UTCTime -> Word64 hundredsOfNanosSinceGregorianReform t = floor $ 10000000 * dt where gregorianReform = UTCTime (fromGregorian 1582 10 15) 0 dt = t `diffUTCTime` gregorianReform uuid-1.3.15/src/Data/UUID/V3.hs0000644000000000000000000000240407346545000013772 0ustar0000000000000000{- | Module : Data.UUID.V3 Copyright : (c) 2010,2012 Antoine Latter License : BSD-style Maintainer : aslatter@gmail.com Stability : experimental Portability : portable NOTE: This module uses MD5 hashing. Unless you know you need to use this module, you should probably be using "Data.UUID.V5", which offers the same sort of functionality as this module except implemented with SHA-1 hashing. This module implements Version 3 UUIDs as specified in RFC 4122. These UUIDs identify an object within a namespace, and are deterministic. The namespace is identified by a UUID. Several sample namespaces are enclosed. -} module Data.UUID.V3 (generateNamed ,Shared.namespaceDNS ,Shared.namespaceURL ,Shared.namespaceOID ,Shared.namespaceX500 ) where import Data.Word import Data.UUID.Types.Internal import qualified Data.UUID.Named as Shared import qualified Crypto.Hash.MD5 as MD5 -- |Generate a 'UUID' within the specified namespace out of the given -- object. -- -- Uses an MD5 hash. The UUID is built from first 128 bits of the hash of -- the namespace UUID and the name (as a series of Word8). generateNamed :: UUID -- ^Namespace -> [Word8] -- ^Object -> UUID generateNamed = Shared.generateNamed MD5.hash 3 uuid-1.3.15/src/Data/UUID/V4.hs0000644000000000000000000000172607346545000014001 0ustar0000000000000000{- | Module : Data.UUID.V4 Copyright : (c) 2012-2016 Antoine Latter License : BSD-style Maintainer : aslatter@gmail.com Stability : experimental Portability : portable This module implements Version 4 UUIDs as specified in RFC 4122. These UUIDs are generated from a pseddo-random generator. We use 'getEntropy' method from package, which should provide cryptographically secure random data. -} module Data.UUID.V4 (nextRandom) where import Data.UUID import Data.UUID.Types.Internal ( buildFromBytes ) import System.Entropy ( getEntropy ) import Data.ByteString ( unpack ) -- | Generate a crytographically secure, random UUID. Introduced in version -- 1.2.6. nextRandom :: IO UUID nextRandom = do [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, ba, bb, bc, bd, be, bf] <- unpack `fmap` getEntropy 16 return $ buildFromBytes 4 b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf uuid-1.3.15/src/Data/UUID/V5.hs0000644000000000000000000000212507346545000013774 0ustar0000000000000000-- | -- Module : Data.UUID.V5 -- Copyright : (c) 2008-2009 Antoine Latter -- -- License : BSD-style -- -- Maintainer : aslatter@gmail.com -- Stability : experimental -- Portability : portable -- -- -- This module implements Version 5 UUIDs as specified -- in RFC 4122. -- -- These UUIDs identify an object within a namespace, -- and are deterministic. -- -- The namespace is identified by a UUID. Several sample -- namespaces are enclosed. module Data.UUID.V5 (generateNamed ,Shared.namespaceDNS ,Shared.namespaceURL ,Shared.namespaceOID ,Shared.namespaceX500 ) where import Data.Word import Data.UUID.Types.Internal import qualified Data.UUID.Named as Shared import qualified Crypto.Hash.SHA1 as SHA1 -- |Generate a 'UUID' within the specified namespace out of the given -- object. -- -- Uses a SHA1 hash. The UUID is built from first 128 bits of the hash of -- the namespace UUID and the name (as a series of Word8). generateNamed :: UUID -- ^Namespace -> [Word8] -- ^Object -> UUID generateNamed = Shared.generateNamed SHA1.hash 5 uuid-1.3.15/src/Data/Word/0000755000000000000000000000000007346545000013313 5ustar0000000000000000uuid-1.3.15/src/Data/Word/Util.hs0000644000000000000000000000057107346545000014567 0ustar0000000000000000 -- | Internal utilites module Data.Word.Util where import Data.Bits import Data.Word w16to32 :: Word16 -> Word16 -> Word32 w16to32 w0s w1s = (w0 `shiftL` 16) .|. w1 where w0 = fromIntegral w0s w1 = fromIntegral w1s w32to64 :: Word32 -> Word32 -> Word64 w32to64 w0s w1s = (w0 `shiftL` 32) .|. w1 where w0 = fromIntegral w0s w1 = fromIntegral w1s uuid-1.3.15/tests/0000755000000000000000000000000007346545000012102 5ustar0000000000000000uuid-1.3.15/tests/TestUUID.hs0000644000000000000000000000642207346545000014050 0ustar0000000000000000{-# LANGUAGE ViewPatterns #-} import Control.Monad (replicateM) import Data.Bits import qualified Data.ByteString.Lazy as BL import Data.Char (ord) import Data.List (nub, (\\)) import Data.Maybe import Data.Word import qualified Data.UUID as U import qualified Data.UUID.V1 as U import qualified Data.UUID.V3 as U3 import qualified Data.UUID.V5 as U5 import Test.QuickCheck ( Arbitrary(arbitrary), choose ) import Test.Tasty ( TestTree, testGroup, defaultMain ) import Test.Tasty.HUnit ( assertBool, (@?=), testCase ) import Test.Tasty.QuickCheck ( testProperty ) type Test = TestTree isValidVersion :: Int -> U.UUID -> Bool isValidVersion v u = lenOK && variantOK && versionOK where bs = U.toByteString u lenOK = BL.length bs == 16 variantOK = (BL.index bs 8) .&. 0xc0 == 0x80 versionOK = (BL.index bs 6) .&. 0xf0 == fromIntegral (v `shiftL` 4) instance Arbitrary U.UUID where -- the UUID random instance ignores bounds arbitrary = choose (U.nil, U.nil) test_null :: Test test_null = testCase "namespaceDNS is not null" $ assertBool "" (not $ U.null U3.namespaceDNS) test_v1 :: [Maybe U.UUID] -> Test test_v1 v1s = testGroup "version 1" [ testCase "V1 unique" $ nub (v1s \\ nub v1s) @?= [], testGroup "V1 not null" $ map (testUUID (not . U.null)) v1s, testGroup "V1 valid" $ map (testUUID (isValidVersion 1)) v1s ] where testUUID :: (U.UUID -> Bool) -> Maybe U.UUID -> Test testUUID p u = testCase (show u) $ assertBool "" $ maybe False p u test_v3 :: Test test_v3 = testCase "V3 computation" $ U3.generateNamed U3.namespaceDNS name @?= uV3 where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8] uV3 = fromJust $ U.fromString "3d813cbb-47fb-32ba-91df-831e1593ac29" test_v5 :: Test test_v5 = testCase "V5 computation" $ U5.generateNamed U5.namespaceDNS name @?= uV5 where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8] uV5 = fromJust $ U.fromString "21f7f8de-8051-5b89-8680-0195ef798b6a" prop_randomsValid :: Test prop_randomsValid = testProperty "Random valid" randomsValid where randomsValid :: U.UUID -> Bool randomsValid = isValidVersion 4 prop_v3NotNull :: Test prop_v3NotNull = testProperty "V3 not null" v3NotNull where v3NotNull :: [Word8] -> Bool v3NotNull = not . U.null . U3.generateNamed U3.namespaceDNS prop_v3Valid :: Test prop_v3Valid = testProperty "V3 valid" v3Valid where v3Valid :: [Word8] -> Bool v3Valid = isValidVersion 3 . U3.generateNamed U3.namespaceDNS prop_v5NotNull :: Test prop_v5NotNull = testProperty "V5 not null" v5NotNull where v5NotNull :: [Word8] -> Bool v5NotNull = not . U.null . U5.generateNamed U5.namespaceDNS prop_v5Valid :: Test prop_v5Valid = testProperty "V5 valid" v5Valid where v5Valid :: [Word8] -> Bool v5Valid = isValidVersion 5 . U5.generateNamed U5.namespaceDNS main :: IO () main = do v1s <- replicateM 100 U.nextUUID defaultMain $ testGroup "tests" $ concat $ [ [ test_null, test_v1 v1s, test_v3, test_v5 ] , [ prop_randomsValid, prop_v3NotNull, prop_v3Valid, prop_v5NotNull, prop_v5Valid ] ] uuid-1.3.15/uuid.cabal0000644000000000000000000000500107346545000012666 0ustar0000000000000000cabal-version: 1.12 name: uuid version: 1.3.15 copyright: (c) 2008-2014 Antoine Latter author: Antoine Latter maintainer: Oleg Grenrus license: BSD3 license-file: LICENSE category: Data build-type: Simple tested-with: GHC ==7.4.2 || ==7.6.3 || ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.4 || ==8.8.4 || ==8.10.3 synopsis: For creating, comparing, parsing and printing Universally Unique Identifiers description: This library is useful for creating, comparing, parsing and printing Universally Unique Identifiers. . See for the general idea. homepage: https://github.com/haskell-hvr/uuid bug-reports: https://github.com/haskell-hvr/uuid/issues extra-source-files: CHANGES.md source-repository head type: git location: https://github.com/haskell-hvr/uuid.git subdir: uuid library build-depends: base >=4.5 && <5 , binary >=0.5.1.0 && <0.9 , bytestring >=0.9.2.1 && <0.12 , cryptohash-md5 >=0.11.100 && <0.12 , cryptohash-sha1 >=0.11.100 && <0.12 , entropy >=0.3.7 && <0.5 , network-info >=0.2 && <0.3 , random >=1.1 && <1.3 , text >=1.2.3.0 && <1.3 , time >=1.4 && <1.12 -- strict dependency on uuid-types, -- as we re-rexport datatype, thus leak instances etc. build-depends: uuid-types >=1.0.5 && <1.0.6 exposed-modules: Data.UUID Data.UUID.Util Data.UUID.V1 Data.UUID.V3 Data.UUID.V4 Data.UUID.V5 other-modules: Data.UUID.Named Data.Word.Util default-language: Haskell2010 default-extensions: DeriveDataTypeable other-extensions: TypeFamilies ghc-options: -Wall hs-source-dirs: src test-suite testuuid type: exitcode-stdio-1.0 main-is: TestUUID.hs hs-source-dirs: tests default-language: Haskell2010 default-extensions: DeriveDataTypeable other-extensions: ViewPatterns ghc-options: -Wall -fno-warn-orphans -- inherited constraints build-depends: base , bytestring , random , uuid -- deps w/o inherited constraints build-depends: QuickCheck >=2.14.2 && <2.15 , tasty >=1.4.0.1 && <1.5 , tasty-hunit >=0.10 && <0.11 , tasty-quickcheck >=0.10 && <0.11