{-# LANGUAGE QuasiQuotes #-}

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

import qualified Cachix.Api as Api
import Cachix.Client.Config (Config)
import Cachix.Client.Exception (CachixException (..))
import qualified Cachix.Client.NetRc as NetRc
import qualified Cachix.Client.NixConf as NixConf
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 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
      }
  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 "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 "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 "nixos" = InstallationMode -> Maybe InstallationMode
forall a. a -> Maybe a
Just InstallationMode
WriteNixOS
fromString "untrusted-requires-sudo" = InstallationMode -> Maybe InstallationMode
forall a. a -> Maybe a
Just InstallationMode
UntrustedRequiresSudo
fromString _ = Maybe InstallationMode
forall a. Maybe a
Nothing

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

getInstallationMode :: NixEnv -> InstallationMode
getInstallationMode :: NixEnv -> InstallationMode
getInstallationMode nixenv :: NixEnv
nixenv
  | 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 -> Api.BinaryCache -> UseOptions -> InstallationMode -> IO ()
addBinaryCache :: Maybe Config
-> BinaryCache -> UseOptions -> InstallationMode -> IO ()
addBinaryCache _ _ _ 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:

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

    |]
addBinaryCache _ _ _ 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 maybeConfig :: Maybe Config
maybeConfig bc :: BinaryCache
bc useOptions :: UseOptions
useOptions WriteNixOS =
  Maybe Config -> BinaryCache -> UseOptions -> IO ()
nixosBinaryCache Maybe Config
maybeConfig BinaryCache
bc UseOptions
useOptions
addBinaryCache maybeConfig :: Maybe Config
maybeConfig bc :: BinaryCache
bc _ (Install ncl :: NixConfLoc
ncl) = do
  -- TODO: might need locking one day
  Maybe NixConf
gnc <- NixConfLoc -> IO (Maybe NixConf)
NixConf.read NixConfLoc
NixConf.Global
  (input :: [Maybe NixConf]
input, output :: Maybe NixConf
output) <-
    case NixConfLoc
ncl of
      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)
      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)
  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
Api.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. StringConv 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
$ "Configured " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BinaryCache -> Text
Api.uri BinaryCache
bc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " binary cache in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. StringConv a b => a -> b
toS String
filename

nixosBinaryCache :: Maybe Config -> Api.BinaryCache -> UseOptions -> IO ()
nixosBinaryCache :: Maybe Config -> BinaryCache -> UseOptions -> IO ()
nixosBinaryCache maybeConfig :: Maybe Config
maybeConfig bc :: 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. StringConv 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. StringConv a b => a -> b
toS Text
toplevel) :: IO (Either SomeException Permissions)
  case Either SomeException Permissions
eitherPermissions of
    Left _ -> 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. StringConv a b => a -> b
toS String
baseDirectory
    Right permissions :: 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. StringConv a b => a -> b
toS String
baseDirectory
  where
    installFiles :: IO ()
installFiles = do
      String -> Text -> IO ()
writeFile (Text -> String
forall a b. StringConv a b => a -> b
toS Text
glueModuleFile) Text
glueModule
      String -> Text -> IO ()
writeFile (Text -> String
forall a b. StringConv a b => a -> b
toS Text
cacheModuleFile) Text
cacheModule
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (BinaryCache -> Bool
Api.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. StringConv a b => a -> b
toS (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
forall a b. StringConv a b => a -> b
toS String
baseDirectory String -> ShowS
</> "configuration.nix"
    namespace :: Text
    namespace :: Text
namespace = "cachix"
    toplevel :: Text
    toplevel :: Text
toplevel = String -> Text
forall a b. StringConv a b => a -> b
toS (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
forall a b. StringConv a b => a -> b
toS String
baseDirectory String -> ShowS
</> Text -> String
forall a b. StringConv a b => a -> b
toS Text
namespace
    glueModuleFile :: Text
    glueModuleFile :: Text
glueModuleFile = Text
toplevel Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ".nix"
    cacheModuleFile :: Text
    cacheModuleFile :: Text
cacheModuleFile = Text
toplevel Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a b. StringConv a b => a -> b
toS (BinaryCache -> Text
Api.name BinaryCache
bc) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ".nix"
    noEtcPermissionInstructions :: Text -> Text
    noEtcPermissionInstructions :: Text -> Text
noEtcPermissionInstructions dir :: 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 ${Api.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 = [
      "${Api.uri bc}"
    ];
    binaryCachePublicKeys = [
      ${T.intercalate " " (map (\s -> "\"" <> s <> "\"") (Api.publicSigningKeys bc))}
    ];
  };
}
    |]

-- TODO: allow overriding netrc location
addPrivateBinaryCacheNetRC :: Maybe Config -> Api.BinaryCache -> NixConf.NixConfLoc -> IO FilePath
addPrivateBinaryCacheNetRC :: Maybe Config -> BinaryCache -> NixConfLoc -> IO String
addPrivateBinaryCacheNetRC maybeConfig :: Maybe Config
maybeConfig bc :: BinaryCache
bc nixconf :: NixConfLoc
nixconf = do
  String
filename <- (String -> ShowS
`replaceFileName` "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
  case Maybe Config
maybeConfig of
    Nothing -> Text -> IO String
forall a. HasCallStack => Text -> a
panic "Run $ cachix authtoken <token>"
    Just config :: Config
config -> do
      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
      Config -> [BinaryCache] -> String -> IO ()
NetRc.add Config
config [BinaryCache
bc] String
netrcfile
      Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Configured private read access credentials in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. StringConv 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 users :: [Text]
users = do
  Text
user <- IO Text
getUser
  -- to detect single user installations
  Permissions
permissions <- String -> IO Permissions
getPermissions "/nix/store"
  let isTrustedU :: Bool
isTrustedU = 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 -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
groups) Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isTrustedU) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    -- TODO: support Nix group syntax
    Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putText "Warn: cachix doesn't yet support checking if user is trusted via groups, so it will recommend sudo"
    Text -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Warn: groups found " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate "," [Text]
groups
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
isTrustedU
  where
    groups :: [Text]
groups = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (\u :: Text
u -> Text -> Char
T.head Text
u Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '@') [Text]
users

getUser :: IO Text
getUser :: IO Text
getUser = do
  Maybe String
maybeUser <- String -> IO (Maybe String)
lookupEnv "USER"
  case Maybe String
maybeUser of
    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 "$USER must be set"
    Just user :: 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. StringConv a b => a -> b
toS String
user