README.md

@@ -1,6 +1,6 @@
 # passman
 
-Copyright (C) 2018-2024 Jonathan Lamothe
+Copyright (C) 2018-2023 Jonathan Lamothe
 <jonathan@jlamothe.net>
 
 This program is free software: you can redistribute it and/or modify

app/Main.hs

@@ -20,15 +20,36 @@ License along with this program.  If not, see
 
 -}
 
-module Main (main) where
+module Main where
 
-import Brick (defaultMain)
+import Control.Monad.Trans.State as S
-import Control.Monad (void)
+import System.Console.HCL (Request, reqIO, runRequest)
+import System.EasyFile
+  ( createDirectoryIfMissing
+  , getAppUserDataDirectory
+  , (</>)
+  )
+import System.Random (getStdGen)
 
-import Password.App
+import Types
-import Password.App.Types
+import UI
+import Util
 
 main :: IO ()
-main = void $ mkInitialState >>= defaultMain passmanApp
+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"
 
 --jl

app/Types.hs

@@ -0,0 +1,53 @@
+{-
+
+passman
+Copyright (C) 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

app/UI.hs

@@ -0,0 +1,282 @@
+{-
+
+passman
+Copyright (C) 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 "\nservice 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

app/Util.hs

@@ -0,0 +1,118 @@
+{-
+
+passman
+Copyright (C) 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 = fromMaybe newPWDatabase <$> reqDefault
+  (reqIO (decodeFileStrict path))
+  (Just newPWDatabase)
+
+save :: S.StateT Status IO ()
+save = do
+  path <- S.gets $ view dbPath
+  db   <- S.gets $ view database
+  lift $ encodeFile path db
+
+--jl

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-2024 Jonathan Lamothe"
+copyright:           "(C) 2018-2023 Jonathan Lamothe"
 homepage:            https://codeberg.org/jlamothe/passman
 bug-reports:         https://codeberg.org/jlamothe/passman/issues
 
@@ -22,16 +22,12 @@ description:         a simple password manager - see README.md for details
 
 dependencies:
 - base >= 4.7 && < 5
-- aeson >= 2.1.2.1 && < 2.2
+- aeson >= 2.0.3.0 && < 2.1
 - 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
 
 ghc-options:
 - -Wall
@@ -42,7 +38,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 >= 2.0.2 && < 2.1
+  - text >= 1.2.4.1 && < 1.3
 
 executables:
   passman:
@@ -54,6 +50,9 @@ 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:

passman.cabal

@@ -1,10 +1,10 @@
 cabal-version: 2.2
 
--- This file has been generated from package.yaml by hpack version 0.37.0.
+-- This file has been generated from package.yaml by hpack version 0.35.1.
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: fb2b45c8e1d5aead518c67637b3af5e78b55b8f0c5a95a34c20ca5d957527fa0
+-- hash: da6c3020622e5c4c06814752b3f3334e52925005f8b3be9516efb9fd1976af9c
 
 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-2024 Jonathan Lamothe
+copyright:      (C) 2018-2023 Jonathan Lamothe
 license:        LGPL-3.0-or-later
 license-file:   LICENSE
 build-type:     Simple
@@ -26,10 +26,6 @@ extra-source-files:
 library
   exposed-modules:
       Password
-      Password.App
-      Password.App.Draw
-      Password.App.Event
-      Password.App.Types
   other-modules:
       Paths_passman
   autogen-modules:
@@ -39,25 +35,24 @@ library
   ghc-options: -Wall
   build-depends:
       SHA >=1.6.4.4 && <1.7
-    , aeson >=2.1.2.1 && <2.2
+    , aeson >=2.0.3.0 && <2.1
     , 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
     , 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 >=2.0.2 && <2.1
+    , text >=1.2.4.1 && <1.3
-    , vty ==6.1.*
   default-language: Haskell2010
 
 executable passman
   main-is: Main.hs
   other-modules:
+      Types
+      UI
+      Util
       Paths_passman
   autogen-modules:
       Paths_passman
@@ -65,18 +60,17 @@ executable passman
       app
   ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      aeson >=2.1.2.1 && <2.2
+      HCL ==1.8.*
+    , aeson >=2.0.3.0 && <2.1
     , 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
     , 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.*
+    , transformers >=0.5.6.2 && <0.6
   default-language: Haskell2010
 
 test-suite passman-test
@@ -105,16 +99,12 @@ test-suite passman-test
   ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       HUnit
-    , aeson >=2.1.2.1 && <2.2
+    , aeson >=2.0.3.0 && <2.1
     , base >=4.7 && <5
-    , brick >=2.1.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-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

src/Password/App.hs

@@ -1,48 +0,0 @@
-{-|
-
-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   = return ()
-  , appAttrMap      = const $ attrMap (style 0) []
-  }
-
---jl

src/Password/App/Draw.hs

@@ -1,46 +0,0 @@
-{-|
-
-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/>.
-
--}
-
-module Password.App.Draw (drawFunc) where
-
-import Brick (Widget, txt, vBox)
-import Brick.Forms (renderForm)
-import Lens.Micro ((^.))
-
-import Password.App.Types
-
--- | Renders the application view
-drawFunc :: AppState -> [Widget ResName]
-drawFunc s = case s^.appMode of
-  InitMode is -> drawPassForm is
-
-drawPassForm :: InitState -> [Widget ResName]
-drawPassForm is =
-  [ vBox
-    [ renderForm $ is^.setPassForm
-    , txt $ is^.spfError
-    ]
-  ]
-
---jl

src/Password/App/Event.hs

@@ -1,79 +0,0 @@
-{-|
-
-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) 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.State.Class (gets)
-import Graphics.Vty.Input.Events (Event (EvKey))
-import Lens.Micro ((^.))
-import Lens.Micro.Mtl (zoom)
-
-import Password.App.Types
-
-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
-
-fallbackHandler :: BrickEvent ResName () -> EventM ResName AppState ()
-fallbackHandler e = gets (^.appMode) >>= \case
-  InitMode _ -> zoom (appMode.initState.setPassForm) $
-    handleFormEvent e
-
-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'])]
-
---jl

src/Password/App/Types.hs

@@ -1,104 +0,0 @@
-{-|
-
-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 (..),
-  AppMode (..),
-  InitState (..),
-  ResName (..),
-  -- * Lenses
-  -- ** AppState
-  randGen,
-  appMode,
-  -- ** AppMode
-  initState,
-  -- ** InitState
-  setPassForm,
-  spfError,
-  -- * 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)
-
--- | The application state
-data AppState = AppState
-  { _randGen :: StdGen
-  -- ^ The random number generator
-  , _appMode :: AppMode
-  }
-
--- | The applicaiton's mode
-newtype AppMode = InitMode
-  { _initState :: InitState
-  -- ^ Initialization state
-  }
-
--- | Application initialization state
-data InitState = InitState
-  { _setPassForm :: Form (Text, Text) () ResName
-  -- ^ password form
-  , _spfError :: Text
-  -- ^ error message
-  }
-
--- | Resource identifier
-data ResName
-  = PassField
-  | ConfField
-  deriving (Eq, Ord, Show)
-
-concat <$> mapM makeLenses
-  [ ''AppState
-  , ''AppMode
-  , ''InitState
-  ]
-
--- | Builds an initial state
-mkInitialState :: MonadIO m => m AppState
-mkInitialState = AppState
-  <$> initStdGen
-  <*> return (InitMode newInitState)
-
--- | New `InitState` value
-newInitState :: InitState
-newInitState = InitState
-  ( newForm
-    [ (txt "Master password: " <+>) @@= editPasswordField _1 PassField
-    , (txt "Confirm password: " <+>) @@= editPasswordField _2 ConfField
-    ]
-    ("", "")
-  )
-  ""
-
---jl

stack.yaml

@@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-22.33
+resolver: lts-20.19
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.
@@ -37,7 +37,8 @@ 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:
+extra-deps:
+- HCL-1.8@sha256:39ec0da0cd6157f20c395e1b0df474df45efb0088afdaab20bb9dfb3662baf7c,1726
 
 # Override default flag values for local packages and extra-deps
 # flags: {}

stack.yaml.lock

@@ -3,10 +3,17 @@
 # For more information, please see the documentation at:
 #   https://docs.haskellstack.org/en/stable/lock_files
 
-packages: []
+packages:
+- completed:
+    hackage: HCL-1.8@sha256:39ec0da0cd6157f20c395e1b0df474df45efb0088afdaab20bb9dfb3662baf7c,1726
+    pantry-tree:
+      sha256: 5c93c5184dc378de5ecf235aa1a60dc24163ab7e0efad19c8f3bbc94354cf2b8
+      size: 1223
+  original:
+    hackage: HCL-1.8@sha256:39ec0da0cd6157f20c395e1b0df474df45efb0088afdaab20bb9dfb3662baf7c,1726
 snapshots:
 - completed:
-    sha256: 098936027eaa1ef14e2b8eb39d9933a973894bb70a68684a1bbf00730249879b
+    sha256: 42f77c84b34f68c30c2cd0bf8c349f617a0f428264362426290847a6a2019b64
-    size: 720001
+    size: 649618
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/33.yaml
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/19.yaml
-  original: lts-22.33
+  original: lts-20.19