{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  Data.ByteArray.HexString.Convert
-- Copyright   :  Aleksandr Krupenkin 2016-2021
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  unportable
--
-- From/to hex conversion functions.
--

module Data.ByteArray.HexString.Convert where

import           Data.Aeson                        (FromJSON (..), ToJSON (..),
                                                    Value (String), withText)
import           Data.ByteArray                    (ByteArray, ByteArrayAccess,
                                                    convert)
import           Data.ByteArray.Encoding           (Base (Base16),
                                                    convertToBase)
import           Data.Text                         (Text)
import           Data.Text.Encoding                (decodeUtf8, encodeUtf8)

import           Data.ByteArray.HexString.Internal (HexString (..), hexString)

-- | Convert type into it's hex representation.
class ToHex a where
    toHex :: a -> HexString

-- | Convert hex string into a type or return an error.
class FromHex a where
    fromHex :: HexString -> Either String a

-- | Reads a raw bytes and converts to hex representation.
fromBytes :: ByteArrayAccess ba => ba -> HexString
fromBytes :: ba -> HexString
fromBytes = ByteString -> HexString
HexString (ByteString -> HexString) -> (ba -> ByteString) -> ba -> HexString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ba -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert

-- | Access to the raw bytes of 'HexString'.
toBytes :: ByteArray ba => HexString -> ba
toBytes :: HexString -> ba
toBytes = ByteString -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (ByteString -> ba) -> (HexString -> ByteString) -> HexString -> ba
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HexString -> ByteString
unHexString

-- | Access to a 'Text' representation of the 'HexString'
toText :: HexString -> Text
toText :: HexString -> Text
toText = (Text
"0x" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (HexString -> Text) -> HexString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (HexString -> ByteString) -> HexString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base16 (ByteString -> ByteString)
-> (HexString -> ByteString) -> HexString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HexString -> ByteString
unHexString

instance FromJSON HexString where
    parseJSON :: Value -> Parser HexString
parseJSON = String -> (Text -> Parser HexString) -> Value -> Parser HexString
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"HexString" ((Text -> Parser HexString) -> Value -> Parser HexString)
-> (Text -> Parser HexString) -> Value -> Parser HexString
forall a b. (a -> b) -> a -> b
$ (String -> Parser HexString)
-> (HexString -> Parser HexString)
-> Either String HexString
-> Parser HexString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser HexString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail HexString -> Parser HexString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String HexString -> Parser HexString)
-> (Text -> Either String HexString) -> Text -> Parser HexString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String HexString
forall ba. ByteArray ba => ba -> Either String HexString
hexString (ByteString -> Either String HexString)
-> (Text -> ByteString) -> Text -> Either String HexString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

instance ToJSON HexString where
    toJSON :: HexString -> Value
toJSON = Text -> Value
String (Text -> Value) -> (HexString -> Text) -> HexString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HexString -> Text
toText