{-# OPTIONS_HADDOCK hide                #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Base 16 or hexadecimal encoding of objects.

module Raaz.Core.Encode.Base16
       ( Base16
       , fromBase16, showBase16
       ) where

import Data.Char
import Data.ByteString as B
import Data.ByteString.Char8 as C8
import Data.ByteString.Internal (c2w)

import Data.ByteString.Unsafe(unsafeIndex)

import Raaz.Core.Prelude
import Raaz.Core.Encode.Internal

-- | The type corresponding to base-16 or hexadecimal encoding. The
-- `Base16` encoding has a special place in this library: most
-- cryptographic types use `Base16` encoding for their `Show` and
-- `IsString` instance. The combinators `fromBase16` and `showBase16`
-- are exposed mainly to make these definitions easy.
--

newtype Base16 = Base16 {Base16 -> ByteString
unBase16 :: ByteString} deriving (Base16 -> Base16 -> Bool
(Base16 -> Base16 -> Bool)
-> (Base16 -> Base16 -> Bool) -> Eq Base16
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Base16 -> Base16 -> Bool
$c/= :: Base16 -> Base16 -> Bool
== :: Base16 -> Base16 -> Bool
$c== :: Base16 -> Base16 -> Bool
Eq, b -> Base16 -> Base16
NonEmpty Base16 -> Base16
Base16 -> Base16 -> Base16
(Base16 -> Base16 -> Base16)
-> (NonEmpty Base16 -> Base16)
-> (forall b. Integral b => b -> Base16 -> Base16)
-> Semigroup Base16
forall b. Integral b => b -> Base16 -> Base16
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Base16 -> Base16
$cstimes :: forall b. Integral b => b -> Base16 -> Base16
sconcat :: NonEmpty Base16 -> Base16
$csconcat :: NonEmpty Base16 -> Base16
<> :: Base16 -> Base16 -> Base16
$c<> :: Base16 -> Base16 -> Base16
Semigroup, Semigroup Base16
Base16
Semigroup Base16
-> Base16
-> (Base16 -> Base16 -> Base16)
-> ([Base16] -> Base16)
-> Monoid Base16
[Base16] -> Base16
Base16 -> Base16 -> Base16
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Base16] -> Base16
$cmconcat :: [Base16] -> Base16
mappend :: Base16 -> Base16 -> Base16
$cmappend :: Base16 -> Base16 -> Base16
mempty :: Base16
$cmempty :: Base16
$cp1Monoid :: Semigroup Base16
Monoid)

-- Developers note: Internally base16 just stores the bytestring as
-- is. The conversion happens when we do an encode and decode of
-- actual base16.
--


instance Encodable Base16 where
  toByteString :: Base16 -> ByteString
toByteString          = ByteString -> ByteString
hex (ByteString -> ByteString)
-> (Base16 -> ByteString) -> Base16 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base16 -> ByteString
unBase16

  fromByteString :: ByteString -> Maybe Base16
fromByteString ByteString
bs
    | Int -> Bool
forall a. Integral a => a -> Bool
odd (ByteString -> Int
B.length ByteString
bs) = Maybe Base16
forall a. Maybe a
Nothing
    | ByteString -> Bool
validInput ByteString
bs     = Base16 -> Maybe Base16
forall a. a -> Maybe a
Just (Base16 -> Maybe Base16) -> Base16 -> Maybe Base16
forall a b. (a -> b) -> a -> b
$ ByteString -> Base16
Base16 (ByteString -> Base16) -> ByteString -> Base16
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
unsafeFromHex ByteString
bs
    | Bool
otherwise         = Maybe Base16
forall a. Maybe a
Nothing
    where validInput :: ByteString -> Bool
validInput  = (Char -> Bool) -> ByteString -> Bool
C8.all Char -> Bool
isHexDigit
  unsafeFromByteString :: ByteString -> Base16
unsafeFromByteString ByteString
bs
    | Int -> Bool
forall a. Integral a => a -> Bool
odd (ByteString -> Int
B.length ByteString
bs) = [Char] -> Base16
forall a. HasCallStack => [Char] -> a
error [Char]
"base16 encoding is always of even size"
    | Bool
otherwise         = ByteString -> Base16
Base16 (ByteString -> Base16) -> ByteString -> Base16
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
unsafeFromHex ByteString
bs

instance Show Base16 where
  show :: Base16 -> [Char]
show = ByteString -> [Char]
C8.unpack (ByteString -> [Char])
-> (Base16 -> ByteString) -> Base16 -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base16 -> ByteString
forall a. Encodable a => a -> ByteString
toByteString

-- | Ignores spaces and ':' (colon).
instance IsString Base16 where
  fromString :: [Char] -> Base16
fromString = ByteString -> Base16
forall a. Encodable a => ByteString -> a
unsafeFromByteString (ByteString -> Base16)
-> ([Char] -> ByteString) -> [Char] -> Base16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
C8.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
useless) (ByteString -> ByteString)
-> ([Char] -> ByteString) -> [Char] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
forall a. IsString a => [Char] -> a
fromString
    where useless :: Char -> Bool
useless Char
c = Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':'

instance Format Base16 where
  encodeByteString :: ByteString -> Base16
encodeByteString = ByteString -> Base16
Base16
  {-# INLINE encodeByteString #-}

  decodeFormat :: Base16 -> ByteString
decodeFormat     = Base16 -> ByteString
unBase16
  {-# INLINE decodeFormat #-}

-- Since the encoding to base16 is usually used for user interaction
-- we can afford to be slower here.
--
-- TODO (Liquid Haskell)
--
{--@ hex :: inp:ByteString -> { bs : ByteString | bslen bs = 2 * bslen inp } @-}
--
hex :: ByteString -> ByteString
hex :: ByteString -> ByteString
hex  ByteString
bs = (ByteString, Maybe Int) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, Maybe Int) -> ByteString)
-> (ByteString, Maybe Int) -> ByteString
forall a b. (a -> b) -> a -> b
$ Int
-> (Int -> Maybe (Word8, Int)) -> Int -> (ByteString, Maybe Int)
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
B.unfoldrN (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* ByteString -> Int
B.length ByteString
bs) Int -> Maybe (Word8, Int)
gen Int
0
    where gen :: Int -> Maybe (Word8, Int)
gen Int
i | Int
rm Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   = (Word8, Int) -> Maybe (Word8, Int)
forall a. a -> Maybe a
Just (Word8 -> Word8
hexDigit (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8
top4 Word8
w, Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                | Bool
otherwise = (Word8, Int) -> Maybe (Word8, Int)
forall a. a -> Maybe a
Just (Word8 -> Word8
hexDigit (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8
bot4 Word8
w, Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
            where (Int
idx, Int
rm) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem Int
i Int
2
                  w :: Word8
w         = ByteString -> Int -> Word8
unsafeIndex ByteString
bs Int
idx





hexDigit :: Word8 -> Word8
hexDigit :: Word8 -> Word8
hexDigit Word8
x | Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
10    = Char -> Word8
c2w Char
'0' Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
x
           | Bool
otherwise = Char -> Word8
c2w Char
'a' Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ (Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
10)

top4 :: Word8 -> Word8; top4 :: Word8 -> Word8
top4 Word8
x  = Word8
x Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4
bot4 :: Word8 -> Word8; bot4 :: Word8 -> Word8
bot4 Word8
x  = Word8
x  Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0F

{-@ unsafeFromHex :: {bs : ByteString | (bslen bs) mod 2 == 0 } -> ByteString @-}
unsafeFromHex :: ByteString -> ByteString
unsafeFromHex :: ByteString -> ByteString
unsafeFromHex ByteString
bs = (ByteString, Maybe Int) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, Maybe Int) -> ByteString)
-> (ByteString, Maybe Int) -> ByteString
forall a b. (a -> b) -> a -> b
$ Int
-> (Int -> Maybe (Word8, Int)) -> Int -> (ByteString, Maybe Int)
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
B.unfoldrN Int
len Int -> Maybe (Word8, Int)
gen Int
0
  where len :: Int
len   = ByteString -> Int
B.length ByteString
bs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2
        gen :: Int -> Maybe (Word8, Int)
gen Int
i = (Word8, Int) -> Maybe (Word8, Int)
forall a. a -> Maybe a
Just (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftL Word8
w0 Int
4 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
w1, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          where w0 :: Word8
w0 = Word8 -> Word8
fromHexWord (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Word8
unsafeIndex ByteString
bs (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)
                w1 :: Word8
w1 = Word8 -> Word8
fromHexWord (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Word8
unsafeIndex ByteString
bs (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        fromHexWord :: Word8 -> Word8
fromHexWord Word8
x
          | Char -> Word8
c2w Char
'0' Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Word8
c2w Char
'9' = Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Char -> Word8
c2w Char
'0'
          | Char -> Word8
c2w Char
'a' Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Word8
c2w Char
'f' = Word8
10 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ (Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Char -> Word8
c2w Char
'a')
          | Char -> Word8
c2w Char
'A' Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Word8
c2w Char
'F' = Word8
10 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ (Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Char -> Word8
c2w Char
'A')
          | Bool
otherwise                    = [Char] -> Word8
forall a. HasCallStack => [Char] -> a
error [Char]
"bad base16 character"


-- | Base16 variant of `fromString`. Useful in definition of
-- `IsString` instances as well as in cases where the default
-- `IsString` instance does not parse from a base16 encoding.
fromBase16 :: Encodable a => String -> a
fromBase16 :: [Char] -> a
fromBase16 = ByteString -> a
forall a. Encodable a => ByteString -> a
unsafeFromByteString (ByteString -> a) -> ([Char] -> ByteString) -> [Char] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base16 -> ByteString
unBase16 (Base16 -> ByteString)
-> ([Char] -> Base16) -> [Char] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Base16
forall a. IsString a => [Char] -> a
fromString

-- | Base16 variant of `show`.
showBase16 :: Encodable a => a -> String
showBase16 :: a -> [Char]
showBase16 = Base16 -> [Char]
forall a. Show a => a -> [Char]
show (Base16 -> [Char]) -> (a -> Base16) -> a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base16
Base16 (ByteString -> Base16) -> (a -> ByteString) -> a -> Base16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. Encodable a => a -> ByteString
toByteString