{-|
Description: Implementation of Nix's base32 encoding.
-}
module System.Nix.Base32
  ( encode
  , decode
  , digits32
  ) where

import Data.ByteString (ByteString)
import Data.Text (Text)
import Data.Vector (Vector)
import Data.Word (Word8)

import qualified Data.Bits
import qualified Data.Bool
import qualified Data.ByteString
import qualified Data.ByteString.Char8
import qualified Data.List
import qualified Data.Maybe
import qualified Data.Text
import qualified Data.Vector
import qualified Numeric

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

-- | Encode a 'BS.ByteString' in Nix's base32 encoding
encode :: ByteString -> Text
encode :: ByteString -> Text
encode ByteString
c = String -> Text
Data.Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> Char
takeCharPosFromDict (Integer -> Char) -> [Integer] -> String
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
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  = HasCallStack => ByteString -> Int -> Word8
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 a. Num a => [a] -> a
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] ]

  takeCharPosFromDict :: Integer -> Char
  takeCharPosFromDict :: Integer -> Char
takeCharPosFromDict 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 String ByteString
decode Text
what =
  Either String ByteString
-> Either String ByteString -> Bool -> Either String ByteString
forall a. a -> a -> Bool -> a
Data.Bool.bool
    (String -> Either String ByteString
forall a b. a -> Either a b
Left String
"Invalid NixBase32 string")
    (Text -> Either String ByteString
unsafeDecode Text
what)
    ((Char -> Bool) -> Text -> Bool
Data.Text.all (Char -> Vector Char -> Bool
forall a. Eq a => a -> Vector a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t 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 String ByteString
unsafeDecode Text
what =
  case
      Integer -> (Char -> Bool) -> (Char -> Int) -> ReadS Integer
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
Numeric.readInt
        Integer
32
        (Char -> Vector Char -> Bool
forall a. Eq a => a -> Vector a -> 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 (String -> Int
forall a. HasCallStack => String -> a
error String
"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 -> String
Data.Text.unpack Text
what)
    of
      [(Integer
i, String
_)] -> ByteString -> Either String ByteString
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Either String ByteString)
-> ByteString -> Either String 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, String)]
x        -> String -> Either String ByteString
forall a b. a -> Either a b
Left (String -> Either String ByteString)
-> String -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ String
"Can't decode: readInt returned " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [(Integer, String)] -> String
forall a. Show a => a -> String
show [(Integer, String)]
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 = String -> ByteString
Data.ByteString.Char8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
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) (String -> String
forall a. HasCallStack => [a] -> [a]
cycle String
"\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]
Data.List.unfoldr Integer -> Maybe (Word8, Integer)
f Integer
i
    | Bool
otherwise = String -> ByteString
forall a. HasCallStack => String -> a
error String
"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
`Data.Bits.shiftR` Int
8)