module System.Nix.Internal.Base32 where

import           Data.ByteString        (ByteString)
import           Data.Vector            (Vector)
import           Data.Text              (Text)
import           Data.Bits              (shiftR)
import           Data.Word              (Word8)
import           Data.List              (unfoldr)
import           Numeric                (readInt)

import qualified Data.Maybe
import qualified Data.ByteString
import qualified Data.ByteString.Char8
import qualified Data.Text
import qualified Data.Vector

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

-- | Encode a 'BS.ByteString' in Nix's base32 encoding
encode :: ByteString -> Text
encode :: ByteString -> Text
encode ByteString
c = [Char] -> Text
Data.Text.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
Data.ByteString.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
Data.ByteString.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
Data.ByteString.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
Data.Vector.! 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 :: Text -> Either String ByteString
decode :: Text -> Either [Char] ByteString
decode Text
what =
  if (Char -> Bool) -> Text -> Bool
Data.Text.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 :: Text -> Either String 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
Data.Maybe.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
Data.Vector.findIndex (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
c) Vector Char
digits32)
         (Text -> [Char]
Data.Text.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
Data.ByteString.length ByteString
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
decLen = ByteString
x ByteString -> ByteString -> ByteString
`Data.ByteString.append` ByteString
bstr
      | Bool
otherwise = ByteString
x
     where
      bstr :: ByteString
bstr = [Char] -> ByteString
Data.ByteString.Char8.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
Data.ByteString.length ByteString
x) ([Char] -> [Char]
forall a. [a] -> [a]
cycle [Char]
"\NUL")

    decLen :: Int
decLen = Text -> Int
Data.Text.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 -> ByteString
integerToBS :: Integer -> ByteString
integerToBS Integer
0 = [Word8] -> ByteString
Data.ByteString.pack [Word8
0]
integerToBS Integer
i
    | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0     = [Word8] -> ByteString
Data.ByteString.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)