{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}

module Data.ByteArray.HexString where

import           Data.Aeson              (FromJSON (..), ToJSON (..),
                                          Value (..), withText)
import           Data.ByteArray          (ByteArray, ByteArrayAccess, convert)
import qualified Data.ByteArray          as BA (drop, take)
import           Data.ByteArray.Encoding (Base (Base16), convertFromBase,
                                          convertToBase)
import           Data.ByteString         (ByteString)
import           Data.String             (IsString (..))
import           Data.Text               (Text)
import           Data.Text.Encoding      (decodeUtf8, encodeUtf8)
import           GHC.Generics            (Generic)

-- | Represents a Hex string. Guarantees that all characters it contains
--   are valid hex characters.
newtype HexString = HexString { HexString -> ByteString
unHexString :: ByteString }
  deriving (HexString -> HexString -> Bool
(HexString -> HexString -> Bool)
-> (HexString -> HexString -> Bool) -> Eq HexString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HexString -> HexString -> Bool
$c/= :: HexString -> HexString -> Bool
== :: HexString -> HexString -> Bool
$c== :: HexString -> HexString -> Bool
Eq, Eq HexString
Eq HexString =>
(HexString -> HexString -> Ordering)
-> (HexString -> HexString -> Bool)
-> (HexString -> HexString -> Bool)
-> (HexString -> HexString -> Bool)
-> (HexString -> HexString -> Bool)
-> (HexString -> HexString -> HexString)
-> (HexString -> HexString -> HexString)
-> Ord HexString
HexString -> HexString -> Bool
HexString -> HexString -> Ordering
HexString -> HexString -> HexString
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HexString -> HexString -> HexString
$cmin :: HexString -> HexString -> HexString
max :: HexString -> HexString -> HexString
$cmax :: HexString -> HexString -> HexString
>= :: HexString -> HexString -> Bool
$c>= :: HexString -> HexString -> Bool
> :: HexString -> HexString -> Bool
$c> :: HexString -> HexString -> Bool
<= :: HexString -> HexString -> Bool
$c<= :: HexString -> HexString -> Bool
< :: HexString -> HexString -> Bool
$c< :: HexString -> HexString -> Bool
compare :: HexString -> HexString -> Ordering
$ccompare :: HexString -> HexString -> Ordering
$cp1Ord :: Eq HexString
Ord, (forall x. HexString -> Rep HexString x)
-> (forall x. Rep HexString x -> HexString) -> Generic HexString
forall x. Rep HexString x -> HexString
forall x. HexString -> Rep HexString x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HexString x -> HexString
$cfrom :: forall x. HexString -> Rep HexString x
Generic, b -> HexString -> HexString
NonEmpty HexString -> HexString
HexString -> HexString -> HexString
(HexString -> HexString -> HexString)
-> (NonEmpty HexString -> HexString)
-> (forall b. Integral b => b -> HexString -> HexString)
-> Semigroup HexString
forall b. Integral b => b -> HexString -> HexString
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> HexString -> HexString
$cstimes :: forall b. Integral b => b -> HexString -> HexString
sconcat :: NonEmpty HexString -> HexString
$csconcat :: NonEmpty HexString -> HexString
<> :: HexString -> HexString -> HexString
$c<> :: HexString -> HexString -> HexString
Semigroup, Semigroup HexString
HexString
Semigroup HexString =>
HexString
-> (HexString -> HexString -> HexString)
-> ([HexString] -> HexString)
-> Monoid HexString
[HexString] -> HexString
HexString -> HexString -> HexString
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [HexString] -> HexString
$cmconcat :: [HexString] -> HexString
mappend :: HexString -> HexString -> HexString
$cmappend :: HexString -> HexString -> HexString
mempty :: HexString
$cmempty :: HexString
$cp1Monoid :: Semigroup HexString
Monoid, HexString -> Int
HexString -> Ptr p -> IO ()
HexString -> (Ptr p -> IO a) -> IO a
(HexString -> Int)
-> (forall p a. HexString -> (Ptr p -> IO a) -> IO a)
-> (forall p. HexString -> Ptr p -> IO ())
-> ByteArrayAccess HexString
forall p. HexString -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. HexString -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: HexString -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. HexString -> Ptr p -> IO ()
withByteArray :: HexString -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall p a. HexString -> (Ptr p -> IO a) -> IO a
length :: HexString -> Int
$clength :: HexString -> Int
ByteArrayAccess, Eq HexString
Ord HexString
Monoid HexString
ByteArrayAccess HexString
(Eq HexString, Ord HexString, Monoid HexString,
 ByteArrayAccess HexString) =>
(forall p a. Int -> (Ptr p -> IO a) -> IO (a, HexString))
-> ByteArray HexString
Int -> (Ptr p -> IO a) -> IO (a, HexString)
forall ba.
(Eq ba, Ord ba, Monoid ba, ByteArrayAccess ba) =>
(forall p a. Int -> (Ptr p -> IO a) -> IO (a, ba)) -> ByteArray ba
forall p a. Int -> (Ptr p -> IO a) -> IO (a, HexString)
allocRet :: Int -> (Ptr p -> IO a) -> IO (a, HexString)
$callocRet :: forall p a. Int -> (Ptr p -> IO a) -> IO (a, HexString)
$cp4ByteArray :: ByteArrayAccess HexString
$cp3ByteArray :: Monoid HexString
$cp2ByteArray :: Ord HexString
$cp1ByteArray :: Eq HexString
ByteArray)

instance Show HexString where
    show :: HexString -> String
show = ("HexString " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (HexString -> String) -> HexString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
show (Text -> String) -> (HexString -> Text) -> HexString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HexString -> Text
format

instance IsString HexString where
    fromString :: String -> HexString
fromString = ByteString -> HexString
hexString' (ByteString -> HexString)
-> (String -> ByteString) -> String -> HexString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString
      where
        hexString' :: ByteString -> HexString
        hexString' :: ByteString -> HexString
hexString' = (String -> HexString)
-> (HexString -> HexString) -> Either String HexString -> HexString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> HexString
forall a. HasCallStack => String -> a
error HexString -> HexString
forall a. a -> a
id (Either String HexString -> HexString)
-> (ByteString -> Either String HexString)
-> ByteString
-> HexString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String HexString
forall ba. ByteArray ba => ba -> Either String HexString
hexString

instance FromJSON HexString where
    parseJSON :: Value -> Parser HexString
parseJSON Null = HexString -> Parser HexString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> HexString
forall ba. ByteArrayAccess ba => ba -> HexString
fromBytes ("" :: ByteString))
    parseJSON v :: Value
v = String -> (Text -> Parser HexString) -> Value -> Parser HexString
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "HexString" ((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) Value
v

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

-- | Smart constructor which trims '0x' and validates length is even.
--   Works with any mixed casing of characters:
--   `hexString "0xAA" == hexString "0xAa" == hexString "0xaA" == hexString "0xaa"`
hexString :: ByteArray ba => ba -> Either String HexString
hexString :: ba -> Either String HexString
hexString bs :: ba
bs = ByteString -> HexString
HexString (ByteString -> HexString)
-> Either String ByteString -> Either String HexString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Base -> ba -> Either String ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base16 ba
bs'
  where
    hexStart :: ba
hexStart = ByteString -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert ("0x" :: ByteString)
    bs' :: ba
bs' | Int -> ba -> ba
forall bs. ByteArray bs => Int -> bs -> bs
BA.take 2 ba
bs ba -> ba -> Bool
forall a. Eq a => a -> a -> Bool
== ba
hexStart = Int -> ba -> ba
forall bs. ByteArray bs => Int -> bs -> bs
BA.drop 2 ba
bs
        | Bool
otherwise = ba
bs

-- | 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 = 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

-- | Access to a 'Text' representation of the 'HexString'
format :: HexString -> Text
format :: HexString -> Text
format a :: HexString
a = "0x" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HexString -> Text
toText HexString
a