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

-- |
-- Module      :  Data.ByteArray.HexString.Internal
-- Copyright   :  Aleksandr Krupenkin 2016-2024
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  unportable
--
-- Hex string data type.
--

module Data.ByteArray.HexString.Internal where

import           Codec.Scale             (Decode, Encode)
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 qualified Data.ByteString.Char8   as C8 (unpack)
import           Data.String             (IsString (..))

-- | 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
$c== :: HexString -> HexString -> Bool
== :: HexString -> HexString -> Bool
$c/= :: HexString -> HexString -> Bool
/= :: 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
$ccompare :: HexString -> HexString -> Ordering
compare :: HexString -> HexString -> Ordering
$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
>= :: HexString -> HexString -> Bool
$cmax :: HexString -> HexString -> HexString
max :: HexString -> HexString -> HexString
$cmin :: HexString -> HexString -> HexString
min :: HexString -> HexString -> HexString
Ord, 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
$c<> :: HexString -> HexString -> HexString
<> :: HexString -> HexString -> HexString
$csconcat :: NonEmpty HexString -> HexString
sconcat :: NonEmpty HexString -> HexString
$cstimes :: forall b. Integral b => b -> HexString -> HexString
stimes :: forall b. Integral b => b -> 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
$cmempty :: HexString
mempty :: HexString
$cmappend :: HexString -> HexString -> HexString
mappend :: HexString -> HexString -> HexString
$cmconcat :: [HexString] -> HexString
mconcat :: [HexString] -> HexString
Monoid, HexString -> Int
(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
$clength :: HexString -> Int
length :: HexString -> Int
$cwithByteArray :: forall p a. HexString -> (Ptr p -> IO a) -> IO a
withByteArray :: forall p a. HexString -> (Ptr p -> IO a) -> IO a
$ccopyByteArrayToPtr :: forall p. HexString -> Ptr p -> IO ()
copyByteArrayToPtr :: forall p. HexString -> Ptr p -> IO ()
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
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)
$callocRet :: forall p a. Int -> (Ptr p -> IO a) -> IO (a, HexString)
allocRet :: forall p a. Int -> (Ptr p -> IO a) -> IO (a, HexString)
ByteArray, Putter HexString
Putter HexString -> Encode HexString
forall a. Putter a -> Encode a
$cput :: Putter HexString
put :: Putter HexString
Encode, Get HexString
Get HexString -> Decode HexString
forall a. Get a -> Decode a
$cget :: Get HexString
get :: Get HexString
Decode)

instance Show HexString where
    show :: HexString -> String
show = (String
"0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (HexString -> String) -> HexString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
C8.unpack (ByteString -> String)
-> (HexString -> ByteString) -> HexString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HexString -> ByteString
unHexString'
      where
        unHexString' :: HexString -> ByteString
        unHexString' :: HexString -> ByteString
unHexString' = 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 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

-- | Smart constructor which trims '0x' and validates length is even.
hexString :: ByteArray ba => ba -> Either String HexString
hexString :: forall ba. ByteArray ba => ba -> Either String HexString
hexString 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 (ByteString
"0x" :: ByteString)
    bs' :: ba
bs' | Int -> ba -> ba
forall bs. ByteArray bs => Int -> bs -> bs
BA.take Int
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 Int
2 ba
bs
        | Bool
otherwise = ba
bs