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 PamRetCode
code 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 String
serviceName String
userName String
password = do
    let custConv :: PamConv
        custConv :: PamConv
custConv Ptr ()
_ [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 (\ PamMessage
_ -> String -> PamResponse
PamResponse String
password) [PamMessage]
messages

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