implemented policy checking

src/Password.hs

@@ -33,10 +33,11 @@ module Password (
   -- ** Default Instances
   newPWPolicy,
   -- * Functions
-  validatePWPolicy
+  validatePWPolicy, applyPWPolicy
   ) where
 
 import Control.Lens (makeLenses, (^.))
+import Data.Char (isUpper, isLower, isDigit, isAlphaNum)
 import Data.Maybe (fromMaybe)
 
 -- | defines a password policy
@@ -82,4 +83,22 @@ validatePWPolicy x = all id
     needed = x^.pwUpper + x^.pwLower + x^.pwDigits + special
     special = fromMaybe 0 $ x^.pwSpecial
 
+-- | checks whether or not a password meets a given password policy
+applyPWPolicy
+  :: String
+  -- ^ the password
+  -> PWPolicy
+  -- ^ the policy
+  -> Bool
+  -- ^ @"True"@ if the password meets the policy, @"False"@ otherwise
+applyPWPolicy pw policy = all id
+  [ length pw <= policy^.pwLength
+  , length (filter isUpper pw) >= policy^.pwUpper
+  , length (filter isLower pw) >= policy^.pwLower
+  , length (filter isDigit pw) >= policy^.pwDigits
+  , length (filter (not . isAlphaNum) pw) >=
+    fromMaybe (succ $ policy^.pwLength) (policy^.pwSpecial)
+  , validatePWPolicy policy
+  ]
+
 --jl

test/Spec.hs

@@ -26,6 +26,7 @@ import Control.Monad (when)
 import System.Exit (exitFailure)
 import Test.HUnit (errors, failures, runTestTT, Test(TestList))
 
+import qualified Spec.ApplyPWPolicy as ApplyPWPolicy
 import qualified Spec.PWPolicy as PWPolicy
 import qualified Spec.ValidatePWPolicy as ValidatePWPolicy
 
@@ -34,6 +35,10 @@ main = do
   when (failures counts > 0 || errors counts > 0)
     exitFailure
 
-tests = TestList [PWPolicy.tests, ValidatePWPolicy.tests]
+tests = TestList
+  [ PWPolicy.tests
+  , ValidatePWPolicy.tests
+  , ApplyPWPolicy.tests
+  ]
 
 --jl

test/Spec/ApplyPWPolicy.hs

@@ -0,0 +1,52 @@
+{-
+
+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.ApplyPWPolicy (tests) where
+
+import Control.Lens (set)
+import Test.HUnit (Test(..), (~?=))
+
+import Password
+
+tests = TestLabel "applyPWPolicy" $ TestList $ map test'
+  [ ( "default pass",         "password",           id,             True  )
+  , ( "too long",             take 99 $ repeat 'x', id,             False )
+  , ( "insufficient upper",   "password",           set pwUpper 1,  False )
+  , ( "sufficient upper",     "Password",           set pwUpper 1,  True  )
+  , ( "insufficient lower",   "PASSWORD",           set pwLower 1,  False )
+  , ( "sufficient lower",     "password",           set pwLower 1,  True  )
+  , ( "insufficient digits",  "password",           set pwDigits 1, False )
+  , ( "sufficient digits",    "password1",          set pwDigits 1, True  )
+  , ( "insifficoent special", "password",           spec (Just 1),  False )
+  , ( "sifficoent special",   "password/",          spec (Just 1),  True  )
+  , ( "illegal special",      "password/",          spec Nothing,   False )
+  , ( "bad policy",           "password",           badPolicy,      False )
+  ]
+
+test' (label, pw, f, expect) = TestLabel label $
+  applyPWPolicy pw (f newPWPolicy) ~?= expect
+
+spec = set pwSpecial
+
+badPolicy = set pwUpper (-1)
+
+--jl