{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module Password (
PWDatabase, PWData(..), PWPolicy (..), PWSalt (..),
pwPolicy, pwSalt,
pwLength, pwUpper, pwLower, pwDigits, pwSpecial,
newPWDatabase, newPWData, newPWPolicy, newPWSalt,
validatePWDatabase, validatePWData, validatePWPolicy,
pwGenerate,
pwCountUpper, pwCountLower, pwCountDigits, pwCountSpecial, pwCount,
pwHasService, pwSetService, pwGetService, pwRemoveService, pwSearch
) where
import Data.Aeson
( FromJSON (parseJSON)
, ToJSON (toJSON)
, object
, withObject
, withText
, (.:)
, (.=)
)
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy.Char8 as B8
import Data.ByteString.Builder (toLazyByteString, stringUtf8)
import qualified Data.ByteString.Base16.Lazy as B16
import qualified Data.ByteString.Base64.Lazy as B64
import Data.Char (isUpper, isLower, isDigit, isAlphaNum, toLower)
import Data.Digest.Pure.SHA
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Lens.Micro (over, set, to, (^.))
import Lens.Micro.TH (makeLenses)
import System.Random (RandomGen, randoms, split)
type PWDatabase = M.Map String PWData
data PWData = PWData
{ PWData -> PWPolicy
_pwPolicy :: PWPolicy
, PWData -> PWSalt
_pwSalt :: PWSalt
} deriving (PWData -> PWData -> Bool
(PWData -> PWData -> Bool)
-> (PWData -> PWData -> Bool) -> Eq PWData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PWData -> PWData -> Bool
$c/= :: PWData -> PWData -> Bool
== :: PWData -> PWData -> Bool
$c== :: PWData -> PWData -> Bool
Eq, Int -> PWData -> ShowS
[PWData] -> ShowS
PWData -> String
(Int -> PWData -> ShowS)
-> (PWData -> String) -> ([PWData] -> ShowS) -> Show PWData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PWData] -> ShowS
$cshowList :: [PWData] -> ShowS
show :: PWData -> String
$cshow :: PWData -> String
showsPrec :: Int -> PWData -> ShowS
$cshowsPrec :: Int -> PWData -> ShowS
Show)
data PWPolicy = PWPolicy
{ PWPolicy -> Int
_pwLength :: Int
, PWPolicy -> Int
_pwUpper :: Int
, PWPolicy -> Int
_pwLower :: Int
, PWPolicy -> Int
_pwDigits :: Int
, PWPolicy -> Maybe Int
_pwSpecial :: Maybe Int
} deriving (PWPolicy -> PWPolicy -> Bool
(PWPolicy -> PWPolicy -> Bool)
-> (PWPolicy -> PWPolicy -> Bool) -> Eq PWPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PWPolicy -> PWPolicy -> Bool
$c/= :: PWPolicy -> PWPolicy -> Bool
== :: PWPolicy -> PWPolicy -> Bool
$c== :: PWPolicy -> PWPolicy -> Bool
Eq, Int -> PWPolicy -> ShowS
[PWPolicy] -> ShowS
PWPolicy -> String
(Int -> PWPolicy -> ShowS)
-> (PWPolicy -> String) -> ([PWPolicy] -> ShowS) -> Show PWPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PWPolicy] -> ShowS
$cshowList :: [PWPolicy] -> ShowS
show :: PWPolicy -> String
$cshow :: PWPolicy -> String
showsPrec :: Int -> PWPolicy -> ShowS
$cshowsPrec :: Int -> PWPolicy -> ShowS
Show)
newtype PWSalt = PWSalt { PWSalt -> ByteString
runPWSalt :: B.ByteString }
deriving (PWSalt -> PWSalt -> Bool
(PWSalt -> PWSalt -> Bool)
-> (PWSalt -> PWSalt -> Bool) -> Eq PWSalt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PWSalt -> PWSalt -> Bool
$c/= :: PWSalt -> PWSalt -> Bool
== :: PWSalt -> PWSalt -> Bool
$c== :: PWSalt -> PWSalt -> Bool
Eq, Int -> PWSalt -> ShowS
[PWSalt] -> ShowS
PWSalt -> String
(Int -> PWSalt -> ShowS)
-> (PWSalt -> String) -> ([PWSalt] -> ShowS) -> Show PWSalt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PWSalt] -> ShowS
$cshowList :: [PWSalt] -> ShowS
show :: PWSalt -> String
$cshow :: PWSalt -> String
showsPrec :: Int -> PWSalt -> ShowS
$cshowsPrec :: Int -> PWSalt -> ShowS
Show)
makeLenses ''PWPolicy
makeLenses ''PWData
instance FromJSON PWData where
parseJSON :: Value -> Parser PWData
parseJSON = String -> (Object -> Parser PWData) -> Value -> Parser PWData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PWData" ((Object -> Parser PWData) -> Value -> Parser PWData)
-> (Object -> Parser PWData) -> Value -> Parser PWData
forall a b. (a -> b) -> a -> b
$ \Object
v -> PWPolicy -> PWSalt -> PWData
PWData
(PWPolicy -> PWSalt -> PWData)
-> Parser PWPolicy -> Parser (PWSalt -> PWData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser PWPolicy
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"policy"
Parser (PWSalt -> PWData) -> Parser PWSalt -> Parser PWData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser PWSalt
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"salt"
instance FromJSON PWPolicy where
parseJSON :: Value -> Parser PWPolicy
parseJSON = String -> (Object -> Parser PWPolicy) -> Value -> Parser PWPolicy
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PWPolicy" ((Object -> Parser PWPolicy) -> Value -> Parser PWPolicy)
-> (Object -> Parser PWPolicy) -> Value -> Parser PWPolicy
forall a b. (a -> b) -> a -> b
$ \Object
v -> Int -> Int -> Int -> Int -> Maybe Int -> PWPolicy
PWPolicy
(Int -> Int -> Int -> Int -> Maybe Int -> PWPolicy)
-> Parser Int
-> Parser (Int -> Int -> Int -> Maybe Int -> PWPolicy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"length"
Parser (Int -> Int -> Int -> Maybe Int -> PWPolicy)
-> Parser Int -> Parser (Int -> Int -> Maybe Int -> PWPolicy)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"min_upper"
Parser (Int -> Int -> Maybe Int -> PWPolicy)
-> Parser Int -> Parser (Int -> Maybe Int -> PWPolicy)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"min_lower"
Parser (Int -> Maybe Int -> PWPolicy)
-> Parser Int -> Parser (Maybe Int -> PWPolicy)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"min_digits"
Parser (Maybe Int -> PWPolicy)
-> Parser (Maybe Int) -> Parser PWPolicy
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"min_special"
instance FromJSON PWSalt where
parseJSON :: Value -> Parser PWSalt
parseJSON = String -> (Text -> Parser PWSalt) -> Value -> Parser PWSalt
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"PWSalt" ((Text -> Parser PWSalt) -> Value -> Parser PWSalt)
-> (Text -> Parser PWSalt) -> Value -> Parser PWSalt
forall a b. (a -> b) -> a -> b
$ \Text
v ->
case ByteString -> Either String ByteString
B64.decode (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
toUTF8 (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
v of
Left String
x -> String -> Parser PWSalt
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
x
Right ByteString
x -> PWSalt -> Parser PWSalt
forall (m :: * -> *) a. Monad m => a -> m a
return (PWSalt -> Parser PWSalt) -> PWSalt -> Parser PWSalt
forall a b. (a -> b) -> a -> b
$ ByteString -> PWSalt
PWSalt ByteString
x
instance ToJSON PWData where
toJSON :: PWData -> Value
toJSON PWData
d = [Pair] -> Value
object
[ Text
"policy" Text -> PWPolicy -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (PWData
dPWData -> Getting PWPolicy PWData PWPolicy -> PWPolicy
forall s a. s -> Getting a s a -> a
^.Getting PWPolicy PWData PWPolicy
Lens' PWData PWPolicy
pwPolicy)
, Text
"salt" Text -> PWSalt -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (PWData
dPWData -> Getting PWSalt PWData PWSalt -> PWSalt
forall s a. s -> Getting a s a -> a
^.Getting PWSalt PWData PWSalt
Lens' PWData PWSalt
pwSalt)
]
instance ToJSON PWPolicy where
toJSON :: PWPolicy -> Value
toJSON PWPolicy
p = [Pair] -> Value
object
[ Text
"length" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (PWPolicy
pPWPolicy -> Getting Int PWPolicy Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int PWPolicy Int
Lens' PWPolicy Int
pwLength)
, Text
"min_upper" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (PWPolicy
pPWPolicy -> Getting Int PWPolicy Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int PWPolicy Int
Lens' PWPolicy Int
pwUpper)
, Text
"min_lower" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (PWPolicy
pPWPolicy -> Getting Int PWPolicy Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int PWPolicy Int
Lens' PWPolicy Int
pwLower)
, Text
"min_digits" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (PWPolicy
pPWPolicy -> Getting Int PWPolicy Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int PWPolicy Int
Lens' PWPolicy Int
pwDigits)
, Text
"min_special" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (PWPolicy
pPWPolicy -> Getting (Maybe Int) PWPolicy (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) PWPolicy (Maybe Int)
Lens' PWPolicy (Maybe Int)
pwSpecial)
]
instance ToJSON PWSalt where
toJSON :: PWSalt -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> (PWSalt -> String) -> PWSalt -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
toB64 (ByteString -> String)
-> (PWSalt -> ByteString) -> PWSalt -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PWSalt -> ByteString
runPWSalt
newPWDatabase :: PWDatabase
newPWDatabase :: PWDatabase
newPWDatabase = PWDatabase
forall k a. Map k a
M.empty
newPWData
:: RandomGen g
=> g
-> (PWData, g)
newPWData :: g -> (PWData, g)
newPWData g
g = (PWData
result, g
g') where
result :: PWData
result = PWPolicy -> PWSalt -> PWData
PWData PWPolicy
newPWPolicy PWSalt
salt
(PWSalt
salt, g
g') = g -> (PWSalt, g)
forall g. RandomGen g => g -> (PWSalt, g)
newPWSalt g
g
newPWPolicy :: PWPolicy
newPWPolicy :: PWPolicy
newPWPolicy = Int -> Int -> Int -> Int -> Maybe Int -> PWPolicy
PWPolicy Int
16 Int
0 Int
0 Int
0 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0)
newPWSalt
:: RandomGen g
=> g
-> (PWSalt, g)
newPWSalt :: g -> (PWSalt, g)
newPWSalt g
g = (PWSalt
result, g
g2) where
result :: PWSalt
result = ByteString -> PWSalt
PWSalt (ByteString -> PWSalt) -> ByteString -> PWSalt
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
32 ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ g -> [Word8]
forall a g. (Random a, RandomGen g) => g -> [a]
randoms g
g1
(g
g1, g
g2) = g -> (g, g)
forall g. RandomGen g => g -> (g, g)
split g
g
validatePWDatabase
:: PWDatabase
-> Bool
validatePWDatabase :: PWDatabase -> Bool
validatePWDatabase = (PWData -> Bool) -> PWDatabase -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all PWData -> Bool
validatePWData
validatePWData
:: PWData
-> Bool
validatePWData :: PWData -> Bool
validatePWData PWData
x =
PWPolicy -> Bool
validatePWPolicy (PWData
xPWData -> Getting PWPolicy PWData PWPolicy -> PWPolicy
forall s a. s -> Getting a s a -> a
^.Getting PWPolicy PWData PWPolicy
Lens' PWData PWPolicy
pwPolicy) Bool -> Bool -> Bool
&&
ByteString -> Int64
B.length (PWData
xPWData -> Getting ByteString PWData ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^.(PWSalt -> Const ByteString PWSalt)
-> PWData -> Const ByteString PWData
Lens' PWData PWSalt
pwSalt((PWSalt -> Const ByteString PWSalt)
-> PWData -> Const ByteString PWData)
-> ((ByteString -> Const ByteString ByteString)
-> PWSalt -> Const ByteString PWSalt)
-> Getting ByteString PWData ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PWSalt -> ByteString) -> SimpleGetter PWSalt ByteString
forall s a. (s -> a) -> SimpleGetter s a
to PWSalt -> ByteString
runPWSalt) Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0
validatePWPolicy
:: PWPolicy
-> Bool
validatePWPolicy :: PWPolicy -> Bool
validatePWPolicy PWPolicy
x = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
[ Int
needed Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= PWPolicy
xPWPolicy -> Getting Int PWPolicy Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int PWPolicy Int
Lens' PWPolicy Int
pwLength
, PWPolicy
xPWPolicy -> Getting Int PWPolicy Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int PWPolicy Int
Lens' PWPolicy Int
pwLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
, PWPolicy
xPWPolicy -> Getting Int PWPolicy Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int PWPolicy Int
Lens' PWPolicy Int
pwUpper Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
, PWPolicy
xPWPolicy -> Getting Int PWPolicy Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int PWPolicy Int
Lens' PWPolicy Int
pwLower Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
, PWPolicy
xPWPolicy -> Getting Int PWPolicy Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int PWPolicy Int
Lens' PWPolicy Int
pwDigits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
, Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (PWPolicy
xPWPolicy -> Getting (Maybe Int) PWPolicy (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) PWPolicy (Maybe Int)
Lens' PWPolicy (Maybe Int)
pwSpecial) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
] where
needed :: Int
needed = PWPolicy
xPWPolicy -> Getting Int PWPolicy Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int PWPolicy Int
Lens' PWPolicy Int
pwUpper Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PWPolicy
xPWPolicy -> Getting Int PWPolicy Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int PWPolicy Int
Lens' PWPolicy Int
pwLower Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PWPolicy
xPWPolicy -> Getting Int PWPolicy Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int PWPolicy Int
Lens' PWPolicy Int
pwDigits Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
special
special :: Int
special = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ PWPolicy
xPWPolicy -> Getting (Maybe Int) PWPolicy (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) PWPolicy (Maybe Int)
Lens' PWPolicy (Maybe Int)
pwSpecial
pwGenerate
:: String
-> PWData
-> Maybe String
pwGenerate :: String -> PWData -> Maybe String
pwGenerate String
pw PWData
d = if PWData -> Bool
validatePWData PWData
d
then String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> PWPolicy -> String
mkPass (ByteString -> String
mkPool ByteString
seed) (PWData
dPWData -> Getting PWPolicy PWData PWPolicy -> PWPolicy
forall s a. s -> Getting a s a -> a
^.Getting PWPolicy PWData PWPolicy
Lens' PWData PWPolicy
pwPolicy)
else Maybe String
forall a. Maybe a
Nothing
where seed :: ByteString
seed = String -> PWData -> ByteString
mkSeed String
pw PWData
d
pwCountUpper
:: String
-> Int
pwCountUpper :: String -> Int
pwCountUpper = (Char -> Bool) -> String -> Int
pwCount Char -> Bool
isUpper
pwCountLower
:: String
-> Int
pwCountLower :: String -> Int
pwCountLower = (Char -> Bool) -> String -> Int
pwCount Char -> Bool
isLower
pwCountDigits
:: String
-> Int
pwCountDigits :: String -> Int
pwCountDigits = (Char -> Bool) -> String -> Int
pwCount Char -> Bool
isDigit
pwCountSpecial
:: String
-> Int
pwCountSpecial :: String -> Int
pwCountSpecial = (Char -> Bool) -> String -> Int
pwCount Char -> Bool
isSpecial
pwCount
:: (Char -> Bool)
-> String
-> Int
pwCount :: (Char -> Bool) -> String -> Int
pwCount Char -> Bool
f = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> ShowS -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
f
pwHasService
:: String
-> PWDatabase
-> Bool
pwHasService :: String -> PWDatabase -> Bool
pwHasService String
x PWDatabase
db = String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
x ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ PWDatabase -> [String]
forall k a. Map k a -> [k]
M.keys PWDatabase
db
pwSetService
:: String
-> PWData
-> PWDatabase
-> PWDatabase
pwSetService :: String -> PWData -> PWDatabase -> PWDatabase
pwSetService = String -> PWData -> PWDatabase -> PWDatabase
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert
pwGetService
:: String
-> PWDatabase
-> Maybe PWData
pwGetService :: String -> PWDatabase -> Maybe PWData
pwGetService = String -> PWDatabase -> Maybe PWData
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup
pwRemoveService
:: String
-> PWDatabase
-> PWDatabase
pwRemoveService :: String -> PWDatabase -> PWDatabase
pwRemoveService = String -> PWDatabase -> PWDatabase
forall k a. Ord k => k -> Map k a -> Map k a
M.delete
pwSearch
:: String
-> PWDatabase
-> [String]
pwSearch :: String -> PWDatabase -> [String]
pwSearch String
x PWDatabase
db = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
y -> ShowS
l String
y String -> String -> Bool
`contains` ShowS
l String
x) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ PWDatabase -> [String]
forall k a. Map k a -> [k]
M.keys PWDatabase
db where
l :: ShowS
l = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
isSpecial :: Char -> Bool
isSpecial :: Char -> Bool
isSpecial = Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAlphaNum
mkPass :: String -> PWPolicy -> String
mkPass :: String -> PWPolicy -> String
mkPass [] PWPolicy
_ = String
""
mkPass (Char
x:String
xs) PWPolicy
p = if PWPolicy
pPWPolicy -> Getting Int PWPolicy Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int PWPolicy Int
Lens' PWPolicy Int
pwLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then String
""
else let p' :: PWPolicy
p' = Char -> PWPolicy -> PWPolicy
nextPolicy Char
x PWPolicy
p in
if PWPolicy -> Bool
validatePWPolicy PWPolicy
p'
then Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String -> PWPolicy -> String
mkPass String
xs PWPolicy
p'
else String -> PWPolicy -> String
mkPass String
xs PWPolicy
p
mkPool :: B.ByteString -> String
mkPool :: ByteString -> String
mkPool = ByteString -> String
toB64 (ByteString -> String)
-> (ByteString -> ByteString) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
raw where
raw :: ByteString -> ByteString
raw ByteString
x = let x' :: ByteString
x' = ByteString -> ByteString
mkHash ByteString
x in
ByteString
x' ByteString -> ByteString -> ByteString
`B.append` ByteString -> ByteString
raw ByteString
x'
mkSeed :: String -> PWData ->B.ByteString
mkSeed :: String -> PWData -> ByteString
mkSeed String
pw PWData
d = String -> ByteString
toUTF8 String
pw ByteString -> ByteString -> ByteString
`B.append` (PWData
dPWData -> Getting ByteString PWData ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^.(PWSalt -> Const ByteString PWSalt)
-> PWData -> Const ByteString PWData
Lens' PWData PWSalt
pwSalt((PWSalt -> Const ByteString PWSalt)
-> PWData -> Const ByteString PWData)
-> ((ByteString -> Const ByteString ByteString)
-> PWSalt -> Const ByteString PWSalt)
-> Getting ByteString PWData ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PWSalt -> ByteString) -> SimpleGetter PWSalt ByteString
forall s a. (s -> a) -> SimpleGetter s a
to PWSalt -> ByteString
runPWSalt)
mkHash :: B.ByteString -> B.ByteString
mkHash :: ByteString -> ByteString
mkHash = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ByteString, ByteString)
B16.decode (ByteString -> (ByteString, ByteString))
-> (ByteString -> ByteString)
-> ByteString
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
toUTF8 (String -> ByteString)
-> (ByteString -> String) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA256State -> String
forall a. Show a => a -> String
show (Digest SHA256State -> String)
-> (ByteString -> Digest SHA256State) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA256State
sha256
nextPolicy :: Char -> PWPolicy -> PWPolicy
nextPolicy :: Char -> PWPolicy -> PWPolicy
nextPolicy Char
x PWPolicy
p = ASetter PWPolicy PWPolicy Int Int
-> (Int -> Int) -> PWPolicy -> PWPolicy
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter PWPolicy PWPolicy Int Int
Lens' PWPolicy Int
pwLength Int -> Int
forall a. Enum a => a -> a
pred (PWPolicy -> PWPolicy) -> PWPolicy -> PWPolicy
forall a b. (a -> b) -> a -> b
$
if Char -> Bool
isUpper Char
x
then ASetter PWPolicy PWPolicy Int Int -> PWPolicy
forall b t. (Ord b, Num b, Enum b) => ASetter PWPolicy t b b -> t
dec ASetter PWPolicy PWPolicy Int Int
Lens' PWPolicy Int
pwUpper
else if Char -> Bool
isLower Char
x
then ASetter PWPolicy PWPolicy Int Int -> PWPolicy
forall b t. (Ord b, Num b, Enum b) => ASetter PWPolicy t b b -> t
dec ASetter PWPolicy PWPolicy Int Int
Lens' PWPolicy Int
pwLower
else if Char -> Bool
isDigit Char
x
then ASetter PWPolicy PWPolicy Int Int -> PWPolicy
forall b t. (Ord b, Num b, Enum b) => ASetter PWPolicy t b b -> t
dec ASetter PWPolicy PWPolicy Int Int
Lens' PWPolicy Int
pwDigits
else case PWPolicy
pPWPolicy -> Getting (Maybe Int) PWPolicy (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) PWPolicy (Maybe Int)
Lens' PWPolicy (Maybe Int)
pwSpecial of
Maybe Int
Nothing -> ASetter PWPolicy PWPolicy (Maybe Int) (Maybe Int)
-> Maybe Int -> PWPolicy -> PWPolicy
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter PWPolicy PWPolicy (Maybe Int) (Maybe Int)
Lens' PWPolicy (Maybe Int)
pwSpecial (Int -> Maybe Int
forall a. a -> Maybe a
Just (-Int
1)) PWPolicy
p
Just Int
_ -> ASetter PWPolicy PWPolicy Int Int -> PWPolicy
forall b t. (Ord b, Num b, Enum b) => ASetter PWPolicy t b b -> t
dec (ASetter PWPolicy PWPolicy Int Int -> PWPolicy)
-> ASetter PWPolicy PWPolicy Int Int -> PWPolicy
forall a b. (a -> b) -> a -> b
$ ASetter PWPolicy PWPolicy (Maybe Int) (Maybe Int)
Lens' PWPolicy (Maybe Int)
pwSpecial ASetter PWPolicy PWPolicy (Maybe Int) (Maybe Int)
-> ((Int -> Identity Int) -> Maybe Int -> Identity (Maybe Int))
-> ASetter PWPolicy PWPolicy Int Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int) -> Maybe Int -> Identity (Maybe Int)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
where
dec :: ASetter PWPolicy t b b -> t
dec ASetter PWPolicy t b b
l = ASetter PWPolicy t b b -> (b -> b) -> PWPolicy -> t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter PWPolicy t b b
l (b -> b -> b
forall a. Ord a => a -> a -> a
max b
0 (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
forall a. Enum a => a -> a
pred) PWPolicy
p
toUTF8 :: String -> B.ByteString
toUTF8 :: String -> ByteString
toUTF8 = Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> (String -> Builder) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
stringUtf8
toB64 :: B.ByteString -> String
toB64 :: ByteString -> String
toB64 = ByteString -> String
B8.unpack (ByteString -> String)
-> (ByteString -> ByteString) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.encode
contains :: String -> String -> Bool
String
_ contains :: String -> String -> Bool
`contains` String
"" = Bool
True
String
"" `contains` String
_ = Bool
False
xs :: String
xs@(Char
_:String
xs') `contains` String
ys
| String
xs String -> String -> Bool
`startsWith` String
ys = Bool
True
| Bool
otherwise = String
xs' String -> String -> Bool
`contains` String
ys
startsWith :: String -> String -> Bool
String
_ startsWith :: String -> String -> Bool
`startsWith` String
"" = Bool
True
String
"" `startsWith` String
_ = Bool
False
(Char
x:String
xs) `startsWith` (Char
y:String
ys)
| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
y = String
xs String -> String -> Bool
`startsWith` String
ys
| Bool
otherwise = Bool
False