module System.Nix.Internal.Base32
 ( encode
 , decode
 , digits32
 )
where


import qualified Data.ByteString               as Bytes
import qualified Data.ByteString.Char8         as Bytes.Char8
import qualified Data.Text
import           Data.Vector                    ( Vector )
import qualified Data.Vector                   as Vector
import           Data.Bits                      ( shiftR )
import           Numeric                        ( readInt )


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

-- | Encode a 'BS.ByteString' in Nix's base32 encoding
encode :: ByteString -> Text
encode :: ByteString -> Text
encode ByteString
c = [Char] -> Text
forall a. ToText a => a -> Text
toText ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> Char
takeCharPosFromDict (Integer -> Char) -> [Integer] -> [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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
Bytes.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
Bytes.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 a (f :: * -> *). (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
* (Integer
256 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
j)
        | Int
j <- [Int
0 .. ByteString -> Int
Bytes.length ByteString
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ]

  takeCharPosFromDict :: Integer -> Char
  takeCharPosFromDict :: Integer -> Char
takeCharPosFromDict Integer
i = Vector Char
digits32 Vector Char -> Int -> Char
forall a. Vector a -> Int -> a
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 =
  Either [Char] ByteString
-> Either [Char] ByteString -> Bool -> Either [Char] ByteString
forall a. a -> a -> Bool -> a
bool
    ([Char] -> Either [Char] ByteString
forall a b. a -> Either a b
Left [Char]
"Invalid NixBase32 string")
    (Text -> Either [Char] ByteString
unsafeDecode Text
what)
    ((Char -> Bool) -> Text -> Bool
Data.Text.all (Char -> Vector Char -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` Vector Char
digits32) Text
what)

-- | 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 (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` Vector Char
digits32)
        (\Char
c -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (Text -> Int
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"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
Vector.findIndex (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) Vector Char
digits32
        )
        (Text -> [Char]
forall a. ToString a => a -> [Char]
toString Text
what)
    of
      [(Integer
i, [Char]
_)] -> ByteString -> Either [Char] ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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. Semigroup a => a -> a -> a
<> [(Integer, [Char])] -> [Char]
forall b a. (Show a, IsString b) => a -> b
show [(Integer, [Char])]
x
 where
  padded :: ByteString -> ByteString
padded ByteString
x
    | ByteString -> Int
Bytes.length ByteString
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
decLen = ByteString
x ByteString -> ByteString -> ByteString
`Bytes.append` ByteString
bstr
    | Bool
otherwise               = ByteString
x
   where
    bstr :: ByteString
bstr = [Char] -> ByteString
Bytes.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
Bytes.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
Bytes.pack [Word8
0]
integerToBS Integer
i
    | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0     = [Word8] -> ByteString
Bytes.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 = Text -> ByteString
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"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)