{-# LANGUAGE DeriveAnyClass #-}

module Cachix.Client.Config
  ( Config (..),
    BinaryCacheConfig (..),
    readConfig,
    writeConfig,
    getDefaultFilename,
    ConfigPath,
    mkConfig,
  )
where

import Cachix.Client.Config.Orphans ()
import Dhall hiding (Text)
import Dhall.Pretty (prettyExpr)
import Protolude
import Servant.Auth.Client
import System.Directory
  ( XdgDirectory (..),
    createDirectoryIfMissing,
    doesFileExist,
    getXdgDirectory,
  )
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, StringConv 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