module System.Nix.Internal.Base32 where

import           Data.Maybe             (fromMaybe)
import           Data.Bits              (shiftR)
import           Data.Word              (Word8)
import           Data.List              (unfoldr)
import qualified Data.ByteString        as BS
import qualified Data.ByteString.Char8  as BSC
import qualified Data.Text              as T
import qualified Data.Vector            as V
import           Numeric                (readInt)

-- omitted: E O U T
digits32 :: Vector Char
digits32 = [Char] -> Vector Char
forall a. [a] -> Vector a
V.fromList [Char]
"0123456789abcdfghijklmnpqrsvwxyz"

-- | Encode a 'BS.ByteString' in Nix's base32 encoding
encode :: BS.ByteString -> T.Text
encode :: ByteString -> Text
encode ByteString
c = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ (Integer -> Char) -> [Integer] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Char
char32 [Integer
nChar Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1, Integer
nChar Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
2 .. Integer
0]
  where
    -- Each base32 character gives us 5 bits of information, while
    -- each byte gives is 8. Because 'div' rounds down, we need to add
    -- one extra character to the result, and because of that extra 1
    -- we need to subtract one from the number of bits in the
    -- bytestring to cover for the case where the number of bits is
    -- already a factor of 5. Thus, the + 1 outside of the 'div' and
    -- the - 1 inside of it.
    nChar :: Integer
nChar = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ ((ByteString -> Int
BS.length ByteString
c Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
5) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

    byte :: Int -> Word8
byte = ByteString -> Int -> Word8
BS.index ByteString
c (Int -> Word8) -> (Int -> Int) -> Int -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

    -- May need to switch to a more efficient calculation at some
    -- point.
    bAsInteger :: Integer
    bAsInteger :: Integer
bAsInteger = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8
byte Int
j) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
256 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
j)
                     | Int
j <- [Int
0 .. ByteString -> Int
BS.length ByteString
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
                     ]

    char32 :: Integer -> Char
    char32 :: Integer -> Char
char32 Integer
i = Vector Char
digits32 Vector Char -> Int -> Char
forall a. Vector a -> Int -> a
V.! Int
digitInd
      where
        digitInd :: Int
digitInd = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$
                   Integer
bAsInteger
                   Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` (Integer
32Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
i)
                   Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
32

-- | Decode Nix's base32 encoded text
decode :: T.Text -> Either String BS.ByteString
decode :: Text -> Either [Char] ByteString
decode Text
what =
  if (Char -> Bool) -> Text -> Bool
T.all (Char -> Vector Char -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Vector Char
digits32) Text
what
    then Text -> Either [Char] ByteString
unsafeDecode Text
what
    else [Char] -> Either [Char] ByteString
forall a b. a -> Either a b
Left [Char]
"Invalid base32 string"

-- | Decode Nix's base32 encoded text
-- Doesn't check if all elements match `digits32`
unsafeDecode :: T.Text -> Either String BS.ByteString
unsafeDecode :: Text -> Either [Char] ByteString
unsafeDecode Text
what =
  case Integer -> (Char -> Bool) -> (Char -> Int) -> ReadS Integer
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
readInt Integer
32
         (Char -> Vector Char -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Vector Char
digits32)
         (\Char
c -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"character not in digits32") (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$
                  (Char -> Bool) -> Vector Char -> Maybe Int
forall a. (a -> Bool) -> Vector a -> Maybe Int
V.findIndex (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
c) Vector Char
digits32)
         (Text -> [Char]
T.unpack Text
what)
    of
      [(Integer
i, [Char]
_)] -> ByteString -> Either [Char] ByteString
forall a b. b -> Either a b
Right (ByteString -> Either [Char] ByteString)
-> ByteString -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
padded (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Integer -> ByteString
integerToBS Integer
i
      [(Integer, [Char])]
x        -> [Char] -> Either [Char] ByteString
forall a b. a -> Either a b
Left ([Char] -> Either [Char] ByteString)
-> [Char] -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"Can't decode: readInt returned " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [(Integer, [Char])] -> [Char]
forall a. Show a => a -> [Char]
show [(Integer, [Char])]
x
  where
    padded :: ByteString -> ByteString
padded ByteString
x
      | ByteString -> Int
BS.length ByteString
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
decLen = ByteString
x ByteString -> ByteString -> ByteString
`BS.append` ByteString
bstr
      | Bool
otherwise = ByteString
x
     where
      bstr :: ByteString
bstr = [Char] -> ByteString
BSC.pack ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take (Int
decLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
x) ([Char] -> [Char]
forall a. [a] -> [a]
cycle [Char]
"\NUL")

    decLen :: Int
decLen = Text -> Int
T.length Text
what Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8

-- | Encode an Integer to a bytestring
-- Similar to Data.Base32String (integerToBS) without `reverse`
integerToBS :: Integer -> BS.ByteString
integerToBS :: Integer -> ByteString
integerToBS Integer
0 = [Word8] -> ByteString
BS.pack [Word8
0]
integerToBS Integer
i
    | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0     = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Integer -> Maybe (Word8, Integer)) -> Integer -> [Word8]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Integer -> Maybe (Word8, Integer)
f Integer
i
    | Bool
otherwise = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"integerToBS not defined for negative values"
  where
    f :: Integer -> Maybe (Word8, Integer)
f Integer
0 = Maybe (Word8, Integer)
forall a. Maybe a
Nothing
    f Integer
x = (Word8, Integer) -> Maybe (Word8, Integer)
forall a. a -> Maybe a
Just (Integer -> Word8
forall a. Num a => Integer -> a
fromInteger Integer
x :: Word8, Integer
x Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)