{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE QuasiQuotes #-}
module Cachix.Client.Config
( Config (binaryCaches),
getAuthTokenRequired,
getAuthTokenOptional,
getAuthTokenMaybe,
setAuthToken,
noAuthTokenError,
BinaryCacheConfig (..),
readConfig,
writeConfig,
getDefaultFilename,
ConfigPath,
mkConfig,
)
where
import Cachix.Client.Config.Orphans ()
import Cachix.Client.Exception (CachixException (..))
import Data.String.Here
import Dhall hiding (Text)
import Dhall.Pretty (prettyExpr)
import Protolude hiding (toS)
import Protolude.Conv
import Servant.Auth.Client
import System.Directory
( XdgDirectory (..),
createDirectoryIfMissing,
doesFileExist,
getXdgDirectory,
)
import System.Environment (lookupEnv)
import System.FilePath.Posix (takeDirectory)
import System.Posix.Files
( ownerReadMode,
ownerWriteMode,
setFileMode,
unionFileModes,
)
data BinaryCacheConfig = BinaryCacheConfig
{ BinaryCacheConfig -> Text
name :: Text,
BinaryCacheConfig -> Text
secretKey :: Text
}
deriving (Int -> BinaryCacheConfig -> ShowS
[BinaryCacheConfig] -> ShowS
BinaryCacheConfig -> String
(Int -> BinaryCacheConfig -> ShowS)
-> (BinaryCacheConfig -> String)
-> ([BinaryCacheConfig] -> ShowS)
-> Show BinaryCacheConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinaryCacheConfig] -> ShowS
$cshowList :: [BinaryCacheConfig] -> ShowS
show :: BinaryCacheConfig -> String
$cshow :: BinaryCacheConfig -> String
showsPrec :: Int -> BinaryCacheConfig -> ShowS
$cshowsPrec :: Int -> BinaryCacheConfig -> ShowS
Show, (forall x. BinaryCacheConfig -> Rep BinaryCacheConfig x)
-> (forall x. Rep BinaryCacheConfig x -> BinaryCacheConfig)
-> Generic BinaryCacheConfig
forall x. Rep BinaryCacheConfig x -> BinaryCacheConfig
forall x. BinaryCacheConfig -> Rep BinaryCacheConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinaryCacheConfig x -> BinaryCacheConfig
$cfrom :: forall x. BinaryCacheConfig -> Rep BinaryCacheConfig x
Generic, InputNormalizer -> Decoder BinaryCacheConfig
(InputNormalizer -> Decoder BinaryCacheConfig)
-> FromDhall BinaryCacheConfig
forall a. (InputNormalizer -> Decoder a) -> FromDhall a
autoWith :: InputNormalizer -> Decoder BinaryCacheConfig
$cautoWith :: InputNormalizer -> Decoder BinaryCacheConfig
Interpret, InputNormalizer -> Encoder BinaryCacheConfig
(InputNormalizer -> Encoder BinaryCacheConfig)
-> ToDhall BinaryCacheConfig
forall a. (InputNormalizer -> Encoder a) -> ToDhall a
injectWith :: InputNormalizer -> Encoder BinaryCacheConfig
$cinjectWith :: InputNormalizer -> Encoder BinaryCacheConfig
Inject)
data Config = Config
{ Config -> Token
authToken :: Token,
Config -> [BinaryCacheConfig]
binaryCaches :: [BinaryCacheConfig]
}
deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show, (forall x. Config -> Rep Config x)
-> (forall x. Rep Config x -> Config) -> Generic Config
forall x. Rep Config x -> Config
forall x. Config -> Rep Config x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Config x -> Config
$cfrom :: forall x. Config -> Rep Config x
Generic, InputNormalizer -> Decoder Config
(InputNormalizer -> Decoder Config) -> FromDhall Config
forall a. (InputNormalizer -> Decoder a) -> FromDhall a
autoWith :: InputNormalizer -> Decoder Config
$cautoWith :: InputNormalizer -> Decoder Config
Interpret, InputNormalizer -> Encoder Config
(InputNormalizer -> Encoder Config) -> ToDhall Config
forall a. (InputNormalizer -> Encoder a) -> ToDhall a
injectWith :: InputNormalizer -> Encoder Config
$cinjectWith :: InputNormalizer -> Encoder Config
Inject)
mkConfig :: Text -> Config
mkConfig :: Text -> Config
mkConfig Text
token =
Config :: Token -> [BinaryCacheConfig] -> Config
Config
{ authToken :: Token
authToken = ByteString -> Token
Token (Text -> ByteString
forall a b. StringConv a b => a -> b
toS Text
token),
binaryCaches :: [BinaryCacheConfig]
binaryCaches = []
}
type ConfigPath = FilePath
readConfig :: ConfigPath -> IO (Maybe Config)
readConfig :: String -> IO (Maybe Config)
readConfig String
filename = do
Bool
doesExist <- String -> IO Bool
doesFileExist String
filename
if Bool
doesExist
then Config -> Maybe Config
forall a. a -> Maybe a
Just (Config -> Maybe Config) -> IO Config -> IO (Maybe Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Config -> String -> IO Config
forall a. Decoder a -> String -> IO a
inputFile Decoder Config
forall a. FromDhall a => Decoder a
auto String
filename
else Maybe Config -> IO (Maybe Config)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Config
forall a. Maybe a
Nothing
getDefaultFilename :: IO FilePath
getDefaultFilename :: IO String
getDefaultFilename = do
String
dir <- XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgConfig String
"cachix"
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/cachix.dhall"
writeConfig :: ConfigPath -> Config -> IO ()
writeConfig :: String -> Config -> IO ()
writeConfig String
filename Config
config = do
let doc :: Doc Ann
doc = Expr Src Void -> Doc Ann
forall a s. Pretty a => Expr s a -> Doc Ann
prettyExpr (Expr Src Void -> Doc Ann) -> Expr Src Void -> Doc Ann
forall a b. (a -> b) -> a -> b
$ Encoder Config -> Config -> Expr Src Void
forall a. Encoder a -> a -> Expr Src Void
embed Encoder Config
forall a. ToDhall a => Encoder a
inject Config
config
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (ShowS
takeDirectory String
filename)
String -> Text -> IO ()
writeFile String
filename (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc Ann -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Doc Ann
doc
String -> IO ()
assureFilePermissions String
filename
String -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Written to " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
filename
assureFilePermissions :: FilePath -> IO ()
assureFilePermissions :: String -> IO ()
assureFilePermissions String
fp =
String -> FileMode -> IO ()
setFileMode String
fp (FileMode -> IO ()) -> FileMode -> IO ()
forall a b. (a -> b) -> a -> b
$ FileMode -> FileMode -> FileMode
unionFileModes FileMode
ownerReadMode FileMode
ownerWriteMode
getAuthTokenRequired :: Maybe Config -> IO Token
getAuthTokenRequired :: Maybe Config -> IO Token
getAuthTokenRequired Maybe Config
maybeConfig = do
Maybe Token
authTokenMaybe <- Maybe Config -> IO (Maybe Token)
getAuthTokenMaybe Maybe Config
maybeConfig
case Maybe Token
authTokenMaybe of
Just Token
authtoken -> Token -> IO Token
forall (m :: * -> *) a. Monad m => a -> m a
return Token
authtoken
Maybe Token
Nothing -> CachixException -> IO Token
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (CachixException -> IO Token) -> CachixException -> IO Token
forall a b. (a -> b) -> a -> b
$ Text -> CachixException
NoConfig (Text -> CachixException) -> Text -> CachixException
forall a b. (a -> b) -> a -> b
$ Text -> Text
forall a b. StringConv a b => a -> b
toS Text
noAuthTokenError
getAuthTokenOptional :: Maybe Config -> IO Token
getAuthTokenOptional :: Maybe Config -> IO Token
getAuthTokenOptional Maybe Config
maybeConfig = do
Maybe Token
authTokenMaybe <- Maybe Config -> IO (Maybe Token)
getAuthTokenMaybe Maybe Config
maybeConfig
Token -> IO Token
forall (m :: * -> *) a. Monad m => a -> m a
return (Token -> IO Token) -> Token -> IO Token
forall a b. (a -> b) -> a -> b
$ Token -> (Token -> Token) -> Maybe Token -> Token
forall b a. b -> (a -> b) -> Maybe a -> b
Protolude.maybe (ByteString -> Token
Token ByteString
"") Token -> Token
forall a. a -> a
identity Maybe Token
authTokenMaybe
getAuthTokenMaybe :: Maybe Config -> IO (Maybe Token)
getAuthTokenMaybe :: Maybe Config -> IO (Maybe Token)
getAuthTokenMaybe Maybe Config
maybeConfig = do
Maybe String
maybeAuthToken <- String -> IO (Maybe String)
lookupEnv String
"CACHIX_AUTH_TOKEN"
case (Maybe String
maybeAuthToken, Maybe Config
maybeConfig) of
(Just String
token, Maybe Config
_) -> Maybe Token -> IO (Maybe Token)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Token -> IO (Maybe Token))
-> Maybe Token -> IO (Maybe Token)
forall a b. (a -> b) -> a -> b
$ Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token) -> Token -> Maybe Token
forall a b. (a -> b) -> a -> b
$ ByteString -> Token
Token (ByteString -> Token) -> ByteString -> Token
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a b. StringConv a b => a -> b
toS String
token
(Maybe String
Nothing, Just Config
cfg) -> Maybe Token -> IO (Maybe Token)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Token -> IO (Maybe Token))
-> Maybe Token -> IO (Maybe Token)
forall a b. (a -> b) -> a -> b
$ Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token) -> Token -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Config -> Token
authToken Config
cfg
(Maybe String
_, Maybe Config
_) -> Maybe Token -> IO (Maybe Token)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Token
forall a. Maybe a
Nothing
noAuthTokenError :: Text
noAuthTokenError :: Text
noAuthTokenError =
[iTrim|
Start by visiting https://app.cachix.org and create a personal/cache auth token.
To configure the token:
a) Via environment variable:
$ export CACHIX_AUTH_TOKEN=<token...>
b) Via configuration file:
$ cachix authtoken <token...>
|]
setAuthToken :: Config -> Token -> Config
setAuthToken :: Config -> Token -> Config
setAuthToken Config
cfg Token
token = Config
cfg {authToken :: Token
authToken = Token
token}