1
0
mirror of https://github.com/redelmann/scat synced 2025-01-10 06:34:20 +01:00
This commit is contained in:
Romain Edelmann 2014-04-25 23:25:46 +02:00
parent a2eb523d5a
commit b94c4fc159
3 changed files with 11 additions and 9 deletions

View File

@ -1,4 +1,4 @@
{-# LANGUAGE OverloadedStrings, PatternGuards #-} {-# LANGUAGE OverloadedStrings #-}
-- | Password scatterer. -- | Password scatterer.
module Main (main) where module Main (main) where
@ -148,7 +148,7 @@ getCode = do
else return "" else return ""
-- | Lists all the available schemas. -- | Lists all the available schemas.
schemas :: [(String, Scat Schema)] schemas :: [(String, Scat Schema)]
schemas = schemas =
[ ("safe", return safe) [ ("safe", return safe)

View File

@ -63,7 +63,7 @@ instance Applicative Builder where
pure x = Builder (\ n -> (n, x)) pure x = Builder (\ n -> (n, x))
f <*> x = Builder $ \ n -> f <*> x = Builder $ \ n ->
let (n', g) = runBuilder f n let (n', g) = runBuilder f n
in fmap g $ runBuilder x n' in g <$> runBuilder x n'
instance Monad Builder where instance Monad Builder where
return = pure return = pure
@ -85,19 +85,19 @@ inRange (a, b) = fmap (+ a) $ lessThan $ b + 1 - a
-- | Returns a lower case letter. -- | Returns a lower case letter.
lower :: Builder Char lower :: Builder Char
lower = fmap (chr . (+ ord 'a')) $ lessThan 26 lower = (chr . (+ ord 'a')) <$> lessThan 26
-- | Returns an upper case letter. -- | Returns an upper case letter.
upper :: Builder Char upper :: Builder Char
upper = fmap (chr . (+ ord 'A')) $ lessThan 26 upper = (chr . (+ ord 'A')) <$> lessThan 26
-- | Returns an printable ascii char. -- | Returns an printable ascii char.
ascii :: Builder Char ascii :: Builder Char
ascii = fmap chr $ inRange (32, 126) ascii = chr <$> inRange (32, 126)
-- | Returns a digit. -- | Returns a digit.
digit :: Builder Char digit :: Builder Char
digit = fmap chr $ inRange (48, 57) digit = chr <$> inRange (48, 57)
-- | Returns a letter. -- | Returns a letter.
letter :: Builder Char letter :: Builder Char

View File

@ -15,6 +15,7 @@ module Scat.Schemas
, getBuilder , getBuilder
-- * Built-in schemas -- * Built-in schemas
-- ** Passwords -- ** Passwords
, safe , safe
, alphanumeric , alphanumeric
@ -36,6 +37,7 @@ import Data.List (intercalate, (\\))
import Data.Vector (Vector) import Data.Vector (Vector)
import qualified Data.Vector as V import qualified Data.Vector as V
import Data.Monoid import Data.Monoid
import Control.Applicative
import Control.Monad (replicateM) import Control.Monad (replicateM)
import System.IO import System.IO
@ -165,7 +167,7 @@ androidPatternLock = withDefaultSize 9 $ \ s -> do
{- | Generates a password with `s` of the original Pokemons and their level. {- | Generates a password with `s` of the original Pokemons and their level.
Entropy of about 55.5 bits for 4 pokemons. -} Entropy of about 55.5 bits for 4 pokemons. -}
pokemons :: IO Schema pokemons :: IO Schema
pokemons = fromFile "pokemons.txt" $ \ vect -> pokemons = fromFile "pokemons.txt" $ \ vect ->
withDefaultSize 4 $ \ s -> do withDefaultSize 4 $ \ s -> do
ps <- replicateM s $ oneOfV vect ps <- replicateM s $ oneOfV vect
ls <- replicateM s $ inRange (1, 100 :: Int) ls <- replicateM s $ inRange (1, 100 :: Int)
@ -186,5 +188,5 @@ fromFile :: FilePath -> (Vector String -> a) -> IO a
fromFile fp bs = do fromFile fp bs = do
fp' <- getDataFileName fp fp' <- getDataFileName fp
withFile fp' ReadMode $ \ h -> do withFile fp' ReadMode $ \ h -> do
!vect <- fmap (V.fromList . lines) $ hGetContents h !vect <- (V.fromList . lines) <$> hGetContents h
return $ bs vect return $ bs vect