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 = 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 = forall a. ToText a => a -> Text
toText forall a b. (a -> b) -> a -> b
$ Integer -> Char
takeCharPosFromDict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Integer
nChar forall a. Num a => a -> a -> a
- Integer
1, Integer
nChar 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ((ByteString -> Int
Bytes.length ByteString
c forall a. Num a => a -> a -> a
* Int
8 forall a. Num a => a -> a -> a
- Int
1) forall a. Integral a => a -> a -> a
`div` Int
5) forall a. Num a => a -> a -> a
+ Int
1

  byte :: Int -> Word8
byte  = HasCallStack => ByteString -> Int -> Word8
Bytes.index ByteString
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
    forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum
      [ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8
byte Int
j) forall a. Num a => a -> a -> a
* (Integer
256 forall a b. (Num a, Integral b) => a -> b -> a
^ Int
j)
        | Int
j <- [Int
0 .. ByteString -> Int
Bytes.length ByteString
c forall a. Num a => a -> a -> a
- Int
1] ]

  takeCharPosFromDict :: Integer -> Char
  takeCharPosFromDict :: Integer -> Char
takeCharPosFromDict Integer
i = Vector Char
digits32 forall a. Vector a -> Int -> a
Vector.! Int
digitInd
   where
    digitInd :: Int
digitInd =
      forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$
        Integer
bAsInteger forall a. Integral a => a -> a -> a
`div` (Integer
32forall a b. (Num a, Integral b) => a -> b -> a
^Integer
i) 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 =
  forall a. a -> a -> Bool -> a
bool
    (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 (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
      forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
readInt
        Integer
32
        (forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` Vector Char
digits32)
        (\Char
c -> forall a. a -> Maybe a -> a
fromMaybe (forall a t. (HasCallStack, IsText t) => t -> a
error Text
"character not in digits32")
          forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Vector a -> Maybe Int
Vector.findIndex (forall a. Eq a => a -> a -> Bool
== Char
c) Vector Char
digits32
        )
        (forall a. ToString a => a -> [Char]
toString Text
what)
    of
      [(Integer
i, [Char]
_)] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
padded forall a b. (a -> b) -> a -> b
$ Integer -> ByteString
integerToBS Integer
i
      [(Integer, [Char])]
x        -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"Can't decode: readInt returned " forall a. Semigroup a => a -> a -> a
<> 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 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 forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take (Int
decLen forall a. Num a => a -> a -> a
- ByteString -> Int
Bytes.length ByteString
x) (forall a. [a] -> [a]
cycle [Char]
"\NUL")

  decLen :: Int
decLen = Text -> Int
Data.Text.length Text
what forall a. Num a => a -> a -> a
* Int
5 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 forall a. Ord a => a -> a -> Bool
> Integer
0     = [Word8] -> ByteString
Bytes.pack forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Integer -> Maybe (Word8, Integer)
f Integer
i
    | Bool
otherwise = 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 = forall a. Maybe a
Nothing
    f Integer
x = forall a. a -> Maybe a
Just (forall a. Num a => Integer -> a
fromInteger Integer
x :: Word8, Integer
x forall a. Bits a => a -> Int -> a
`shiftR` Int
8)