fix: fix tests

package.yaml

@@ -136,6 +136,7 @@ dependencies:
   - constraints
   - memory
   - pqueue
+  - deepseq
 
 other-extensions:
   - GeneralizedNewtypeDeriving

src/Audit.hs

@@ -20,6 +20,9 @@ import qualified Network.Wai as Wai
 import qualified Network.Socket as Wai
 
 import qualified Net.IP as IP
+import qualified Net.IPv6 as IPv6
+
+import Control.Exception (ErrorCall(..), evaluate)
 
 {-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-}
 
@@ -30,18 +33,19 @@ data AuditRemoteException
 instance Exception AuditRemoteException
 
 
-getRemote :: (MonadHandler m, MonadThrow m, HasAppSettings (HandlerSite m)) => m IP
-getRemote = do
+getRemote :: forall m. (MonadHandler m, MonadCatch m, HasAppSettings (HandlerSite m)) => m IP
+getRemote = handle testHandler $ do
   ipFromHeader <- getsYesod $ view _appIpFromHeader
   wai <- waiRequest
 
-  if
+  ip <- if
     | ipFromHeader
     , Just ip <- byHeader wai
       -> return ip
     | otherwise
       -> byRemoteHost wai
-  
+
+  liftIO $ evaluate $!! ip
   where
     byHeader wai = listToMaybe $ do
       (h, v) <- Wai.requestHeaders wai
@@ -58,6 +62,15 @@ getRemote = do
             in return $ IP.ipv6 w1 w2 w3 w4 w5 w6 w7 w8
       _other -> throwM ARUnsupportedSocketKind
 
+    testHandler :: ErrorCall -> m IP
+    -- ^ `Yesod.Core.Unsafe.runFakeHandler` does not set a `Wai.remoteHost`
+    --
+    -- We catch only the specific error call used by
+    -- `Yesod.Core.Unsafe.runFakeHandler` and replace it with `IPv6.any` as a
+    -- placeholder value for testing.
+    testHandler (ErrorCall "runFakeHandler-remoteHost") = return $ IP.fromIPv6 IPv6.any
+    testHandler err = throwM err
+
 
 data AuditException
   = AuditRemoteException AuditRemoteException

src/Handler/Material.hs

@@ -356,7 +356,7 @@ postMDelR tid ssh csh mnm = do
     , drSuccessMessage = SomeMessage $ MsgMaterialDeleted mnm
     , drSuccess = SomeRoute $ CourseR tid ssh csh   MaterialListR
     , drAbort   = SomeRoute $ CourseR tid ssh csh $ MaterialR mnm MShowR
-    , drDelete  = \_ -> id  -- TODO: audit 
+    , drDelete  = const id  -- TODO: audit 
     }
 
 -- | Serve all material-files

src/Handler/Utils/Course.hs

@@ -24,5 +24,5 @@ courseDeleteRoute drRecords = DeleteRoute
   , drSuccessMessage = SomeMessage MsgCourseDeleted
   , drAbort = error "drAbort undefined"
   , drSuccess = error "drSuccess undefined"
-  , drDelete = \_ -> id  -- TODO: audit
+  , drDelete = const id  -- TODO: audit
   }

src/Handler/Utils/Sheet.hs

@@ -79,5 +79,5 @@ sheetDeleteRoute drRecords = DeleteRoute
   , drSuccessMessage = SomeMessage MsgSheetDeleted
   , drAbort = error "drAbort undefined"
   , drSuccess = error "drSuccess undefined"
-  , drDelete = \_ -> id  -- TODO: audit
+  , drDelete = const id  -- TODO: audit
   }

src/Net/IP/Instances.hs

@@ -12,6 +12,13 @@ import Database.Persist.Sql
 
 import qualified Data.Text.Encoding as Text
 
+import Control.DeepSeq (NFData)
+
+import Net.IPv6.Instances ()
+
+
+deriving instance Generic IP
+
 
 instance PersistField IP where
   toPersistValue = PersistDbSpecific . encodeUtf8 . IP.encode
@@ -21,3 +28,5 @@ instance PersistField IP where
   fromPersistValue _ = Left "IP-address values must be converted from PersistDbSpecific, PersistText, or PersistByteString"
 instance PersistFieldSql IP where
   sqlType _ = SqlOther "inet"
+
+instance NFData IP

src/Net/IPv6/Instances.hs

@@ -0,0 +1,16 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Net.IPv6.Instances
+  (
+  ) where
+
+import ClassyPrelude
+
+import Net.IPv6 (IPv6)
+import qualified Net.IPv6 as IPv6
+
+import Control.DeepSeq (NFData)
+
+
+deriving instance Generic IPv6
+
+instance NFData IPv6