password policy validation

src/Password.hs

@@ -31,10 +31,13 @@ module Password (
   -- $lenses
   pwLength, pwUpper, pwLower, pwDigits, pwSpecial,
   -- ** Default Instances
-  newPWPolicy
+  newPWPolicy,
+  -- * Functions
+  validatePWPolicy
   ) where
 
-import Control.Lens (makeLenses)
+import Control.Lens (makeLenses, (^.))
+import Data.Maybe (fromMaybe)
 
 -- | defines a password policy
 data PWPolicy = PWPolicy
@@ -62,4 +65,17 @@ makeLenses ''PWPolicy
 newPWPolicy :: PWPolicy
 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

test/Spec.hs

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

test/Spec/ValidatePWPolicy.hs

@@ -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