module Util.ByteString
  ( HexJSONByteString(..)
  ) where

import Data.Aeson (FromJSON(..), ToJSON(..), withText)
import Text.Hex (decodeHex, encodeHex)

-- | Newtype wrapper for ByteString which uses hexadecimal representation
-- for JSON serialization.
newtype HexJSONByteString = HexJSONByteString { HexJSONByteString -> ByteString
unHexJSONByteString :: ByteString }

instance ToJSON HexJSONByteString where
  toJSON :: HexJSONByteString -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (HexJSONByteString -> Text) -> HexJSONByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHex (ByteString -> Text)
-> (HexJSONByteString -> ByteString) -> HexJSONByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HexJSONByteString -> ByteString
unHexJSONByteString

instance FromJSON HexJSONByteString where
  parseJSON :: Value -> Parser HexJSONByteString
parseJSON =
    String
-> (Text -> Parser HexJSONByteString)
-> Value
-> Parser HexJSONByteString
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "Hex-encoded bytestring" ((Text -> Parser HexJSONByteString)
 -> Value -> Parser HexJSONByteString)
-> (Text -> Parser HexJSONByteString)
-> Value
-> Parser HexJSONByteString
forall a b. (a -> b) -> a -> b
$ \t :: Text
t ->
      case Text -> Maybe ByteString
decodeHex Text
t of
        Nothing -> String -> Parser HexJSONByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid hex encoding"
        Just res :: ByteString
res -> HexJSONByteString -> Parser HexJSONByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> HexJSONByteString
HexJSONByteString ByteString
res)