{-# LANGUAGE DataKinds #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}

module Cachix.Client.Commands
  ( authtoken,
    create,
    generateKeypair,
    push,
    use,
  )
where

import qualified Cachix.Api as Api
import Cachix.Api.Error
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 (..))
import Cachix.Client.HumanSize (humanSize)
import qualified Cachix.Client.InstallationMode as InstallationMode
import qualified Cachix.Client.NixConf as NixConf
import Cachix.Client.NixVersion (assertNixVersion)
import Cachix.Client.OptionsParser
  ( CachixOptions (..),
    PushArguments (..),
    PushOptions (..),
  )
import Cachix.Client.Push
import Cachix.Client.Secrets
  ( SigningKey (SigningKey),
    exportSigningKey,
    parseSigningKeyLenient,
  )
import Cachix.Client.Servant
import qualified Cachix.Types.SigningKeyCreate as SigningKeyCreate
import Control.Exception.Safe (handle, throwM)
import Control.Retry (RetryStatus (rsIterNumber))
import Crypto.Sign.Ed25519
import qualified Data.ByteString.Base64 as B64
import Data.List (isSuffixOf)
import Data.String.Here
import qualified Data.Text as T
import Network.HTTP.Types (status401, status404)
import Protolude
import Servant.API (NoContent)
import Servant.Auth.Client
import Servant.Client.Streaming
import Servant.Conduit ()
import System.Directory (doesFileExist)
import System.Environment (lookupEnv)
import System.FSNotify
import System.IO (hIsTerminalDevice)

authtoken :: Env -> Text -> IO ()
authtoken :: Env -> Text -> IO ()
authtoken env :: Env
env token :: Text
token = do
  -- TODO: check that token actually authenticates!
  ConfigPath -> Config -> IO ()
writeConfig (CachixOptions -> ConfigPath
configPath (Env -> CachixOptions
cachixoptions Env
env)) (Config -> IO ()) -> Config -> IO ()
forall a b. (a -> b) -> a -> b
$ case Env -> Maybe Config
config Env
env of
    Just cfg :: Config
cfg -> Config
cfg {authToken :: Token
authToken = ByteString -> Token
Token (Text -> ByteString
forall a b. StringConv a b => a -> b
toS Text
token)}
    Nothing -> Text -> Config
mkConfig Text
token

create :: Env -> Text -> IO ()
create :: Env -> Text -> IO ()
create _ _ =
  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
DeprecatedCommand "Create command has been deprecated. Please visit https://cachix.org to create a binary cache."

generateKeypair :: Env -> Text -> IO ()
generateKeypair :: Env -> Text -> IO ()
generateKeypair Env {config :: Env -> Maybe Config
config = Maybe Config
Nothing} _ = 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
NoConfig "Start with visiting https://cachix.org and copying the token to $ cachix authtoken <token>"
generateKeypair env :: Env
env@Env {config :: Env -> Maybe Config
config = Just cfg :: Config
cfg} name :: Text
name = do
  (PublicKey pk :: ByteString
pk, sk :: SecretKey
sk) <- IO (PublicKey, SecretKey)
createKeypair
  let signingKey :: Text
signingKey = SigningKey -> Text
exportSigningKey (SigningKey -> Text) -> SigningKey -> Text
forall a b. (a -> b) -> a -> b
$ SecretKey -> SigningKey
SigningKey SecretKey
sk
      signingKeyCreate :: SigningKeyCreate
signingKeyCreate = Text -> SigningKeyCreate
SigningKeyCreate.SigningKeyCreate (ByteString -> Text
forall a b. StringConv a b => a -> b
toS (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B64.encode ByteString
pk)
      bcc :: BinaryCacheConfig
bcc = Text -> Text -> BinaryCacheConfig
BinaryCacheConfig Text
name Text
signingKey
  -- we first validate if key can be added to the binary cache
  (NoContent
_ :: NoContent) <-
    Either ClientError NoContent -> IO NoContent
forall exc (m :: * -> *) a.
(Exception exc, MonadThrow m) =>
Either exc a -> m a
escalate (Either ClientError NoContent -> IO NoContent)
-> (ClientM NoContent -> IO (Either ClientError NoContent))
-> ClientM NoContent
-> IO NoContent
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (ClientM NoContent -> ClientEnv -> IO (Either ClientError NoContent)
forall a.
NFData a =>
ClientM a -> ClientEnv -> IO (Either ClientError a)
`runClientM` Env -> ClientEnv
clientenv Env
env) (ClientM NoContent -> IO NoContent)
-> ClientM NoContent -> IO NoContent
forall a b. (a -> b) -> a -> b
$
      BinaryCacheAPI (AsClientT ClientM)
-> Token -> SigningKeyCreate -> ClientM NoContent
forall route.
BinaryCacheAPI route
-> route
   :- (CachixAuth
       :> ("key"
           :> (ReqBody '[JSON] SigningKeyCreate :> Post '[JSON] NoContent)))
Api.createKey (Text -> BinaryCacheAPI (AsClientT ClientM)
cachixBCClient Text
name) (Config -> Token
authToken Config
cfg) SigningKeyCreate
signingKeyCreate
  -- if key was successfully added, write it to the config
  -- TODO: warn if binary cache with the same key already exists
  ConfigPath -> Config -> IO ()
writeConfig (CachixOptions -> ConfigPath
configPath (Env -> CachixOptions
cachixoptions Env
env)) (Config -> IO ()) -> Config -> IO ()
forall a b. (a -> b) -> a -> b
$
    Config
cfg {binaryCaches :: [BinaryCacheConfig]
binaryCaches = Config -> [BinaryCacheConfig]
binaryCaches Config
cfg [BinaryCacheConfig] -> [BinaryCacheConfig] -> [BinaryCacheConfig]
forall a. Semigroup a => a -> a -> a
<> [BinaryCacheConfig
bcc]}
  Text -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn
    ( [iTrim|
Secret signing key has been saved in the file above. To populate
your binary cache:

    $ nix-build | cachix push ${name}

Or if you'd like to use the signing key on another machine or CI:

    $ export CACHIX_SIGNING_KEY=${signingKey}
    $ nix-build | cachix push ${name}

To instruct Nix to use the binary cache:

    $ cachix use ${name}

IMPORTANT: Make sure to make a backup for the signing key above, as you have the only copy.
  |] ::
        Text
    )

envToToken :: Env -> Token
envToToken :: Env -> Token
envToToken env :: Env
env =
  Token -> (Config -> Token) -> Maybe Config -> Token
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> Token
Token "") Config -> Token
authToken (Env -> Maybe Config
config Env
env)

notAuthenticatedBinaryCache :: CachixException
notAuthenticatedBinaryCache :: CachixException
notAuthenticatedBinaryCache =
  Text -> CachixException
AccessDeniedBinaryCache "You must first authenticate using:  $ cachix authtoken <token>"

accessDeniedBinaryCache :: Text -> CachixException
accessDeniedBinaryCache :: Text -> CachixException
accessDeniedBinaryCache name :: Text
name =
  Text -> CachixException
AccessDeniedBinaryCache (Text -> CachixException) -> Text -> CachixException
forall a b. (a -> b) -> a -> b
$ "You don't seem to have API access to binary cache " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name

use :: Env -> Text -> InstallationMode.UseOptions -> IO ()
use :: Env -> Text -> UseOptions -> IO ()
use env :: Env
env name :: Text
name useOptions :: UseOptions
useOptions = do
  -- 1. get cache public key
  Either ClientError BinaryCache
res <- (ClientM BinaryCache
-> ClientEnv -> IO (Either ClientError BinaryCache)
forall a.
NFData a =>
ClientM a -> ClientEnv -> IO (Either ClientError a)
`runClientM` Env -> ClientEnv
clientenv Env
env) (ClientM BinaryCache -> IO (Either ClientError BinaryCache))
-> ClientM BinaryCache -> IO (Either ClientError BinaryCache)
forall a b. (a -> b) -> a -> b
$ BinaryCacheAPI (AsClientT ClientM) -> Token -> ClientM BinaryCache
forall route.
BinaryCacheAPI route
-> route :- (CachixAuth :> Get '[JSON] BinaryCache)
Api.get (Text -> BinaryCacheAPI (AsClientT ClientM)
cachixBCClient Text
name) (Env -> Token
envToToken Env
env)
  case Either ClientError BinaryCache
res of
    Left err :: ClientError
err
      | ClientError -> Status -> Bool
isErr ClientError
err Status
status401 Bool -> Bool -> Bool
&& Maybe Config -> Bool
forall a. Maybe a -> Bool
isJust (Env -> Maybe Config
config Env
env) -> CachixException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CachixException -> IO ()) -> CachixException -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> CachixException
accessDeniedBinaryCache Text
name
      | ClientError -> Status -> Bool
isErr ClientError
err Status
status401 -> CachixException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM CachixException
notAuthenticatedBinaryCache
      | ClientError -> Status -> Bool
isErr ClientError
err Status
status404 -> CachixException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CachixException -> IO ()) -> CachixException -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> CachixException
BinaryCacheNotFound (Text -> CachixException) -> Text -> CachixException
forall a b. (a -> b) -> a -> b
$ "Binary cache" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " does not exist."
      | Bool
otherwise -> ClientError -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ClientError
err
    Right binaryCache :: BinaryCache
binaryCache -> do
      () <- (Text -> CachixException) -> Either Text () -> IO ()
forall exc (m :: * -> *) l a.
(Exception exc, MonadThrow m) =>
(l -> exc) -> Either l a -> m a
escalateAs Text -> CachixException
UnsupportedNixVersion (Either Text () -> IO ()) -> IO (Either Text ()) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either Text ())
assertNixVersion
      Text
user <- IO Text
InstallationMode.getUser
      Maybe NixConf
nc <- NixConfLoc -> IO (Maybe NixConf)
NixConf.read NixConfLoc
NixConf.Global
      Bool
isTrusted <- [Text] -> IO Bool
InstallationMode.isTrustedUser ([Text] -> IO Bool) -> [Text] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [NixConf] -> (NixConfLine -> Maybe [Text]) -> [Text]
NixConf.readLines ([Maybe NixConf] -> [NixConf]
forall a. [Maybe a] -> [a]
catMaybes [Maybe NixConf
nc]) NixConfLine -> Maybe [Text]
NixConf.isTrustedUsers
      Bool
isNixOS <- ConfigPath -> IO Bool
doesFileExist "/etc/NIXOS"
      let nixEnv :: NixEnv
nixEnv =
            NixEnv :: Bool -> Bool -> Bool -> NixEnv
InstallationMode.NixEnv
              { isRoot :: Bool
InstallationMode.isRoot = Text
user Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "root",
                isTrusted :: Bool
InstallationMode.isTrusted = Bool
isTrusted,
                isNixOS :: Bool
InstallationMode.isNixOS = Bool
isNixOS
              }
      Maybe Config
-> BinaryCache -> UseOptions -> InstallationMode -> IO ()
InstallationMode.addBinaryCache (Env -> Maybe Config
config Env
env) BinaryCache
binaryCache UseOptions
useOptions (InstallationMode -> IO ()) -> InstallationMode -> IO ()
forall a b. (a -> b) -> a -> b
$
        InstallationMode -> Maybe InstallationMode -> InstallationMode
forall a. a -> Maybe a -> a
fromMaybe (NixEnv -> InstallationMode
InstallationMode.getInstallationMode NixEnv
nixEnv) (UseOptions -> Maybe InstallationMode
InstallationMode.useMode UseOptions
useOptions)

-- TODO: lots of room for performance improvements
push :: Env -> PushArguments -> IO ()
push :: Env -> PushArguments -> IO ()
push env :: Env
env (PushPaths opts :: PushOptions
opts name :: Text
name cliPaths :: [Text]
cliPaths) = do
  Bool
hasStdin <- Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Bool
hIsTerminalDevice Handle
stdin
  [Text]
inputStorePaths <-
    case (Bool
hasStdin, [Text]
cliPaths) of
      (False, []) -> 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
NoInput "You need to specify store paths either as stdin or as an command argument"
      (True, []) -> Text -> [Text]
T.words (Text -> [Text]) -> IO Text -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
getContents
      -- If we get both stdin and cli args, prefer cli args.
      -- This avoids hangs in cases where stdin is non-interactive but unused by caller
      -- some programming environments always create a (non-interactive) stdin
      -- that may or may not be written to by the caller.
      -- This is somewhat like the behavior of `cat` for example.
      (_, paths :: [Text]
paths) -> [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
paths
  SigningKey
sk <- Env -> Text -> IO SigningKey
findSigningKey Env
env Text
name
  Store
store <- Async Store -> IO Store
forall a. Async a -> IO a
wait (Env -> Async Store
storeAsync Env
env)
  IO [()] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [()] -> IO ()) -> IO [()] -> IO ()
forall a b. (a -> b) -> a -> b
$
    (forall a b. (a -> IO b) -> [a] -> IO [b])
-> ClientEnv
-> Store
-> PushCache
-> (Text -> PushStrategy IO ())
-> [Text]
-> IO [()]
forall (m :: * -> *) r.
(MonadIO m, MonadMask m) =>
(forall a b. (a -> m b) -> [a] -> m [b])
-> ClientEnv
-> Store
-> PushCache
-> (Text -> PushStrategy m r)
-> [Text]
-> m [r]
pushClosure
      (Int -> (a -> IO b) -> [a] -> IO [b]
forall (t :: * -> *) a b.
Traversable t =>
Int -> (a -> IO b) -> t a -> IO (t b)
mapConcurrentlyBounded (PushOptions -> Int
numJobs PushOptions
opts))
      (Env -> ClientEnv
clientenv Env
env)
      Store
store
      PushCache :: Text -> SigningKey -> Token -> PushCache
PushCache
        { pushCacheToken :: Token
pushCacheToken = Env -> Token
envToToken Env
env,
          pushCacheName :: Text
pushCacheName = Text
name,
          pushCacheSigningKey :: SigningKey
pushCacheSigningKey = SigningKey
sk
        }
      (Env -> PushOptions -> Text -> Text -> PushStrategy IO ()
pushStrategy Env
env PushOptions
opts Text
name)
      [Text]
inputStorePaths
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putText "All done."
push env :: Env
env (PushWatchStore opts :: PushOptions
opts name :: Text
name) = (WatchManager -> IO ()) -> IO ()
forall a. (WatchManager -> IO a) -> IO a
withManager ((WatchManager -> IO ()) -> IO ())
-> (WatchManager -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \mgr :: WatchManager
mgr -> do
  IO ()
_ <- WatchManager
-> ConfigPath -> ActionPredicate -> Action -> IO (IO ())
watchDir WatchManager
mgr "/nix/store" ActionPredicate
filterF Action
action
  Store
_ <- Async Store -> IO Store
forall a. Async a -> IO a
wait (Env -> Async Store
storeAsync Env
env)
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putText "Watching /nix/store for new builds ..."
  IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay 1000000
  where
    logErr :: FilePath -> SomeException -> IO ()
    logErr :: ConfigPath -> SomeException -> IO ()
logErr fp :: ConfigPath
fp e :: SomeException
e = Handle -> ConfigPath -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => Handle -> a -> m ()
hPutStrLn Handle
stderr (ConfigPath -> IO ()) -> ConfigPath -> IO ()
forall a b. (a -> b) -> a -> b
$ "Exception occured while pushing " ConfigPath -> ConfigPath -> ConfigPath
forall a. Semigroup a => a -> a -> a
<> ConfigPath
fp ConfigPath -> ConfigPath -> ConfigPath
forall a. Semigroup a => a -> a -> a
<> ": " ConfigPath -> ConfigPath -> ConfigPath
forall a. Semigroup a => a -> a -> a
<> SomeException -> ConfigPath
forall a b. (Show a, StringConv ConfigPath b) => a -> b
show SomeException
e
    action :: Action
    action :: Action
action (Removed fp :: ConfigPath
fp _ _) =
      (SomeException -> IO ()) -> IO () -> IO ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
Control.Exception.Safe.handle (ConfigPath -> SomeException -> IO ()
logErr ConfigPath
fp)
        (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Env -> PushOptions -> Text -> Text -> IO ()
pushStorePath Env
env PushOptions
opts Text
name
        (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ ConfigPath -> Text
forall a b. StringConv a b => a -> b
toS
        (ConfigPath -> Text) -> ConfigPath -> Text
forall a b. (a -> b) -> a -> b
$ Int -> ConfigPath -> ConfigPath
forall a. Int -> [a] -> [a]
dropEnd 5 ConfigPath
fp
    action _ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    filterF :: ActionPredicate
    filterF :: ActionPredicate
filterF (Removed fp :: ConfigPath
fp _ _)
      | ".lock" ConfigPath -> ConfigPath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` ConfigPath
fp = Bool
True
    filterF _ = Bool
False
    dropEnd :: Int -> [a] -> [a]
    dropEnd :: Int -> [a] -> [a]
dropEnd index :: Int
index xs :: [a]
xs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
index) [a]
xs

-- | Find a secret key in the 'Config' or environment variable
findSigningKey ::
  Env ->
  -- | Cache name
  Text ->
  -- | Secret key or exception
  IO SigningKey
findSigningKey :: Env -> Text -> IO SigningKey
findSigningKey env :: Env
env name :: Text
name = do
  Maybe ConfigPath
maybeEnvSK <- ConfigPath -> IO (Maybe ConfigPath)
lookupEnv "CACHIX_SIGNING_KEY"
  -- we reverse list of caches to prioritize keys added as last
  let matches :: Config -> [BinaryCacheConfig]
matches c :: Config
c = (BinaryCacheConfig -> Bool)
-> [BinaryCacheConfig] -> [BinaryCacheConfig]
forall a. (a -> Bool) -> [a] -> [a]
filter (\bc :: BinaryCacheConfig
bc -> BinaryCacheConfig -> Text
Config.name BinaryCacheConfig
bc Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name) ([BinaryCacheConfig] -> [BinaryCacheConfig])
-> [BinaryCacheConfig] -> [BinaryCacheConfig]
forall a b. (a -> b) -> a -> b
$ [BinaryCacheConfig] -> [BinaryCacheConfig]
forall a. [a] -> [a]
reverse ([BinaryCacheConfig] -> [BinaryCacheConfig])
-> [BinaryCacheConfig] -> [BinaryCacheConfig]
forall a b. (a -> b) -> a -> b
$ Config -> [BinaryCacheConfig]
binaryCaches Config
c
      maybeBCSK :: Maybe Text
maybeBCSK = case Env -> Maybe Config
config Env
env of
        Nothing -> Maybe Text
forall a. Maybe a
Nothing
        Just c :: Config
c -> BinaryCacheConfig -> Text
Config.secretKey (BinaryCacheConfig -> Text)
-> Maybe BinaryCacheConfig -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BinaryCacheConfig] -> Maybe BinaryCacheConfig
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head (Config -> [BinaryCacheConfig]
matches Config
c)
  Text
signingKey <- case Maybe Text
maybeBCSK Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ConfigPath -> Text
forall a b. StringConv a b => a -> b
toS (ConfigPath -> Text) -> Maybe ConfigPath -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ConfigPath
maybeEnvSK of
    Just key :: Text
key -> Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
key
    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
NoSigningKey Text
msg
  (Text -> FatalError) -> Either Text SigningKey -> IO SigningKey
forall exc (m :: * -> *) l a.
(Exception exc, MonadThrow m) =>
(l -> exc) -> Either l a -> m a
escalateAs Text -> FatalError
FatalError (Either Text SigningKey -> IO SigningKey)
-> Either Text SigningKey -> IO SigningKey
forall a b. (a -> b) -> a -> b
$ Text -> Either Text SigningKey
parseSigningKeyLenient Text
signingKey
  where
    msg :: Text
    msg :: Text
msg =
      [iTrim|
Signing key not found. 

It is generated by `cachix generate-keypair <name>` and stored in ~/config/cachix/cachix.dhall

There are a few options why this happened:

a) You haven't generated signing key yet for your cache 

b) You have the key but you're pushing from a different machine. 
   You can set it via $CACHIX_SIGNING_KEY environment variable.

c) You've lost the signing key. In that case it's best to delete the cache and start again.
   Note that everyone that configured the binary cache will have to do it again to set the new
   public key.
      |]

retryText :: RetryStatus -> Text
retryText :: RetryStatus -> Text
retryText retrystatus :: RetryStatus
retrystatus =
  if RetryStatus -> Int
rsIterNumber RetryStatus
retrystatus Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
    then ""
    else "(retry #" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, StringConv ConfigPath b) => a -> b
show (RetryStatus -> Int
rsIterNumber RetryStatus
retrystatus) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ") "

pushStrategy :: Env -> PushOptions -> Text -> Text -> PushStrategy IO ()
pushStrategy :: Env -> PushOptions -> Text -> Text -> PushStrategy IO ()
pushStrategy env :: Env
env opts :: PushOptions
opts name :: Text
name storePath :: Text
storePath =
  PushStrategy :: forall (m :: * -> *) r.
m r
-> (RetryStatus -> Int64 -> m ())
-> m r
-> (ClientError -> m r)
-> m r
-> (forall a.
    (ConduitM ByteString ByteString (ResourceT IO) () -> m a) -> m a)
-> Bool
-> PushStrategy m r
PushStrategy
    { onAlreadyPresent :: IO ()
onAlreadyPresent = IO ()
forall (f :: * -> *). Applicative f => f ()
pass,
      on401 :: IO ()
on401 =
        if Maybe Config -> Bool
forall a. Maybe a -> Bool
isJust (Env -> Maybe Config
config Env
env)
          then CachixException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CachixException -> IO ()) -> CachixException -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> CachixException
accessDeniedBinaryCache Text
name
          else CachixException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM CachixException
notAuthenticatedBinaryCache,
      onError :: ClientError -> IO ()
onError = ClientError -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM,
      onAttempt :: RetryStatus -> Int64 -> IO ()
onAttempt = \retrystatus :: RetryStatus
retrystatus size :: Int64
size ->
        -- we append newline instead of putStrLn due to https://github.com/haskell/text/issues/242
        Text -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ RetryStatus -> Text
retryText RetryStatus
retrystatus Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "compressing and pushing " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
storePath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
humanSize (Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
size) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")\n",
      onDone :: IO ()
onDone = IO ()
forall (f :: * -> *). Applicative f => f ()
pass,
      withXzipCompressor :: forall a.
(ConduitM ByteString ByteString (ResourceT IO) () -> IO a) -> IO a
withXzipCompressor = Int
-> forall (m :: * -> *) a.
   (ConduitM ByteString ByteString (ResourceT IO) () -> m a) -> m a
defaultWithXzipCompressorWithLevel (PushOptions -> Int
compressionLevel PushOptions
opts),
      omitDeriver :: Bool
Cachix.Client.Push.omitDeriver = PushOptions -> Bool
Cachix.Client.OptionsParser.omitDeriver PushOptions
opts
    }

pushStorePath :: Env -> PushOptions -> Text -> Text -> IO ()
pushStorePath :: Env -> PushOptions -> Text -> Text -> IO ()
pushStorePath env :: Env
env opts :: PushOptions
opts name :: Text
name storePath :: Text
storePath = do
  SigningKey
sk <- Env -> Text -> IO SigningKey
findSigningKey Env
env Text
name
  -- use secret key from config or env
  -- TODO: this shouldn't happen for each store path
  Store
store <- Async Store -> IO Store
forall a. Async a -> IO a
wait (Env -> Async Store
storeAsync Env
env)
  ClientEnv
-> Store -> PushCache -> PushStrategy IO () -> Text -> IO ()
forall (m :: * -> *) r.
(MonadMask m, MonadIO m) =>
ClientEnv -> Store -> PushCache -> PushStrategy m r -> Text -> m r
pushSingleStorePath
    (Env -> ClientEnv
clientenv Env
env)
    Store
store
    PushCache :: Text -> SigningKey -> Token -> PushCache
PushCache
      { pushCacheToken :: Token
pushCacheToken = Env -> Token
envToToken Env
env,
        pushCacheName :: Text
pushCacheName = Text
name,
        pushCacheSigningKey :: SigningKey
pushCacheSigningKey = SigningKey
sk
      }
    (Env -> PushOptions -> Text -> Text -> PushStrategy IO ()
pushStrategy Env
env PushOptions
opts Text
name Text
storePath)
    Text
storePath