JSON encoding/decoding

package.yaml

@@ -21,6 +21,7 @@ description:         Please see the README on GitHub at <https://github.com/jlam
 
 dependencies:
 - base >= 4.7 && < 5
+- aeson
 - bytestring
 - containers
 - lens

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

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

test/Spec/JSON.hs

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