diff --git a/Graphics/Captcha.hs b/Graphics/Captcha.hs new file mode 100644 --- /dev/null +++ b/Graphics/Captcha.hs @@ -0,0 +1,149 @@ +module Graphics.Captcha (makeCaptcha) where + +import Data.ByteString +import Data.Char +import Graphics.GD +import System.Random + + +main :: IO () +main = do + string <- makeRandomString + image <- createInitialImage string + chirpDoubleRandom image + chirpDoubleRandom image + image <- cropToFinalSize image + Prelude.putStrLn string + savePngFile "captcha.png" image + + +makeCaptcha :: IO (String, ByteString) +makeCaptcha = do + string <- makeRandomString + image <- createInitialImage string + chirpDoubleRandom image + chirpDoubleRandom image + image <- cropToFinalSize image + byteString <- savePngByteString image + return (string, byteString) + + +makeRandomString :: IO String +makeRandomString = do + let makeRandomLetter = do + n <- randomRIO (0, 25) + return $ chr (ord 'A' + n) + mapM (\_ -> makeRandomLetter) [0..5] + + +chirpDoubleRandom :: Image -> IO () +chirpDoubleRandom image = do + depth1 <- randomRIO (2.0, 5.0) + period1 <- randomRIO (1, 6) + period2 <- randomRIO (1, 6) + depth2 <- randomRIO (2.0, 5.0) + period3 <- randomRIO (1, 6) + period4 <- randomRIO (1, 6) + chirpVertically (makeChirpFunction depth1 + (fromIntegral captchaSize / period1) + (fromIntegral captchaSize / period2)) + image + chirpHorizontally (makeChirpFunction depth2 + (fromIntegral captchaSize / period3) + (fromIntegral captchaSize / period4)) + image + + +chirpHorizontally :: (Int -> Int) -> Image -> IO () +chirpHorizontally chirpFunction image = do + withImage (newImage (captchaSize, captchaSize)) + (\temporaryImage -> do + copyRegion (0, 0) (captchaSize, captchaSize) image + (0, 0) temporaryImage + let shiftRow row amount + = copyRegion (0, row) (captchaSize, 1) image + (amount, row) temporaryImage + shiftRows function + = shiftRows' 0 function + shiftRows' i function + = if i == captchaSize + then return () + else do + shiftRow i (function i) + shiftRows' (i+1) function + shiftRows chirpFunction + copyRegion (0, 0) (captchaSize, captchaSize) temporaryImage + (0, 0) image) + + +chirpVertically :: (Int -> Int) -> Image -> IO () +chirpVertically chirpFunction image = do + withImage (newImage (captchaSize, captchaSize)) + (\temporaryImage -> do + copyRegion (0, 0) (captchaSize, captchaSize) image + (0, 0) temporaryImage + let shiftColumn column amount + = copyRegion (column, 0) (1, captchaSize) image + (column, amount) temporaryImage + shiftColumns function + = shiftColumns' 0 function + shiftColumns' i function + = if i == captchaSize + then return () + else do + shiftColumn i (function i) + shiftColumns' (i+1) function + shiftColumns chirpFunction + copyRegion (0, 0) (captchaSize, captchaSize) temporaryImage + (0, 0) image) + + +makeChirpFunction :: Float -> Float -> Float -> Int -> Int +makeChirpFunction depth startingWaveLength endingWaveLength row + = let waveLength = ((startingWaveLength * fromIntegral row) + + (endingWaveLength * fromIntegral (captchaSize - row))) + / fromIntegral captchaSize + in floor $ depth * (sin $ (fromIntegral row) * ((2*pi) / waveLength)) + + +createInitialImage :: String -> IO Image +createInitialImage string = do + image <- newImage (captchaSize, captchaSize) + useFontConfig True + drawFilledRectangle (0, 0) (captchaSize, captchaSize) 0xFFFFFF image + ((left, top), _, (right, bottom), _) + <- measureString fontName fontSize 0.0 (0, 0) string 0x000000 + width <- return $ right - left + height <- return $ top - bottom + originX <- return $ (captchaSize - width) `div` 2 + originY <- return $ (captchaSize + height) `div` 2 + drawString fontName fontSize 0.0 (originX, originY) string 0x000000 image + return image + + +cropToFinalSize :: Image -> IO Image +cropToFinalSize image = do + result <- newImage finalSize + copyRegion ((captchaSize - fst finalSize) `div` 2, + (captchaSize - snd finalSize) `div` 2) + finalSize + image + (0, 0) + result + return result + + +fontName :: String +fontName = "Courier New" + + +fontSize :: Double +fontSize = 22.0 + + +captchaSize :: Int +captchaSize = 192 + + +finalSize :: (Int, Int) +finalSize = (128, 64) diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,22 @@ +Copyright (c) 2009 Dan Knapp + +Permission is hereby granted, free of charge, to any person +obtaining a copy of this software and associated documentation +files (the "Software"), to deal in the Software without +restriction, including without limitation the rights to use, +copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the +Software is furnished to do so, subject to the following +conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +OTHER DEALINGS IN THE SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,5 @@ +#!/usr/bin/env runhaskell + +import Distribution.Simple + +main = defaultMain diff --git a/hs-captcha.cabal b/hs-captcha.cabal new file mode 100644 --- /dev/null +++ b/hs-captcha.cabal @@ -0,0 +1,23 @@ +name: hs-captcha +version: 1.0 +cabal-version: >= 1.2 +build-type: Simple +license: BSD3 +license-file: LICENSE +copyright: Copyright (c) 2009 Dan Knapp +author: Dan Knapp +maintainer: dankna@gmail.com +homepage: http://www.dankna.com/software/ +bug-reports: http://www.dankna.com/issues/create/ +category: Graphics +synopsis: Generate images suitable for use as CAPTCHAs in online web-form security. +description: + Generates images suitable for use as CAPTCHAs in online web-form security. Does not + integrate with any web framework; simply exports a function that creates the image + itself as a ByteString (containing a PNG), and the correct answer to the challenge as a + String. HS-Captcha is designed to be as simple as possible to integrate in other + frameworks. + +Library + exposed-modules: Graphics.Captcha + build-depends: gd, bytestring, random, base >= 4.1 && < 5