packages feed

cachix 1.0.0 → 1.0.1

raw patch · 12 files changed

+329/−166 lines, 12 filesdep +eitherdep +prettyprinter

Dependencies added: either, prettyprinter

Files

CHANGELOG.md view
@@ -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
cachix.cabal view
@@ -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
src/Cachix/Client.hs view
@@ -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
src/Cachix/Client/Commands.hs view
@@ -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       }
src/Cachix/Client/Config.hs view
@@ -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 <token...>   |] -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)
src/Cachix/Client/Config/Orphans.hs view
@@ -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
src/Cachix/Client/Env.hs view
@@ -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)
src/Cachix/Client/InstallationMode.hs view
@@ -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
src/Cachix/Client/OptionsParser.hs view
@@ -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'
src/Cachix/Client/Push.hs view
@@ -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
src/Cachix/Deploy/ActivateCommand.hs view
@@ -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
src/Cachix/Deploy/Agent.hs view
@@ -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                         }                   }