diff options
| -rw-r--r-- | erebos.cabal | 5 | ||||
| -rw-r--r-- | main/Test.hs | 2 | ||||
| -rw-r--r-- | src/Erebos/UUID.hs | 62 |
3 files changed, 8 insertions, 61 deletions
diff --git a/erebos.cabal b/erebos.cabal index 749de5a..ebe6a63 100644 --- a/erebos.cabal +++ b/erebos.cabal @@ -119,7 +119,6 @@ library Erebos.Storage.Key Erebos.Storage.Merge Erebos.Sync - Erebos.UUID other-modules: Erebos.Flow @@ -128,6 +127,7 @@ library Erebos.Storage.Internal Erebos.Storage.Memory Erebos.Storage.Platform + Erebos.UUID Erebos.Util c-sources: @@ -169,6 +169,7 @@ library stm >=2.5 && <2.6, text >= 1.2 && <2.2, time ^>= { 1.8, 1.9, 1.10, 1.11, 1.12, 1.13, 1.14 }, + uuid-types ^>= { 1.0.4 }, zlib >=0.6 && <0.8 if os(windows) @@ -212,4 +213,4 @@ executable erebos text, time, transformers >= 0.5 && <0.7, - uuid, + uuid-types, diff --git a/main/Test.hs b/main/Test.hs index 4f2de73..f2adf22 100644 --- a/main/Test.hs +++ b/main/Test.hs @@ -26,6 +26,7 @@ import Data.Text qualified as T import Data.Text.Encoding import Data.Text.IO qualified as T import Data.Typeable +import Data.UUID.Types qualified as U import Network.Socket @@ -50,7 +51,6 @@ import Erebos.Storage import Erebos.Storage.Head import Erebos.Storage.Merge import Erebos.Sync -import Erebos.UUID qualified as U import Test.Service diff --git a/src/Erebos/UUID.hs b/src/Erebos/UUID.hs index 353cc0e..128d450 100644 --- a/src/Erebos/UUID.hs +++ b/src/Erebos/UUID.hs @@ -6,67 +6,13 @@ module Erebos.UUID ( nextRandom, ) where -import Control.Monad - import Crypto.Random.Entropy import Data.Bits -import Data.ByteString (ByteString) import Data.ByteString qualified as BS -import Data.ByteString.Char8 qualified as BSC -import Data.Text (Text) -import Data.Text.Encoding - -import Erebos.Util - - -newtype UUID = UUID ByteString - deriving (Eq, Ord) - -instance Show UUID where - show = toString - - -toString :: UUID -> String -toString = BSC.unpack . toASCIIBytes - -fromString :: String -> Maybe UUID -fromString = fromASCIIBytes . BSC.pack - -toText :: UUID -> Text -toText = decodeUtf8 . toASCIIBytes - -fromText :: Text -> Maybe UUID -fromText = fromASCIIBytes . encodeUtf8 - -toASCIIBytes :: UUID -> ByteString -toASCIIBytes (UUID uuid) = BS.concat - [ showHex $ BS.take 4 $ uuid - , BSC.singleton '-' - , showHex $ BS.take 2 $ BS.drop 4 uuid - , BSC.singleton '-' - , showHex $ BS.take 2 $ BS.drop 6 uuid - , BSC.singleton '-' - , showHex $ BS.take 2 $ BS.drop 8 uuid - , BSC.singleton '-' - , showHex $ BS.drop 10 uuid - ] - -fromASCIIBytes :: ByteString -> Maybe UUID -fromASCIIBytes bs = do - guard $ BS.length bs == 36 - guard $ BSC.index bs 8 == '-' - guard $ BSC.index bs 13 == '-' - guard $ BSC.index bs 18 == '-' - guard $ BSC.index bs 23 == '-' - UUID . BS.concat <$> sequence - [ readHex $ BS.take 8 $ bs - , readHex $ BS.take 4 $ BS.drop 9 bs - , readHex $ BS.take 4 $ BS.drop 14 bs - , readHex $ BS.take 4 $ BS.drop 19 bs - , readHex $ BS.drop 24 bs - ] - +import Data.ByteString.Lazy qualified as BSL +import Data.Maybe +import Data.UUID.Types nextRandom :: IO UUID nextRandom = do @@ -75,4 +21,4 @@ nextRandom = do let version = 4 b6' = b6 .&. 0x0f .|. (version `shiftL` 4) b8' = b8 .&. 0x3f .|. 0x80 - return $ UUID $ BS.pack [ b0, b1, b2, b3, b4, b5, b6', b7, b8', b9, ba, bb, bc, bd, be, bf ] + return $ fromJust $ fromByteString $ BSL.pack [ b0, b1, b2, b3, b4, b5, b6', b7, b8', b9, ba, bb, bc, bd, be, bf ] |