password policy validation

This commit is contained in:
Jonathan Lamothe 2018-12-12 18:41:34 -05:00
parent 63105399b8
commit 3a92469554
3 changed files with 80 additions and 3 deletions

View File

@ -31,10 +31,13 @@ module Password (
-- $lenses -- $lenses
pwLength, pwUpper, pwLower, pwDigits, pwSpecial, pwLength, pwUpper, pwLower, pwDigits, pwSpecial,
-- ** Default Instances -- ** Default Instances
newPWPolicy newPWPolicy,
-- * Functions
validatePWPolicy
) where ) where
import Control.Lens (makeLenses) import Control.Lens (makeLenses, (^.))
import Data.Maybe (fromMaybe)
-- | defines a password policy -- | defines a password policy
data PWPolicy = PWPolicy data PWPolicy = PWPolicy
@ -62,4 +65,17 @@ makeLenses ''PWPolicy
newPWPolicy :: PWPolicy newPWPolicy :: PWPolicy
newPWPolicy = PWPolicy 16 0 0 0 (Just 0) newPWPolicy = PWPolicy 16 0 0 0 (Just 0)
-- | validates a password policy
validatePWPolicy
:: PWPolicy
-- ^ the policy being validated
-> Maybe PWPolicy
-- ^ the policy if it is valid, or @"Nothing"@ if it is not
validatePWPolicy x = if needed <= x^.pwLength
then Just x
else Nothing
where
needed = x^.pwUpper + x^.pwLower + x^.pwDigits + special
special = fromMaybe 0 $ x^.pwSpecial
--jl --jl

View File

@ -27,12 +27,13 @@ import System.Exit (exitFailure)
import Test.HUnit (errors, failures, runTestTT, Test(TestList)) import Test.HUnit (errors, failures, runTestTT, Test(TestList))
import qualified Spec.PWPolicy as PWPolicy import qualified Spec.PWPolicy as PWPolicy
import qualified Spec.ValidatePWPolicy as ValidatePWPolicy
main = do main = do
counts <- runTestTT tests counts <- runTestTT tests
when (failures counts > 0 || errors counts > 0) when (failures counts > 0 || errors counts > 0)
exitFailure exitFailure
tests = TestList [PWPolicy.tests] tests = TestList [PWPolicy.tests, ValidatePWPolicy.tests]
--jl --jl

View File

@ -0,0 +1,60 @@
{-
passman
Copyright (C) 2018 Jonathan Lamothe
<jlamothe1980@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation, either version 3 of the
License, or (at your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this program. If not, see
<https://www.gnu.org/licenses/>.
-}
module Spec.ValidatePWPolicy (tests) where
import Control.Lens (set)
import Test.HUnit (Test(..), (~?=))
import Password
tests = TestLabel "validatePWPolicy" $ TestList $ map test'
[ ( "default", id, True )
, ( "no special chars", set pwSpecial Nothing, True )
, ( "valid minimums", validMins, True )
, ( "excessive upper", set pwUpper 99, False )
, ( "excessive lower", set pwLower 99, False )
, ( "excessive digits", set pwDigits 99, False )
, ( "excessive total", excessive, False )
, ( "short", set pwLength 8, True )
, ( "short valid", shortValid, True )
, ( "short invalid", shortInvalid, False )
]
test' (label, f, valid) = TestLabel label $
validatePWPolicy x ~?= if valid then Just x else Nothing where
x = f newPWPolicy
validMins = setAll 1
excessive = setAll 5
shortValid = set pwLength 8 . setAll 2
shortInvalid = set pwLength 8 . set pwUpper 9
setAll x = set pwUpper x .
set pwLower x .
set pwDigits x .
set pwSpecial (Just x)
--jl