{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
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
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
$c== :: Base16 -> Base16 -> Bool
== :: Base16 -> Base16 -> Bool
$c/= :: Base16 -> Base16 -> Bool
/= :: Base16 -> Base16 -> Bool
Eq, 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
$c<> :: Base16 -> Base16 -> Base16
<> :: Base16 -> Base16 -> Base16
$csconcat :: NonEmpty Base16 -> Base16
sconcat :: NonEmpty Base16 -> Base16
$cstimes :: forall b. Integral b => b -> Base16 -> Base16
stimes :: forall b. Integral b => b -> 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
$cmempty :: Base16
mempty :: Base16
$cmappend :: Base16 -> Base16 -> Base16
mappend :: Base16 -> Base16 -> Base16
$cmconcat :: [Base16] -> Base16
mconcat :: [Base16] -> Base16
Monoid)
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
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 #-}
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 :: 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"
fromBase16 :: Encodable a => String -> a
fromBase16 :: forall a. Encodable a => [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
showBase16 :: Encodable a => a -> String
showBase16 :: forall a. Encodable a => 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