chore(avs): better error management

src/Handler/Utils/Avs.hs

@@ -1,6 +1,6 @@
 module Handler.Utils.Avs 
-  (
-    checkLicences
+  ( checkLicences
+  , setLicence
   ) where
 
 import Import
@@ -12,13 +12,19 @@ import Utils.Avs
 
 -- | Retrieve all currently valid driving licences and check against our database
 --   Only react to changes as compared to last seen status in avs.model
+--   TODO: turn into a job, once the interface is actually available
 checkLicences :: Handler ()
 checkLicences = do
-  getsYesod (view _appAvsQuery) >>= \case  
-    Nothing -> error "Avs Fail" -- TODO
-    Just AvsQuery{..} -> do
-      avsQueryGetLicences >>= \case      
-        Left err -> error $ show err -- TODO
-        Right (AvsGetLicences _licences) -> do 
-          error "CONTINUE HERE" -- TODO STUB
+  AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
+  AvsGetLicences _licences <- throwLeftM avsQueryGetLicences
+  --TODO this must be chunked into separate jobs/tasks
+  --forM licences $ \AvsDataLicence{..} -> do
+  error "CONTINUE HERE" -- TODO STUB
 
+-- Do we need this?
+-- getLicence :: UserId -> Handler AvsLicence
+
+--
+setLicence :: UserId -> AvsLicence -> Handler ()
+setLicence _uid _al = do 
+  error "CONTINUE HERE" -- TODO STUB

src/Model/Types/Avs.hs

@@ -61,6 +61,7 @@ data AvsLicence = AvsNoLicence | AvsLicenceVorfeld | AvsLicenceRollfeld
   deriving (Bounded, Enum, Eq, Ord, Read, Show, Generic, Typeable)
 
 instance ToJSON AvsLicence where
+    -- toJSON al = Number $ fromEnum AvsLicence -- would do, but...
     toJSON AvsNoLicence       = Number 0
     toJSON AvsLicenceVorfeld  = Number 1
     toJSON AvsLicenceRollfeld = Number 2

src/Utils.hs

@@ -791,6 +791,10 @@ catchMPlus _ = handle (const mzero :: e -> m a)
 catchIfMPlus :: forall m e a. (MonadPlus m, MonadCatch m, Exception e) => (e -> Bool) -> m a -> m a
 catchIfMPlus p act = catchIf p act (const mzero)
 
+-- | Monadic version of 'fromMaybe'
+fromMaybeM :: Monad m => m a -> m (Maybe a) -> m a
+fromMaybeM act = maybeM act pure
+
 fromMaybeT :: MaybeT Identity a -> Maybe a
 fromMaybeT = runIdentity . runMaybeT
 
@@ -816,8 +820,10 @@ formResultToMaybe  _              = empty
 maybeThrow :: (MonadThrow m, Exception e) => e -> Maybe a -> m a
 maybeThrow exc = maybe (throwM exc) return
 
-maybeThrowM :: (MonadThrow m, Exception e) => m e -> Maybe a -> m a
-maybeThrowM excM = maybe (throwM =<< excM) return
+-- | Monadic version of 'fromMaybe'
+maybeThrowM :: (Exception e, MonadThrow m) => e -> m (Maybe a) -> m a
+maybeThrowM = fromMaybeM . throwM
+
 
 mapMaybeM :: ( Monad m
              , MonoFoldable (f a)
@@ -880,15 +886,17 @@ whenIsRight :: Applicative f => Either a b -> (b -> f ()) -> f ()
 whenIsRight (Right x) f = f x
 whenIsRight (Left  _) _ = pure ()
 
-throwLeft :: (MonadThrow m, Exception exc) => Either exc a -> m a
-throwLeft = either throwM return
-
-
 {- Just a reminder for Steffen:
 mapLeft :: (a -> c) -> Either a b -> Either c b 
 mapLeft = over _Left 
 -}
 
+throwLeft :: (MonadThrow m, Exception exc) => Either exc a -> m a
+throwLeft = either throwM return
+
+throwLeftM :: (MonadThrow m, Exception exc) => m (Either exc a) -> m a
+throwLeftM = (throwLeft =<<)
+
 actLeft :: Applicative f => Either a b -> (a -> f (Either c b)) -> f (Either c b)
 actLeft (Left  x) f = f x
 actLeft (Right y) _ = pure $ Right y

src/Utils/Avs.hs

@@ -54,6 +54,19 @@ mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery
       | 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: