simplified application state

generate passord form error message
created post-initialization state
2024-09-12 20:57:51 -04:00 · 2024-09-12 20:09:13 -04:00 · 2024-09-12 19:47:33 -04:00 · 2024-09-10 20:12:46 -04:00 · 2024-09-10 20:00:24 -04:00 · 2024-09-10 19:03:19 -04:00
30 changed files with 369 additions and 534 deletions
--- a/ChangeLog.md
+++ b/ChangeLog.md
@ -1,5 +1,10 @@
 # Changelog for passman

+## current
+
+- minor UI tweak
+- minor refactoring
+
 ## 0.3.1.1

 - updated documentation to on longer mention GitHub
--- a/README.md
+++ b/README.md
@ -1,6 +1,6 @@
 # passman

-Copyright (C) 2018-2023 Jonathan Lamothe
+Copyright (C) 2018-2024 Jonathan Lamothe
 <jonathan@jlamothe.net>

 This program is free software: you can redistribute it and/or modify
@ -38,8 +38,8 @@ This package uses [Haskell Stack](https://haskellstack.org).  Please
 refer to [their
 website](https://docs.haskellstack.org/en/stable/README/#how-to-install)
 for instructions on installing Haskell Stack.  Once you have done
-this, you can simply enter the command `stack install passman` in the
-terminal to install passman.
+this, you can simply enter the command `stack install` in the terminal
+from this directory to install passman.

 ## Codeberg

--- a/app/Main.hs
+++ b/app/Main.hs
@ -1,7 +1,7 @@
 {-

 passman
-Copyright (C) 2018-2021 Jonathan Lamothe
+Copyright (C) Jonathan Lamothe
 <jonathan@jlamothe.net>

 This program is free software: you can redistribute it and/or modify
@ -20,36 +20,15 @@ License along with this program.  If not, see

 -}

-module Main where
+module Main (main) where

-import Control.Monad.Trans.State as S
-import System.Console.HCL (Request, reqIO, runRequest)
-import System.EasyFile
-  ( createDirectoryIfMissing
-  , getAppUserDataDirectory
-  , (</>)
-  )
-import System.Random (getStdGen)
+import Brick (defaultMain)
+import Control.Monad (void)

-import Types
-import UI
-import Util
+import Password.App
+import Password.App.Types

 main :: IO ()
-main = runRequest setup >>= mapM_ (S.evalStateT mainMenu)
-
-setup :: Request Status
-setup = do
-  g  <- reqIO getStdGen
-  p  <- getDBPath
-  db <- loadFrom p
-  pw <- getMasterPass
-  return $ Status g pw p db
-
-getDBPath :: Request FilePath
-getDBPath = reqIO $ do
-  path <- getAppUserDataDirectory "passman"
-  createDirectoryIfMissing True path
-  return $ path </> "database.json"
+main = void $ mkInitialState >>= defaultMain passmanApp

 --jl
--- a/app/Types.hs
+++ b/app/Types.hs
@ -1,53 +0,0 @@
-{-
-
-passman
-Copyright (C) 2018-2021 Jonathan Lamothe
-<jonathan@jlamothe.net>
-
-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/>.
-
-}
-
-{-# LANGUAGE TemplateHaskell #-}
-
-module Types (Status (Status), gen, dbPath, masterPass, database) where
-
-import Lens.Micro (set, (^.))
-import Lens.Micro.TH (makeLenses)
-import System.Random (RandomGen (genWord64, split), StdGen)
-
-import Password
-
-data Status = Status
-  { _gen        :: StdGen
-  , _masterPass :: String
-  , _dbPath     :: FilePath
-  , _database   :: PWDatabase
-  }
-
-makeLenses ''Status
-
-instance RandomGen Status where
-  genWord64 s = (x, s') where
-    (x, g') = genWord64 g
-    s' = set gen g' s
-    g = s^.gen
-  split s = (s1, s2) where
-    s1 = set gen g1 s
-    s2 = set gen g2 s
-    (g1, g2) = split g
-    g = s^.gen
-
--jl
--- a/app/UI.hs
+++ b/app/UI.hs
@ -1,282 +0,0 @@
-{-
-
-passman
-Copyright (C) 2018-2021 Jonathan Lamothe
-<jonathan@jlamothe.net>
-
-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/>.
-
-}
-
-{-# LANGUAGE LambdaCase #-}
-
-module UI (getMasterPass, mainMenu) where
-
-import Control.Monad (when)
-import Control.Monad.Trans.Class (lift)
-import qualified Control.Monad.Trans.State as S
-import Lens.Micro (over, set, (^.), (.~))
-import Lens.Micro.Extras (view)
-import System.Console.HCL
-  ( Request
-  , prompt
-  , reqDefault
-  , reqFail
-  , reqIf
-  , reqInt
-  , reqIO
-  , reqPassword
-  , reqResp
-  , required
-  , runRequest
-  )
-
-import Password
-
-import Types
-import Util
-
-getMasterPass :: Request String
-getMasterPass = do
-  p1 <- required $ prompt "master password: " reqPassword
-  p2 <- required $ prompt "confirm master password: " reqPassword
-  if p1 /= p2
-    then do
-      reqIO $ putStrLn "The passwords you entered do not match."
-      reqFail
-    else return p1
-
-mainMenu :: S.StateT Status IO ()
-mainMenu =
-  menu "Main Menu"
-    [ ( "view/edit a password",   viewEditMenu     )
-    , ( "add a password",         addPassword      )
-    , ( "change master password", changeMasterPass )
-    , ( "save manually",          save >> mainMenu )
-    , ( "lock session",           lockSession      )
-    , ( "quit",                   quit             )
-    ]
-
-addPassword :: S.StateT Status IO ()
-addPassword = do
-  pass <- S.gets (^.masterPass)
-
-  lift (runRequest $ prompt "confirm master password: " reqPassword)
-    >>= \case
-      Nothing -> mainMenu
-      Just chkPass
-        | pass == chkPass -> addPassword'
-
-        | otherwise -> do
-          lift $ putStrLn "Incorrect master password."
-          mainMenu
-
-addPassword' :: S.StateT Status IO ()
-addPassword' = do
-  svc <- req $ prompt "service name: " reqResp
-  ifServExists svc
-    (do
-      edit <- req (confirm $
-        "The service already exists in the database.\n" ++
-        "Would you like to edit it?")
-      if edit
-        then servMenu svc
-        else mainMenu)
-    (do
-      d <- buildData
-      setService svc d
-      showPass svc
-      servMenu svc)
-
-viewEditMenu :: S.StateT Status IO ()
-viewEditMenu = menu "View/Edit Password"
-  [ ( "search services", searchServ )
-  , ( "list services",   listServ   )
-  , ( "cancel",          mainMenu   )
-  ]
-
-changeMasterPass :: S.StateT Status IO ()
-changeMasterPass = do
-  req (confirm $
-    "\nWARNING: Changing your master password will change all of your saved passwords.\n" ++
-    "Are you sure you would like to proceed?") >>= flip when
-    (do
-      oldP <- S.gets $ view masterPass
-      newP <- req $ reqDefault getMasterPass oldP
-      S.modify $ set masterPass newP)
-  mainMenu
-
-lockSession :: S.StateT Status IO ()
-lockSession = do
-  lift $ putStrLn "\nThe session is locked."
-  pass <- S.gets $ view masterPass
-  x <- req $ prompt "master password: " reqPassword
-  if x == pass
-    then mainMenu
-    else lockSession
-
-quit :: S.StateT Status IO ()
-quit = save
-
-buildData :: S.StateT Status IO PWData
-buildData = do
-  d <- run newPWData
-  req $ reqIf (confirm "Would you like to change the password policy?")
-    (do
-      let p = d^.pwPolicy
-      p' <- reqDefault (editPolicy p) p
-      return $ set pwPolicy p' d)
-    (return d)
-
-searchServ :: S.StateT Status IO ()
-searchServ = do
-  svc <- req $ prompt "service name: " reqResp
-  db  <- S.gets $ view database
-  case pwSearch svc db of
-    []  -> do
-      lift $ putStrLn "\nThe service could not be found in the database."
-      mainMenu
-    [x] -> servMenu x
-    xs  -> selectServ xs
-
-listServ :: S.StateT Status IO ()
-listServ = S.gets (view database) >>= selectServ . pwSearch ""
-
-selectServ :: [String] -> S.StateT Status IO ()
-selectServ xs = menu "Select Service" $
-  map (\x -> (x, servMenu x)) xs ++
-  [("(cancel)", mainMenu)]
-
-servMenu :: String -> S.StateT Status IO ()
-servMenu x = menu x
-  [ ( "show password",           showPass x >> servMenu x )
-  , ( "show alternate password", showAltPass x            )
-  , ( "edit password",           editPassMenu x           )
-  , ( "remove service",          removeServ x             )
-  , ( "rename service",          renameServ x             )
-  , ( "back",                    mainMenu                 )
-  ]
-
-editPassMenu :: String -> S.StateT Status IO ()
-editPassMenu x = menu (x ++ " : Edit Password")
-  [ ( "generate new password", changeSalt x   )
-  , ( "edit password policy",  doEditPolicy x )
-  , ( "back",                  servMenu x     )
-  ]
-
-removeServ :: String -> S.StateT Status IO ()
-removeServ x = do
-  go <- req $ confirm $
-    "Are you sure you want to delete the password for " ++ x ++ "?"
-  if go
-    then do
-      removeServ' x
-      mainMenu
-    else servMenu x
-
-removeServ' :: String -> S.StateT Status IO ()
-removeServ' = S.modify . over database . pwRemoveService
-
-renameServ :: String -> S.StateT Status IO ()
-renameServ x = do
-  y <- req $ prompt "new service name: " reqResp
-  if x == y
-    then servMenu x
-    else ifServExists y
-      (do
-        overwrite <- req $ confirm $
-          y ++ " already exists.\n" ++
-          "Would you like to overwrite it?"
-        if overwrite
-          then renameServ' x y
-          else servMenu x)
-      (renameServ' x y)
-
-renameServ' :: String -> String -> S.StateT Status IO ()
-renameServ' x y = withService x mainMenu $ \d -> do
-  removeServ' x
-  setService y d
-  servMenu y
-
-changeSalt :: String -> S.StateT Status IO ()
-changeSalt x = withService x mainMenu $ \d -> do
-  salt <- run newPWSalt
-  setService x $ set pwSalt salt d
-  showPass x
-  editPassMenu x
-
-doEditPolicy :: String -> S.StateT Status IO ()
-doEditPolicy x = withService x mainMenu $ \d -> do
-  let p = d^.pwPolicy
-  p' <- req $ reqDefault (editPolicy p) p
-  setService x $ set pwPolicy p' d
-  showPass x
-  editPassMenu x
-
-showPass :: String -> S.StateT Status IO ()
-showPass x = withService x
-  (lift $ putStrLn "The service could not be found in the database.") $
-  \d -> do
-    lift $ putStrLn ""
-    mp <- S.gets $ view masterPass
-    lift $ putStrLn $ case pwGenerate mp d of
-      Nothing -> "The password data were not valid."
-      Just pw -> "password for " ++ x ++ ": " ++ pw
-
-showAltPass :: String -> S.StateT Status IO ()
-showAltPass srv = do
-  lift $ putStrLn ""
-  old <- S.gets $ view masterPass
-  Just new <- lift $ runRequest $ required $ prompt "alternate master password: " reqPassword
-  S.modify $ masterPass .~ new
-  showPass srv
-  S.modify $ masterPass .~ old
-  servMenu srv
-
-- TODO: refactor this monstrosity
-editPolicy :: PWPolicy -> Request PWPolicy
-editPolicy policy = do
-  p <-
-    edit "length" (policy^.pwLength) pwLength policy >>=
-    edit "min upper case"  (policy^.pwUpper) pwUpper >>=
-    edit "min lower case" (policy^.pwLower) pwLower  >>=
-    edit "min digits" (policy^.pwDigits) pwDigits    >>=
-    special
-  if validatePWPolicy p
-    then return p
-    else do
-      reqIO $ putStrLn $
-        "\nThe password policy you entered is invalid\n." ++
-        "It will not be changed."
-      reqFail
-  where
-    edit l v t p = do
-      v' <- reqDefault
-        (prompt ("new " ++ l ++ " (default " ++ show v ++ "): ") reqInt) v
-      return $ set t v' p
-    special p = do
-      reqIO $ putStrLn $ "Special characters are currently " ++
-        (case p^.pwSpecial of
-          Nothing -> "not "
-          Just _  -> "") ++ "allowed."
-      reqIf (confirm "Would you like to allow special characters?")
-        (case p^.pwSpecial of
-          Nothing -> do
-            x <- required $ prompt "min special chars: " reqInt
-            return $ set pwSpecial (Just x) p
-          Just x -> edit "min special chars" x (pwSpecial.traverse) p)
-        (return $ set pwSpecial Nothing p)
-
--jl
--- a/app/Util.hs
+++ b/app/Util.hs
@ -1,118 +0,0 @@
-{-
-
-passman
-Copyright (C) 2018-2021 Jonathan Lamothe
-<jonathan@jlamothe.net>
-
-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 Util
-  ( menu
-  , run
-  , withService
-  , ifServExists
-  , setService
-  , req
-  , tryReq
-  , confirm
-  , loadFrom
-  , save
-  ) where
-
-import Control.Monad (join)
-import Control.Monad.Trans.Class (lift)
-import qualified Control.Monad.Trans.State as S
-import Data.Aeson (decodeFileStrict, encodeFile)
-import Data.Maybe (fromJust, fromMaybe)
-import Lens.Micro (over)
-import Lens.Micro.Extras (view)
-import System.Console.HCL
-  ( Request
-  , prompt
-  , reqAgree
-  , reqChar
-  , reqDefault
-  , reqIO
-  , reqMenu
-  , required
-  , runRequest
-  )
-
-import Password
-
-import Types
-
-menu
-  :: String
-  -> [(String, S.StateT Status IO a)]
-  -> S.StateT Status IO a
-menu title = reqState . prompt ("\n*** " ++ title ++ " ***") .
-  reqMenu . map menuItem
-
-menuItem :: (String, a) -> (String, Request a)
-menuItem (str, x) = (str, return x)
-
-reqState :: Request (S.StateT s IO a) -> S.StateT s IO a
-reqState = join . req
-
-run :: Monad m => (s -> (a, s)) -> S.StateT s m a
-run f = S.StateT $ return . f
-
-withService
-  :: String
-  -> S.StateT Status IO a
-  -> (PWData -> S.StateT Status IO a)
-  -> S.StateT Status IO a
-withService srv fb act = do
-  db <- S.gets $ view database
-  maybe fb act $ pwGetService srv db
-
-ifServExists
-  :: String
-  -> S.StateT Status IO a
-  -> S.StateT Status IO a
-  -> S.StateT Status IO a
-ifServExists s x y = do
-  db <- S.gets $ view database
-  if pwHasService s db
-    then x
-    else y
-
-setService :: String -> PWData -> S.StateT Status IO ()
-setService k = S.modify . over database . pwSetService k
-
-req :: Request a -> S.StateT s IO a
-req = lift . fmap fromJust . runRequest . required
-
-tryReq :: Request a -> S.StateT s IO (Maybe a)
-tryReq = lift . runRequest
-
-confirm :: String -> Request Bool
-confirm x = prompt (x ++ " (y/n): ") $ reqAgree Nothing $ fmap return reqChar
-
-loadFrom :: FilePath -> Request PWDatabase
-loadFrom path = reqDefault
-  (reqIO (decodeFileStrict path))
-  (Just newPWDatabase) >>= (return . fromMaybe newPWDatabase)
-
-save :: S.StateT Status IO ()
-save = do
-  path <- S.gets $ view dbPath
-  db   <- S.gets $ view database
-  lift $ encodeFile path db
-
--jl
--- a/package.yaml
+++ b/package.yaml
@ -3,7 +3,7 @@ version:             0.3.1.1
 license:             LGPL-3.0-or-later
 author:              "Jonathan Lamothe"
 maintainer:          "jonathan@jlamothe.net"
-copyright:           "(C) 2018-2023 Jonathan Lamothe"
+copyright:           "(C) 2018-2024 Jonathan Lamothe"
 homepage:            https://codeberg.org/jlamothe/passman
 bug-reports:         https://codeberg.org/jlamothe/passman/issues

@ -22,12 +22,17 @@ description:         a simple password manager - see README.md for details

 dependencies:
 - base >= 4.7 && < 5
- aeson >= 2.0.3.0 && < 2.1
+- aeson >= 2.1.2.1 && < 2.2
 - bytestring >= 0.11.4.0 && < 0.12
 - containers >= 0.6.2.1 && < 0.7
 - microlens >= 0.4.11.2 && < 0.5
 - microlens-th >= 0.4.3.6 && < 0.5
+- microlens-mtl >= 0.2.0.3 && < 0.3
 - random >=1.2.1.1 && < 1.3
+- brick >= 2.1.1 && < 2.2
+- vty >= 6.1 && < 6.2
+- mtl >= 2.3.1 && < 2.4
+- easy-file >= 0.2.5 && < 0.3

 ghc-options:
 - -Wall
@ -38,7 +43,7 @@ library:
  - base16-bytestring >= 1.0.2.0 && < 1.1
  - base64-bytestring >= 1.2.1.0 && < 1.3
  - SHA >= 1.6.4.4 && < 1.7
-  - text >= 1.2.4.1 && < 1.3
+  - text >= 2.0.2 && < 2.1

 executables:
  passman:
@ -50,9 +55,6 @@ executables:
    - -with-rtsopts=-N
    dependencies:
    - passman
-    - easy-file >= 0.2.2 && < 0.3
-    - HCL >= 1.8 && < 1.9
-    - transformers >= 0.5.6.2 && < 0.6

 tests:
  passman-test:
--- a/passman.cabal
+++ b/passman.cabal
@ -1,10 +1,10 @@
 cabal-version: 2.2

-- This file has been generated from package.yaml by hpack version 0.35.1.
+-- This file has been generated from package.yaml by hpack version 0.37.0.
 --
 -- see: https://github.com/sol/hpack
 --
-- hash: da6c3020622e5c4c06814752b3f3334e52925005f8b3be9516efb9fd1976af9c
+-- hash: d18a8e1efd32ff2d20b0b1f5ac8186be5242411bd72a6a017fd9f97d401a9836

 name:           passman
 version:        0.3.1.1
@ -15,7 +15,7 @@ homepage:       https://codeberg.org/jlamothe/passman
 bug-reports:    https://codeberg.org/jlamothe/passman/issues
 author:         Jonathan Lamothe
 maintainer:     jonathan@jlamothe.net
-copyright:      (C) 2018-2023 Jonathan Lamothe
+copyright:      (C) 2018-2024 Jonathan Lamothe
 license:        LGPL-3.0-or-later
 license-file:   LICENSE
 build-type:     Simple
@ -26,6 +26,10 @@ extra-source-files:
 library
  exposed-modules:
      Password
+      Password.App
+      Password.App.Draw
+      Password.App.Event
+      Password.App.Types
  other-modules:
      Paths_passman
  autogen-modules:
@ -35,24 +39,26 @@ library
  ghc-options: -Wall
  build-depends:
      SHA >=1.6.4.4 && <1.7
-    , aeson >=2.0.3.0 && <2.1
+    , aeson >=2.1.2.1 && <2.2
    , base >=4.7 && <5
    , base16-bytestring >=1.0.2.0 && <1.1
    , base64-bytestring >=1.2.1.0 && <1.3
+    , brick >=2.1.1 && <2.2
    , bytestring >=0.11.4.0 && <0.12
    , containers >=0.6.2.1 && <0.7
+    , easy-file >=0.2.5 && <0.3
    , microlens >=0.4.11.2 && <0.5
+    , microlens-mtl >=0.2.0.3 && <0.3
    , microlens-th >=0.4.3.6 && <0.5
+    , mtl >=2.3.1 && <2.4
    , random >=1.2.1.1 && <1.3
-    , text >=1.2.4.1 && <1.3
+    , text >=2.0.2 && <2.1
+    , vty ==6.1.*
  default-language: Haskell2010

 executable passman
  main-is: Main.hs
  other-modules:
-      Types
-      UI
-      Util
      Paths_passman
  autogen-modules:
      Paths_passman
@ -60,17 +66,19 @@ executable passman
      app
  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
  build-depends:
-      HCL ==1.8.*
-    , aeson >=2.0.3.0 && <2.1
+      aeson >=2.1.2.1 && <2.2
    , base >=4.7 && <5
+    , brick >=2.1.1 && <2.2
    , bytestring >=0.11.4.0 && <0.12
    , containers >=0.6.2.1 && <0.7
-    , easy-file >=0.2.2 && <0.3
+    , easy-file >=0.2.5 && <0.3
    , microlens >=0.4.11.2 && <0.5
+    , microlens-mtl >=0.2.0.3 && <0.3
    , microlens-th >=0.4.3.6 && <0.5
+    , mtl >=2.3.1 && <2.4
    , passman
    , random >=1.2.1.1 && <1.3
-    , transformers >=0.5.6.2 && <0.6
+    , vty ==6.1.*
  default-language: Haskell2010

 test-suite passman-test
@ -99,12 +107,17 @@ test-suite passman-test
  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
  build-depends:
      HUnit
-    , aeson >=2.0.3.0 && <2.1
+    , aeson >=2.1.2.1 && <2.2
    , base >=4.7 && <5
+    , brick >=2.1.1 && <2.2
    , bytestring >=0.11.4.0 && <0.12
    , containers >=0.6.2.1 && <0.7
+    , easy-file >=0.2.5 && <0.3
    , microlens >=0.4.11.2 && <0.5
+    , microlens-mtl >=0.2.0.3 && <0.3
    , microlens-th >=0.4.3.6 && <0.5
+    , mtl >=2.3.1 && <2.4
    , passman
    , random >=1.2.1.1 && <1.3
+    , vty ==6.1.*
  default-language: Haskell2010
--- a/src/Password.hs
+++ b/src/Password.hs
@ -2,7 +2,7 @@

 Module:      Password
 Description: a simple password manager
-Copyright:   (C) 2018-2021 Jonathan Lamothe
+Copyright:   (C) Jonathan Lamothe
 License:     LGPLv3 (or later)
 Maintainer:  jonathan@jlamothe.net

--- a/src/Password/App.hs
+++ b/src/Password/App.hs
@ -0,0 +1,48 @@
+{-|
+
+Module:      Password.App
+Description: the application frontend
+Copyright:   (C) Jonathan Lamothe
+License:     LGPLv3 (or later)
+Maintainer:  jonathan@jlamothe.net
+
+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 Password.App (passmanApp) where
+
+import Brick
+  ( App (..)
+  , attrMap
+  , showFirstCursor
+  , style
+  )
+
+import Password.App.Draw
+import Password.App.Event
+import Password.App.Types
+
+-- | The main application
+passmanApp :: App AppState () ResName
+passmanApp = App
+  { appDraw         = drawFunc
+  , appChooseCursor = showFirstCursor
+  , appHandleEvent  = eventHandler
+  , appStartEvent   = loadDatabase
+  , appAttrMap      = const $ attrMap (style 0) []
+  }
+
+--jl
--- a/src/Password/App/Draw.hs
+++ b/src/Password/App/Draw.hs
@ -0,0 +1,54 @@
+{-|
+
+Module:      Password.App.Draw
+Description: widget drawing functions
+Copyright:   (C) Jonathan Lamothe
+License:     LGPLv3 (or later)
+Maintainer:  jonathan@jlamothe.net
+
+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/>.
+
+-}
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Password.App.Draw (drawFunc) where
+
+import Brick (Widget, emptyWidget, txt, vBox)
+import Brick.Forms (Form, formState, renderForm)
+import Data.Text (Text)
+import Lens.Micro ((^.))
+
+import Password.App.Types
+
+-- | Renders the application view
+drawFunc :: AppState -> [Widget ResName]
+drawFunc s = maybe [emptyWidget] drawPassForm $ s^.passForm
+
+drawPassForm :: Form (Text, Text) () ResName -> [Widget ResName]
+drawPassForm f =
+  [ vBox
+    [ renderForm f
+    , txt $ pfText $ formState f
+    ]
+  ]
+
+pfText :: (Text, Text) -> Text
+pfText (pass, conf)
+  | pass == ""   = "Password cannot be blank."
+  | pass /= conf = "Passwords do not match."
+  | otherwise    = ""
+
+--jl
--- a/src/Password/App/Event.hs
+++ b/src/Password/App/Event.hs
@ -0,0 +1,106 @@
+{-|
+
+Module:      Password.App.Event
+Description: event handling functions
+Copyright:   (C) Jonathan Lamothe
+License:     LGPLv3 (or later)
+Maintainer:  jonathan@jlamothe.net
+
+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/>.
+
+-}
+
+{-# LANGUAGE LambdaCase, OverloadedStrings #-}
+
+module Password.App.Event (eventHandler, loadDatabase) where
+
+import Brick (BrickEvent (VtyEvent), EventM, halt)
+import Brick.Forms (handleFormEvent)
+import Brick.Keybindings
+  ( Binding
+  , KeyDispatcher
+  , ctrl
+  , handleKey
+  , keyDispatcher
+  , keyEvents
+  , newKeyConfig
+  , onEvent
+  )
+import Control.Monad (unless)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.State.Class (gets, put)
+import Data.Aeson (decodeFileStrict)
+import Graphics.Vty.Input.Events (Event (EvKey))
+import Lens.Micro (each, (^.))
+import Lens.Micro.Mtl (zoom)
+import System.EasyFile
+  ( createDirectoryIfMissing
+  , doesFileExist
+  , getAppUserDataDirectory
+  , (</>)
+  )
+
+import Password.App.Types
+
+dbFile :: String
+dbFile = "database.json"
+
+data KEventID = QuitKE deriving (Eq, Ord, Show)
+
+-- | The main event handler
+eventHandler :: BrickEvent ResName () -> EventM ResName AppState ()
+eventHandler e@(VtyEvent (EvKey k m)) = do
+  disp <- gets getKeyDispatcher
+  handleKey disp k m >>= flip unless (fallbackHandler e)
+eventHandler e = fallbackHandler e
+
+loadDatabase :: EventM ResName AppState ()
+loadDatabase = zoom database $ liftIO
+  ( do
+    dir <- mkAppDir
+    let fn = dir </> dbFile
+    doesFileExist fn >>= \case
+      True  -> decodeFileStrict fn
+      False -> return Nothing
+  ) >>= mapM_ put
+
+fallbackHandler :: BrickEvent ResName () -> EventM ResName AppState ()
+fallbackHandler e = gets (^.passForm) >>= \case
+  Just _  -> zoom (passForm.each) $ handleFormEvent e
+  Nothing -> return ()
+
+getKeyDispatcher
+  :: AppState
+  -> KeyDispatcher KEventID (EventM ResName AppState)
+getKeyDispatcher s = either (error "can't build dispatcher") id $
+  keyDispatcher conf handlers
+  where
+    conf     = newKeyConfig ke bs []
+    ke       = keyEvents []
+    bs       = keyBindingsFor s
+    handlers =
+      [ onEvent QuitKE "Quit Application" halt
+      ]
+
+keyBindingsFor :: AppState -> [(KEventID, [Binding])]
+keyBindingsFor = const [(QuitKE, [ctrl 'c'])]
+
+mkAppDir :: IO FilePath
+mkAppDir = do
+  path <- getAppUserDataDirectory "passman"
+  createDirectoryIfMissing True path
+  return path
+
+--jl
--- a/src/Password/App/Types.hs
+++ b/src/Password/App/Types.hs
@ -0,0 +1,89 @@
+{-|
+
+Module:      Password.App.Types
+Description: data types used by the application
+Copyright:   (C) Jonathan Lamothe
+License:     LGPLv3 (or later)
+Maintainer:  jonathan@jlamothe.net
+
+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/>.
+
+-}
+
+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
+
+module Password.App.Types (
+  -- * Types
+  AppState (..),
+  ResName (..),
+  -- * Lenses
+  -- ** AppState
+  randGen,
+  database,
+  mainPass,
+  passForm,
+  -- * Constructors
+  mkInitialState,
+  ) where
+
+import Brick (txt, (<+>))
+import Brick.Forms (Form, editPasswordField, newForm, (@@=))
+import Control.Monad.IO.Class (MonadIO)
+import Data.Text (Text)
+import Lens.Micro (_1, _2)
+import Lens.Micro.TH (makeLenses)
+import System.Random (StdGen, initStdGen)
+
+import Password
+
+-- | The application state
+data AppState = AppState
+  { _randGen :: StdGen
+  -- ^ The random number generator
+  , _database :: PWDatabase
+  -- ^ The password database
+  , _mainPass :: String
+  -- ^ The main password
+  , _passForm :: Maybe PassForm
+  }
+
+-- | A password form (with confirmation)
+type PassForm = Form (Text, Text) () ResName
+
+-- | Resource identifier
+data ResName
+  = PassField
+  | ConfField
+  deriving (Eq, Ord, Show)
+
+makeLenses ''AppState
+
+-- | Builds an initial state
+mkInitialState :: MonadIO m => m AppState
+mkInitialState = AppState
+  <$> initStdGen
+  <*> return newPWDatabase
+  <*> return ""
+  <*> return (Just newPassForm)
+
+-- | Constructs a blank password form
+newPassForm :: PassForm
+newPassForm = newForm
+  [ (txt "Master password: " <+>) @@= editPasswordField _1 PassField
+  , (txt "Confirm password: " <+>) @@= editPasswordField _2 ConfField
+  ]
+  ("", "")
+
+--jl
--- a/stack.yaml
+++ b/stack.yaml
@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-20.19
+resolver: lts-22.33

 # User packages to be built.
 # Various formats can be used as shown in the example below.
@ -37,8 +37,7 @@ packages:
 # Dependency packages to be pulled from upstream that are not in the resolver
 # using the same syntax as the packages field.
 # (e.g., acme-missiles-0.3)
-extra-deps:
- HCL-1.8@sha256:39ec0da0cd6157f20c395e1b0df474df45efb0088afdaab20bb9dfb3662baf7c,1726
+# extra-deps:

 # Override default flag values for local packages and extra-deps
 # flags: {}
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@ -3,17 +3,10 @@
 # For more information, please see the documentation at:
 #   https://docs.haskellstack.org/en/stable/lock_files

-packages:
- completed:
-    hackage: HCL-1.8@sha256:39ec0da0cd6157f20c395e1b0df474df45efb0088afdaab20bb9dfb3662baf7c,1726
-    pantry-tree:
-      sha256: 5c93c5184dc378de5ecf235aa1a60dc24163ab7e0efad19c8f3bbc94354cf2b8
-      size: 1223
-  original:
-    hackage: HCL-1.8@sha256:39ec0da0cd6157f20c395e1b0df474df45efb0088afdaab20bb9dfb3662baf7c,1726
+packages: []
 snapshots:
 - completed:
-    sha256: 42f77c84b34f68c30c2cd0bf8c349f617a0f428264362426290847a6a2019b64
-    size: 649618
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/19.yaml
-  original: lts-20.19
+    sha256: 098936027eaa1ef14e2b8eb39d9933a973894bb70a68684a1bbf00730249879b
+    size: 720001
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/33.yaml
+  original: lts-22.33
--- a/test/Spec.hs
+++ b/test/Spec.hs
@ -1,7 +1,7 @@
 {-

 passman
-Copyright (C) 2018-2021 Jonathan Lamothe
+Copyright (C) Jonathan Lamothe
 <jonathan@jlamothe.net>

 This program is free software: you can redistribute it and/or modify
--- a/test/Spec/JSON.hs
+++ b/test/Spec/JSON.hs
@ -1,7 +1,7 @@
 {-

 passman
-Copyright (C) 2018-2021 Jonathan Lamothe
+Copyright (C) Jonathan Lamothe
 <jonathan@jlamothe.net>

 This program is free software: you can redistribute it and/or modify
--- a/test/Spec/NewPWData.hs
+++ b/test/Spec/NewPWData.hs
@ -1,7 +1,7 @@
 {-

 passman
-Copyright (C) 2018-2021 Jonathan Lamothe
+Copyright (C) Jonathan Lamothe
 <jonathan@jlamothe.net>

 This program is free software: you can redistribute it and/or modify
--- a/test/Spec/NewPWDatabase.hs
+++ b/test/Spec/NewPWDatabase.hs
@ -1,7 +1,7 @@
 {-

 passman
-Copyright (C) 2018-2021 Jonathan Lamothe
+Copyright (C) Jonathan Lamothe
 <jonathan@jlamothe.net>

 This program is free software: you can redistribute it and/or modify
--- a/test/Spec/NewPWPolicy.hs
+++ b/test/Spec/NewPWPolicy.hs
@ -1,7 +1,7 @@
 {-

 passman
-Copyright (C) 2018-2021 Jonathan Lamothe
+Copyright (C) Jonathan Lamothe
 <jonathan@jlamothe.net>

 This program is free software: you can redistribute it and/or modify
--- a/test/Spec/NewPWSalt.hs
+++ b/test/Spec/NewPWSalt.hs
@ -1,7 +1,7 @@
 {-

 passman
-Copyright (C) 2018-2021 Jonathan Lamothe
+Copyright (C) Jonathan Lamothe
 <jonathan@jlamothe.net>

 This program is free software: you can redistribute it and/or modify
--- a/test/Spec/PWGenerate.hs
+++ b/test/Spec/PWGenerate.hs
@ -1,7 +1,7 @@
 {-

 passman
-Copyright (C) 2018-2021 Jonathan Lamothe
+Copyright (C) Jonathan Lamothe
 <jonathan@jlamothe.net>

 This program is free software: you can redistribute it and/or modify
--- a/test/Spec/PWGetService.hs
+++ b/test/Spec/PWGetService.hs
@ -1,7 +1,7 @@
 {-

 passman
-Copyright (C) 2018-2021 Jonathan Lamothe
+Copyright (C) Jonathan Lamothe
 <jonathan@jlamothe.net>

 This program is free software: you can redistribute it and/or modify
--- a/test/Spec/PWHasService.hs
+++ b/test/Spec/PWHasService.hs
@ -1,7 +1,7 @@
 {-

 passman
-Copyright (C) 2018-2021 Jonathan Lamothe
+Copyright (C) Jonathan Lamothe
 <jonathan@jlamothe.net>

 This program is free software: you can redistribute it and/or modify
--- a/test/Spec/PWRemoveService.hs
+++ b/test/Spec/PWRemoveService.hs
@ -1,7 +1,7 @@
 {-

 passman
-Copyright (C) 2018-2021 Jonathan Lamothe
+Copyright (C) Jonathan Lamothe
 <jonathan@jlamothe.net>

 This program is free software: you can redistribute it and/or modify
--- a/test/Spec/PWSearch.hs
+++ b/test/Spec/PWSearch.hs
@ -1,7 +1,7 @@
 {-

 passman
-Copyright (C) 2018-2021 Jonathan Lamothe
+Copyright (C) Jonathan Lamothe
 <jonathan@jlamothe.net>

 This program is free software: you can redistribute it and/or modify
--- a/test/Spec/PWSetService.hs
+++ b/test/Spec/PWSetService.hs
@ -1,7 +1,7 @@
 {-

 passman
-Copyright (C) 2018-2021 Jonathan Lamothe
+Copyright (C) Jonathan Lamothe
 <jonathan@jlamothe.net>

 This program is free software: you can redistribute it and/or modify
--- a/test/Spec/ValidatePWData.hs
+++ b/test/Spec/ValidatePWData.hs
@ -1,7 +1,7 @@
 {-

 passman
-Copyright (C) 2018-2021 Jonathan Lamothe
+Copyright (C) Jonathan Lamothe
 <jonathan@jlamothe.net>

 This program is free software: you can redistribute it and/or modify
--- a/test/Spec/ValidatePWDatabase.hs
+++ b/test/Spec/ValidatePWDatabase.hs
@ -1,7 +1,7 @@
 {-

 passman
-Copyright (C) 2018-2021 Jonathan Lamothe
+Copyright (C) Jonathan Lamothe
 <jonathan@jlamothe.net>

 This program is free software: you can redistribute it and/or modify
--- a/test/Spec/ValidatePWPolicy.hs
+++ b/test/Spec/ValidatePWPolicy.hs
@ -1,7 +1,7 @@
 {-

 passman
-Copyright (C) 2018-2021 Jonathan Lamothe
+Copyright (C) Jonathan Lamothe
 <jonathan@jlamothe.net>

 This program is free software: you can redistribute it and/or modify
Author	SHA1	Message	Date
Jonathan Lamothe	41278e81a9	simplified application state	2024-09-12 20:57:51 -04:00
Jonathan Lamothe	8bddf35a1a	generate passord form error message	2024-09-12 20:09:13 -04:00
Jonathan Lamothe	b0487d4d03	created post-initialization state	2024-09-12 19:47:33 -04:00
Jonathan Lamothe	233a559aaf	Don't crash if the database doesn't exist	2024-09-10 20:12:46 -04:00
Jonathan Lamothe	86278db578	load database on start	2024-09-10 20:00:24 -04:00
Jonathan Lamothe	a872fcfd6c	added password database to `AppState`	2024-09-10 19:03:19 -04:00
Jonathan Lamothe	d049c40b7a	handle events for password entry form	2024-09-07 20:41:43 -04:00
Jonathan Lamothe	ffce0d6a1c	render the master password form	2024-09-07 18:30:25 -04:00
Jonathan Lamothe	2b427789d2	defined data structure for master password form	2024-09-07 16:57:20 -04:00
Jonathan Lamothe	a3f405d9c5	make lenses for `AppState`	2024-09-07 15:40:46 -04:00
Jonathan Lamothe	76d2600fcf	initialize random number generator	2024-09-07 15:40:46 -04:00
Jonathan Lamothe	11870423ed	use `brick`	2024-09-07 15:00:17 -04:00
Jonathan Lamothe	4b057272d3	updated copyright to reflect current year	2024-09-07 14:43:22 -04:00
Jonathan Lamothe	3e661e3b24	use LTS 22.33	2024-09-07 14:36:48 -04:00
Jonathan Lamothe	f65a478fb5	stripped out frontend	2024-09-07 14:26:15 -04:00
Jonathan Lamothe	85920c26a0	minor refactor to app/Util.hs to make hlint happy	2023-05-04 14:47:20 -04:00
Jonathan Lamothe	8be90e9822	add blank line before prompting for service name to search for	2023-05-04 14:24:55 -04:00
Jonathan Lamothe	bb85081380	removed copyright years from individual source files it remains intact in the README.md and package.yml files	2023-05-02 19:40:22 -04:00
Jonathan Lamothe	f423d202ce	fixed installation instructions	2023-05-02 17:45:48 -04:00