6 Commits

6 changed files with 78 additions and 54 deletions

View File

@@ -32,6 +32,7 @@ dependencies:
- brick >= 2.1.1 && < 2.2 - brick >= 2.1.1 && < 2.2
- vty >= 6.1 && < 6.2 - vty >= 6.1 && < 6.2
- mtl >= 2.3.1 && < 2.4 - mtl >= 2.3.1 && < 2.4
- easy-file >= 0.2.5 && < 0.3
ghc-options: ghc-options:
- -Wall - -Wall

View File

@@ -4,7 +4,7 @@ cabal-version: 2.2
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
-- --
-- hash: fb2b45c8e1d5aead518c67637b3af5e78b55b8f0c5a95a34c20ca5d957527fa0 -- hash: d18a8e1efd32ff2d20b0b1f5ac8186be5242411bd72a6a017fd9f97d401a9836
name: passman name: passman
version: 0.3.1.1 version: 0.3.1.1
@@ -46,6 +46,7 @@ library
, brick >=2.1.1 && <2.2 , brick >=2.1.1 && <2.2
, bytestring >=0.11.4.0 && <0.12 , bytestring >=0.11.4.0 && <0.12
, containers >=0.6.2.1 && <0.7 , containers >=0.6.2.1 && <0.7
, easy-file >=0.2.5 && <0.3
, microlens >=0.4.11.2 && <0.5 , microlens >=0.4.11.2 && <0.5
, microlens-mtl >=0.2.0.3 && <0.3 , microlens-mtl >=0.2.0.3 && <0.3
, microlens-th >=0.4.3.6 && <0.5 , microlens-th >=0.4.3.6 && <0.5
@@ -70,6 +71,7 @@ executable passman
, brick >=2.1.1 && <2.2 , brick >=2.1.1 && <2.2
, bytestring >=0.11.4.0 && <0.12 , bytestring >=0.11.4.0 && <0.12
, containers >=0.6.2.1 && <0.7 , containers >=0.6.2.1 && <0.7
, easy-file >=0.2.5 && <0.3
, microlens >=0.4.11.2 && <0.5 , microlens >=0.4.11.2 && <0.5
, microlens-mtl >=0.2.0.3 && <0.3 , microlens-mtl >=0.2.0.3 && <0.3
, microlens-th >=0.4.3.6 && <0.5 , microlens-th >=0.4.3.6 && <0.5
@@ -110,6 +112,7 @@ test-suite passman-test
, brick >=2.1.1 && <2.2 , brick >=2.1.1 && <2.2
, bytestring >=0.11.4.0 && <0.12 , bytestring >=0.11.4.0 && <0.12
, containers >=0.6.2.1 && <0.7 , containers >=0.6.2.1 && <0.7
, easy-file >=0.2.5 && <0.3
, microlens >=0.4.11.2 && <0.5 , microlens >=0.4.11.2 && <0.5
, microlens-mtl >=0.2.0.3 && <0.3 , microlens-mtl >=0.2.0.3 && <0.3
, microlens-th >=0.4.3.6 && <0.5 , microlens-th >=0.4.3.6 && <0.5

View File

@@ -41,7 +41,7 @@ passmanApp = App
{ appDraw = drawFunc { appDraw = drawFunc
, appChooseCursor = showFirstCursor , appChooseCursor = showFirstCursor
, appHandleEvent = eventHandler , appHandleEvent = eventHandler
, appStartEvent = return () , appStartEvent = loadDatabase
, appAttrMap = const $ attrMap (style 0) [] , appAttrMap = const $ attrMap (style 0) []
} }

View File

@@ -22,25 +22,33 @@ License along with this program. If not, see
-} -}
{-# LANGUAGE OverloadedStrings #-}
module Password.App.Draw (drawFunc) where module Password.App.Draw (drawFunc) where
import Brick (Widget, txt, vBox) import Brick (Widget, emptyWidget, txt, vBox)
import Brick.Forms (renderForm) import Brick.Forms (Form, formState, renderForm)
import Data.Text (Text)
import Lens.Micro ((^.)) import Lens.Micro ((^.))
import Password.App.Types import Password.App.Types
-- | Renders the application view -- | Renders the application view
drawFunc :: AppState -> [Widget ResName] drawFunc :: AppState -> [Widget ResName]
drawFunc s = case s^.appMode of drawFunc s = maybe [emptyWidget] drawPassForm $ s^.passForm
InitMode is -> drawPassForm is
drawPassForm :: InitState -> [Widget ResName] drawPassForm :: Form (Text, Text) () ResName -> [Widget ResName]
drawPassForm is = drawPassForm f =
[ vBox [ vBox
[ renderForm $ is^.setPassForm [ renderForm f
, txt $ is^.spfError , txt $ pfText $ formState f
] ]
] ]
pfText :: (Text, Text) -> Text
pfText (pass, conf)
| pass == "" = "Password cannot be blank."
| pass /= conf = "Passwords do not match."
| otherwise = ""
--jl --jl

View File

@@ -24,7 +24,7 @@ License along with this program. If not, see
{-# LANGUAGE LambdaCase, OverloadedStrings #-} {-# LANGUAGE LambdaCase, OverloadedStrings #-}
module Password.App.Event (eventHandler) where module Password.App.Event (eventHandler, loadDatabase) where
import Brick (BrickEvent (VtyEvent), EventM, halt) import Brick (BrickEvent (VtyEvent), EventM, halt)
import Brick.Forms (handleFormEvent) import Brick.Forms (handleFormEvent)
@@ -39,13 +39,24 @@ import Brick.Keybindings
, onEvent , onEvent
) )
import Control.Monad (unless) import Control.Monad (unless)
import Control.Monad.State.Class (gets) 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 Graphics.Vty.Input.Events (Event (EvKey))
import Lens.Micro ((^.)) import Lens.Micro (each, (^.))
import Lens.Micro.Mtl (zoom) import Lens.Micro.Mtl (zoom)
import System.EasyFile
( createDirectoryIfMissing
, doesFileExist
, getAppUserDataDirectory
, (</>)
)
import Password.App.Types import Password.App.Types
dbFile :: String
dbFile = "database.json"
data KEventID = QuitKE deriving (Eq, Ord, Show) data KEventID = QuitKE deriving (Eq, Ord, Show)
-- | The main event handler -- | The main event handler
@@ -55,10 +66,20 @@ eventHandler e@(VtyEvent (EvKey k m)) = do
handleKey disp k m >>= flip unless (fallbackHandler e) handleKey disp k m >>= flip unless (fallbackHandler e)
eventHandler e = 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 :: BrickEvent ResName () -> EventM ResName AppState ()
fallbackHandler e = gets (^.appMode) >>= \case fallbackHandler e = gets (^.passForm) >>= \case
InitMode _ -> zoom (appMode.initState.setPassForm) $ Just _ -> zoom (passForm.each) $ handleFormEvent e
handleFormEvent e Nothing -> return ()
getKeyDispatcher getKeyDispatcher
:: AppState :: AppState
@@ -76,4 +97,10 @@ getKeyDispatcher s = either (error "can't build dispatcher") id $
keyBindingsFor :: AppState -> [(KEventID, [Binding])] keyBindingsFor :: AppState -> [(KEventID, [Binding])]
keyBindingsFor = const [(QuitKE, [ctrl 'c'])] keyBindingsFor = const [(QuitKE, [ctrl 'c'])]
mkAppDir :: IO FilePath
mkAppDir = do
path <- getAppUserDataDirectory "passman"
createDirectoryIfMissing True path
return path
--jl --jl

View File

@@ -27,18 +27,13 @@ License along with this program. If not, see
module Password.App.Types ( module Password.App.Types (
-- * Types -- * Types
AppState (..), AppState (..),
AppMode (..),
InitState (..),
ResName (..), ResName (..),
-- * Lenses -- * Lenses
-- ** AppState -- ** AppState
randGen, randGen,
appMode, database,
-- ** AppMode mainPass,
initState, passForm,
-- ** InitState
setPassForm,
spfError,
-- * Constructors -- * Constructors
mkInitialState, mkInitialState,
) where ) where
@@ -51,26 +46,21 @@ import Lens.Micro (_1, _2)
import Lens.Micro.TH (makeLenses) import Lens.Micro.TH (makeLenses)
import System.Random (StdGen, initStdGen) import System.Random (StdGen, initStdGen)
import Password
-- | The application state -- | The application state
data AppState = AppState data AppState = AppState
{ _randGen :: StdGen { _randGen :: StdGen
-- ^ The random number generator -- ^ The random number generator
, _appMode :: AppMode , _database :: PWDatabase
-- ^ The password database
, _mainPass :: String
-- ^ The main password
, _passForm :: Maybe PassForm
} }
-- | The applicaiton's mode -- | A password form (with confirmation)
newtype AppMode = InitMode type PassForm = Form (Text, Text) () ResName
{ _initState :: InitState
-- ^ Initialization state
}
-- | Application initialization state
data InitState = InitState
{ _setPassForm :: Form (Text, Text) () ResName
-- ^ password form
, _spfError :: Text
-- ^ error message
}
-- | Resource identifier -- | Resource identifier
data ResName data ResName
@@ -78,27 +68,22 @@ data ResName
| ConfField | ConfField
deriving (Eq, Ord, Show) deriving (Eq, Ord, Show)
concat <$> mapM makeLenses makeLenses ''AppState
[ ''AppState
, ''AppMode
, ''InitState
]
-- | Builds an initial state -- | Builds an initial state
mkInitialState :: MonadIO m => m AppState mkInitialState :: MonadIO m => m AppState
mkInitialState = AppState mkInitialState = AppState
<$> initStdGen <$> initStdGen
<*> return (InitMode newInitState) <*> return newPWDatabase
<*> return ""
<*> return (Just newPassForm)
-- | New `InitState` value -- | Constructs a blank password form
newInitState :: InitState newPassForm :: PassForm
newInitState = InitState newPassForm = newForm
( newForm [ (txt "Master password: " <+>) @@= editPasswordField _1 PassField
[ (txt "Master password: " <+>) @@= editPasswordField _1 PassField , (txt "Confirm password: " <+>) @@= editPasswordField _2 ConfField
, (txt "Confirm password: " <+>) @@= editPasswordField _2 ConfField ]
] ("", "")
("", "")
)
""
--jl --jl