module System.Nix.Base32 (encode) where

-- Copied from hnix-store-core until there's a new release

import qualified Data.ByteString as BS
import qualified Data.Text as T
import qualified Data.Vector as V
import Protolude

-- | Encode a 'BS.ByteString' in Nix's base32 encoding
encode :: BS.ByteString -> T.Text
encode :: ByteString -> Text
encode c :: ByteString
c = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (Integer -> Char) -> [Integer] -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Integer -> Char
char32 [Integer
nChar Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1, Integer
nChar Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 2 .. 0]
  where
    digits32 :: Vector Char
digits32 = String -> Vector Char
forall a. [a] -> Vector a
V.fromList "0123456789abcdfghijklmnpqrsvwxyz"
    -- 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
* 8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 5) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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 (f :: * -> *) a. (Foldable f, Num a) => f 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
* (256 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
j)
          | Int
j <- [0 .. ByteString -> Int
BS.length ByteString
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]
        ]
    char32 :: Integer -> Char
    char32 :: Integer -> Char
char32 i :: 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` (32 Integer -> 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` 32