Compare commits
No commits in common. "d049c40b7a8a65f5916bc362d58a466d98eb6e57" and "85920c26a04c53de8128e5ece733d9e2a746053a" have entirely different histories.
d049c40b7a
...
85920c26a0
|
|
@ -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
|
||||
|
|
|
|||
33
app/Main.hs
33
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 (void)
|
||||
import Control.Monad.Trans.State as S
|
||||
import System.Console.HCL (Request, reqIO, runRequest)
|
||||
import System.EasyFile
|
||||
( createDirectoryIfMissing
|
||||
, getAppUserDataDirectory
|
||||
, (</>)
|
||||
)
|
||||
import System.Random (getStdGen)
|
||||
|
||||
import Password.App
|
||||
import Password.App.Types
|
||||
import 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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
13
package.yaml
13
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:
|
||||
|
|
|
|||
|
|
@ -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
|
||||
, vty ==6.1.*
|
||||
, text >=1.2.4.1 && <1.3
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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: {}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
size: 720001
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/33.yaml
|
||||
original: lts-22.33
|
||||
sha256: 42f77c84b34f68c30c2cd0bf8c349f617a0f428264362426290847a6a2019b64
|
||||
size: 649618
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/19.yaml
|
||||
original: lts-20.19
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user