1 files changed, 49 insertions, 0 deletions
diff --git a/lambda/Crackme.hs b/lambda/Crackme.hs
new file mode 100644
index 0000000..8c48306
--- /dev/null
+++ b/lambda/Crackme.hs
@@ -0,0 +1,49 @@
+-- UMASS{functi0n4lsh17}
+
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module Crackme where
+
+import Data.Char
+import Foreign.C.Types
+import Foreign.C.String
+
+rotate :: Int -> [a] -> [a]
+rotate _ [] = []
+rotate n xs = zipWith const (drop n (cycle xs)) xs
+
+checkPairs :: Int -> [(Int, Int)] -> Bool
+checkPairs _ [] = True
+checkPairs 0 ((a, b):[]) = ((a, b) == (208,42))
+checkPairs 1 ((a, b):cdr) = ((a, b) == (120,-10)) && checkPairs 0 cdr
+checkPairs 2 ((a, b):cdr) = ((a, b) == (126,-28)) && checkPairs 1 cdr
+checkPairs 3 ((a, b):cdr) = ((a, b) == (189,19)) && checkPairs 2 cdr
+checkPairs 4 ((a, b):cdr) = ((a, b) == (240,-10)) && checkPairs 3 cdr
+checkPairs 5 ((a, b):cdr) = ((a, b) == (163,53)) && checkPairs 4 cdr
+checkPairs 6 ((a, b):cdr) = ((a, b) == (101,3)) && checkPairs 5 cdr
+checkPairs 7 ((a, b):cdr) = ((a, b) == (214,6)) && checkPairs 6 cdr
+checkPairs 8 ((a, b):cdr) = ((a, b) == (163,-67)) && checkPairs 7 cdr
+checkPairs 9 ((a, b):cdr) = ((a, b) == (213,-3)) && checkPairs 8 cdr
+checkPairs 10 ((a, b):cdr) = ((a, b) == (168,64)) && checkPairs 9 cdr
+checkPairs 11 ((a, b):cdr) = ((a, b) == (209,-11)) && checkPairs 10 cdr
+checkPairs 12 ((a, b):cdr) = ((a, b) == (158,62)) && checkPairs 11 cdr
+checkPairs 13 ((a, b):cdr) = ((a, b) == (222,12)) && checkPairs 12 cdr
+checkPairs 14 ((a, b):cdr) = ((a, b) == (218,-14)) && checkPairs 13 cdr
+checkPairs 15 ((a, b):cdr) = ((a, b) == (222,24)) && checkPairs 14 cdr
+checkPairs 16 ((a, b):cdr) = ((a, b) == (193,-27)) && checkPairs 15 cdr
+checkPairs 17 ((a, b):cdr) = ((a, b) == (200,-34)) && checkPairs 16 cdr
+checkPairs 18 ((a, b):cdr) = ((a, b) == (167,-37)) && checkPairs 17 cdr
+checkPairs 19 ((a, b):cdr) = ((a, b) == (200,-46)) && checkPairs 18 cdr
+checkPairs 20 ((a, b):cdr) = ((a, b) == (168,2)) && checkPairs 19 cdr
+checkPairs i pairs = False
+
+keyCheck :: String -> Bool
+keyCheck key = checkPairs 20 pairs
+  where pairs = map (\(x, y) -> (ord x + ord y, ord x - ord y)) $ zip key $ rotate 4 key
+
+keycheck_hs :: CString -> IO CInt
+keycheck_hs encoded =
+  do key <- peekCString encoded
+     return $ if (keyCheck key) then 1 else 0
+
+foreign export ccall keycheck_hs :: CString -> IO CInt