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

-- |
-- Module      :  Data.ByteArray.HexString.Internal
-- Copyright   :  Aleksandr Krupenkin 2016-2021
-- 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
/= :: 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, 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, Putter HexString
Putter HexString -> Encode HexString
forall a. Putter a -> Encode a
put :: Putter HexString
$cput :: Putter HexString
Encode, Get HexString
Get HexString -> Decode HexString
forall a. Get a -> Decode a
get :: Get HexString
$cget :: 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 :: 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