From aa0b8e13d2c5d5401b2e06b896155482c0412975 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Sat, 29 Dec 2018 12:21:25 -0500 Subject: [PATCH] JSON encoding/decoding --- package.yaml | 1 + src/Password.hs | 49 +++++++++++++++++++++++++++++++++++++++++ test/Spec.hs | 2 ++ test/Spec/JSON.hs | 55 +++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 107 insertions(+) create mode 100644 test/Spec/JSON.hs diff --git a/package.yaml b/package.yaml index 5c0ec32..75f581e 100644 --- a/package.yaml +++ b/package.yaml @@ -21,6 +21,7 @@ description: Please see the README on GitHub at = 4.7 && < 5 +- aeson - bytestring - containers - lens diff --git a/src/Password.hs b/src/Password.hs index 0f39d73..d57e076 100644 --- a/src/Password.hs +++ b/src/Password.hs @@ -23,6 +23,7 @@ License along with this program. If not, see -} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} module Password ( -- * Data Types @@ -47,12 +48,23 @@ module Password ( ) where import Control.Lens (makeLenses, over, set, (^.)) +import Data.Aeson + ( FromJSON (parseJSON) + , ToJSON (toJSON) + , Value (String) + , object + , withObject + , withText + , (.:) + , (.=) + ) import qualified Data.ByteString.Lazy as B 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 qualified Data.Text.Lazy as T import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8) import System.Random (RandomGen, randoms, split) @@ -94,6 +106,43 @@ type PWSalt = B.ByteString makeLenses ''PWPolicy makeLenses ''PWData +instance FromJSON PWData where + parseJSON = withObject "PWData" $ \v -> PWData + <$> v .: "policy" + <*> v .: "salt" + +instance FromJSON PWPolicy where + parseJSON = withObject "PWPolicy" $ \v -> PWPolicy + <$> v .: "length" + <*> v .: "min_upper" + <*> v .: "min_lower" + <*> v .: "min_digits" + <*> v .: "min_special" + +instance FromJSON B.ByteString where + parseJSON = withText "ByteString" $ \v -> + case B64.decode $ encodeUtf8 $ T.pack $ T'.unpack v of + Left x -> fail x + Right x -> return x + +instance ToJSON PWData where + toJSON d = object + [ "policy" .= (d^.pwPolicy) + , "salt" .= (d^.pwSalt) + ] + +instance ToJSON PWPolicy where + toJSON p = object + [ "length" .= (p^.pwLength) + , "min_upper" .= (p^.pwUpper) + , "min_lower" .= (p^.pwLower) + , "min_digits" .= (p^.pwDigits) + , "min_special" .= (p^.pwSpecial) + ] + +instance ToJSON B.ByteString where + toJSON = toJSON . toB64 + -- | default (empty) password database newPWDatabase :: PWDatabase newPWDatabase = M.empty diff --git a/test/Spec.hs b/test/Spec.hs index 467c429..0494491 100644 --- a/test/Spec.hs +++ b/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.JSON as JSON import qualified Spec.NewPWData as NewPWData import qualified Spec.NewPWDatabase as NewPWDatabase import qualified Spec.NewPWPolicy as NewPWPolicy @@ -57,6 +58,7 @@ tests = TestList , PWSetService.tests , PWGetService.tests , PWSearch.tests + , JSON.tests ] --jl diff --git a/test/Spec/JSON.hs b/test/Spec/JSON.hs new file mode 100644 index 0000000..5cc3227 --- /dev/null +++ b/test/Spec/JSON.hs @@ -0,0 +1,55 @@ +{- + +passman +Copyright (C) 2018 Jonathan Lamothe + + +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 +. + +-} + +module Spec.JSON (tests) where + +import Data.Aeson (eitherDecode, encode, decode) +import qualified Data.ByteString.Lazy as B +import qualified Data.Map as M +import System.Random (mkStdGen) +import Test.HUnit (Test (..), (~?=)) + +import Password + +tests = TestLabel "JSON" $ TestList [success, failure] + +success = TestLabel "succeasful encoding/decoding" $ + eitherDecode (encode db) ~?= Right db + +failure = TestLabel "decoding failure" $ + (decode B.empty :: Maybe PWDatabase) ~?= Nothing + +db = M.fromList + [ ( "foo", foo ) + , ( "bar", bar ) + , ( "baz", baz ) + ] + +(foo, g') = newPWData g + +(bar, g'') = newPWData g' + +(baz, _) = newPWData g'' + +g = mkStdGen 1 + +--jl