module HashAddressed.App.Meta.Reading
  (
    readHashFunctionFromConfig,
  )
  where

import Essentials
import HashAddressed.App.HashFunction.Naming
import HashAddressed.App.Meta.Paths
import HashAddressed.App.Meta.Version
import HashAddressed.App.Command.Type

import Control.Monad.IO.Class (liftIO)
import Prelude (FilePath)

import qualified Data.Sequence as Seq
import qualified Control.Monad.Trans.Except as Except
import qualified Data.ByteString as Strict.ByteString
import qualified Data.Either as Either
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Ini as INI
import qualified Data.Text as Strict.Text
import qualified Data.Text.Encoding as Strict.Text

readHashFunctionFromConfig :: FilePath -> CommandAction HashFunctionName
readHashFunctionFromConfig :: String -> CommandAction HashFunctionName
readHashFunctionFromConfig String
storeDirectory = do

    ByteString
bs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
Strict.ByteString.readFile (String -> String
configFile String
storeDirectory)

    Text
text <- case ByteString -> Either UnicodeException Text
Strict.Text.decodeUtf8' ByteString
bs of
        Either.Left UnicodeException
_ -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Except.throwE forall a b. (a -> b) -> a -> b
$ forall a. a -> Seq a
Seq.singleton forall a b. (a -> b) -> a -> b
$
            String
"Invalid UTF-8 in config file " forall a. Semigroup a => a -> a -> a
<> String -> String
configFile String
storeDirectory
        Either.Right Text
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
x

    INI.Ini HashMap Text [(Text, Text)]
_ [(Text, Text)]
iniGlobals <- case Text -> Either String Ini
INI.parseIni Text
text of
        Either.Left String
_ -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Except.throwE forall a b. (a -> b) -> a -> b
$ forall a. a -> Seq a
Seq.singleton forall a b. (a -> b) -> a -> b
$
            String
"Invalid config file " forall a. Semigroup a => a -> a -> a
<> String -> String
configFile String
storeDirectory
        Either.Right Ini
ini -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Ini
ini

    let map :: HashMap Text Text
map = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text, Text)]
iniGlobals

    Text
versionText <- case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (String -> Text
Strict.Text.pack String
"version") HashMap Text Text
map of
        Maybe Text
Nothing -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Except.throwE forall a b. (a -> b) -> a -> b
$ forall a. a -> Seq a
Seq.singleton forall a b. (a -> b) -> a -> b
$
            String
"Missing version in config file " forall a. Semigroup a => a -> a -> a
<> String -> String
configFile String
storeDirectory
        Just Text
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
x

    Version
_configVersion <- case Text -> String
Strict.Text.unpack Text
versionText of
        String
"1" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
V1
        String
v -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Except.throwE forall a b. (a -> b) -> a -> b
$ forall a. a -> Seq a
Seq.singleton forall a b. (a -> b) -> a -> b
$
            String
"Unsupported config version " forall a. Semigroup a => a -> a -> a
<> String
v forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> String -> String
configFile String
storeDirectory

    Text
hashFunctionText <- case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (String -> Text
Strict.Text.pack String
"hash function") HashMap Text Text
map of
        Maybe Text
Nothing -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Except.throwE forall a b. (a -> b) -> a -> b
$ forall a. a -> Seq a
Seq.singleton forall a b. (a -> b) -> a -> b
$
            String
"Missing hash function in config file " forall a. Semigroup a => a -> a -> a
<> String -> String
configFile String
storeDirectory
        Just Text
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
x

    case Text -> Maybe HashFunctionName
readHashFunctionText Text
hashFunctionText of
        Maybe HashFunctionName
Nothing -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Except.throwE forall a b. (a -> b) -> a -> b
$ forall a. a -> Seq a
Seq.singleton forall a b. (a -> b) -> a -> b
$
            String
"Unsupported hash function " forall a. Semigroup a => a -> a -> a
<> Text -> String
Strict.Text.unpack Text
hashFunctionText
            forall a. Semigroup a => a -> a -> a
<> String
" in config file " forall a. Semigroup a => a -> a -> a
<> String -> String
configFile String
storeDirectory
        Just HashFunctionName
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HashFunctionName
x