{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Data.ByteString.Base64.Internal
( validateBase64
, validateLastPad
) where
import qualified Data.ByteString as BS
import Data.ByteString.Internal
import Data.Text (Text)
import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Storable
import System.IO.Unsafe
validateBase64 :: ByteString -> ByteString -> Bool
validateBase64 :: ByteString -> ByteString -> Bool
validateBase64 !ByteString
alphabet (PS !ForeignPtr Word8
fp !Int
off !Int
l) =
IO Bool -> Bool
forall a. IO a -> a
accursedUnutterablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
Ptr Word8 -> Ptr Word8 -> IO Bool
go (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
off) (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off))
where
go :: Ptr Word8 -> Ptr Word8 -> IO Bool
go !Ptr Word8
p !Ptr Word8
end
| Ptr Word8
p Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
end = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
| Bool
otherwise = do
Word8
w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p
let f :: Word8 -> Bool
f Word8
a
| Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x3d, Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
1 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
end = Bool
True
| Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x3d, Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
2 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
end = Bool
True
| Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x3d = Bool
False
| Bool
otherwise = Word8 -> ByteString -> Bool
BS.elem Word8
a ByteString
alphabet
if Word8 -> Bool
f Word8
w then Ptr Word8 -> Ptr Word8 -> IO Bool
go (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
1) Ptr Word8
end else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
{-# INLINE validateBase64 #-}
validateLastPad
:: ByteString
-> IO (Either Text ByteString)
-> Either Text ByteString
validateLastPad :: ByteString -> IO (Either Text ByteString) -> Either Text ByteString
validateLastPad !ByteString
bs IO (Either Text ByteString)
io
| ByteString -> Word8
BS.last ByteString
bs Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x3d = Text -> Either Text ByteString
forall a b. a -> Either a b
Left Text
"Base64-encoded bytestring has invalid padding"
| Bool
otherwise = IO (Either Text ByteString) -> Either Text ByteString
forall a. IO a -> a
unsafeDupablePerformIO IO (Either Text ByteString)
io
{-# INLINE validateLastPad #-}