{-# LANGUAGE OverloadedStrings #-}

-- | Handles the execution of 'wpa_*' commands as well as the template loading,
-- compilation and substitution.
module Templating
  ( createFiles
  ) where

import qualified Config
import qualified Data.Text.IO       as TextIO
import           System.FilePath    ((</>))
import qualified System.IO          as IO
import           System.Posix.Files
import           System.Process
import           Text.Mustache
import           Text.Parsec.Error  (ParseError)

data ScriptSpec = ScriptSpec
  { interface    :: String
  , dataFilename :: String
  }

instance ToMustache ScriptSpec where
  toMustache spec =
    object ["interface" ~> interface spec, "data_filename" ~> dataFilename spec]

newtype DataSpec = DataSpec
  { wpaPassphraseOutput :: String
  }

instance ToMustache DataSpec where
  toMustache spec = object ["wpa_passphrase_output" ~> wpaPassphraseOutput spec]

type Interface = String

type SSID = String

type Passphrase = String

type FileResult = Either ParseError FilePath

type WPAPassphraseOutput = String

createScript :: FilePath -> Interface -> FilePath -> IO FileResult
createScript filename iface dataFile =
  createFile filename Config.scriptDirectory scriptSpec "script.mustache"
  where
    scriptSpec = ScriptSpec {interface = iface, dataFilename = dataFile}

runWPAPassphrase :: SSID -> Passphrase -> IO WPAPassphraseOutput
runWPAPassphrase ssid passphrase = do
  (_, Just hout, _, _) <-
    createProcess wpa_passphrase_process {std_out = CreatePipe}
  IO.hGetContents hout
  where
    wpa_passphrase_process = proc "wpa_passphrase" [ssid, passphrase]

createData :: FilePath -> WPAPassphraseOutput -> IO FileResult
createData filename wpaPPoutput =
  createFile filename Config.dataDirectory dataSpec "data.mustache"
  where
    dataSpec = DataSpec {wpaPassphraseOutput = wpaPPoutput}

createFile ::
     ToMustache a => FilePath -> IO FilePath -> a -> FilePath -> IO FileResult
createFile filename outputDirFunc spec templateFile = do
  templateDir <- Config.templateDirectory
  outputDir <- outputDirFunc
  compiled <- automaticCompile [templateDir] templateFile
  let outputPath = outputDir </> filename
  case compiled of
    Left err -> pure (Left err)
    Right template -> do
      TextIO.writeFile outputPath $ substitute template spec
      pure (Right outputPath)

-- | 'createFiles' creates both the script- and data-file for a 'FilePath',
-- 'Interface', 'SSID' and 'Passphrase'. These filenames are then returned in a
-- tuple so that they may be used to notify the user of their creation.
createFiles ::
     FilePath -> Interface -> SSID -> Passphrase -> IO (FilePath, FilePath)
createFiles filename iface ssid passphrase = do
  wpaPPoutput <- runWPAPassphrase ssid passphrase
  (Right dataFile) <- createData filename wpaPPoutput
  (Right scriptFile) <- createScript filename iface dataFile
  setFileMode scriptFile ownerModes
  setFileMode dataFile (unionFileModes ownerWriteMode ownerReadMode)
  pure (dataFile, scriptFile)