77 lines
3.1 KiB
Haskell
77 lines
3.1 KiB
Haskell
module Utils.Avs where
|
|
|
|
import Import.NoModel
|
|
import Utils.Lens
|
|
|
|
import Servant
|
|
import Servant.Client
|
|
import Servant.Client.Core (requestPath)
|
|
|
|
import Model.Types.Avs
|
|
|
|
|
|
-------------
|
|
-- AVS API --
|
|
-------------
|
|
type AVS = BasicAuth "avs_fradrive" String :> "FraVSMService" :> "v1" :> (AVSPersonSearch :<|> AVSPersonStatus :<|> AVSSetRampLicence :<|> AVSGetRampLicences)
|
|
type AVSPersonSearch = "PersonSearch" :> ReqBody '[JSON] AvsQueryPerson :> Post '[JSON] AvsResponsePerson
|
|
type AVSPersonStatus = "PersonStatus" :> ReqBody '[JSON] AvsQueryStatus :> Post '[JSON] AvsResponseStatus
|
|
type AVSSetRampLicence = "SetRampDrivingLicence" :> ReqBody '[JSON] AvsDataLicence :> Post '[JSON] ()
|
|
type AVSGetRampLicences = "InfoRampDrivingLicence" :> Post '[JSON] AvsGetLicences
|
|
|
|
avsApi :: Proxy AVS
|
|
avsApi = Proxy
|
|
|
|
{-
|
|
-- Somehow the GADT-style declaration is not flexible enough to compile at the location of the function call
|
|
data AvsQuery where
|
|
AvsQuery :: { avsQueryPerson :: MonadIO m => AvsQueryPerson -> m (Either ClientError AvsResponsePerson)
|
|
, avsQueryStatus :: MonadIO m => AvsQueryStatus -> m (Either ClientError AvsResponseStatus)
|
|
}
|
|
-> AvsQuery
|
|
-}
|
|
|
|
data AvsQuery = AvsQuery
|
|
{ avsQueryPerson :: forall m. MonadIO m => AvsQueryPerson -> m (Either ClientError AvsResponsePerson)
|
|
, avsQueryStatus :: forall m. MonadIO m => AvsQueryStatus -> m (Either ClientError AvsResponseStatus)
|
|
, avsQuerySetLicence :: forall m. MonadIO m => AvsDataLicence -> m (Either ClientError ())
|
|
, avsQueryGetLicences :: forall m. MonadIO m => m (Either ClientError AvsGetLicences)
|
|
}
|
|
|
|
makeLenses_ ''AvsQuery
|
|
|
|
mkAvsQuery :: BaseUrl -> BasicAuthData -> ClientEnv -> AvsQuery
|
|
mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery
|
|
{ avsQueryPerson = \q -> liftIO $ catch404toEmpty <$> runClientM (rawQueryPerson q) cliEnv
|
|
, avsQueryStatus = \q -> liftIO $ runClientM (rawQueryStatus q) cliEnv
|
|
, avsQuerySetLicence = \q -> liftIO $ runClientM (rawQuerySetLicence q) cliEnv
|
|
, avsQueryGetLicences = liftIO $ runClientM rawQueryGetLicences cliEnv
|
|
}
|
|
where
|
|
(rawQueryPerson :<|> rawQueryStatus :<|> rawQuerySetLicence :<|> rawQueryGetLicences) = client avsApi basicAuth
|
|
catch404toEmpty :: Either ClientError AvsResponsePerson -> Either ClientError AvsResponsePerson
|
|
catch404toEmpty (Left (FailureResponse (requestPath -> (base, _path)) (statusCode . responseStatusCode -> 404)))
|
|
| baseUrl == base = Right $ AvsResponsePerson mempty -- WORKAROUND: AVS server erroneously returns 404 if no matching person could be found in its database!
|
|
catch404toEmpty other = other
|
|
|
|
|
|
|
|
--------------------
|
|
-- AVS Exceptions --
|
|
--------------------
|
|
|
|
data AvsException
|
|
= AvsInterfaceUnavailable
|
|
deriving (Show, Generic, Typeable)
|
|
instance Exception AvsException
|
|
|
|
|
|
|
|
{-
|
|
TODOs
|
|
Connect AVS query to LDAP queries for automatic synchronisation:
|
|
- add query to Auth.LDAP.campusUserMatr
|
|
- add query to Auth.LDAP.campusLogin
|
|
- jobs.Handler.dispatchJobSynchroniseLdap
|
|
|
|
-} |