feat: Basic functionality

.gitignore

@@ -0,0 +1,2 @@
+/get-password
+/dist-newstyle

CHANGELOG.md

@@ -0,0 +1,5 @@
+# Revision history for get-password
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

LICENSE

@@ -0,0 +1,26 @@
+Copyright (c) 2023, Tom Oram
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the
+   distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

Makefile

@@ -0,0 +1,28 @@
+all: get-password
+
+.PHONY=test
+test:
+	@cabal test --test-show-details=direct --test-option=--format=checks
+
+get-password: get-password.cabal $(shell find {src,app} -type f)
+	@cabal build
+	@cp $$(cabal list-bin get-password) get-password
+
+.PHONY=clean
+clean:
+	@cabal clean
+	@rm -f get-password
+
+.PHONY=install-tools
+install-tools:
+	@cabal install hlint ormolu
+
+.PHONY=lint
+lint:
+	@find {src,app,tests} -type f -name '*.hs' -exec hlint {} \;
+	@find {src,app,tests} -type f -name '*.hs' -exec ormolu --mode check {} \;
+
+.PHONY=format
+format:
+	@find {src,app,tests} -type f -name '*.hs' -exec ormolu --mode inplace {} \;
+

README.md

@@ -0,0 +1,3 @@
+# get-password
+
+Wrapper around the LastPass CLI to quickly search for passwords.

app/Main.hs

@@ -0,0 +1,17 @@
+module Main where
+
+import Control.Monad.Except (runExceptT)
+import qualified GetPassword (getPassword)
+import qualified LastPass (runLastPassT)
+import System.Environment (getArgs)
+
+main :: IO ()
+main = do
+  args <- getArgs
+  case args of
+    [search] -> do
+      result <- runExceptT $ LastPass.runLastPassT $ GetPassword.getPassword search
+      case result of
+        Left err -> putStrLn ("Error: " <> show err)
+        Right password -> putStrLn ("Password is " <> password)
+    _ -> putStrLn "Usage: lastpass-hs <search>"

get-password.cabal

@@ -0,0 +1,64 @@
+cabal-version:      3.0
+name:               get-password
+
+-- PVP summary:     +-+------- breaking API changes
+--                  | | +----- non-breaking API additions
+--                  | | | +--- code changes with no API change
+version:            0.1.0.0
+synopsis:
+    A wrapper around the LastPass CLI to quickly search for passwords.
+homepage:           https://github.com/tomphp/get-password
+license:            BSD-2-Clause
+license-file:       LICENSE
+author:             Tom Oram
+maintainer:         [email protected]
+category:           Tool
+build-type:         Simple
+extra-doc-files:
+    README.md,
+    CHANGELOG.md
+
+common warnings
+    ghc-options: -Wall
+
+library
+    import:           warnings
+    exposed-modules:
+        GetPassword,
+        LastPass,
+        PasswordEntry,
+        EntryListParser
+    build-depends:
+        base ^>=4.16.4.0,
+        megaparsec,
+        mtl,
+        process-extras,
+        text
+    hs-source-dirs:   src
+    default-language: GHC2021
+
+executable get-password
+    import:           warnings
+    main-is:          Main.hs
+    build-depends:
+        base ^>=4.16.4.0,
+        get-password,
+        mtl
+    hs-source-dirs:   app
+    default-language: GHC2021
+
+test-suite get-password-test
+    import:           warnings
+    default-language: GHC2021
+    type:             exitcode-stdio-1.0
+    hs-source-dirs:   tests
+    main-is:          Spec.hs
+    other-modules:
+        LastPassMock,
+        GetPasswordSpec,
+        EntryListParserSpec
+    build-depends:
+        base ^>=4.16.4.0,
+        get-password,
+        hspec,
+        mtl

src/EntryListParser.hs

@@ -0,0 +1,27 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module EntryListParser (parseEntryList) where
+
+import Control.Monad (void)
+import Data.Bifunctor (Bifunctor (first))
+import Data.Text (Text)
+import Data.Void (Void)
+import PasswordEntry (PasswordEntry (PasswordEntry, entryId, name, url))
+import Text.Megaparsec (MonadParsec (eof), Parsec, anySingle, between, many, manyTill, noneOf, parse, some, (<?>), (<|>))
+import Text.Megaparsec.Char (char, digitChar, eol, spaceChar)
+import Text.Megaparsec.Error (errorBundlePretty)
+
+parseEntryList :: Text -> Either String [PasswordEntry]
+parseEntryList = first errorBundlePretty . parse parseEntries ""
+
+parseEntries :: Parsec Void Text [PasswordEntry]
+parseEntries = many parseEntry
+
+parseEntry :: Parsec Void Text PasswordEntry
+parseEntry = do
+  entryId <- some digitChar <?> "Entry ID"
+  void spaceChar
+  name <- between (char '"') (char '"' <?> "closing double quote") (many (noneOf "\"")) <?> "Name"
+  void spaceChar
+  url <- manyTill anySingle (void eol <|> eof) <?> "URL"
+  return PasswordEntry {..}

src/GetPassword.hs

@@ -0,0 +1,22 @@
+module GetPassword (getPassword) where
+
+import Control.Monad (void)
+import Control.Monad.Except (MonadError (throwError))
+import Data.List (isInfixOf)
+import LastPass (LastPassError (LastPassMultiplePasswordsFound, LastPassPasswordNotFound), MonadLastPass (..))
+import PasswordEntry (PasswordEntry (entryId, name, url))
+
+getPassword :: (MonadLastPass m, MonadError LastPassError m) => String -> m String
+getPassword search = do
+  void checkIsInstalled
+  void checkIsLoggedIn
+
+  results <- filter (matches search) <$> listPasswords
+
+  case results of
+    [] -> throwError LastPassPasswordNotFound
+    [entry] -> showPassword (entryId entry)
+    _ -> throwError (LastPassMultiplePasswordsFound results)
+
+matches :: String -> PasswordEntry -> Bool
+matches search entry = search `isInfixOf` name entry || search `isInfixOf` url entry

src/LastPass.hs

@@ -0,0 +1,66 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module LastPass (MonadLastPass (..), LassPassT (..), LastPassError (..)) where
+
+import Control.Monad.Error.Class (MonadError (catchError, throwError), liftEither)
+import Control.Monad.Except (ExceptT, void)
+import Control.Monad.Trans (MonadTrans (lift))
+import Data.Bifunctor (first)
+import Data.Text (pack, unpack)
+import EntryListParser (parseEntryList)
+import GHC.IO.Exception (ExitCode (ExitSuccess))
+import PasswordEntry (PasswordEntry)
+import System.Process.Text (readProcessWithExitCode)
+
+data LastPassError
+  = LastPassNotInstalled
+  | LastPassNotLoggedIn
+  | LastPassListPasswordsFailed
+  | LastPassListPasswordsParseFailed String
+  | LastPassShowPasswordFailed String
+  | LastPassPasswordNotFound
+  | LastPassMultiplePasswordsFound [PasswordEntry]
+  deriving (Show, Eq)
+
+class (MonadError LastPassError m, Monad m) => MonadLastPass m where
+  checkIsInstalled :: m ()
+  checkIsLoggedIn :: m ()
+  listPasswords :: m [PasswordEntry]
+  showPassword :: String -> m String
+
+run :: FilePath -> [String] -> LastPassError -> LassPassT (ExceptT LastPassError IO) String
+run cmd args err = do
+  (exitCode, output, _) <-
+    lift $
+      lift $ readProcessWithExitCode cmd args ""
+  case exitCode of
+    ExitSuccess -> return $ unpack output
+    _ -> liftEither (Left err)
+
+lpass :: [String] -> LastPassError -> LassPassT (ExceptT LastPassError IO) String
+lpass = run "lpass"
+
+instance MonadLastPass (LassPassT (ExceptT LastPassError IO)) where
+  checkIsInstalled =
+    void $ lpass ["--version"] LastPassNotInstalled
+
+  checkIsLoggedIn =
+    void $ lpass ["status"] LastPassNotLoggedIn
+
+  listPasswords = do
+    output <- lpass ["ls", "--sync=now", "--format=%ai \"%an\" %al"] LastPassListPasswordsFailed
+    liftEither $ first LastPassListPasswordsParseFailed (parseEntryList $ pack output)
+
+  showPassword :: String -> (LassPassT (ExceptT LastPassError IO)) String
+  showPassword entryId =
+    run "lpass" ["show", "--password", entryId] (LastPassShowPasswordFailed "fixme")
+
+newtype LassPassT m a = LassPassT {runLastPassT :: m a}
+  deriving (Functor, Applicative, Monad)
+
+instance MonadTrans LassPassT where
+  lift = LassPassT
+
+instance MonadError LastPassError m => MonadError LastPassError (LassPassT m) where
+  throwError = lift . throwError
+  catchError (LassPassT m) f = LassPassT $ catchError m (runLastPassT . f)

src/PasswordEntry.hs

@@ -0,0 +1,8 @@
+module PasswordEntry (PasswordEntry (..)) where
+
+data PasswordEntry = PasswordEntry
+  { entryId :: !String,
+    name :: !String,
+    url :: !String
+  }
+  deriving (Show, Eq)

tests/EntryListParserSpec.hs

@@ -0,0 +1,24 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module EntryListParserSpec (spec) where
+
+import EntryListParser (parseEntryList)
+import PasswordEntry (PasswordEntry (PasswordEntry, entryId, name, url))
+import Test.Hspec
+
+spec :: Spec
+spec = describe "parseEntryList" $ do
+  it "returns an empty list for an empty string" $ do
+    parseEntryList "" `shouldBe` Right []
+
+  it "returns entries" $ do
+    parseEntryList
+      ( mconcat
+          [ "11111 \"ebay\" http://www.ebay.com\n",
+            "22222 \"amazon\" http://www.amazon.com"
+          ]
+      )
+      `shouldBe` Right
+        [ PasswordEntry {entryId = "11111", name = "ebay", url = "http://www.ebay.com"},
+          PasswordEntry {entryId = "22222", name = "amazon", url = "http://www.amazon.com"}
+        ]