2020-03-19 00:39:58 +01:00
|
|
|
{-# LANGUAGE DataKinds #-}
|
|
|
|
module Foo where
|
|
|
|
|
|
|
|
import Crypto.Hash
|
2020-03-20 00:37:08 +01:00
|
|
|
import Data.Word
|
|
|
|
import Network.Socket (HostAddress6)
|
2020-03-19 00:39:58 +01:00
|
|
|
import qualified Data.ByteString as BS
|
|
|
|
import qualified Data.ByteString.Builder as BB
|
|
|
|
import qualified Data.ByteString.Lazy as BL
|
|
|
|
import qualified Data.ByteString.UTF8 as BSU
|
2020-03-20 00:37:08 +01:00
|
|
|
import qualified Data.Binary.Strict.Get as BinGet
|
2020-03-19 00:39:58 +01:00
|
|
|
import qualified Data.ByteArray as BA
|
|
|
|
|
|
|
|
-- important: only works with strict ByteStrings
|
|
|
|
hashToShake128 string = hash bstr :: Digest (SHAKE128 128)
|
|
|
|
where
|
|
|
|
bstr = BSU.fromString string
|
|
|
|
|
|
|
|
-- TODO: type signature
|
|
|
|
-- TODO: convert byte string to Integer (as separate function, useful for parsing later on)
|
2020-03-20 00:37:08 +01:00
|
|
|
hashNodeIDBS :: HostAddress6 -> String -> Word8 -> BS.ByteString
|
|
|
|
hashNodeIDBS ipaddr@(a, b, _, _) domain vserver =
|
2020-03-19 00:39:58 +01:00
|
|
|
hashIpaddrUpper `BS.append` hashID domain' `BS.append` hashIpaddLower
|
|
|
|
where
|
|
|
|
vsBS = BS.pack [vserver] -- attention: only works for vserver IDs up to 255
|
|
|
|
-- TODO: this is inefficient and possibly better done with binary-strict
|
|
|
|
ipaddrNet = (BL.toStrict . BB.toLazyByteString . mconcat $ map BB.word32BE [a, b]) `BS.append` vsBS
|
|
|
|
domain' = BSU.fromString domain `BS.append` vsBS
|
|
|
|
hashID bstr = BS.pack . BA.unpack $ (hash bstr :: Digest (SHAKE128 128))
|
|
|
|
(hashIpaddrUpper, hashIpaddLower) = BS.splitAt 64 $ hashID ipaddrNet
|
|
|
|
|
2020-03-20 00:37:08 +01:00
|
|
|
|
2020-03-20 19:00:00 +01:00
|
|
|
hashNodeID :: HostAddress6 -> String -> Word8 -> Integer
|
|
|
|
hashNodeID ip domain vs = byteStringToUInteger $ hashNodeIDBS ip domain vs
|
2020-03-20 00:37:08 +01:00
|
|
|
|
|
|
|
|
|
|
|
-- | parses the bit pattern of a ByteString as an unsigned Integer in Big Endian order
|
|
|
|
-- by iterating it byte-wise from the back and shifting the byte values according to their offset
|
|
|
|
byteStringToUInteger :: BS.ByteString -> Integer
|
|
|
|
byteStringToUInteger bs = sum $ parsedBytes 0 bs
|
|
|
|
where
|
|
|
|
parsedBytes :: Integer -> BS.ByteString -> [ Integer ]
|
|
|
|
parsedBytes offset bs = case BS.unsnoc bs of
|
|
|
|
Nothing -> []
|
|
|
|
Just (bs, w) -> parseWithOffset offset w : parsedBytes (offset+1) bs
|
|
|
|
|
|
|
|
parseWithOffset :: Integer -> Word8 -> Integer
|
|
|
|
parseWithOffset 0 word = toInteger word -- a shift of 0 is always 0
|
2020-03-20 01:21:00 +01:00
|
|
|
parseWithOffset offset word = toInteger word * 2^(8 * offset)
|
2020-03-20 00:37:08 +01:00
|
|
|
|
|
|
|
-- |Utility function creating a strict ByteString from [Word32],
|
|
|
|
-- needed for encoding @HostAddress6@ as a ByteString
|
|
|
|
--packW32 :: [ Word32 ] -> BS.ByteString
|
|
|
|
--packW32 [] = BS.empty
|
|
|
|
--packW32 xs = map BinGet.
|
|
|
|
--
|
|
|
|
--w32ToBSParser :: BinGet.Get [Word8]
|
|
|
|
--w32ToBSParser = do
|
|
|
|
-- a <- getWord8
|
|
|
|
-- b <- getWord8
|
|
|
|
-- c <- getWord8
|
|
|
|
-- d <- getWord8
|
|
|
|
-- return [a, b, c, d]
|
|
|
|
|
|
|
|
|
|
|
|
--- test data ---
|
|
|
|
|
|
|
|
testIDHash = hashNodeIDBS (0x2001 + 0x16b8, 0x755a + 0xb1100, 0x7d6a + 0x12ab, 0xf0c5 + 0x386e) "example.com" 0
|
|
|
|
zweiHoch248 = BS.pack $ 1:replicate 31 0
|