{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoFieldSelectors #-}

module WikiMusic.Config (readConfig) where

import Data.ByteString.Lazy qualified as BL
import Data.Text (strip, unpack)
import Data.Text.Encoding qualified
import Toml
import WikiMusic.Model.Config
import WikiMusic.Protolude

readConfig :: (MonadIO m) => Text -> m (Either Text AppConfig)
readConfig :: forall (m :: * -> *).
MonadIO m =>
Text -> m (Either Text AppConfig)
readConfig Text
filePath = do
  Either [TomlDecodeError] AppConfig
parseResult <- IO (Either [TomlDecodeError] AppConfig)
-> m (Either [TomlDecodeError] AppConfig)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either [TomlDecodeError] AppConfig)
 -> m (Either [TomlDecodeError] AppConfig))
-> IO (Either [TomlDecodeError] AppConfig)
-> m (Either [TomlDecodeError] AppConfig)
forall a b. (a -> b) -> a -> b
$ TomlCodec AppConfig
-> FilePath -> IO (Either [TomlDecodeError] AppConfig)
forall a (m :: * -> *).
MonadIO m =>
TomlCodec a -> FilePath -> m (Either [TomlDecodeError] a)
decodeFileEither TomlCodec AppConfig
appConfigCodec (Text -> FilePath
unpack Text
filePath)
  case Either [TomlDecodeError] AppConfig
parseResult of
    Left [TomlDecodeError]
e -> Either Text AppConfig -> m (Either Text AppConfig)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text AppConfig -> m (Either Text AppConfig))
-> (Text -> Either Text AppConfig)
-> Text
-> m (Either Text AppConfig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text AppConfig
forall a b. a -> Either a b
Left (Text -> m (Either Text AppConfig))
-> Text -> m (Either Text AppConfig)
forall a b. (a -> b) -> a -> b
$ [TomlDecodeError] -> Text
prettyTomlDecodeErrors [TomlDecodeError]
e
    Right AppConfig
r -> AppConfig -> m AppConfig
forall (m :: * -> *). MonadIO m => AppConfig -> m AppConfig
readSecrets AppConfig
r m AppConfig
-> (AppConfig -> Either Text AppConfig)
-> m (Either Text AppConfig)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> AppConfig -> Either Text AppConfig
forall a b. b -> Either a b
Right

readSecrets :: (MonadIO m) => AppConfig -> m AppConfig
readSecrets :: forall (m :: * -> *). MonadIO m => AppConfig -> m AppConfig
readSecrets AppConfig
cfg = do
  Text
mailPassword <- AppConfig -> (AppConfig -> Text) -> m Text
forall (m :: * -> *) t. MonadIO m => t -> (t -> Text) -> m Text
readSecretFromFile AppConfig
cfg (AppConfig -> Optic' A_Lens NoIx AppConfig Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx AppConfig AppConfig MailConfig MailConfig
#mail Optic A_Lens NoIx AppConfig AppConfig MailConfig MailConfig
-> Optic A_Lens NoIx MailConfig MailConfig Text Text
-> Optic' A_Lens NoIx AppConfig Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx MailConfig MailConfig Text Text
#passwordFile)
  Text
mailUser <- AppConfig -> (AppConfig -> Text) -> m Text
forall (m :: * -> *) t. MonadIO m => t -> (t -> Text) -> m Text
readSecretFromFile AppConfig
cfg (AppConfig -> Optic' A_Lens NoIx AppConfig Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx AppConfig AppConfig MailConfig MailConfig
#mail Optic A_Lens NoIx AppConfig AppConfig MailConfig MailConfig
-> Optic A_Lens NoIx MailConfig MailConfig Text Text
-> Optic' A_Lens NoIx AppConfig Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx MailConfig MailConfig Text Text
#userFile)
  let mailConfig :: MailConfig
mailConfig = AppConfig
cfg AppConfig
-> Optic A_Lens NoIx AppConfig AppConfig MailConfig MailConfig
-> MailConfig
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx AppConfig AppConfig MailConfig MailConfig
#mail
  let finalCfg :: AppConfig
finalCfg =
        AppConfig
cfg
          { mail =
              mailConfig
                { password = Just mailPassword,
                  user = Just mailUser
                }
          }

  AppConfig -> m AppConfig
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AppConfig
finalCfg

readSecretFromFile :: (MonadIO m) => t -> (t -> Text) -> m Text
readSecretFromFile :: forall (m :: * -> *) t. MonadIO m => t -> (t -> Text) -> m Text
readSecretFromFile t
cfg t -> Text
getFilePath = do
  ByteString
passwordFileContents <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString)
-> (t -> IO ByteString) -> t -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ByteString
BL.readFile (FilePath -> IO ByteString)
-> (t -> FilePath) -> t -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
unpack (Text -> FilePath) -> (t -> Text) -> t -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Text
getFilePath (t -> m ByteString) -> t -> m ByteString
forall a b. (a -> b) -> a -> b
$ t
cfg
  Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Text -> m Text) -> (ByteString -> Text) -> ByteString -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
strip
    (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Data.Text.Encoding.decodeUtf8
    (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict
    (ByteString -> m Text) -> ByteString -> m Text
forall a b. (a -> b) -> a -> b
$ ByteString
passwordFileContents