{-# LANGUAGE NoFieldSelectors    #-}
{-# LANGUAGE OverloadedRecordDot #-}

-- | The module of this name differs as between Windows and non-Windows builds.

-- This is the Windows version. Non-Windows builds rely on the unix package,

-- which exposes a module of the same name.


module System.Posix.User
  ( getEffectiveUserID
  , getEffectiveGroupID
  , getGroups
  , getUserEntryForName
  , homeDirectory
  , setGroupID
  , setUserID
  ) where

import           System.IO.Error ( illegalOperationErrorType, mkIOError )
import           System.PosixCompat.Types ( GroupID, UserID )

unsupported :: String -> IO a
unsupported :: forall a. String -> IO a
unsupported String
f = IOError -> IO a
forall a. IOError -> IO a
ioError (IOError -> IO a) -> IOError -> IO a
forall a b. (a -> b) -> a -> b
$ IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
illegalOperationErrorType String
x Maybe Handle
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
 where
  x :: String
x = String
"System.Posix.User." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": not supported on Windows."

getEffectiveUserID :: IO UserID
getEffectiveUserID :: IO UserID
getEffectiveUserID = String -> IO UserID
forall a. String -> IO a
unsupported String
"getEffectiveUserID"

getEffectiveGroupID :: IO GroupID
getEffectiveGroupID :: IO GroupID
getEffectiveGroupID = String -> IO GroupID
forall a. String -> IO a
unsupported String
"getEffectiveGroupID"

getGroups :: IO [GroupID]
getGroups :: IO [GroupID]
getGroups = [GroupID] -> IO [GroupID]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []

getUserEntryForName :: String -> IO UserEntry
getUserEntryForName :: String -> IO UserEntry
getUserEntryForName String
_ = String -> IO UserEntry
forall a. String -> IO a
unsupported String
"getUserEntryForName"

setGroupID :: GroupID -> IO ()
setGroupID :: GroupID -> IO ()
setGroupID GroupID
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

setUserID :: UserID -> IO ()
setUserID :: UserID -> IO ()
setUserID UserID
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

data UserEntry = UserEntry
    { UserEntry -> String
userName      :: String
    , UserEntry -> String
userPassword  :: String
    , UserEntry -> UserID
userID        :: UserID
    , UserEntry -> GroupID
userGroupID   :: GroupID
    , UserEntry -> String
userGecos     :: String
    , UserEntry -> String
homeDirectory :: String
    , UserEntry -> String
userShell     :: String
    } deriving (UserEntry -> UserEntry -> Bool
(UserEntry -> UserEntry -> Bool)
-> (UserEntry -> UserEntry -> Bool) -> Eq UserEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserEntry -> UserEntry -> Bool
== :: UserEntry -> UserEntry -> Bool
$c/= :: UserEntry -> UserEntry -> Bool
/= :: UserEntry -> UserEntry -> Bool
Eq, ReadPrec [UserEntry]
ReadPrec UserEntry
Int -> ReadS UserEntry
ReadS [UserEntry]
(Int -> ReadS UserEntry)
-> ReadS [UserEntry]
-> ReadPrec UserEntry
-> ReadPrec [UserEntry]
-> Read UserEntry
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS UserEntry
readsPrec :: Int -> ReadS UserEntry
$creadList :: ReadS [UserEntry]
readList :: ReadS [UserEntry]
$creadPrec :: ReadPrec UserEntry
readPrec :: ReadPrec UserEntry
$creadListPrec :: ReadPrec [UserEntry]
readListPrec :: ReadPrec [UserEntry]
Read, Int -> UserEntry -> String -> String
[UserEntry] -> String -> String
UserEntry -> String
(Int -> UserEntry -> String -> String)
-> (UserEntry -> String)
-> ([UserEntry] -> String -> String)
-> Show UserEntry
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> UserEntry -> String -> String
showsPrec :: Int -> UserEntry -> String -> String
$cshow :: UserEntry -> String
show :: UserEntry -> String
$cshowList :: [UserEntry] -> String -> String
showList :: [UserEntry] -> String -> String
Show)

homeDirectory :: UserEntry -> String
homeDirectory :: UserEntry -> String
homeDirectory UserEntry
ue = UserEntry
ue.homeDirectory