diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,12 @@ ## Unreleased +# [1.0.1] - 2022-09-24 + +### Added + +- `cachix config`: allow setting hostname + # [1.0.0] - 2022-09-06 - Cachix Deploy: auto rollback if the agent can't connect to the backend service anymore diff --git a/cachix.cabal b/cachix.cabal --- a/cachix.cabal +++ b/cachix.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: cachix -version: 1.0.0 +version: 1.0.1 license: Apache-2.0 license-file: LICENSE copyright: 2018 Domen Kozar @@ -25,6 +25,7 @@ DeriveAnyClass DeriveGeneric DerivingVia + NamedFieldPuns OverloadedStrings ghc-options: @@ -92,6 +93,7 @@ , dhall >=1.28.0 , directory , ed25519 + , either , extra , filepath , fsnotify @@ -111,6 +113,7 @@ , netrc , optparse-applicative , pretty-terminal + , prettyprinter , process , protolude , resourcet @@ -137,7 +140,10 @@ , websockets , wuss - pkgconfig-depends: nix-store ==2.0 || >2.0, nix-main ==2.0 || >2.0 + -- These versions should match those supported by hercules-ci-cnix-store + pkgconfig-depends: + nix-main (==2.4 || >2.4) && <2.11, + nix-store (==2.4 || >2.4) && <2.11 executable cachix import: defaults diff --git a/src/Cachix/Client.hs b/src/Cachix/Client.hs --- a/src/Cachix/Client.hs +++ b/src/Cachix/Client.hs @@ -4,7 +4,8 @@ where import Cachix.Client.Commands as Commands -import Cachix.Client.Env (mkEnv) +import qualified Cachix.Client.Config as Config +import Cachix.Client.Env (cachixoptions, mkEnv) import Cachix.Client.OptionsParser (CachixCommand (..), getOpts) import Cachix.Client.Version (cachixVersion) import Cachix.Deploy.ActivateCommand as ActivateCommand @@ -14,10 +15,12 @@ main :: IO () main = do - (cachixoptions, command) <- getOpts - env <- mkEnv cachixoptions + (flags, command) <- getOpts + env <- mkEnv flags + let cachixOptions = cachixoptions env case command of AuthToken token -> Commands.authtoken env token + Config configCommand -> Config.run cachixOptions configCommand GenerateKeypair name -> Commands.generateKeypair env name Push pushArgs -> Commands.push env pushArgs WatchStore watchArgs name -> Commands.watchStore env watchArgs name @@ -26,5 +29,5 @@ Version -> putText cachixVersion DeployCommand deployCommand -> case deployCommand of - DeployOptions.Agent opts -> AgentCommand.run cachixoptions opts - DeployOptions.Activate opts -> ActivateCommand.run cachixoptions opts + DeployOptions.Agent opts -> AgentCommand.run cachixOptions opts + DeployOptions.Activate opts -> ActivateCommand.run cachixOptions opts diff --git a/src/Cachix/Client/Commands.hs b/src/Cachix/Client/Commands.hs --- a/src/Cachix/Client/Commands.hs +++ b/src/Cachix/Client/Commands.hs @@ -16,12 +16,6 @@ import qualified Cachix.API as API import Cachix.API.Error import Cachix.Client.CNix (filterInvalidStorePath) -import Cachix.Client.Config - ( BinaryCacheConfig (BinaryCacheConfig), - Config (..), - mkConfig, - writeConfig, - ) import qualified Cachix.Client.Config as Config import Cachix.Client.Env (Env (..)) import Cachix.Client.Exception (CachixException (..)) @@ -30,8 +24,7 @@ import qualified Cachix.Client.NixConf as NixConf import Cachix.Client.NixVersion (assertNixVersion) import Cachix.Client.OptionsParser - ( CachixOptions (..), - PushArguments (..), + ( PushArguments (..), PushOptions (..), ) import Cachix.Client.Push @@ -51,7 +44,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as T.IO import GHC.IO.Handle (hDuplicate, hDuplicateTo) -import Hercules.CNix.Store (Store, StorePath, followLinksToStorePath, isValidPath, storePathToPath) +import Hercules.CNix.Store (Store, StorePath, followLinksToStorePath, storePathToPath) import Network.HTTP.Types (status401, status404) import Protolude hiding (toS) import Protolude.Conv @@ -64,33 +57,30 @@ import qualified System.Posix.Signals as Signals import qualified System.Process +-- TODO: check that token actually authenticates! authtoken :: Env -> Maybe Text -> IO () -authtoken env (Just token) = do - -- TODO: check that token actually authenticates! - writeConfig (configPath (cachixoptions env)) $ case config env of - Just cfg -> Config.setAuthToken cfg $ Token (toS token) - Nothing -> mkConfig token +authtoken Env {cachixoptions} (Just token) = do + let configPath = Config.configPath cachixoptions + config <- Config.getConfig configPath + Config.writeConfig configPath $ config {Config.authToken = Token (toS token)} authtoken env Nothing = authtoken env . Just . T.strip =<< T.IO.getContents generateKeypair :: Env -> Text -> IO () generateKeypair env name = do - cachixAuthToken <- Config.getAuthTokenRequired (config env) + authToken <- Config.getAuthTokenRequired (config env) (PublicKey pk, sk) <- createKeypair let signingKey = exportSigningKey $ SigningKey sk signingKeyCreate = SigningKeyCreate.SigningKeyCreate (toS $ B64.encode pk) - bcc = BinaryCacheConfig name signingKey + bcc = Config.BinaryCacheConfig name signingKey -- we first validate if key can be added to the binary cache (_ :: NoContent) <- escalate <=< retryAll $ \_ -> (`runClientM` clientenv env) $ - API.createKey cachixClient cachixAuthToken name signingKeyCreate + API.createKey cachixClient authToken name signingKeyCreate -- if key was successfully added, write it to the config -- TODO: warn if binary cache with the same key already exists - let cfg = case config env of - Just it -> it - Nothing -> Config.mkConfig $ toS $ getToken cachixAuthToken - writeConfig (configPath (cachixoptions env)) $ - cfg {binaryCaches = binaryCaches cfg <> [bcc]} + let cfg = config env & Config.setBinaryCaches [bcc] + Config.writeConfig (Config.configPath (cachixoptions env)) cfg putStrLn ( [iTrim| Secret signing key has been saved in the file above. To populate @@ -123,12 +113,14 @@ use :: Env -> Text -> InstallationMode.UseOptions -> IO () use env name useOptions = do - cachixAuthToken <- Config.getAuthTokenOptional (config env) + optionalAuthToken <- Config.getAuthTokenMaybe (config env) + let token = fromMaybe (Token "") optionalAuthToken -- 1. get cache public key - res <- retryAll $ \_ -> (`runClientM` clientenv env) $ API.getCache cachixClient cachixAuthToken name + res <- retryAll $ \_ -> (`runClientM` clientenv env) $ API.getCache cachixClient token name case res of Left err - | isErr err status401 && isJust (config env) -> throwM $ accessDeniedBinaryCache name + -- TODO: is checking for the existence of the config file the right thing to do here? + | isErr err status401 && isJust optionalAuthToken -> throwM $ accessDeniedBinaryCache name | isErr err status401 -> throwM $ notAuthenticatedBinaryCache name | isErr err status404 -> throwM $ BinaryCacheNotFound $ "Binary cache" <> name <> " does not exist." | otherwise -> throwM err @@ -209,14 +201,14 @@ then "" else "(retry #" <> show (rsIterNumber retrystatus) <> ") " -pushStrategy :: Store -> Env -> PushOptions -> Text -> StorePath -> PushStrategy IO () -pushStrategy store env opts name storePath = +pushStrategy :: Store -> Maybe Token -> PushOptions -> Text -> StorePath -> PushStrategy IO () +pushStrategy store authToken opts name storePath = PushStrategy { onAlreadyPresent = pass, on401 = - if isJust (config env) - then throwM $ accessDeniedBinaryCache name - else throwM $ notAuthenticatedBinaryCache name, + if isJust authToken + then throwM (accessDeniedBinaryCache name) + else throwM (notAuthenticatedBinaryCache name), onError = throwM, onAttempt = \retrystatus size -> do path <- decodeUtf8With lenientDecode <$> storePathToPath store storePath @@ -231,11 +223,12 @@ getPushParams env pushOpts name = do pushSecret <- findPushSecret (config env) name store <- wait (storeAsync env) + authToken <- Config.getAuthTokenMaybe (config env) return $ PushParams { pushParamsName = name, pushParamsSecret = pushSecret, pushParamsClientEnv = clientenv env, - pushParamsStrategy = pushStrategy store env pushOpts name, + pushParamsStrategy = pushStrategy store authToken pushOpts name, pushParamsStore = store } diff --git a/src/Cachix/Client/Config.hs b/src/Cachix/Client/Config.hs --- a/src/Cachix/Client/Config.hs +++ b/src/Cachix/Client/Config.hs @@ -1,34 +1,46 @@ -{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE QuasiQuotes #-} module Cachix.Client.Config - ( Config (binaryCaches), + ( -- CLI options + run, + parser, + Command (..), + CachixOptions (..), + -- Auth token helpers getAuthTokenRequired, - getAuthTokenOptional, getAuthTokenMaybe, setAuthToken, noAuthTokenError, - BinaryCacheConfig (..), + -- Config + getConfig, readConfig, writeConfig, getDefaultFilename, ConfigPath, - mkConfig, + Config (..), + BinaryCacheConfig (..), + setBinaryCaches, ) where import Cachix.Client.Config.Orphans () import Cachix.Client.Exception (CachixException (..)) +import Cachix.Client.URI as URI +import qualified Control.Exception.Safe as Safe +import Data.Either.Extra (eitherToMaybe) import Data.String.Here -import Dhall hiding (Text) -import Dhall.Pretty (prettyExpr) +import qualified Dhall +import qualified Dhall.Pretty +import qualified Options.Applicative as Opt +import qualified Prettyprinter as Pretty +import qualified Prettyprinter.Render.Text as Pretty import Protolude hiding (toS) import Protolude.Conv import Servant.Auth.Client import System.Directory ( XdgDirectory (..), createDirectoryIfMissing, - doesFileExist, getXdgDirectory, ) import System.Environment (lookupEnv) @@ -39,43 +51,68 @@ setFileMode, unionFileModes, ) +import qualified URI.ByteString as URI -data BinaryCacheConfig = BinaryCacheConfig - { name :: Text, - secretKey :: Text +data CachixOptions = CachixOptions + { host :: URI.URIRef URI.Absolute, + configPath :: ConfigPath, + verbose :: Bool } - deriving (Show, Generic, Interpret, Inject) + deriving (Show) data Config = Config { authToken :: Token, + hostname :: URI.URIRef URI.Absolute, binaryCaches :: [BinaryCacheConfig] } - deriving (Show, Generic, Interpret, Inject) + deriving (Show, Generic, Dhall.ToDhall, Dhall.FromDhall) -mkConfig :: Text -> Config -mkConfig token = +data BinaryCacheConfig = BinaryCacheConfig + { name :: Text, + secretKey :: Text + } + deriving (Show, Generic, Dhall.FromDhall, Dhall.ToDhall) + +defaultConfig :: Config +defaultConfig = Config - { authToken = Token (toS token), + { authToken = Token "", + hostname = URI.defaultCachixURI, binaryCaches = [] } +mergeWithDefault :: Text -> Text +mergeWithDefault config = + serializeConfig defaultConfig <> " // " <> config + type ConfigPath = FilePath +getConfig :: ConfigPath -> IO Config +getConfig filename = do + userConfig <- readConfig filename + pure $ fromMaybe defaultConfig userConfig + readConfig :: ConfigPath -> IO (Maybe Config) -readConfig filename = do - doesExist <- doesFileExist filename - if doesExist - then Just <$> inputFile auto filename - else return Nothing +readConfig filename = fmap eitherToMaybe . Safe.tryIO $ do + userConfig <- readFile filename + let config = mergeWithDefault userConfig + Dhall.detailed (Dhall.input Dhall.auto config) getDefaultFilename :: IO FilePath getDefaultFilename = do dir <- getXdgDirectory XdgConfig "cachix" return $ dir <> "/cachix.dhall" +serializeConfig :: Config -> Text +serializeConfig = + Pretty.renderStrict + . Pretty.layoutPretty Pretty.defaultLayoutOptions + . Dhall.Pretty.prettyExpr + . Dhall.embed Dhall.inject + writeConfig :: ConfigPath -> Config -> IO () writeConfig filename config = do - let doc = prettyExpr $ embed inject config + let doc = Dhall.Pretty.prettyExpr $ Dhall.embed Dhall.inject config createDirectoryIfMissing True (takeDirectory filename) writeFile filename $ show doc assureFilePermissions filename @@ -86,27 +123,26 @@ assureFilePermissions fp = setFileMode fp $ unionFileModes ownerReadMode ownerWriteMode -getAuthTokenRequired :: Maybe Config -> IO Token -getAuthTokenRequired maybeConfig = do - authTokenMaybe <- getAuthTokenMaybe maybeConfig +getAuthTokenFromConfig :: Config -> Maybe Token +getAuthTokenFromConfig = inspectToken . authToken + where + inspectToken (Token "") = Nothing + inspectToken token = Just token + +getAuthTokenRequired :: Config -> IO Token +getAuthTokenRequired config = do + authTokenMaybe <- getAuthTokenMaybe config case authTokenMaybe of Just authtoken -> return authtoken Nothing -> throwIO $ NoConfig $ toS noAuthTokenError --- TODO: https://github.com/haskell-servant/servant-auth/issues/173 -getAuthTokenOptional :: Maybe Config -> IO Token -getAuthTokenOptional maybeConfig = do - authTokenMaybe <- getAuthTokenMaybe maybeConfig - return $ Protolude.maybe (Token "") identity authTokenMaybe - -- get auth token from env variable or fallback to config -getAuthTokenMaybe :: Maybe Config -> IO (Maybe Token) -getAuthTokenMaybe maybeConfig = do +getAuthTokenMaybe :: Config -> IO (Maybe Token) +getAuthTokenMaybe config = do maybeAuthToken <- lookupEnv "CACHIX_AUTH_TOKEN" - case (maybeAuthToken, maybeConfig) of - (Just token, _) -> return $ Just $ Token $ toS token - (Nothing, Just cfg) -> return $ Just $ authToken cfg - (_, _) -> return Nothing + case maybeAuthToken of + Just token -> return $ Just $ Token (toS token) + Nothing -> return $ getAuthTokenFromConfig config noAuthTokenError :: Text noAuthTokenError = @@ -124,5 +160,81 @@ $ cachix authtoken |] -setAuthToken :: Config -> Token -> Config -setAuthToken cfg token = cfg {authToken = token} +-- Setters + +setAuthToken :: Token -> Config -> Config +setAuthToken token config = config {authToken = token} + +setBinaryCaches :: [BinaryCacheConfig] -> Config -> Config +setBinaryCaches caches config = config {binaryCaches = binaryCaches config <> caches} + +-- CLI parsers + +data Command + = Get GetCommand + | Set SetCommand + deriving (Show) + +data GetCommand + = GetHostname + deriving (Show) + +data SetCommand + = SetHostname (URI.URIRef URI.Absolute) + deriving (Show) + +run :: CachixOptions -> Command -> IO () +run CachixOptions {configPath} (Get cmd) = getConfigOption configPath cmd +run CachixOptions {configPath} (Set cmd) = setConfigOption configPath cmd + +getConfigOption :: ConfigPath -> GetCommand -> IO () +getConfigOption configPath cmd = do + config <- getConfig configPath + case cmd of + GetHostname -> putStrLn $ URI.serializeURIRef' (hostname config) + +setConfigOption :: ConfigPath -> SetCommand -> IO () +setConfigOption configPath (SetHostname hostname) = do + config <- getConfig configPath + writeConfig configPath config {hostname} + +parser :: Opt.ParserInfo Command +parser = + Opt.info (Opt.helper <*> commandParser) $ + Opt.progDesc "Manage configuration settings for cachix" + +commandParser :: Opt.Parser Command +commandParser = + Opt.subparser $ + mconcat + [ Opt.command "get" $ + Opt.info (Opt.helper <*> getConfigOptionParser) $ + Opt.progDesc "Get a configuration option", + Opt.command "set" $ + Opt.info (Opt.helper <*> setConfigOptionParser) $ + Opt.progDesc "Set a configuration option" + ] + +getConfigOptionParser :: Opt.Parser Command +getConfigOptionParser = + Opt.subparser $ Opt.metavar "KEY" <> mconcat (supportedOptions False) + +setConfigOptionParser :: Opt.Parser Command +setConfigOptionParser = + Opt.subparser $ Opt.metavar "KEY VALUE" <> mconcat (supportedOptions True) + +supportedOptions :: Bool -> [Opt.Mod Opt.CommandFields Command] +supportedOptions canModify = + [ Opt.command "hostname" $ + Opt.info (Opt.helper <*> if canModify then fmap Set hostnameParser else pure (Get GetHostname)) $ + Opt.progDesc "The hostname for the Cachix Deploy service." + ] + +hostnameParser :: Opt.Parser SetCommand +hostnameParser = do + SetHostname + <$> Opt.argument uriOption (Opt.metavar "HOSTNAME") + +uriOption :: Opt.ReadM (URI.URIRef URI.Absolute) +uriOption = Opt.eitherReader $ \s -> + first show $ URI.parseURI URI.strictURIParserOptions (toS s) diff --git a/src/Cachix/Client/Config/Orphans.hs b/src/Cachix/Client/Config/Orphans.hs --- a/src/Cachix/Client/Config/Orphans.hs +++ b/src/Cachix/Client/Config/Orphans.hs @@ -1,24 +1,53 @@ {-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE FlexibleInstances #-} module Cachix.Client.Config.Orphans ( ) where -import Dhall hiding (Text) -import Dhall.Core (Chunks (..), Expr (..)) +import qualified Dhall +import qualified Dhall.Core import Protolude hiding (toS) import Protolude.Conv import Servant.Auth.Client +import qualified URI.ByteString as URI +import Data.Either.Validation ( Validation(Failure, Success) ) -instance FromDhall Token where - autoWith _ = strictText {extract = ex} +instance Dhall.FromDhall Token where + autoWith _ = Dhall.strictText {Dhall.extract = ex} where - ex (TextLit (Chunks [] t)) = pure (Token (toS t)) + ex (Dhall.Core.TextLit (Dhall.Core.Chunks [] t)) = pure (Token (toS t)) ex _ = panic "Unexpected Dhall value. Did it typecheck?" -instance ToDhall Token where - injectWith _ = Encoder - { embed = TextLit . Chunks [] . toS . getToken, - declared = Text +instance Dhall.ToDhall Token where + injectWith _ = Dhall.Encoder + { Dhall.embed = Dhall.Core.TextLit . Dhall.Core.Chunks [] . toS . getToken, + Dhall.declared = Dhall.Core.Text } + +instance Dhall.FromDhall (URI.URIRef URI.Absolute) where + autoWith opts = + Dhall.Decoder extract expected + where + textDecoder :: Dhall.Decoder Text + textDecoder = Dhall.autoWith opts + + extract expression = + case Dhall.extract textDecoder expression of + Success x -> case URI.parseURI URI.strictURIParserOptions (toS x) of + Left exception -> Dhall.extractError (show exception) + Right path -> Success path + Failure e -> Failure e + + expected = Dhall.expected textDecoder + +instance Dhall.ToDhall (URI.URIRef URI.Absolute) where + injectWith opts = Dhall.Encoder embed declared + where + textEncoder :: Dhall.Encoder Text + textEncoder = Dhall.injectWith opts + + embed uri = Dhall.embed textEncoder $ toS (URI.serializeURIRef' uri) + + declared = Dhall.Core.Text diff --git a/src/Cachix/Client/Env.hs b/src/Cachix/Client/Env.hs --- a/src/Cachix/Client/Env.hs +++ b/src/Cachix/Client/Env.hs @@ -6,8 +6,9 @@ ) where -import Cachix.Client.Config (Config, readConfig) -import Cachix.Client.OptionsParser (CachixOptions (..)) +import Cachix.Client.Config (Config) +import qualified Cachix.Client.Config as Config +import qualified Cachix.Client.OptionsParser as Options import Cachix.Client.URI (getBaseUrl) import Cachix.Client.Version (cachixVersion) import Hercules.CNix.Store (Store, openStore) @@ -25,25 +26,30 @@ import System.Directory (canonicalizePath) data Env = Env - { config :: Maybe Config, + { cachixoptions :: Config.CachixOptions, clientenv :: ClientEnv, - cachixoptions :: CachixOptions, + config :: Config, storeAsync :: Async Store } -mkEnv :: CachixOptions -> IO Env -mkEnv rawcachixoptions = do +mkEnv :: Options.Flags -> IO Env +mkEnv flags = do store <- async openStore -- make sure path to the config is passed as absolute to dhall logic - canonicalConfigPath <- canonicalizePath (configPath rawcachixoptions) - let cachixOptions = rawcachixoptions {configPath = canonicalConfigPath} - cfg <- readConfig $ configPath cachixOptions + canonicalConfigPath <- canonicalizePath (Options.configPath flags) + cfg <- Config.getConfig canonicalConfigPath + let cachixOptions = + Config.CachixOptions + { Config.configPath = canonicalConfigPath, + Config.host = fromMaybe (Config.hostname cfg) (Options.hostname flags), + Config.verbose = Options.verbose flags + } clientEnv <- createClientEnv cachixOptions return Env - { config = cfg, + { cachixoptions = cachixOptions, clientenv = clientEnv, - cachixoptions = cachixOptions, + config = cfg, storeAsync = store } @@ -55,7 +61,7 @@ managerModifyRequest = return . setRequestHeader "User-Agent" [toS cachixVersion] } -createClientEnv :: CachixOptions -> IO ClientEnv +createClientEnv :: Config.CachixOptions -> IO ClientEnv createClientEnv cachixOptions = do manager <- newTlsManagerWith customManagerSettings - return $ mkClientEnv manager $ getBaseUrl (host cachixOptions) + return $ mkClientEnv manager $ getBaseUrl (Config.host cachixOptions) diff --git a/src/Cachix/Client/InstallationMode.hs b/src/Cachix/Client/InstallationMode.hs --- a/src/Cachix/Client/InstallationMode.hs +++ b/src/Cachix/Client/InstallationMode.hs @@ -76,7 +76,7 @@ | otherwise = UntrustedRequiresSudo -- | Add a Binary cache to nix.conf, print nixos config or fail -addBinaryCache :: Maybe Config -> BinaryCache.BinaryCache -> UseOptions -> InstallationMode -> IO () +addBinaryCache :: Config -> BinaryCache.BinaryCache -> UseOptions -> InstallationMode -> IO () addBinaryCache _ _ _ UntrustedNixOS = do user <- getUser throwIO $ @@ -108,9 +108,9 @@ echo "trusted-users = root ${user}" | sudo tee -a /etc/nix/nix.conf && sudo pkill nix-daemon |] -addBinaryCache maybeConfig bc useOptions WriteNixOS = - nixosBinaryCache maybeConfig bc useOptions -addBinaryCache maybeConfig bc _ (Install ncl) = do +addBinaryCache config bc useOptions WriteNixOS = + nixosBinaryCache config bc useOptions +addBinaryCache config bc _ (Install ncl) = do -- TODO: might need locking one day gnc <- NixConf.read NixConf.Global (input, output) <- @@ -123,7 +123,7 @@ lnc <- NixConf.read ncl return ([lnc], lnc) let nixconf = fromMaybe (NixConf.NixConf []) output - netrcLocMaybe <- forM (guard $ not (BinaryCache.isPublic bc)) $ const $ addPrivateBinaryCacheNetRC maybeConfig bc ncl + netrcLocMaybe <- forM (guard $ not (BinaryCache.isPublic bc)) $ const $ addPrivateBinaryCacheNetRC config bc ncl let addNetRCLine :: NixConf.NixConf -> NixConf.NixConf addNetRCLine = fromMaybe identity $ do netrcLoc <- netrcLocMaybe :: Maybe FilePath @@ -135,8 +135,8 @@ filename <- NixConf.getFilename ncl putStrLn $ "Configured " <> BinaryCache.uri bc <> " binary cache in " <> toS filename -nixosBinaryCache :: Maybe Config -> BinaryCache.BinaryCache -> UseOptions -> IO () -nixosBinaryCache maybeConfig bc UseOptions {useNixOSFolder = baseDirectory} = do +nixosBinaryCache :: Config -> BinaryCache.BinaryCache -> UseOptions -> IO () +nixosBinaryCache config bc UseOptions {useNixOSFolder = baseDirectory} = do _ <- try $ createDirectoryIfMissing True $ toS toplevel :: IO (Either SomeException ()) eitherPermissions <- try $ getPermissions (toS toplevel) :: IO (Either SomeException Permissions) case eitherPermissions of @@ -148,7 +148,7 @@ installFiles = do writeFile (toS glueModuleFile) glueModule writeFile (toS cacheModuleFile) cacheModule - unless (BinaryCache.isPublic bc) $ void $ addPrivateBinaryCacheNetRC maybeConfig bc NixConf.Global + unless (BinaryCache.isPublic bc) $ void $ addPrivateBinaryCacheNetRC config bc NixConf.Global putText instructions configurationNix :: Text configurationNix = toS $ toS baseDirectory "configuration.nix" @@ -213,10 +213,10 @@ |] -- TODO: allow overriding netrc location -addPrivateBinaryCacheNetRC :: Maybe Config -> BinaryCache.BinaryCache -> NixConf.NixConfLoc -> IO FilePath -addPrivateBinaryCacheNetRC maybeConfig bc nixconf = do +addPrivateBinaryCacheNetRC :: Config -> BinaryCache.BinaryCache -> NixConf.NixConfLoc -> IO FilePath +addPrivateBinaryCacheNetRC config bc nixconf = do filename <- (`replaceFileName` "netrc") <$> NixConf.getFilename nixconf - authToken <- Config.getAuthTokenRequired maybeConfig + authToken <- Config.getAuthTokenRequired config let netrcfile = fromMaybe filename Nothing -- TODO: get netrc from nixconf NetRc.add authToken [bc] netrcfile putErrText $ "Configured private read access credentials in " <> toS filename diff --git a/src/Cachix/Client/OptionsParser.hs b/src/Cachix/Client/OptionsParser.hs --- a/src/Cachix/Client/OptionsParser.hs +++ b/src/Cachix/Client/OptionsParser.hs @@ -1,68 +1,77 @@ +{-# LANGUAGE ApplicativeDo #-} + module Cachix.Client.OptionsParser ( CachixCommand (..), - CachixOptions (..), PushArguments (..), PushOptions (..), BinaryCacheName, getOpts, + Flags (..), ) where import qualified Cachix.Client.Config as Config import qualified Cachix.Client.InstallationMode as InstallationMode -import Cachix.Client.URI (defaultCachixURI) +import qualified Cachix.Client.URI as URI import qualified Cachix.Deploy.OptionsParser as DeployOptions import Options.Applicative -import Protolude hiding (option, toS) +import Protolude hiding (toS) import Protolude.Conv -import URI.ByteString - ( Absolute, - URIRef, - parseURI, - serializeURIRef', - strictURIParserOptions, - ) +import qualified URI.ByteString as URI -data CachixOptions = CachixOptions - { host :: URIRef Absolute, - configPath :: Config.ConfigPath, +data Flags = Flags + { configPath :: Config.ConfigPath, + hostname :: Maybe (URI.URIRef URI.Absolute), verbose :: Bool } - deriving (Show) -parserCachixOptions :: Config.ConfigPath -> Parser CachixOptions -parserCachixOptions defaultConfigPath = - CachixOptions - <$> option - uriOption - ( long "host" - <> value defaultCachixURI - <> metavar "URI" - <> showDefaultWith (toS . serializeURIRef') - <> help "Host to connect to" - ) - <*> strOption - ( long "config" - <> short 'c' - <> value defaultConfigPath - <> metavar "CONFIGPATH" - <> showDefault - <> help "Cachix configuration file" - ) - <*> switch - ( long "verbose" - <> short 'v' - <> help "Verbose mode" - ) +flagParser :: Config.ConfigPath -> Parser Flags +flagParser defaultConfigPath = do + hostname <- + optional $ + option + uriOption + ( mconcat + [ long "hostname", + metavar "URI", + help ("Host to connect to (default: " <> defaultHostname <> ")") + ] + ) + -- Accept `host` for backwards compatibility + <|> option uriOption (long "host" <> hidden) -uriOption :: ReadM (URIRef Absolute) + configPath <- + strOption $ + mconcat + [ long "config", + short 'c', + value defaultConfigPath, + metavar "CONFIGPATH", + showDefault, + help "Cachix configuration file" + ] + + verbose <- + switch $ + mconcat + [ long "verbose", + short 'v', + help "Verbose mode" + ] + + pure Flags {hostname, configPath, verbose} + where + defaultHostname = toS (URI.serializeURIRef' URI.defaultCachixURI) + +uriOption :: ReadM (URI.URIRef URI.Absolute) uriOption = eitherReader $ \s -> - first show $ parseURI strictURIParserOptions $ toS s + first show $ URI.parseURI URI.strictURIParserOptions $ toS s type BinaryCacheName = Text data CachixCommand = AuthToken (Maybe Text) + | Config Config.Command | GenerateKeypair BinaryCacheName | Push PushArguments | WatchStore PushOptions Text @@ -84,10 +93,11 @@ } deriving (Show) -parserCachixCommand :: Parser CachixCommand -parserCachixCommand = +commandParser :: Parser CachixCommand +commandParser = subparser $ command "authtoken" (infoH authtoken (progDesc "Configure authentication token for communication to HTTP API")) + <> command "config" (Config <$> Config.parser) <> command "generate-keypair" (infoH generateKeypair (progDesc "Generate signing key pair for a binary cache")) <> command "push" (infoH push (progDesc "Upload Nix store paths to a binary cache")) <> command "watch-exec" (infoH watchExec (progDesc "Run a command while it's running watch /nix/store for newly added store paths and upload them to a binary cache")) @@ -167,15 +177,15 @@ ) ) -getOpts :: IO (CachixOptions, CachixCommand) +getOpts :: IO (Flags, CachixCommand) getOpts = do configpath <- Config.getDefaultFilename customExecParser (prefs showHelpOnEmpty) (optsInfo configpath) -optsInfo :: Config.ConfigPath -> ParserInfo (CachixOptions, CachixCommand) +optsInfo :: Config.ConfigPath -> ParserInfo (Flags, CachixCommand) optsInfo configpath = infoH parser desc where - parser = (,) <$> parserCachixOptions configpath <*> (parserCachixCommand <|> versionParser) + parser = (,) <$> flagParser configpath <*> (commandParser <|> versionParser) versionParser :: Parser CachixCommand versionParser = flag' diff --git a/src/Cachix/Client/Push.hs b/src/Cachix/Client/Push.hs --- a/src/Cachix/Client/Push.hs +++ b/src/Cachix/Client/Push.hs @@ -281,7 +281,7 @@ -- | Find auth token or signing key in the 'Config' or environment variable findPushSecret :: - Maybe Config.Config -> + Config.Config -> -- | Cache name Text -> -- | Secret key or exception @@ -289,9 +289,7 @@ findPushSecret config name = do maybeSigningKeyEnv <- toS <<$>> lookupEnv "CACHIX_SIGNING_KEY" maybeAuthToken <- Config.getAuthTokenMaybe config - let maybeSigningKeyConfig = case config of - Nothing -> Nothing - Just cfg -> Config.secretKey <$> head (getBinaryCache cfg) + let maybeSigningKeyConfig = Config.secretKey <$> head (getBinaryCache config) case maybeSigningKeyEnv <|> maybeSigningKeyConfig of Just signingKey -> escalateAs FatalError $ PushSigningKey (fromMaybe (Token "") maybeAuthToken) <$> parseSigningKeyLenient signingKey Nothing -> case maybeAuthToken of diff --git a/src/Cachix/Deploy/ActivateCommand.hs b/src/Cachix/Deploy/ActivateCommand.hs --- a/src/Cachix/Deploy/ActivateCommand.hs +++ b/src/Cachix/Deploy/ActivateCommand.hs @@ -4,8 +4,8 @@ import qualified Cachix.API.Deploy as API import Cachix.API.Error (escalate) +import qualified Cachix.Client.Config as Config import qualified Cachix.Client.Env as Env -import qualified Cachix.Client.OptionsParser as CachixOptions import Cachix.Client.Servant (deployClient) import qualified Cachix.Deploy.OptionsParser as DeployOptions import qualified Cachix.Types.DeployResponse as DeployResponse @@ -18,7 +18,7 @@ import Servant.Conduit () import System.Environment (getEnv) -run :: CachixOptions.CachixOptions -> DeployOptions.ActivateOptions -> IO () +run :: Config.CachixOptions -> DeployOptions.ActivateOptions -> IO () run cachixOptions DeployOptions.ActivateOptions {DeployOptions.payloadPath} = do agentToken <- getEnv "CACHIX_ACTIVATE_TOKEN" clientEnv <- Env.createClientEnv cachixOptions diff --git a/src/Cachix/Deploy/Agent.hs b/src/Cachix/Deploy/Agent.hs --- a/src/Cachix/Deploy/Agent.hs +++ b/src/Cachix/Deploy/Agent.hs @@ -3,7 +3,7 @@ module Cachix.Deploy.Agent where import qualified Cachix.API.WebSocketSubprotocol as WSS -import qualified Cachix.Client.OptionsParser as CachixOptions +import qualified Cachix.Client.Config as Config import Cachix.Client.URI (getBaseUrl) import qualified Cachix.Deploy.OptionsParser as AgentOptions import Cachix.Deploy.StdinProcess (readProcess) @@ -16,11 +16,11 @@ import Protolude.Conv import qualified Servant.Client as Servant -run :: CachixOptions.CachixOptions -> AgentOptions.AgentOptions -> IO () +run :: Config.CachixOptions -> AgentOptions.AgentOptions -> IO () run cachixOptions agentOpts = CachixWebsocket.runForever options handleMessage where - host = toS $ Servant.baseUrlHost $ getBaseUrl $ CachixOptions.host cachixOptions + host = toS $ Servant.baseUrlHost $ getBaseUrl $ Config.host cachixOptions name = AgentOptions.name agentOpts profile = fromMaybe "system" (AgentOptions.profile agentOpts) options = @@ -29,7 +29,7 @@ CachixWebsocket.name = name, CachixWebsocket.path = "/ws", CachixWebsocket.profile = profile, - CachixWebsocket.isVerbose = CachixOptions.verbose cachixOptions + CachixWebsocket.isVerbose = Config.verbose cachixOptions } handleMessage :: ByteString -> (K.KatipContextT IO () -> IO ()) -> WS.Connection -> CachixWebsocket.AgentState -> ByteString -> K.KatipContextT IO () handleMessage payload _ _ agentState _ = @@ -51,6 +51,6 @@ name = name, path = "/ws-deployment", profile = profile, - isVerbose = CachixOptions.verbose cachixOptions + isVerbose = Config.verbose cachixOptions } }