-- | Render SHA message digests in the peculiar base32'ish format used by Nix.

module Distribution.Nixpkgs.Hashes ( printSHA256, packHex ) where

import Control.Exception ( assert )
import Data.Bits
import Data.ByteString ( ByteString )
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import Data.Char
import Data.Word

base32chars :: ByteString   -- omitted: E O U T
base32chars :: ByteString
base32chars = String -> ByteString
BSC.pack String
"0123456789abcdfghijklmnpqrsvwxyz";

-- | Render a SHA265 message digest into the somewhat unusual base32 scheme
-- used by Nix. That algorithm is remarkable, because it twists the bits of the
-- input buffer around quite a bit before grouping them into quintets that are
-- then translated into the target alphabet @0123456789abcdfghijklmnpqrsvwxyz@.
--
-- Basically, the sequence of bits
--
-- >  255 254 253 252 251 250 249 248   ...   7  6  5  4  3  2  1  0
-- > |_______________________________|       |______________________|
-- >             byte 0                              byte 31
--
-- is split into quintets as follows:
--
-- >               7   6  5  4  3  2   1 0 14 13 12  ...  251 252 253 254 255
-- > |______________| |_____________| |____________|     |___________________|
-- >    quintet 0        quintet 1      quintet 2             quintet 51
--
-- before the encoding takes place. This leads to somewhat surprising results:
--
-- >>> printSHA256 (packHex "0000000000000000000000000000000000000000000000000000000000000080")
-- "1000000000000000000000000000000000000000000000000000"
-- >>> printSHA256 (packHex "0000000000000000000000000000000000000000000000000000000000000001")
-- "0080000000000000000000000000000000000000000000000000"
-- >>> printSHA256 (packHex "7459ca5c6e117538122f04caf3dbfc58303028c26c58943430c16ff28a3b1d49")
-- "0j8x7f5g4vy160s98n3cq8l30c2qzkdz7jh45w93hx8idrfclnbl"

printSHA256 :: ByteString -> String
printSHA256 :: ByteString -> String
printSHA256 ByteString
buf = Bool -> String -> String
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (ByteString -> Int
BS.length ByteString
buf Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
  (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Int -> Char
BSC.index ByteString
base32chars (Int -> Char) -> (Int -> Int) -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> (Int -> Word8) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int -> Word8
getQuintet ByteString
buf) [Int
51,Int
50..Int
0]

getQuintet :: ByteString -> Int -> Word8
getQuintet :: ByteString -> Int -> Word8
getQuintet ByteString
buf Int
n = (Word8
c1 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
c2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x1f
  where
    b :: Int
b     = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5
    (Int
i,Int
j) = Int
b Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
8
    c1 :: Word8
c1    = ByteString -> Int -> Word8
BS.index ByteString
buf Int
i Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
j
    c2 :: Word8
c2    = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
31 then Word8
0 else ByteString -> Int -> Word8
BS.index ByteString
buf (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` (Int
8Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
j)

-- | Parse a hexadecimal hash representation into its binary form suitable for
-- encoding with 'printSHA256'.
--
-- >>> packHex "48656c6c6f2c20776f726c642e"
-- "Hello, world."
--
-- Leading zeros can be omitted, i.e. it's unnecessary to pad the input to an
-- even number of bytes:
--
-- >>> packHex "0"
-- "\NUL"

packHex :: String -> ByteString
packHex :: String -> ByteString
packHex = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> (String -> [Word8]) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Word8]
hex2bin

hex2bin :: String -> [Word8]
hex2bin :: String -> [Word8]
hex2bin String
input = String -> [Word8]
f (String -> [Word8]) -> String -> [Word8]
forall a b. (a -> b) -> a -> b
$ (if Int -> Bool
forall a. Integral a => a -> Bool
even (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
input) then String -> String
forall a. a -> a
id else (Char
'0'Char -> String -> String
forall a. a -> [a] -> [a]
:)) String
input
  where
    f :: String -> [Word8]
    f :: String -> [Word8]
f []         = []
    f [Char
x]        = [Char -> Word8
digit Char
x]
    f (Char
x1:Char
x2:String
xs) = ((Char -> Word8
digit Char
x1 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Char -> Word8
digit Char
x2) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: String -> [Word8]
f String
xs

    digit :: Char -> Word8
    digit :: Char -> Word8
digit = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitToInt