    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE MagicHash #-}
    {-# LANGUAGE MultiWayIf #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE TypeApplications #-}
    -- |
    -- Module       : Data.ByteString.Base64.Internal
    -- Copyright    : (c) 2019-2020 Emily Pillmore
    -- License      : BSD-style
    --
    -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>
    -- Stability    : Experimental
    -- Portability  : portable
    --
    -- Internal module defining the encoding and decoding
    -- processes and tables.
    --
    module Data.ByteString.Base64.Internal
    ( validateBase64
    , validateBase64Url
    , 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

    -- | Given a bytestring, check to see that it conforms to a given alphabet
    --
    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 a. a -> IO a
    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 a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
    {-# INLINE validateBase64 #-}

    validateBase64Url :: ByteString -> ByteString -> Bool
    validateBase64Url :: ByteString -> ByteString -> Bool
    validateBase64Url !ByteString
    alphabet bs :: ByteString
    bs@(PS ForeignPtr Word8
    _ Int
    _ Int
    l)
        | Int
    l Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = Bool
    True
        | Int
    r Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = ByteString -> Bool
    f ByteString
    bs
        | Int
    r Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    2 = ByteString -> Bool
    f (ByteString -> ByteString -> ByteString
    BS.append ByteString
    bs ByteString
    "==")
        | Int
    r Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    3 = ByteString -> Bool
    f (ByteString -> ByteString -> ByteString
    BS.append ByteString
    bs ByteString
    "=")
        | Bool
    otherwise = Bool
    False

      where
        r :: Int
    r = Int
    l Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `rem` Int
    4

        f :: ByteString -> Bool
    f (PS ForeignPtr Word8
    fp Int
    o Int
    n) = 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
    o) (Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    plusPtr Ptr Word8
    p (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    o))

        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 a. a -> IO a
    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 check :: Word8 -> Bool
    check 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
    check 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 a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
    {-# INLINE validateBase64Url #-}

    -- | This function checks that the last char of a bytestring is '='
    -- and, if true, fails with a message or completes some io action.
    --
    -- This is necessary to check when decoding permissively (i.e. filling in padding chars).
    -- Consider the following 4 cases of a string of length l:
    --
    -- l = 0 mod 4: No pad chars are added, since the input is assumed to be good.
    -- l = 1 mod 4: Never an admissible length in base64
    -- l = 2 mod 4: 2 padding chars are added. If padding chars are present in the string, they will fail as to decode as final quanta
    -- l = 3 mod 4: 1 padding char is added. In this case  a string is of the form <body> + <padchar>. If adding the
    -- pad char "completes"" the string so that it is `l = 0 mod 4`, then this may possibly be forming corrupting data.
    -- This case is degenerate and should be disallowed.
    --
    -- Hence, permissive decodes should only fill in padding chars when it makes sense to add them. That is,
    -- if an input is degenerate, it should never succeed when we add padding chars. We need the following invariant to hold:
    --
    -- @
    --   B64U.decodeUnpadded <|> B64U.decodePadded ~ B64U.decodePadded
    -- @
    --
    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
        | HasCallStack => ByteString -> Word8
    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 #-}