{-# LANGUAGE QuasiQuotes #-}

module Cachix.Client.InstallationMode
  ( InstallationMode (..),
    NixEnv (..),
    getInstallationMode,
    addBinaryCache,
    isTrustedUser,
    getUser,
    fromString,
    toString,
    UseOptions (..),
  )
where

import Cachix.Client.Config (Config)
import qualified Cachix.Client.Config as Config
import Cachix.Client.Exception (CachixException (..))
import qualified Cachix.Client.NetRc as NetRc
import qualified Cachix.Client.NixConf as NixConf
import qualified Cachix.Types.BinaryCache as BinaryCache
import qualified Data.Maybe
import Data.String.Here
import qualified Data.Text as T
import Protolude
import System.Directory (Permissions, createDirectoryIfMissing, getPermissions, writable)
import System.Environment (lookupEnv)
import System.FilePath (replaceFileName, (</>))
import System.Process (readProcessWithExitCode)
import Prelude (String)

data NixEnv = NixEnv
  { NixEnv -> Bool
isTrusted :: Bool,
    NixEnv -> Bool
isRoot :: Bool,
    NixEnv -> Bool
isNixOS :: Bool
  }

-- NOTE: update the list of options for --mode argument in OptionsParser.hs
data InstallationMode
  = Install NixConf.NixConfLoc
  | WriteNixOS
  | UntrustedRequiresSudo
  | UntrustedNixOS
  deriving (Int -> InstallationMode -> ShowS
[InstallationMode] -> ShowS
InstallationMode -> String
(Int -> InstallationMode -> ShowS)
-> (InstallationMode -> String)
-> ([InstallationMode] -> ShowS)
-> Show InstallationMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstallationMode] -> ShowS
$cshowList :: [InstallationMode] -> ShowS
show :: InstallationMode -> String
$cshow :: InstallationMode -> String
showsPrec :: Int -> InstallationMode -> ShowS
$cshowsPrec :: Int -> InstallationMode -> ShowS
Show, InstallationMode -> InstallationMode -> Bool
(InstallationMode -> InstallationMode -> Bool)
-> (InstallationMode -> InstallationMode -> Bool)
-> Eq InstallationMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstallationMode -> InstallationMode -> Bool
$c/= :: InstallationMode -> InstallationMode -> Bool
== :: InstallationMode -> InstallationMode -> Bool
$c== :: InstallationMode -> InstallationMode -> Bool
Eq)

data UseOptions = UseOptions
  { UseOptions -> Maybe InstallationMode
useMode :: Maybe InstallationMode,
    UseOptions -> String
useNixOSFolder :: FilePath,
    UseOptions -> Maybe String
useOutputDirectory :: Maybe FilePath
  }
  deriving (Int -> UseOptions -> ShowS
[UseOptions] -> ShowS
UseOptions -> String
(Int -> UseOptions -> ShowS)
-> (UseOptions -> String)
-> ([UseOptions] -> ShowS)
-> Show UseOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UseOptions] -> ShowS
$cshowList :: [UseOptions] -> ShowS
show :: UseOptions -> String
$cshow :: UseOptions -> String
showsPrec :: Int -> UseOptions -> ShowS
$cshowsPrec :: Int -> UseOptions -> ShowS
Show)

fromString :: String -> Maybe InstallationMode
fromString :: String -> Maybe InstallationMode
fromString String
"root-nixconf" = InstallationMode -> Maybe InstallationMode
forall a. a -> Maybe a
Just (InstallationMode -> Maybe InstallationMode)
-> InstallationMode -> Maybe InstallationMode
forall a b. (a -> b) -> a -> b
$ NixConfLoc -> InstallationMode
Install NixConfLoc
NixConf.Global
fromString String
"user-nixconf" = InstallationMode -> Maybe InstallationMode
forall a. a -> Maybe a
Just (InstallationMode -> Maybe InstallationMode)
-> InstallationMode -> Maybe InstallationMode
forall a b. (a -> b) -> a -> b
$ NixConfLoc -> InstallationMode
Install NixConfLoc
NixConf.Local
fromString String
"nixos" = InstallationMode -> Maybe InstallationMode
forall a. a -> Maybe a
Just InstallationMode
WriteNixOS
fromString String
"untrusted-requires-sudo" = InstallationMode -> Maybe InstallationMode
forall a. a -> Maybe a
Just InstallationMode
UntrustedRequiresSudo
fromString String
_ = Maybe InstallationMode
forall a. Maybe a
Nothing

toString :: InstallationMode -> String
toString :: InstallationMode -> String
toString (Install NixConfLoc
NixConf.Global) = String
"root-nixconf"
toString (Install NixConfLoc
NixConf.Local) = String
"user-nixconf"
toString (Install (NixConf.Custom String
_)) = String
"custom-nixconf"
toString InstallationMode
WriteNixOS = String
"nixos"
toString InstallationMode
UntrustedRequiresSudo = String
"untrusted-requires-sudo"
toString InstallationMode
UntrustedNixOS = String
"untrusted-nixos"

getInstallationMode :: NixEnv -> UseOptions -> InstallationMode
getInstallationMode :: NixEnv -> UseOptions -> InstallationMode
getInstallationMode NixEnv
nixenv UseOptions
useOptions
  | (NixEnv -> Bool
isRoot NixEnv
nixenv Bool -> Bool -> Bool
|| NixEnv -> Bool
isTrusted NixEnv
nixenv) Bool -> Bool -> Bool
&& Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (UseOptions -> Maybe String
useOutputDirectory UseOptions
useOptions) = NixConfLoc -> InstallationMode
Install (String -> NixConfLoc
NixConf.Custom (String -> NixConfLoc) -> String -> NixConfLoc
forall a b. (a -> b) -> a -> b
$ Maybe String -> String
forall a. HasCallStack => Maybe a -> a
Data.Maybe.fromJust (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ UseOptions -> Maybe String
useOutputDirectory UseOptions
useOptions)
  | Maybe InstallationMode -> Bool
forall a. Maybe a -> Bool
isJust (UseOptions -> Maybe InstallationMode
useMode UseOptions
useOptions) = Maybe InstallationMode -> InstallationMode
forall a. HasCallStack => Maybe a -> a
Data.Maybe.fromJust (Maybe InstallationMode -> InstallationMode)
-> Maybe InstallationMode -> InstallationMode
forall a b. (a -> b) -> a -> b
$ UseOptions -> Maybe InstallationMode
useMode UseOptions
useOptions
  | NixEnv -> Bool
isNixOS NixEnv
nixenv Bool -> Bool -> Bool
&& NixEnv -> Bool
isRoot NixEnv
nixenv = InstallationMode
WriteNixOS
  | Bool -> Bool
not (NixEnv -> Bool
isNixOS NixEnv
nixenv) Bool -> Bool -> Bool
&& NixEnv -> Bool
isRoot NixEnv
nixenv = NixConfLoc -> InstallationMode
Install NixConfLoc
NixConf.Global
  | NixEnv -> Bool
isTrusted NixEnv
nixenv = NixConfLoc -> InstallationMode
Install NixConfLoc
NixConf.Local
  | NixEnv -> Bool
isNixOS NixEnv
nixenv = InstallationMode
UntrustedNixOS
  | Bool
otherwise = InstallationMode
UntrustedRequiresSudo

-- | Add a Binary cache to nix.conf, print nixos config or fail
addBinaryCache :: Maybe Config -> BinaryCache.BinaryCache -> UseOptions -> InstallationMode -> IO ()
addBinaryCache :: Maybe Config
-> BinaryCache -> UseOptions -> InstallationMode -> IO ()
addBinaryCache Maybe Config
_ BinaryCache
_ UseOptions
_ InstallationMode
UntrustedNixOS = do
  Text
user <- IO Text
getUser
  CachixException -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (CachixException -> IO ()) -> CachixException -> IO ()
forall a b. (a -> b) -> a -> b
$
    Text -> CachixException
MustBeRoot
      [i|This user doesn't have permissions to configure binary caches.

You can either:

a) Run the same command as root to write NixOS configuration.

b) Add the following to your configuration.nix to add your user as trusted 
   and then try again:

  nix.trustedUsers = [ "root" "${user}" ];

|]
addBinaryCache Maybe Config
_ BinaryCache
_ UseOptions
_ InstallationMode
UntrustedRequiresSudo = do
  Text
user <- IO Text
getUser
  CachixException -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (CachixException -> IO ()) -> CachixException -> IO ()
forall a b. (a -> b) -> a -> b
$
    Text -> CachixException
MustBeRoot
      [i|This user doesn't have permissions to configure binary caches.

You can either:

a) Run the same command as root to configure them globally.

b) Run the following command to add your user as trusted 
   and then try again:

  echo "trusted-users = root ${user}" | sudo tee -a /etc/nix/nix.conf && sudo pkill nix-daemon
|]
addBinaryCache Maybe Config
maybeConfig BinaryCache
bc UseOptions
useOptions InstallationMode
WriteNixOS =
  Maybe Config -> BinaryCache -> UseOptions -> IO ()
nixosBinaryCache Maybe Config
maybeConfig BinaryCache
bc UseOptions
useOptions
addBinaryCache Maybe Config
maybeConfig BinaryCache
bc UseOptions
_ (Install NixConfLoc
ncl) = do
  -- TODO: might need locking one day
  Maybe NixConf
gnc <- NixConfLoc -> IO (Maybe NixConf)
NixConf.read NixConfLoc
NixConf.Global
  ([Maybe NixConf]
input, Maybe NixConf
output) <-
    case NixConfLoc
ncl of
      NixConfLoc
NixConf.Global -> ([Maybe NixConf], Maybe NixConf)
-> IO ([Maybe NixConf], Maybe NixConf)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe NixConf
gnc], Maybe NixConf
gnc)
      NixConfLoc
NixConf.Local -> do
        Maybe NixConf
lnc <- NixConfLoc -> IO (Maybe NixConf)
NixConf.read NixConfLoc
NixConf.Local
        ([Maybe NixConf], Maybe NixConf)
-> IO ([Maybe NixConf], Maybe NixConf)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe NixConf
gnc, Maybe NixConf
lnc], Maybe NixConf
lnc)
      NixConf.Custom String
_ -> do
        Maybe NixConf
lnc <- NixConfLoc -> IO (Maybe NixConf)
NixConf.read NixConfLoc
ncl
        ([Maybe NixConf], Maybe NixConf)
-> IO ([Maybe NixConf], Maybe NixConf)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe NixConf
lnc], Maybe NixConf
lnc)
  let nixconf :: NixConf
nixconf = NixConf -> Maybe NixConf -> NixConf
forall a. a -> Maybe a -> a
fromMaybe ([NixConfLine] -> NixConf
forall a. a -> NixConfG a
NixConf.NixConf []) Maybe NixConf
output
  Maybe String
netrcLocMaybe <- Maybe () -> (() -> IO String) -> IO (Maybe String)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (BinaryCache -> Bool
BinaryCache.isPublic BinaryCache
bc)) ((() -> IO String) -> IO (Maybe String))
-> (() -> IO String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ IO String -> () -> IO String
forall a b. a -> b -> a
const (IO String -> () -> IO String) -> IO String -> () -> IO String
forall a b. (a -> b) -> a -> b
$ Maybe Config -> BinaryCache -> NixConfLoc -> IO String
addPrivateBinaryCacheNetRC Maybe Config
maybeConfig BinaryCache
bc NixConfLoc
ncl
  let addNetRCLine :: NixConf.NixConf -> NixConf.NixConf
      addNetRCLine :: NixConf -> NixConf
addNetRCLine = (NixConf -> NixConf)
-> Maybe (NixConf -> NixConf) -> NixConf -> NixConf
forall a. a -> Maybe a -> a
fromMaybe NixConf -> NixConf
forall a. a -> a
identity (Maybe (NixConf -> NixConf) -> NixConf -> NixConf)
-> Maybe (NixConf -> NixConf) -> NixConf -> NixConf
forall a b. (a -> b) -> a -> b
$ do
        String
netrcLoc <- Maybe String
netrcLocMaybe :: Maybe FilePath
        -- We only add the netrc line for local user configs for now.
        -- On NixOS we assume it will be picked up from the default location.
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (NixConfLoc
ncl NixConfLoc -> NixConfLoc -> Bool
forall a. Eq a => a -> a -> Bool
== NixConfLoc
NixConf.Local)
        (NixConf -> NixConf) -> Maybe (NixConf -> NixConf)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> NixConf -> NixConf
NixConf.setNetRC (Text -> NixConf -> NixConf) -> Text -> NixConf -> NixConf
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertText a b => a -> b
toS String
netrcLoc)
  NixConfLoc -> NixConf -> IO ()
NixConf.write NixConfLoc
ncl (NixConf -> IO ()) -> NixConf -> IO ()
forall a b. (a -> b) -> a -> b
$ NixConf -> NixConf
addNetRCLine (NixConf -> NixConf) -> NixConf -> NixConf
forall a b. (a -> b) -> a -> b
$ BinaryCache -> [NixConf] -> NixConf -> NixConf
NixConf.add BinaryCache
bc ([Maybe NixConf] -> [NixConf]
forall a. [Maybe a] -> [a]
catMaybes [Maybe NixConf]
input) NixConf
nixconf
  String
filename <- NixConfLoc -> IO String
NixConf.getFilename NixConfLoc
ncl
  Text -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Configured " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BinaryCache -> Text
BinaryCache.uri BinaryCache
bc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" binary cache in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertText a b => a -> b
toS String
filename

nixosBinaryCache :: Maybe Config -> BinaryCache.BinaryCache -> UseOptions -> IO ()
nixosBinaryCache :: Maybe Config -> BinaryCache -> UseOptions -> IO ()
nixosBinaryCache Maybe Config
maybeConfig BinaryCache
bc UseOptions {useNixOSFolder :: UseOptions -> String
useNixOSFolder = String
baseDirectory} = do
  Either SomeException ()
_ <- IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a b. ConvertText a b => a -> b
toS Text
toplevel :: IO (Either SomeException ())
  Either SomeException Permissions
eitherPermissions <- IO Permissions -> IO (Either SomeException Permissions)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO Permissions -> IO (Either SomeException Permissions))
-> IO Permissions -> IO (Either SomeException Permissions)
forall a b. (a -> b) -> a -> b
$ String -> IO Permissions
getPermissions (Text -> String
forall a b. ConvertText a b => a -> b
toS Text
toplevel) :: IO (Either SomeException Permissions)
  case Either SomeException Permissions
eitherPermissions of
    Left SomeException
_ -> CachixException -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (CachixException -> IO ()) -> CachixException -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> CachixException
NixOSInstructions (Text -> CachixException) -> Text -> CachixException
forall a b. (a -> b) -> a -> b
$ Text -> Text
noEtcPermissionInstructions (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertText a b => a -> b
toS String
baseDirectory
    Right Permissions
permissions
      | Permissions -> Bool
writable Permissions
permissions -> IO ()
installFiles
      | Bool
otherwise -> CachixException -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (CachixException -> IO ()) -> CachixException -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> CachixException
NixOSInstructions (Text -> CachixException) -> Text -> CachixException
forall a b. (a -> b) -> a -> b
$ Text -> Text
noEtcPermissionInstructions (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertText a b => a -> b
toS String
baseDirectory
  where
    installFiles :: IO ()
installFiles = do
      String -> Text -> IO ()
writeFile (Text -> String
forall a b. ConvertText a b => a -> b
toS Text
glueModuleFile) Text
glueModule
      String -> Text -> IO ()
writeFile (Text -> String
forall a b. ConvertText a b => a -> b
toS Text
cacheModuleFile) Text
cacheModule
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (BinaryCache -> Bool
BinaryCache.isPublic BinaryCache
bc) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO String -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO String -> IO ()) -> IO String -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Config -> BinaryCache -> NixConfLoc -> IO String
addPrivateBinaryCacheNetRC Maybe Config
maybeConfig BinaryCache
bc NixConfLoc
NixConf.Global
      Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putText Text
instructions
    configurationNix :: Text
    configurationNix :: Text
configurationNix = String -> Text
forall a b. ConvertText a b => a -> b
toS (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
forall a b. ConvertText a b => a -> b
toS String
baseDirectory String -> ShowS
</> String
"configuration.nix"
    namespace :: Text
    namespace :: Text
namespace = Text
"cachix"
    toplevel :: Text
    toplevel :: Text
toplevel = String -> Text
forall a b. ConvertText a b => a -> b
toS (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
forall a b. ConvertText a b => a -> b
toS String
baseDirectory String -> ShowS
</> Text -> String
forall a b. ConvertText a b => a -> b
toS Text
namespace
    glueModuleFile :: Text
    glueModuleFile :: Text
glueModuleFile = Text
toplevel Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".nix"
    cacheModuleFile :: Text
    cacheModuleFile :: Text
cacheModuleFile = Text
toplevel Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a b. ConvertText a b => a -> b
toS (BinaryCache -> Text
BinaryCache.name BinaryCache
bc) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".nix"
    noEtcPermissionInstructions :: Text -> Text
    noEtcPermissionInstructions :: Text -> Text
noEtcPermissionInstructions Text
dir =
      [iTrim|
Could not install NixOS configuration to ${dir} due to lack of write permissions.

Pass `--nixos-folder /etc/mynixos/` as an alternative location with write permissions.
|]
    instructions :: Text
    instructions :: Text
instructions =
      [iTrim|
Cachix configuration written to ${glueModuleFile}.
Binary cache ${BinaryCache.name bc} configuration written to ${cacheModuleFile}.

To start using cachix add the following to your ${configurationNix}:

    imports = [ ./cachix.nix ];

Then run:

    $ sudo nixos-rebuild switch
|]
    glueModule :: Text
    glueModule :: Text
glueModule =
      [i|
# WARN: this file will get overwritten by $ cachix use <name>
{ pkgs, lib, ... }:

let
  folder = ./cachix;
  toImport = name: value: folder + ("/" + name);
  filterCaches = key: value: value == "regular" && lib.hasSuffix ".nix" key;
  imports = lib.mapAttrsToList toImport (lib.filterAttrs filterCaches (builtins.readDir folder));
in {
  inherit imports;
  nix.binaryCaches = ["https://cache.nixos.org/"];
}
|]
    cacheModule :: Text
    cacheModule :: Text
cacheModule =
      [i|
{
  nix = {
    binaryCaches = [
      "${BinaryCache.uri bc}"
    ];
    binaryCachePublicKeys = [
      ${T.intercalate " " (map (\s -> "\"" <> s <> "\"") (BinaryCache.publicSigningKeys bc))}
    ];
  };
}
|]

-- TODO: allow overriding netrc location
addPrivateBinaryCacheNetRC :: Maybe Config -> BinaryCache.BinaryCache -> NixConf.NixConfLoc -> IO FilePath
addPrivateBinaryCacheNetRC :: Maybe Config -> BinaryCache -> NixConfLoc -> IO String
addPrivateBinaryCacheNetRC Maybe Config
maybeConfig BinaryCache
bc NixConfLoc
nixconf = do
  String
filename <- (String -> ShowS
`replaceFileName` String
"netrc") ShowS -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NixConfLoc -> IO String
NixConf.getFilename NixConfLoc
nixconf
  Token
authToken <- Maybe Config -> IO Token
Config.getAuthTokenRequired Maybe Config
maybeConfig
  let netrcfile :: String
netrcfile = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
filename Maybe String
forall a. Maybe a
Nothing -- TODO: get netrc from nixconf
  Token -> [BinaryCache] -> String -> IO ()
NetRc.add Token
authToken [BinaryCache
bc] String
netrcfile
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Configured private read access credentials in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertText a b => a -> b
toS String
filename
  String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
filename

isTrustedUser :: [Text] -> IO Bool
isTrustedUser :: [Text] -> IO Bool
isTrustedUser [Text]
users = do
  Text
user <- IO Text
getUser
  -- to detect single user installations
  Permissions
permissions <- String -> IO Permissions
getPermissions String
"/nix/store"
  Bool
isInAGroup <- Text -> IO Bool
userInAnyGroup Text
user
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Permissions -> Bool
writable Permissions
permissions Bool -> Bool -> Bool
|| Text
user Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
users Bool -> Bool -> Bool
|| Bool
isInAGroup
  where
    groups :: [Text]
    groups :: [Text]
groups = (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Text
T.tail ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Text
u -> ((Char, Text) -> Char
forall a b. (a, b) -> a
fst ((Char, Text) -> Char) -> Maybe (Char, Text) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Char, Text)
T.uncons Text
u) Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'@') [Text]
users
    userInAnyGroup :: Text -> IO Bool
    userInAnyGroup :: Text -> IO Bool
userInAnyGroup Text
user = do
      [Bool]
isIn <- [Text] -> (Text -> IO Bool) -> IO [Bool]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Text]
groups ((Text -> IO Bool) -> IO [Bool]) -> (Text -> IO Bool) -> IO [Bool]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO Bool
checkUserInGroup Text
user
      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Bool -> Bool
forall a. a -> a
identity [Bool]
isIn
    checkUserInGroup :: Text -> Text -> IO Bool
    checkUserInGroup :: Text -> Text -> IO Bool
checkUserInGroup Text
user Text
groupName = do
      (ExitCode
_exitcode, String
out, String
_err) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
"id" [String
"-Gn", Text -> String
forall a b. ConvertText a b => a -> b
toS Text
user] String
forall a. Monoid a => a
mempty
      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Text
groupName Text -> Text -> Bool
`T.isInfixOf` String -> Text
forall a b. ConvertText a b => a -> b
toS String
out

getUser :: IO Text
getUser :: IO Text
getUser = do
  Maybe String
maybeUser <- String -> IO (Maybe String)
lookupEnv String
"USER"
  case Maybe String
maybeUser of
    Maybe String
Nothing -> CachixException -> IO Text
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (CachixException -> IO Text) -> CachixException -> IO Text
forall a b. (a -> b) -> a -> b
$ Text -> CachixException
UserEnvNotSet Text
"$USER must be set"
    Just String
user -> Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertText a b => a -> b
toS String
user