{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# OPTIONS_GHC -fno-warn-missing-export-lists #-}

-- | The platform environment
module Podenv.Env where

import Data.List.NonEmpty qualified
import Data.Maybe qualified
import Data.Text qualified
import Lens.Family.TH (makeLenses)
import Podenv.Prelude

data AppEnv = AppEnv
  { AppEnv -> Maybe FilePath
_hostXdgRunDir :: Maybe FilePath,
    AppEnv -> Maybe FilePath
_hostHomeDir :: Maybe FilePath,
    AppEnv -> FilePath
_hostCwd :: FilePath,
    AppEnv -> UserID
_hostUid :: UserID,
    AppEnv -> Maybe FilePath
_appHomeDir :: Maybe FilePath,
    AppEnv -> FilePath -> IO (Maybe FilePath)
_rootfsHome :: FilePath -> IO (Maybe FilePath)
  }

$(makeLenses ''AppEnv)

type AppEnvT a = ReaderT AppEnv IO a

-- | Get the current uid home path in the rootfs
getRootfsHome :: UserID -> Maybe FilePath -> FilePath -> IO (Maybe FilePath)
getRootfsHome :: UserID -> Maybe FilePath -> FilePath -> IO (Maybe FilePath)
getRootfsHome UserID
_ (Just FilePath
hostHome) FilePath
"/" = Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
hostHome
getRootfsHome UserID
uid Maybe FilePath
_ FilePath
fp = do
  Text
passwd <- FilePath -> IO Text
readFileM (FilePath
fp FilePath -> FilePath -> FilePath
</> FilePath
"etc/passwd")
  Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$
    Text -> FilePath
forall a. ToString a => a -> FilePath
toString (Text -> FilePath)
-> (NonEmpty Text -> Text) -> NonEmpty Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> Text
forall a. NonEmpty a -> a
Data.List.NonEmpty.head
      (NonEmpty Text -> FilePath)
-> Maybe (NonEmpty Text) -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
Data.List.NonEmpty.nonEmpty ((Text -> Maybe Text) -> [Text] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
Data.Maybe.mapMaybe Text -> Maybe Text
isUser ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
forall t. IsText t "lines" => t -> [t]
Podenv.Prelude.lines Text
passwd)
  where
    isUser :: Text -> Maybe Text
isUser Text
l = case Text -> Text -> [Text]
Data.Text.splitOn Text
":" Text
l of
      (Text
_ : Text
_ : Text
uid' : Text
_ : Text
_ : Text
home : [Text]
_) | FilePath -> Maybe UserID
forall a. Read a => FilePath -> Maybe a
readMaybe (Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
uid') Maybe UserID -> Maybe UserID -> Bool
forall a. Eq a => a -> a -> Bool
== UserID -> Maybe UserID
forall a. a -> Maybe a
Just UserID
uid -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
home
      [Text]
_ -> Maybe Text
forall a. Maybe a
Nothing

new :: IO AppEnv
new :: IO AppEnv
new = do
  UserID
uid <- IO UserID
getRealUserID
  Maybe FilePath
home <- FilePath -> IO (Maybe FilePath)
forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe FilePath)
lookupEnv FilePath
"HOME"
  Maybe FilePath
-> Maybe FilePath
-> FilePath
-> UserID
-> Maybe FilePath
-> (FilePath -> IO (Maybe FilePath))
-> AppEnv
AppEnv
    (Maybe FilePath
 -> Maybe FilePath
 -> FilePath
 -> UserID
 -> Maybe FilePath
 -> (FilePath -> IO (Maybe FilePath))
 -> AppEnv)
-> IO (Maybe FilePath)
-> IO
     (Maybe FilePath
      -> FilePath
      -> UserID
      -> Maybe FilePath
      -> (FilePath -> IO (Maybe FilePath))
      -> AppEnv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe FilePath)
lookupEnv FilePath
"XDG_RUNTIME_DIR"
    IO
  (Maybe FilePath
   -> FilePath
   -> UserID
   -> Maybe FilePath
   -> (FilePath -> IO (Maybe FilePath))
   -> AppEnv)
-> IO (Maybe FilePath)
-> IO
     (FilePath
      -> UserID
      -> Maybe FilePath
      -> (FilePath -> IO (Maybe FilePath))
      -> AppEnv)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
home
    IO
  (FilePath
   -> UserID
   -> Maybe FilePath
   -> (FilePath -> IO (Maybe FilePath))
   -> AppEnv)
-> IO FilePath
-> IO
     (UserID
      -> Maybe FilePath -> (FilePath -> IO (Maybe FilePath)) -> AppEnv)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO FilePath
getCurrentDirectory
    IO
  (UserID
   -> Maybe FilePath -> (FilePath -> IO (Maybe FilePath)) -> AppEnv)
-> IO UserID
-> IO
     (Maybe FilePath -> (FilePath -> IO (Maybe FilePath)) -> AppEnv)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserID -> IO UserID
forall (f :: * -> *) a. Applicative f => a -> f a
pure UserID
uid
    IO (Maybe FilePath -> (FilePath -> IO (Maybe FilePath)) -> AppEnv)
-> IO (Maybe FilePath)
-> IO ((FilePath -> IO (Maybe FilePath)) -> AppEnv)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
    IO ((FilePath -> IO (Maybe FilePath)) -> AppEnv)
-> IO (FilePath -> IO (Maybe FilePath)) -> IO AppEnv
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FilePath -> IO (Maybe FilePath))
-> IO (FilePath -> IO (Maybe FilePath))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserID -> Maybe FilePath -> FilePath -> IO (Maybe FilePath)
getRootfsHome UserID
uid Maybe FilePath
home)