refactor(ldap): CampusUserError -> LdapUserError

src/Auth/LDAP.hs

@@ -8,7 +8,7 @@ module Auth.LDAP
   ( apLdap
   , ADError(..), ADInvalidCredentials(..)
   , ldapLogin
-  , CampusUserException(..)
+  , LdapUserException(..)
   , ldapUser, ldapUser', ldapUser''
 --, ldapUserReTest, ldapUserReTest'
   , ldapUserMatr, ldapUserMatr'
@@ -46,11 +46,13 @@ apLdap = "LDAP"
 deriving newtype instance Ord Ldap.Attr
 
 
+-- TODO: rename
 data CampusLogin = CampusLogin
   { campusIdent :: CI Text
   , campusPassword :: Text
   } deriving (Generic)
 
+-- TODO: rename
 data CampusMessage = MsgCampusIdentPlaceholder
                    | MsgCampusIdent
                    | MsgCampusPassword
@@ -118,15 +120,14 @@ ldapUserEmail = Ldap.Attr "mail" :|
   ]
 
 
--- TODO: rename
+data LdapUserException = LdapUserLdapError LdapPoolError
-data CampusUserException = CampusUserLdapError LdapPoolError
+                       | LdapUserNoResult
-                         | CampusUserNoResult
+                       | LdapUserAmbiguous
-                         | CampusUserAmbiguous
   deriving (Show, Eq, Generic)
 
-instance Exception CampusUserException
+instance Exception LdapUserException
 
-makePrisms ''CampusUserException
+makePrisms ''LdapUserException
 
 
 ldapUserWith :: ( MonadUnliftIO m
@@ -139,13 +140,13 @@ ldapUserWith :: ( MonadUnliftIO m
                 --     -> m (Either LdapPoolError (Either CampusUserException (Ldap.AttrList [])))
                 -- )
              => (    LdapPool
-                  -> (Ldap -> m (Either CampusUserException (Ldap.AttrList [])))
+                  -> (Ldap -> m (Either LdapUserException (Ldap.AttrList [])))
-                  -> m (Either LdapPoolError (Either CampusUserException (Ldap.AttrList [])))
+                  -> m (Either LdapPoolError (Either LdapUserException (Ldap.AttrList [])))
                 )
              -> (LdapConf, LdapPool)
              -> Creds site
-             -> m (Either CampusUserException (Ldap.AttrList []))
+             -> m (Either LdapUserException (Ldap.AttrList []))
-ldapUserWith withLdap' (conf@LdapConf{..}, pool) Creds{..} = either (throwM . CampusUserLdapError) return <=< withLdap' pool $ \ldap -> liftIO . runExceptT $ do
+ldapUserWith withLdap' (conf@LdapConf{..}, pool) Creds{..} = either (throwM . LdapUserLdapError) return <=< withLdap' pool $ \ldap -> liftIO . runExceptT $ do
   lift $ Ldap.bind ldap ldapDn ldapPassword
   results <- case lookup "DN" credsExtra of
     Just userDN -> do
@@ -154,9 +155,9 @@ ldapUserWith withLdap' (conf@LdapConf{..}, pool) Creds{..} = either (throwM . Ca
     Nothing -> do
       lift $ findUser conf ldap credsIdent []
   case results of
-    [] -> throwE CampusUserNoResult
+    [] -> throwE LdapUserNoResult
     [Ldap.SearchEntry _ attrs] -> return attrs
-    _otherwise -> throwE CampusUserAmbiguous
+    _otherwise -> throwE LdapUserAmbiguous
 
 
 -- TODO: reintroduce once failover has been reimplemented
@@ -212,7 +213,7 @@ ldapUser'' :: ( MonadMask m
            -> Text
            -> m (Maybe (Ldap.AttrList []))
 ldapUser'' pool ident
-  = runMaybeT . catchIfMaybeT (is _CampusUserNoResult) $ ldapUser pool (Creds apLdap ident [])
+  = runMaybeT . catchIfMaybeT (is _LdapUserNoResult) $ ldapUser pool (Creds apLdap ident [])
 
 
 ldapUserMatr :: ( MonadUnliftIO m
@@ -222,13 +223,13 @@ ldapUserMatr :: ( MonadUnliftIO m
              => (LdapConf, LdapPool)
              -> UserMatriculation
              -> m (Ldap.AttrList [])
-ldapUserMatr (conf@LdapConf{..}, pool) userMatr = either (throwM . CampusUserLdapError) return <=< withLdap pool $ \ldap -> liftIO $ do
+ldapUserMatr (conf@LdapConf{..}, pool) userMatr = either (throwM . LdapUserLdapError) return <=< withLdap pool $ \ldap -> liftIO $ do
   Ldap.bind ldap ldapDn ldapPassword
   results <- findUserMatr conf ldap userMatr []
   case results of
-    [] -> throwM CampusUserNoResult
+    [] -> throwM LdapUserNoResult
     [Ldap.SearchEntry _ attrs] -> return attrs
-    _otherwise -> throwM CampusUserAmbiguous
+    _otherwise -> throwM LdapUserAmbiguous
 
 ldapUserMatr' :: ( MonadMask m
                  , MonadUnliftIO m
@@ -237,7 +238,7 @@ ldapUserMatr' :: ( MonadMask m
               => (LdapConf, LdapPool)
               -> UserMatriculation
               -> m (Maybe (Ldap.AttrList []))
-ldapUserMatr' pool = runMaybeT . catchIfMaybeT (is _CampusUserNoResult) . ldapUserMatr pool
+ldapUserMatr' pool = runMaybeT . catchIfMaybeT (is _LdapUserNoResult) . ldapUserMatr pool
 
 
 newtype ADInvalidCredentials = ADInvalidCredentials ADError