module System.Posix.PAM where

import Control.Monad.IO.Class    ( MonadIO, liftIO )

import Foreign.Ptr

import System.Posix.PAM.LowLevel
import System.Posix.PAM.Types

-- | `isSuccess` @responseCode@ checks if @responseCode@ is equal to `PamSuccess`,
--   i.e. checking if the account check/authentication succeeded
isSuccess :: PamRetCode -> Bool
isSuccess :: PamRetCode -> Bool
isSuccess = (PamRetCode -> PamRetCode -> Bool
forall a. Eq a => a -> a -> Bool
== PamRetCode
PamSuccess)

-- | `whenSuccess` @responseCode action@ returns @action@ if @responseCode@ is
--   `PamSuccess`, otherwise returns @responseCode@
whenSuccess :: MonadIO m => PamRetCode -> m PamRetCode -> m PamRetCode
whenSuccess :: PamRetCode -> m PamRetCode -> m PamRetCode
whenSuccess code :: PamRetCode
code action :: m PamRetCode
action = if PamRetCode -> Bool
isSuccess PamRetCode
code then m PamRetCode
action else PamRetCode -> m PamRetCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure PamRetCode
code

-- | `authenticate` @service user password@ attempts to authenticate @user@ and
--   @password@ with PAM using @service@ to determine which file in /etc/pam.d to
--   use
authenticate :: MonadIO m => String -> String -> String -> m PamRetCode
authenticate :: String -> String -> String -> m PamRetCode
authenticate serviceName :: String
serviceName userName :: String
userName password :: String
password = do
    let custConv :: PamConv
        custConv :: PamConv
custConv _ messages :: [PamMessage]
messages = [PamResponse] -> IO [PamResponse]
forall (m :: * -> *) a. Monad m => a -> m a
return ([PamResponse] -> IO [PamResponse])
-> [PamResponse] -> IO [PamResponse]
forall a b. (a -> b) -> a -> b
$ (PamMessage -> PamResponse) -> [PamMessage] -> [PamResponse]
forall a b. (a -> b) -> [a] -> [b]
map (\ _ -> String -> PamResponse
PamResponse String
password) [PamMessage]
messages

    (pamH :: PamHandle
pamH, r1 :: PamRetCode
r1) <- IO (PamHandle, PamRetCode) -> m (PamHandle, PamRetCode)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PamHandle, PamRetCode) -> m (PamHandle, PamRetCode))
-> IO (PamHandle, PamRetCode) -> m (PamHandle, PamRetCode)
forall a b. (a -> b) -> a -> b
$ String -> String -> (PamConv, Ptr ()) -> IO (PamHandle, PamRetCode)
pamStart String
serviceName String
userName (PamConv
custConv, Ptr ()
forall a. Ptr a
nullPtr)

    PamRetCode -> m PamRetCode -> m PamRetCode
forall (m :: * -> *).
MonadIO m =>
PamRetCode -> m PamRetCode -> m PamRetCode
whenSuccess PamRetCode
r1 (m PamRetCode -> m PamRetCode) -> m PamRetCode -> m PamRetCode
forall a b. (a -> b) -> a -> b
$ do
        PamRetCode
status <- IO PamRetCode -> m PamRetCode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PamRetCode -> m PamRetCode) -> IO PamRetCode -> m PamRetCode
forall a b. (a -> b) -> a -> b
$ PamHandle -> PamFlag -> IO PamRetCode
pamAuthenticate PamHandle
pamH PamFlag
PamSilent
        PamRetCode -> m PamRetCode -> m PamRetCode
forall (m :: * -> *).
MonadIO m =>
PamRetCode -> m PamRetCode -> m PamRetCode
whenSuccess PamRetCode
status (m PamRetCode -> m PamRetCode) -> m PamRetCode -> m PamRetCode
forall a b. (a -> b) -> a -> b
$ IO PamRetCode -> m PamRetCode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PamRetCode -> m PamRetCode) -> IO PamRetCode -> m PamRetCode
forall a b. (a -> b) -> a -> b
$ PamHandle -> PamRetCode -> IO PamRetCode
pamEnd PamHandle
pamH PamRetCode
PamSuccess

-- | `checkAccount` @service user@ checks if @user@ is a valid user. @service@ is
--   is the service name given to PAM (see `authenticate`)
checkAccount :: MonadIO m => String -> String -> m PamRetCode
checkAccount :: String -> String -> m PamRetCode
checkAccount serviceName :: String
serviceName userName :: String
userName = do
    (pamH :: PamHandle
pamH, r1 :: PamRetCode
r1) <- IO (PamHandle, PamRetCode) -> m (PamHandle, PamRetCode)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PamHandle, PamRetCode) -> m (PamHandle, PamRetCode))
-> IO (PamHandle, PamRetCode) -> m (PamHandle, PamRetCode)
forall a b. (a -> b) -> a -> b
$ String -> String -> (PamConv, Ptr ()) -> IO (PamHandle, PamRetCode)
pamStart String
serviceName String
userName (\_ _ -> [PamResponse] -> IO [PamResponse]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [], Ptr ()
forall a. Ptr a
nullPtr)

    PamRetCode -> m PamRetCode -> m PamRetCode
forall (m :: * -> *).
MonadIO m =>
PamRetCode -> m PamRetCode -> m PamRetCode
whenSuccess PamRetCode
r1 (m PamRetCode -> m PamRetCode) -> m PamRetCode -> m PamRetCode
forall a b. (a -> b) -> a -> b
$ do
        PamRetCode
status <- IO PamRetCode -> m PamRetCode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PamRetCode -> m PamRetCode) -> IO PamRetCode -> m PamRetCode
forall a b. (a -> b) -> a -> b
$ PamHandle -> PamFlag -> IO PamRetCode
pamAcctMgmt PamHandle
pamH PamFlag
PamSilent
        PamRetCode -> m PamRetCode -> m PamRetCode
forall (m :: * -> *).
MonadIO m =>
PamRetCode -> m PamRetCode -> m PamRetCode
whenSuccess PamRetCode
status (m PamRetCode -> m PamRetCode) -> m PamRetCode -> m PamRetCode
forall a b. (a -> b) -> a -> b
$ IO PamRetCode -> m PamRetCode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PamRetCode -> m PamRetCode) -> IO PamRetCode -> m PamRetCode
forall a b. (a -> b) -> a -> b
$ PamHandle -> PamRetCode -> IO PamRetCode
pamEnd PamHandle
pamH PamRetCode
PamSuccess

-- | `pamCodeToMessage` @responseCode@ returns a description of @responseCode@
--   in the context of PAM
pamCodeToMessage :: PamRetCode -> String
pamCodeToMessage :: PamRetCode -> String
pamCodeToMessage = (String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String)
-> (PamRetCode -> (String, String)) -> PamRetCode -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PamRetCode -> (String, String)
pamCodeDetails

-- | `pamCodeToMessage` @responseCode@ returns the name of the define used in C
--   to represent @responseCode@
pamCodeToCDefine :: PamRetCode -> String
pamCodeToCDefine :: PamRetCode -> String
pamCodeToCDefine = (String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String)
-> (PamRetCode -> (String, String)) -> PamRetCode -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PamRetCode -> (String, String)
pamCodeDetails

-- | `pamCodeDetails` @responseCode@ returns a tuple of the name of the C define
--   and a description of @responseCode@
pamCodeDetails :: PamRetCode -> (String, String)
pamCodeDetails :: PamRetCode -> (String, String)
pamCodeDetails PamSuccess        = ("PAM_SUCCESS", "Successful function return")
pamCodeDetails (PamRetCode code :: Int
code) = case Int
code of
    1 -> ("PAM_OPEN_ERR", "dlopen() failure when dynamically loading a service module")
    2 -> ("PAM_SYMBOL_ERR", "Symbol not found")
    3 -> ("PAM_SERVICE_ERR", "Error in service module")
    4 -> ("PAM_SYSTEM_ERR", "System error")
    5 -> ("PAM_BUF_ERR", "Memory buffer error")
    6 -> ("PAM_PERM_DENIED", "Permission denied")
    7 -> ("PAM_AUTH_ERR", "Authentication failure")
    8 -> ("PAM_CRED_INSUFFICIENT", "Can not access authentication data due to insufficient credentials")
    9 -> ("PAM_AUTHINFO_UNAVAIL", "Underlying authentication service can not retrieve authentication information")
    10 -> ("PAM_USER_UNKNOWN", "User not known to the underlying authenticaiton module")
    11 -> ("PAM_MAXTRIES", "An authentication service has maintained a retry count which has been reached.  No further retries should be attempted")
    12 -> ("PAM_NEW_AUTHTOK_REQD", "New authentication token required. This is normally returned if the machine security policies require that the password should be changed beccause the password is NULL or it has aged")
    13 -> ("PAM_ACCT_EXPIRED", "User account has expired")
    14 -> ("PAM_SESSION_ERR", "Can not make/remove an entry for the specified session")
    15 -> ("PAM_CRED_UNAVAIL", "Underlying authentication service can not retrieve user credentials unavailable")
    16 -> ("PAM_CRED_EXPIRED", "User credentials expired")
    17 -> ("PAM_CRED_ERR", "Failure setting user credentials")
    18 -> ("PAM_NO_MODULE_DATA", "No module specific data is present")
    19 -> ("PAM_CONV_ERR", "Conversation error")
    20 -> ("PAM_AUTHTOK_ERR", "Authentication token manipulation error")
    21 -> ("PAM_AUTHTOK_RECOVERY_ERR", "Authentication information cannot be recovered")
    22 -> ("PAM_AUTHTOK_LOCK_BUSY", "Authentication token lock busy")
    23 -> ("PAM_AUTHTOK_DISABLE_AGING", "Authentication token aging disabled")
    24 -> ("PAM_TRY_AGAIN", "Preliminary check by password service")
    25 -> ("PAM_IGNORE", "Ignore underlying account module regardless of whether the control flag is required, optional, or sufficient")
    26 -> ("PAM_ABORT", "Critical error (?module fail now request)")
    27 -> ("PAM_AUTHTOK_EXPIRED", "user's authentication token has expired")
    28 -> ("PAM_MODULE_UNKNOWN", "module is not known")
    29 -> ("PAM_BAD_ITEM", "Bad item passed to pam_*_item()")
    30 -> ("PAM_CONV_AGAIN", "conversation function is event driven and data is not available yet")
    31 -> ("PAM_INCOMPLETE", "please call this function again to complete authentication stack. Before calling again, verify that conversation is completed")
    a :: Int
a -> ("PAM_UNKNOWN", "There is no code description in haskell pam library: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
a)