{-# LANGUAGE BangPatterns, MagicHash #-}

{-# OPTIONS_GHC -fno-warn-missing-local-signatures #-}

-- |
-- Module      : Data.ByteString.Base16
-- Copyright   : (c) 2011 MailRank, Inc.
--
-- License     : BSD
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- Fast and efficient encoding and decoding of base16-encoded strings.
--
-- This code is lifted directly from https://hackage.haskell.org/package/base16-bytestring-0.1.1.7/docs/src/Data.ByteString.Base16.html
-- and is intended to be temporary to facilitate migration from base16-bytestring-0.1.1.7 to base16-bytestring-1.0.0.0

module Cardano.Prelude.Base16.Internal
  ( decode
  ) where

import Data.Functor
import Data.Eq
import Data.Bool
import Data.Function
import Data.ByteString.Char8 (empty)
import Control.Monad
import Data.ByteString.Internal (ByteString(..), createAndTrim')
import Data.Bits (shiftL)
import Data.Ord
import GHC.Num
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import Foreign.Ptr (Ptr, minusPtr, plusPtr)
import Foreign.Storable (peek, poke)
import System.IO.Unsafe (unsafePerformIO)
import GHC.Prim
import GHC.Types
import GHC.Word
import GHC.Real

-- | Decode a string from base16 form. The first element of the
-- returned tuple contains the decoded data. The second element starts
-- at the first invalid base16 sequence in the original string.
--
-- Examples:
--
-- > decode "666f6f"  == ("foo", "")
-- > decode "66quux"  == ("f", "quux")
-- > decode "666quux" == ("f", "6quux")
decode :: ByteString -> (ByteString, ByteString)
decode :: ByteString -> (ByteString, ByteString)
decode (PS ForeignPtr Word8
sfp Int
soff Int
slen) =
  IO (ByteString, ByteString) -> (ByteString, ByteString)
forall a. IO a -> a
unsafePerformIO (IO (ByteString, ByteString) -> (ByteString, ByteString))
-> ((Ptr Word8 -> IO (Int, Int, ByteString))
    -> IO (ByteString, ByteString))
-> (Ptr Word8 -> IO (Int, Int, ByteString))
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> (Ptr Word8 -> IO (Int, Int, ByteString))
-> IO (ByteString, ByteString)
forall a.
Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
createAndTrim' (Int
slen Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) ((Ptr Word8 -> IO (Int, Int, ByteString))
 -> (ByteString, ByteString))
-> (Ptr Word8 -> IO (Int, Int, ByteString))
-> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
      ForeignPtr Word8
-> (Ptr Word8 -> IO (Int, Int, ByteString))
-> IO (Int, Int, ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO (Int, Int, ByteString))
 -> IO (Int, Int, ByteString))
-> (Ptr Word8 -> IO (Int, Int, ByteString))
-> IO (Int, Int, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sptr ->
        Ptr Word8 -> Ptr Word8 -> IO (Int, Int, ByteString)
forall b a.
(Storable b, Num a, Num b) =>
Ptr Word8 -> Ptr b -> IO (a, Int, ByteString)
dec (Ptr Word8
sptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
soff) Ptr Word8
dptr
 where
  dec :: Ptr Word8 -> Ptr b -> IO (a, Int, ByteString)
dec Ptr Word8
sptr = Ptr Word8 -> Ptr b -> IO (a, Int, ByteString)
forall b a.
(Storable b, Num a, Num b) =>
Ptr Word8 -> Ptr b -> IO (a, Int, ByteString)
go Ptr Word8
sptr where
    e :: Ptr b
e = Ptr Word8
sptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` if Int -> Bool
forall a. Integral a => a -> Bool
odd Int
slen then Int
slen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 else Int
slen
    go :: Ptr Word8 -> Ptr b -> IO (a, Int, ByteString)
go Ptr Word8
s Ptr b
d | Ptr Word8
s Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall b. Ptr b
e = let len :: Int
len = Ptr Any
forall b. Ptr b
e Ptr Any -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
sptr
                      in (a, Int, ByteString) -> IO (a, Int, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
0, Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2, ForeignPtr Word8 -> Int -> Int -> ByteString
ps ForeignPtr Word8
sfp (Int
soffInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
len) (Int
slenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
len))
           | Bool
otherwise = do
      Word8
hi <- Int -> Word8
hex (Int -> Word8) -> IO Int -> IO Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr Word8 -> IO Int
peek8 Ptr Word8
s
      Word8
lo <- Int -> Word8
hex (Int -> Word8) -> IO Int -> IO Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr Word8 -> IO Int
peek8 (Ptr Word8
s Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
      if Word8
lo Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xff Bool -> Bool -> Bool
|| Word8
hi Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xff
        then let len :: Int
len = Ptr Word8
s Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
sptr
             in (a, Int, ByteString) -> IO (a, Int, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
0, Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2, ForeignPtr Word8 -> Int -> Int -> ByteString
ps ForeignPtr Word8
sfp (Int
soffInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
len) (Int
slenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
len))
        else do
          Ptr b -> b -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr b
d (b -> IO ()) -> (Word8 -> b) -> Word8 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Word8
lo Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ (Word8
hi Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
4)
          Ptr Word8 -> Ptr b -> IO (a, Int, ByteString)
go (Ptr Word8
s Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) (Ptr b
d Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)

    hex :: Int -> Word8
hex (I# Int#
index) = Word# -> Word8
W8# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
table Int#
index)
    !table :: Addr#
table =
        Addr#
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\xff\xff\xff\xff\xff\xff\
        \\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#

peek8 :: Ptr Word8 -> IO Int
peek8 :: Ptr Word8 -> IO Int
peek8 Ptr Word8
p = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> IO Word8 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p

ps :: ForeignPtr Word8 -> Int -> Int -> ByteString
ps :: ForeignPtr Word8 -> Int -> Int -> ByteString
ps ForeignPtr Word8
fp Int
off Int
len
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ByteString
empty
    | Bool
otherwise = ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp Int
off Int
len