0 | ||| Note that libuuid appears to consider a string a valid UUID string if it takes the form
 1 | ||| "xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx" where each "x" is a hexidecimal digit, regardless of
 2 | ||| whether it could be created by any of established UUID algorithms. As an aside, this means
 3 | ||| `fromBytes` will always return a UUID.
 4 | module UUID.Driver.C
 5 |
 6 | import System.FFI
 7 |
 8 | import public UUID
 9 | import UUID.Data.Vect
10 |
11 | ffi : String -> String
12 | ffi fn = "C:\{fn},libidris2_uuid,idris2_uuid.h"
13 |
14 | %foreign (ffi "sizeof_uuid_t")
15 | sizeOfUUID_t : Bits64
16 |
17 | %foreign (ffi "uuid_get")
18 | prim__uuidGetByte : GCAnyPtr -> Bits64 -> Bits8
19 |
20 | %foreign (ffi "uuid_set")
21 | prim__uuidSetByte : GCAnyPtr -> Bits64 -> Bits8 -> PrimIO ()
22 |
23 | %foreign (ffi "idris2_uuid_compare")
24 | prim__uuidCompare : GCAnyPtr -> GCAnyPtr -> Int
25 |
26 | %foreign (ffi "idris2_uuid_generate_random")
27 | prim__uuidGenerateRandom : GCAnyPtr -> PrimIO ()
28 |
29 | %foreign (ffi "idris2_uuid_generate_time_safe")
30 | prim__uuidGenerateTimeSafe : GCAnyPtr -> PrimIO Int
31 |
32 | %foreign (ffi "idris2_uuid_generate_md5")
33 | prim__uuidGenerateMD5 : GCAnyPtr -> GCAnyPtr -> String -> Bits64 -> PrimIO ()
34 |
35 | %foreign (ffi "idris2_uuid_generate_sha1")
36 | prim__uuidGenerateSHA1 : GCAnyPtr -> GCAnyPtr -> String -> Bits64 -> PrimIO ()
37 |
38 | %foreign (ffi "idris2_uuid_parse")
39 | prim__uuidParse : String -> GCAnyPtr -> PrimIO Int
40 |
41 | %foreign (ffi "idris2_uuid_unparse")
42 | prim__uuidUnparse : GCAnyPtr -> PrimIO String
43 |
44 | compare' : UUID -> UUID -> Ordering
45 | compare' = flip compare 0 .: prim__uuidCompare `on` ptr
46 |
47 | export Eq UUID where x == y = compare' x y == EQ
48 | export Ord UUID where compare = compare'
49 |
50 | allocUUID : IO GCAnyPtr
51 | allocUUID = onCollectAny !(malloc $ cast sizeOfUUID_t) free
52 |
53 | toByteArray : Vect 16 Bits8 -> GCAnyPtr
54 | toByteArray bytes = unsafePerformIO $ do
55 |   uuid <- allocUUID
56 |   traverse_ (\(i, x) => primIO $ prim__uuidSetByte uuid (cast i) x) $ enumerate bytes
57 |   pure uuid
58 |
59 | export
60 | UUIDGen where
61 |   toBytes uuid = map (prim__uuidGetByte uuid.ptr . cast) (range 16)
62 |
63 |   uuid1 = do
64 |     uuid <- allocUUID
65 |     ok <- primIO $ prim__uuidGenerateTimeSafe uuid
66 |     pure (MkUUID uuid, ok == 0)
67 |
68 |   uuid3 ns name = unsafePerformIO $ do
69 |     uuid <- allocUUID
70 |     primIO $ prim__uuidGenerateMD5 uuid (toByteArray ns) name (cast $ length name)
71 |     pure $ MkUUID uuid
72 |
73 |   uuid4 = do
74 |     uuid <- allocUUID
75 |     primIO $ prim__uuidGenerateRandom uuid
76 |     pure $ MkUUID uuid
77 |
78 |   uuid5 ns name = unsafePerformIO $ do
79 |     uuid <- allocUUID
80 |     primIO $ prim__uuidGenerateSHA1 uuid (toByteArray ns) name (cast $ length name)
81 |     pure $ MkUUID uuid
82 |
83 |   parse str = unsafePerformIO $ do
84 |     uuid <- allocUUID
85 |     ok <- primIO $ prim__uuidParse str uuid
86 |     pure $ if ok == 0 then Just (MkUUID uuid) else Nothing
87 |
88 |   unparse uuid = unsafePerformIO $ primIO $ prim__uuidUnparse uuid.ptr
89 |