module Codec.CBOR.UUID (encode, decode) where

import qualified Codec.Serialise as Ser
import qualified Codec.CBOR.Encoding as Ser (Encoding, encodeTag)
import qualified Codec.CBOR.Decoding as Ser (Decoder, decodeTag)
import qualified Data.ByteString.Lazy as BL
import qualified Data.UUID.Types as UUID

-- | Encoded according to [draft-bormann-cbor-tags-oid-06](https://tools.ietf.org/html/draft-bormann-cbor-tags-oid-06).
--
-- 19 bytes consisting of @0xd8@, @0x25@, @0x50@, and the 16 raw bytes of the
-- UUID in network order. For example, the UUID @8b0d1a20-dcc5-11d9-bda9-0002a5d5c51b@ is
-- encoded as @"\\xd8\\x25\\x50\\x8b\\x0d\\x1a\\x20\\xdc\\xc5\\x11\\xd9\\xbd\\xa9\\x00\\x02\\xa5\\xd5\\xc5\\x1b"@.
encode :: UUID.UUID -> Ser.Encoding
encode :: UUID -> Encoding
encode = \u :: UUID
u ->
  Word -> Encoding
Ser.encodeTag 0x25 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<>
  ByteString -> Encoding
forall a. Serialise a => a -> Encoding
Ser.encode (ByteString -> ByteString
BL.toStrict (UUID -> ByteString
UUID.toByteString UUID
u))
{-# INLINABLE encode #-}

-- | Decode according to [draft-bormann-cbor-tags-oid-06](https://tools.ietf.org/html/draft-bormann-cbor-tags-oid-06).
--
-- 19 bytes consisting of @0xd8@, @0x25@, @0x50@, and the 16 raw bytes of the
-- UUID in network order. For example, the UUID @8b0d1a20-dcc5-11d9-bda9-0002a5d5c51b@ is expected to be
-- encoded as @"\\xd8\\x25\\x50\\x8b\\x0d\\x1a\\x20\\xdc\\xc5\\x11\\xd9\\xbd\\xa9\\x00\\x02\\xa5\\xd5\\xc5\\x1b"@.
decode :: Ser.Decoder s UUID.UUID
decode :: Decoder s UUID
decode = do
  Word
tag <- Decoder s Word
forall s. Decoder s Word
Ser.decodeTag
  case Word
tag of
    0x25 -> do
      ByteString
bs <- Decoder s ByteString
forall a s. Serialise a => Decoder s a
Ser.decode
      case ByteString -> Maybe UUID
UUID.fromByteString (ByteString -> ByteString
BL.fromStrict ByteString
bs) of
        Nothing -> String -> Decoder s UUID
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "UUID"
        Just x :: UUID
x -> UUID -> Decoder s UUID
forall (f :: * -> *) a. Applicative f => a -> f a
pure UUID
x
    _ -> String -> Decoder s UUID
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "UUID"
{-# INLINABLE decode #-}