JSON encoding/decoding
This commit is contained in:
parent
0f83374060
commit
aa0b8e13d2
@ -21,6 +21,7 @@ description: Please see the README on GitHub at <https://github.com/jlam
|
|||||||
|
|
||||||
dependencies:
|
dependencies:
|
||||||
- base >= 4.7 && < 5
|
- base >= 4.7 && < 5
|
||||||
|
- aeson
|
||||||
- bytestring
|
- bytestring
|
||||||
- containers
|
- containers
|
||||||
- lens
|
- lens
|
||||||
|
@ -23,6 +23,7 @@ License along with this program. If not, see
|
|||||||
-}
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module Password (
|
module Password (
|
||||||
-- * Data Types
|
-- * Data Types
|
||||||
@ -47,12 +48,23 @@ module Password (
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Lens (makeLenses, over, set, (^.))
|
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.Lazy as B
|
||||||
import qualified Data.ByteString.Base64.Lazy as B64
|
import qualified Data.ByteString.Base64.Lazy as B64
|
||||||
import Data.Char (isUpper, isLower, isDigit, isAlphaNum, toLower)
|
import Data.Char (isUpper, isLower, isDigit, isAlphaNum, toLower)
|
||||||
import Data.Digest.Pure.SHA
|
import Data.Digest.Pure.SHA
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
|
import qualified Data.Text as T'
|
||||||
import qualified Data.Text.Lazy as T
|
import qualified Data.Text.Lazy as T
|
||||||
import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)
|
import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)
|
||||||
import System.Random (RandomGen, randoms, split)
|
import System.Random (RandomGen, randoms, split)
|
||||||
@ -94,6 +106,43 @@ type PWSalt = B.ByteString
|
|||||||
makeLenses ''PWPolicy
|
makeLenses ''PWPolicy
|
||||||
makeLenses ''PWData
|
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
|
-- | default (empty) password database
|
||||||
newPWDatabase :: PWDatabase
|
newPWDatabase :: PWDatabase
|
||||||
newPWDatabase = M.empty
|
newPWDatabase = M.empty
|
||||||
|
@ -26,6 +26,7 @@ import Control.Monad (when)
|
|||||||
import System.Exit (exitFailure)
|
import System.Exit (exitFailure)
|
||||||
import Test.HUnit (errors, failures, runTestTT, Test(TestList))
|
import Test.HUnit (errors, failures, runTestTT, Test(TestList))
|
||||||
|
|
||||||
|
import qualified Spec.JSON as JSON
|
||||||
import qualified Spec.NewPWData as NewPWData
|
import qualified Spec.NewPWData as NewPWData
|
||||||
import qualified Spec.NewPWDatabase as NewPWDatabase
|
import qualified Spec.NewPWDatabase as NewPWDatabase
|
||||||
import qualified Spec.NewPWPolicy as NewPWPolicy
|
import qualified Spec.NewPWPolicy as NewPWPolicy
|
||||||
@ -57,6 +58,7 @@ tests = TestList
|
|||||||
, PWSetService.tests
|
, PWSetService.tests
|
||||||
, PWGetService.tests
|
, PWGetService.tests
|
||||||
, PWSearch.tests
|
, PWSearch.tests
|
||||||
|
, JSON.tests
|
||||||
]
|
]
|
||||||
|
|
||||||
--jl
|
--jl
|
||||||
|
55
test/Spec/JSON.hs
Normal file
55
test/Spec/JSON.hs
Normal file
@ -0,0 +1,55 @@
|
|||||||
|
{-
|
||||||
|
|
||||||
|
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.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
|
Loading…
x
Reference in New Issue
Block a user