refactor(avs): remove need for undecideable super classes by simply using a sensible class definition

src/Handler/Utils/Avs.hs

@@ -49,6 +49,8 @@ import           Database.Esqueleto.Experimental ((:&)(..))
 import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
 import qualified Database.Esqueleto.Utils        as E
 
+import Servant.Client.Core.ClientError (ClientError)
+
 
 
 --------------------
@@ -572,38 +574,51 @@ updateReceivers uid = do
 -- CR3 Functions
 
 
-avsQuery :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m, SomeAvsQuery q) => q -> m (SomeAvsResponse q)
+-- | `SomeAvsQuery` is an umbrella to unify usage of all AVS queries, since Servant required separate types to fit the existing AVS-VSM API
-avsQuery qry
+class SomeAvsQuery q where 
-    | (Just (qto,qfr)) <- cacheable (pure qry) = do
+  type SomeAvsResponse q :: Type  
-        cexpire <- getsYesod $ preview $ _appAvsConf . _Just . _avsCacheExpiry . to Right
+  pickQuery       :: (MonadIO m) => AvsQuery -> q -> m (Either ClientError (SomeAvsResponse q))
-        let qry' = qto qry
+  -- | send query to AVS or maybe look it up within cache, depending on the type of the query
-        res <- memcachedBy cexpire qry' $ avsQueryNoCache qry'
+  avsQuery        :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m) => q -> m (SomeAvsResponse q)
-        return $ qfr res
+  avsQuery = avsQueryNoCache
-    | otherwise = avsQueryNoCache qry
+  -- | send query to AVS directly, never cached
+  avsQueryNoCache :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m) => q -> m (SomeAvsResponse q)
+  avsQueryNoCache qry = do 
+                          qfun <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ preview (_appAvsQuery . _Just . to pickQuery)
+                          throwLeftM $ qfun qry
+        
+avsQueryCached :: (SomeAvsQuery q, Binary q, Binary (SomeAvsResponse q), Typeable (SomeAvsResponse q), NFData (SomeAvsResponse q)
+                  ,   MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m) => q -> m (SomeAvsResponse q)
+avsQueryCached qry = do
+  cexpire <- getsYesod $ preview $ _appAvsConf . _Just . _avsCacheExpiry . to Right        
+  memcachedBy cexpire qry $ avsQueryNoCache qry  
+
+
+instance SomeAvsQuery AvsQueryPerson where
+  type SomeAvsResponse AvsQueryPerson = AvsResponsePerson
+  pickQuery = avsQueryPerson
+  avsQuery  = avsQueryCached
+            
+instance SomeAvsQuery AvsQueryStatus where
+  type SomeAvsResponse AvsQueryStatus = AvsResponseStatus
+  pickQuery = avsQueryStatus
+  avsQuery  = avsQueryCached
+
+instance SomeAvsQuery AvsQueryContact where
+  type SomeAvsResponse AvsQueryContact = AvsResponseContact
+  pickQuery = avsQueryContact
+  avsQuery  = avsQueryCached
+
+instance SomeAvsQuery AvsQuerySetLicences where
+  type SomeAvsResponse AvsQuerySetLicences = AvsResponseSetLicences
+  pickQuery = avsQuerySetLicences
+  -- NOTE: avsQuery  = avsQueryCached -- should not and indeed does not compile
+
+instance SomeAvsQuery AvsQueryGetAllLicences where
+  type SomeAvsResponse AvsQueryGetAllLicences = AvsResponseGetLicences
+  pickQuery  = const . avsQueryGetAllLicences
   
 
-avsQueryNoCache :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m, SomeAvsQuery q) => q -> m (SomeAvsResponse q)
-avsQueryNoCache qry = do 
-  qfun <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ preview (_appAvsQuery . _Just . to pickQuery)
-  throwLeftM $ qfun qry
-
--- avsQueryCached :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m, SomeAvsQueryCached q) => q -> m (SomeAvsResponse q)
--- avsQueryCached qry = do
---   cexpire <- getsYesod $ preview $ _appAvsConf . _Just . _avsCacheExpiry . to Right
---   memcachedBy cexpire qry $ avsQuery qry -- assumes that avsQueryNoCache is renamed to avsQuery as the default
-
-
--- avsPersonQueryCached :: AvsQueryPerson -> Handler AvsResponsePerson
--- avsPersonQueryCached = avsQueryCached
-
--- avsPersonQueryCached :: AvsQueryPerson -> Handler AvsResponsePerson
--- avsPersonQueryCached apq = do 
---   cexpire <- getsYesod $ preview $ _appAvsConf . _Just . _avsCacheExpiry . to Right
---   memcachedBy cexpire apq $ do
---     AvsQuery{avsQueryPerson} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
---     throwLeftM $ avsQueryPerson apq
-
-
 
 queryAvsCardNos :: Foldable t => t (Either AvsCardNo AvsFullCardNo) -> Handler (Set AvsPersonId)
 queryAvsCardNos = foldMapM queryAvsCardNo

src/Utils/Avs.hs

@@ -2,7 +2,6 @@
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
-{-# LANGUAGE UndecidableSuperClasses #-}
 
 module Utils.Avs where
 
@@ -65,54 +64,6 @@ data AvsQuery = AvsQuery
 makeLenses_ ''AvsQuery
 
 
--- | `SomeAvsQuery` is an umbrella to unify usage of all AVS queries, since Servant required separate types to fit the existing AVS-VSM API
-class (SomeAvsQuery (SomeAvsCachable q), Binary (SomeAvsCachable q), Binary (SomeAvsResponse (SomeAvsCachable q)), Typeable (SomeAvsResponse (SomeAvsCachable q)), NFData (SomeAvsResponse (SomeAvsCachable q)))
-    => SomeAvsQuery q where 
-  type SomeAvsResponse q :: Type  
-  pickQuery :: (MonadIO m) => AvsQuery -> q -> m (Either ClientError (SomeAvsResponse q))    
-  type SomeAvsCachable q :: Type
-  cacheable :: Proxy q -> Maybe (q -> SomeAvsCachable q, SomeAvsResponse (SomeAvsCachable q) -> SomeAvsResponse q)
-            
-instance SomeAvsQuery AvsQueryPerson where
-  type SomeAvsResponse AvsQueryPerson = AvsResponsePerson
-  pickQuery          = avsQueryPerson
-  type SomeAvsCachable AvsQueryPerson = AvsQueryPerson
-  cacheable _ = Just (id, id)
-            
-instance SomeAvsQuery AvsQueryStatus where
-  type SomeAvsResponse AvsQueryStatus = AvsResponseStatus
-  pickQuery          = avsQueryStatus
-  type SomeAvsCachable AvsQueryStatus = AvsQueryStatus
-  cacheable _ = Just (id, id)
-
-instance SomeAvsQuery AvsQueryContact where
-  type SomeAvsResponse AvsQueryContact = AvsResponseContact
-  pickQuery          = avsQueryContact
-  type SomeAvsCachable AvsQueryContact = AvsQueryContact
-  cacheable _ = Just (id, id)
-
---  class (SomeAvsQuery q, Typeable q, Binary q, Binary (SomeAvsResponse q), Typeable (SomeAvsResponse q), NFData (SomeAvsResponse q)) => SomeAvsCachable q
---  instance SomeAvsCachable AvsQueryPerson
-
--- a dummy for non-cacheable queries
-instance SomeAvsQuery () where
-  type SomeAvsResponse () = ()
-  type SomeAvsCachable () = ()
-  pickQuery _ () = return $ Right () 
-  cacheable _ = Just (id,id)
-
-instance SomeAvsQuery AvsQuerySetLicences where
-  type SomeAvsResponse AvsQuerySetLicences = AvsResponseSetLicences
-  pickQuery = avsQuerySetLicences
-  type SomeAvsCachable AvsQuerySetLicences = () -- not cachable 
-  cacheable _ = Nothing
-
-instance SomeAvsQuery AvsQueryGetAllLicences where
-  type SomeAvsResponse AvsQueryGetAllLicences = AvsResponseGetLicences
-  pickQuery  = const . avsQueryGetAllLicences
-  type SomeAvsCachable AvsQueryGetAllLicences = () -- not cachable 
-  cacheable _ = Nothing
-
 -- AVS/VSM-Interface currently only allows to query ID 0, which means all licences
 -- instance SomeAvsQuery AvsQueryGetLicences where
 --   type SomeAvsResponse AvsQueryGetLicences = AvsResponseGetLicences