Haskell to generate bitsquat domains.

BitSquat.hs

{-# LANGUAGE TemplateHaskell #-}
module BitSquat where

import Data.Char
import Data.Bits
import Test.QuickCheck

flipBit :: Char -> Int -> Char
flipBit c n = chr $ xor (ord c) (2 ^ n)

flipCharBit :: Int -> Int -> String -> String
flipCharBit c b s = before ++ [middle] ++ after
    where before = take c s
          middle = flipBit (s !! c) b
          after = drop (c+1) s

validDomain :: String -> Bool
validDomain = all isAsciiLower
    where isAsciiLower c = isAscii c && (isLower c || c `elem` ".-")

allOneCharFlips :: String -> [String]
allOneCharFlips s = filter validDomain [flipCharBit c b s | c <- [0..(length s - 1)], b <- [0..7]]


prop_preservesLength input = all sameLength $ allOneCharFlips input
    where sameLength s = length s == length input

prop_onlyOneBitChanged input = (all checkSumMatches $ allOneCharFlips input)
    where checkSumMatches s = abs ((checksum s) - (checksum input)) == 1
          checksum s = sum $ map (popCount . ord) s


return []
main = $quickCheckAll