{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Trustworthy #-}
module Data.ByteString.Base32.Hex
( encodeBase32
, encodeBase32'
, decodeBase32
, encodeBase32Unpadded
, encodeBase32Unpadded'
, decodeBase32Unpadded
, decodeBase32Padded
, isBase32Hex
, isValidBase32Hex
) where
import qualified Data.ByteString as BS
import Data.ByteString.Internal (ByteString(..))
import Data.ByteString.Base32.Internal
import Data.ByteString.Base32.Internal.Head
import Data.ByteString.Base32.Internal.Tables
import Data.Either (isRight)
import Data.Text (Text)
import qualified Data.Text.Encoding as T
import System.IO.Unsafe (unsafeDupablePerformIO)
encodeBase32 :: ByteString -> Text
encodeBase32 = T.decodeUtf8 . encodeBase32'
{-# INLINE encodeBase32 #-}
encodeBase32' :: ByteString -> ByteString
encodeBase32' = encodeBase32_ "0123456789ABCDEFGHIJKLMNOPQRSTUV"#
{-# INLINE encodeBase32' #-}
decodeBase32 :: ByteString -> Either Text ByteString
decodeBase32 bs@(PS _ _ !l)
| l == 0 = Right bs
| r == 0 = unsafeDupablePerformIO $ decodeBase32_ dlen hexDecodeTable bs
| r == 2 = unsafeDupablePerformIO $ decodeBase32_ dlen hexDecodeTable (BS.append bs "======")
| r == 4 = validateLastNPads 2 bs $ decodeBase32_ dlen hexDecodeTable (BS.append bs "====")
| r == 5 = validateLastNPads 3 bs $ decodeBase32_ dlen hexDecodeTable (BS.append bs "===")
| r == 7 = validateLastNPads 5 bs $ decodeBase32_ dlen hexDecodeTable (BS.append bs "=")
| otherwise = Left "Base32-encoded bytestring has invalid size"
where
!r = l `rem` 8
!q = l `quot` 8
!dlen = q * 8
{-# INLINE decodeBase32 #-}
encodeBase32Unpadded :: ByteString -> Text
encodeBase32Unpadded = T.decodeUtf8 . encodeBase32Unpadded'
{-# INLINE encodeBase32Unpadded #-}
encodeBase32Unpadded' :: ByteString -> ByteString
encodeBase32Unpadded' = encodeBase32NoPad_ "0123456789ABCDEFGHIJKLMNOPQRSTUV"#
{-# INLINE encodeBase32Unpadded' #-}
decodeBase32Unpadded :: ByteString -> Either Text ByteString
decodeBase32Unpadded bs@(PS _ _ !l)
| l == 0 = Right bs
| r == 0 = validateLastNPads 1 bs $ decodeBase32_ dlen hexDecodeTable bs
| r == 2 = unsafeDupablePerformIO $ decodeBase32_ dlen hexDecodeTable (BS.append bs "======")
| r == 4 = validateLastNPads 1 bs $ decodeBase32_ dlen hexDecodeTable (BS.append bs "====")
| r == 5 = validateLastNPads 1 bs $ decodeBase32_ dlen hexDecodeTable (BS.append bs "===")
| r == 7 = validateLastNPads 1 bs $ decodeBase32_ dlen hexDecodeTable (BS.append bs "=")
| otherwise = Left "Base32-encoded bytestring has invalid size"
where
!q = l `quot` 8
!r = l `rem` 8
!dlen = q * 5
{-# INLINE decodeBase32Unpadded #-}
decodeBase32Padded :: ByteString -> Either Text ByteString
decodeBase32Padded bs@(PS _ _ !l)
| l == 0 = Right bs
| r == 1 = Left "Base32-encoded bytestring has invalid size"
| r == 3 = Left "Base32-encoded bytestring has invalid size"
| r == 6 = Left "Base32-encoded bytestring has invalid size"
| r /= 0 = Left "Base32-encoded bytestring requires padding"
| otherwise = unsafeDupablePerformIO $ decodeBase32_ dlen hexDecodeTable bs
where
!q = l `quot` 8
!r = l `rem` 8
!dlen = q * 5
{-# INLINE decodeBase32Padded #-}
isBase32Hex :: ByteString -> Bool
isBase32Hex bs = isValidBase32Hex bs && isRight (decodeBase32 bs)
{-# INLINE isBase32Hex #-}
isValidBase32Hex :: ByteString -> Bool
isValidBase32Hex = validateBase32 "0123456789ABCDEFGHIJKLMNOPQRSTUV"
{-# INLINE isValidBase32Hex #-}