{-# LANGUAGE OverloadedStrings #-}

{-|
Module      : Config
Description : Process the YAML configuration file.
Copyright   : (c) IOcrafts, 2024-present
License     : BSD
Maintainer  : Maurizio Dusi
Stability   : stable
Portability : POSIX

This module parses a YAML file with configuration options.

__Example of conf.yaml:__

@
    remote:
        hostname: sftp.domain.com
        port: 22
        username: username
        password: password
        known_hosts: \/home\/user\/.ssh\/known_hosts
@

-}

module Config
    ( Config (..)
    , mkConfig
    ) where

import           Control.Monad ( MonadPlus (mzero) )

import           Data.Aeson    ( FromJSON (parseJSON), (.!=), (.:) )
import qualified Data.Yaml     as Y


-- | Represents the configuration settings for the application.
data Config
  = Config { -- | The host address of the server.
             Config -> String
configHost       :: String
             -- | The port number to connect to.
           , Config -> Int
configPort       :: Int
             -- | The username for authentication.
           , Config -> String
configUser       :: String
             -- | The password for authentication.
           , Config -> String
configPassword   :: String
             -- | The file path to the known hosts file.
           , Config -> String
configKnownHosts :: FilePath
           }
  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
$cshowsPrec :: Int -> Config -> ShowS
showsPrec :: Int -> Config -> ShowS
$cshow :: Config -> String
show :: Config -> String
$cshowList :: [Config] -> ShowS
showList :: [Config] -> ShowS
Show)

-- | Represents a YAML configuration with a remote value.
newtype YamlConfig
  = YamlConfig { YamlConfig -> Remote
yamlRemote :: Remote }
  deriving (Int -> YamlConfig -> ShowS
[YamlConfig] -> ShowS
YamlConfig -> String
(Int -> YamlConfig -> ShowS)
-> (YamlConfig -> String)
-> ([YamlConfig] -> ShowS)
-> Show YamlConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> YamlConfig -> ShowS
showsPrec :: Int -> YamlConfig -> ShowS
$cshow :: YamlConfig -> String
show :: YamlConfig -> String
$cshowList :: [YamlConfig] -> ShowS
showList :: [YamlConfig] -> ShowS
Show)

-- | Represents a remote SFTP configuration.
data Remote
  = Remote { Remote -> String
remoteHost       :: String
             -- ^ SFTP site
           , Remote -> Int
remotePort       :: Int
             -- ^ SFTP port
           , Remote -> String
remoteUser       :: String
             -- ^ SFTP username
           , Remote -> String
remotePassword   :: String
             -- ^ SFTP password
           , Remote -> String
remoteKnownHosts :: FilePath
             -- ^ Path to the known_hosts file
           }
  deriving (Int -> Remote -> ShowS
[Remote] -> ShowS
Remote -> String
(Int -> Remote -> ShowS)
-> (Remote -> String) -> ([Remote] -> ShowS) -> Show Remote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Remote -> ShowS
showsPrec :: Int -> Remote -> ShowS
$cshow :: Remote -> String
show :: Remote -> String
$cshowList :: [Remote] -> ShowS
showList :: [Remote] -> ShowS
Show)

-- | Create a 'Config' from a 'YamlConfig'.
--
-- This function takes a 'YamlConfig' and extracts the necessary fields to create a 'Config' object.
-- It returns an 'IO' action that produces the resulting 'Config'.
mkConfig :: YamlConfig -> IO Config
mkConfig :: YamlConfig -> IO Config
mkConfig YamlConfig{Remote
yamlRemote :: YamlConfig -> Remote
yamlRemote :: Remote
..} = do
  let Remote {Int
String
remoteHost :: Remote -> String
remotePort :: Remote -> Int
remoteUser :: Remote -> String
remotePassword :: Remote -> String
remoteKnownHosts :: Remote -> String
remoteHost :: String
remotePort :: Int
remoteUser :: String
remotePassword :: String
remoteKnownHosts :: String
..} = Remote
yamlRemote
  Config -> IO Config
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> IO Config) -> Config -> IO Config
forall a b. (a -> b) -> a -> b
$
    Config { configHost :: String
configHost = String
remoteHost
           , configPort :: Int
configPort = Int
remotePort
           , configUser :: String
configUser = String
remoteUser
           , configPassword :: String
configPassword = String
remotePassword
           , configKnownHosts :: String
configKnownHosts = String
remoteKnownHosts
           }


-- | Parses a JSON object into a 'YamlConfig' value.
instance FromJSON YamlConfig where
  parseJSON :: Value -> Parser YamlConfig
parseJSON (Y.Object Object
v) =
    Remote -> YamlConfig
YamlConfig  (Remote -> YamlConfig) -> Parser Remote -> Parser YamlConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Remote
forall a. FromJSON a => Object -> Key -> Parser a
.:   Key
"remote"
  parseJSON Value
_ = Parser YamlConfig
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | Parses a JSON object into a 'Remote' data type.
instance FromJSON Remote where
  parseJSON :: Value -> Parser Remote
parseJSON (Y.Object Object
v) =
    String -> Int -> String -> String -> String -> Remote
Remote  (String -> Int -> String -> String -> String -> Remote)
-> Parser String
-> Parser (Int -> String -> String -> String -> Remote)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.:   Key
"hostname"
            Parser (Int -> String -> String -> String -> Remote)
-> Parser Int -> Parser (String -> String -> String -> Remote)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser a
.:   Key
"port"         Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= Int
22
            Parser (String -> String -> String -> Remote)
-> Parser String -> Parser (String -> String -> Remote)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.:   Key
"username"
            Parser (String -> String -> Remote)
-> Parser String -> Parser (String -> Remote)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.:   Key
"password"
            Parser (String -> Remote) -> Parser String -> Parser Remote
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.:   Key
"known_hosts"
  parseJSON Value
_ = Parser Remote
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero