advent14c.hs

   1 import Data.List (nub, tails)
   2 import Data.ByteString.Char8 (pack)
   3 import Crypto.Hash (hash, Digest, MD5)
   4
   5 salt = "yjdafjpo"
   6 -- salt = "abc"
   7
   8 main :: IO ()
   9 main = do
  10         part1
  11         part2
  12
  13 part1 :: IO ()
  14 part1 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..]
  15     where sq = md5sequence
  16
  17 part2 :: IO ()
  18 part2 = print $ head $ drop 63 $ filter (\i -> possibleKey sq i && confirmKey sq i) [0..]
  19     where sq = md5sequenceS
  20
  21 getHash :: String -> String
  22 getHash bs = show (hash $ pack bs :: Digest MD5)
  23
  24 md5sequence :: [String]
  25 md5sequence = [makeMd5 i | i <- [0..]]
  26     where makeMd5 i = getHash (salt ++ show i)
  27
  28 md5sequenceS :: [String]
  29 md5sequenceS = [makeMd5 i | i <- [0..]]
  30     where makeMd5 i = stretch $ getHash (salt ++ show i)
  31           stretch h0 = foldr (\_ h -> getHash h) h0 [1..2016]
  32
  33 possibleKey :: [String] -> Int-> Bool
  34 possibleKey s = not . null . repeats 3 . ((!!) s)
  35
  36 confirmKey :: [String] -> Int -> Bool
  37 confirmKey s i = any (confirmation) $ take 1000 $ drop (i+1) s
  38     where c = head $ repeats 3 $ s!!i
  39           confirmation m = c `elem` (repeats 5 m)
  40
  41 repeats :: Int -> String -> [String]
  42 repeats n = filter (null . tail) . map (nub) . substrings n
  43
  44 substrings :: Int -> [a] -> [[a]]
  45 substrings l = filter (\s -> (length s) == l) . map (take l) . tails