{-# 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 token :: 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 filename :: 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 -> Text -> IO Config
forall a. Decoder a -> Text -> IO a
input Decoder Config
forall a. FromDhall a => Decoder a
auto (String -> Text
forall a b. StringConv a b => a -> b
toS 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 "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
<> "/cachix.dhall"

writeConfig :: ConfigPath -> Config -> IO ()
writeConfig :: String -> Config -> IO ()
writeConfig filename :: String
filename config :: 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
$ "Written to " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
filename

-- chmod rw filepath
assureFilePermissions :: FilePath -> IO ()
assureFilePermissions :: String -> IO ()
assureFilePermissions fp :: 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 maybeConfig :: Maybe Config
maybeConfig = do
  Maybe Token
authTokenMaybe <- Maybe Config -> IO (Maybe Token)
getAuthTokenMaybe Maybe Config
maybeConfig
  case Maybe Token
authTokenMaybe of
    Just authtoken :: Token
authtoken -> Token -> IO Token
forall (m :: * -> *) a. Monad m => a -> m a
return Token
authtoken
    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

-- TODO: https://github.com/haskell-servant/servant-auth/issues/173
getAuthTokenOptional :: Maybe Config -> IO Token
getAuthTokenOptional :: Maybe Config -> IO Token
getAuthTokenOptional maybeConfig :: 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 "") Token -> Token
forall a. a -> a
identity Maybe Token
authTokenMaybe

-- get auth token from env variable or fallback to config
getAuthTokenMaybe :: Maybe Config -> IO (Maybe Token)
getAuthTokenMaybe :: Maybe Config -> IO (Maybe Token)
getAuthTokenMaybe maybeConfig :: Maybe Config
maybeConfig = do
  Maybe String
maybeAuthToken <- String -> IO (Maybe String)
lookupEnv "CACHIX_AUTH_TOKEN"
  case (Maybe String
maybeAuthToken, Maybe Config
maybeConfig) of
    (Just token :: String
token, _) -> 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
    (Nothing, Just cfg :: 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 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 cfg :: Config
cfg token :: Token
token = Config
cfg {authToken :: Token
authToken = Token
token}