Upgrade to GHC 8.4 and LTS 12

clone-deps.sh

@@ -1,17 +1,16 @@
 #!/bin/sh
 
 VERVIS='https://dev.angeley.es/s/fr33domlover/r'
-HUB='https://hub.darcs.net/fr33domlover'
 
 mkdir -p lib
 cd lib
-darcs clone $HUB/hit-graph
+darcs clone $VERVIS/hit-graph
-darcs clone $HUB/hit-harder
+darcs clone $VERVIS/hit-harder
-darcs clone $HUB/hit-network
+darcs clone $VERVIS/hit-network
 darcs clone $VERVIS/darcs-lights
 darcs clone $VERVIS/darcs-rev
 darcs clone $VERVIS/ssh
 darcs clone $VERVIS/persistent-migration
 darcs clone $VERVIS/persistent-email-address
 darcs clone $VERVIS/time-interval-aeson
-darcs clone $VERVIS/yesod-mail-send --to-hash 2800294a41daf57cd420710bc79c8c9b06c0d3dd
+darcs clone $VERVIS/yesod-mail-send

src/Data/CaseInsensitive/Local.hs

@@ -36,13 +36,13 @@ import Data.Hashable (Hashable)
 import Data.String (IsString)
 
 newtype AsOriginal s = AsOriginal { unOriginal :: CI s }
-    deriving (Eq, Ord, Read, Show, IsString, Monoid, Hashable, FoldCase)
+    deriving (Eq, Ord, Read, Show, IsString, Semigroup, Hashable, FoldCase)
 
 mkOrig :: FoldCase s => s -> AsOriginal s
 mkOrig = AsOriginal . mk
 
 newtype AsCaseFolded s = AsCaseFolded { unCaseFolded :: CI s }
-    deriving (Eq, Ord, Read, Show, IsString, Monoid, Hashable, FoldCase)
+    deriving (Eq, Ord, Read, Show, IsString, Semigroup, Hashable, FoldCase)
 
 mkFolded :: FoldCase s => s -> AsCaseFolded s
 mkFolded = AsCaseFolded . mk

src/Data/Git/Local.hs

@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -33,6 +33,7 @@ import Control.Monad (when)
 import Data.Byteable (toBytes)
 import Data.Git
 import Data.Git.Harder
+import Data.Git.Ref (SHA1)
 import Data.Git.Types (GitTime (..))
 import Data.Set (Set)
 import Data.Text (Text)
@@ -104,7 +105,7 @@ data PathView
     | TreeView Text ObjId TreeRows
     | BlobView Text ObjId BL.ByteString
 
-viewPath :: Git -> Tree -> EntPath -> IO PathView
+viewPath :: Git SHA1 -> Tree SHA1 -> EntPath -> IO PathView
 viewPath git root path = do
     let toEnt False = EntObjBlob
         toEnt True  = EntObjTree
@@ -122,8 +123,8 @@ viewPath git root path = do
                 Left blob  -> return $ BlobView nameT oid (blobGetContent blob)
                 Right tree -> TreeView nameT oid <$> mkRows tree
 
-listBranches :: Git -> IO (Set Text)
+listBranches :: Git SHA1 -> IO (Set Text)
 listBranches git = S.mapMonotonic (T.pack . refNameRaw) <$> branchList git
 
-listTags :: Git -> IO (Set Text)
+listTags :: Git SHA1 -> IO (Set Text)
 listTags git = S.mapMonotonic (T.pack . refNameRaw) <$> tagList git

src/Database/Persist/Local/Sql/Orphan/Common.hs

@@ -13,7 +13,6 @@ module Database.Persist.Local.Sql.Orphan.Common
     ( fieldName
     , dummyFromFilts
     , getFiltsValues
-    , updatePersistValue
     , filterClause
     , orderClause
     )
@@ -203,10 +202,6 @@ filterClauseHelper includeTable includeWhere conn orNull filters =
         showSqlFilter NotIn = " NOT IN "
         showSqlFilter (BackendSpecificFilter s) = s
 
-updatePersistValue :: Update v -> PersistValue
-updatePersistValue (Update _ v _) = toPersistValue v
-updatePersistValue _ = error "BackendUpdate not implemented"
-
 filterClause :: (PersistEntity val, PersistEntityBackend val ~ SqlBackend)
              => Bool -- ^ include table name?
              -> SqlBackend

src/Vervis/Application.hs

@@ -102,7 +102,7 @@ makeFoundation appSettings = do
 
     appSvgFont <-
         if appLoadFontFromLibData appSettings
-            then return lin2
+            then lin2
             else loadFont "data/LinLibertineCut.svg"
 
     -- We need a log function to create a connection pool. We need a connection

src/Vervis/Foundation.hs

@@ -386,7 +386,7 @@ instance Yesod App where
 
     -- What messages should be logged. The following includes all messages when
     -- in development, and warnings and errors in production.
-    shouldLog app _source level =
+    shouldLogIO app _source level = pure $
         appShouldLogAll (appSettings app)
             || level == LevelWarn
             || level == LevelError
@@ -433,7 +433,7 @@ instance YesodAuth App where
     -- Override the above two destinations when a Referer: header is present
     redirectToReferer _ = True
 
-    authenticate creds = do
+    authenticate creds = liftHandler $ do
         let ident = credsIdent creds
         mpid <- runDB $ getBy $ UniquePersonLogin $ credsIdent creds
         return $ case mpid of
@@ -443,7 +443,7 @@ instance YesodAuth App where
     -- You can add other plugins like BrowserID, email or OAuth here
     authPlugins _ = [accountPlugin]
 
-    authHttpManager = getHttpManager
+    authHttpManager = getsYesod getHttpManager
 
     onLogout = clearUnverifiedCreds False
 
@@ -517,7 +517,7 @@ instance YesodAuthAccount AccountPersistDB' App where
     allowLoginByEmailAddress _   = True
     runAccountDB                 = unAccountPersistDB'
     unregisteredLogin u          = do
-        lift $ setUnverifiedCreds True $ Creds "account" (username u) []
+        setUnverifiedCreds True $ Creds "account" (username u) []
         return mempty
 
 -- This instance is required to use forms. You can modify renderMessage to

src/Vervis/Git.hs

@@ -18,24 +18,27 @@ module Vervis.Git
     , readChangesView
     , listRefs
     , readPatch
+    , lastCommitTime
     )
 where
 
 import Prelude
 
 import Control.Arrow ((***))
+import Control.Monad (join)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Except
 import Data.Algorithm.Patience (diff, Item (..))
 import Data.Byteable (toBytes)
-import Data.Foldable (find)
+import Data.Foldable (foldlM, find)
-import Data.Git
 import Data.Git.Diff
 import Data.Git.Graph
 import Data.Git.Harder
-import Data.Git.Ref (fromHex, toHex)
+import Data.Git.Monad
-import Data.Git.Repository (getCommit)
+import Data.Git.Ref (SHA1, fromHex, toHex)
 import Data.Git.Storage (getObject_)
 import Data.Git.Storage.Object (Object (..))
-import Data.Git.Types (GitTime (..))
+import Data.Git.Types (GitTime (..), ModePerm (..), EntPath, Blob (..))
 import Data.Graph.Inductive.Graph (noNodes)
 import Data.Graph.Inductive.Query.Topsort
 import Data.List.NonEmpty (NonEmpty ((:|)))
@@ -43,7 +46,8 @@ import Data.Set (Set)
 import Data.String (fromString)
 import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8, decodeUtf8)
-import Data.Time.Clock ()
+import Data.Time.Calendar (Day (..))
+import Data.Time.Clock (UTCTime (..))
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
 import Data.Traversable (for)
 import Data.Word (Word32)
@@ -54,8 +58,9 @@ import Time.Types (Elapsed (..), Seconds (..))
 import qualified Data.ByteString as B (intercalate)
 import qualified Data.ByteString.Lazy as BL (ByteString, toStrict, length)
 import qualified Data.DList as D (DList, empty, snoc, toList)
+import qualified Data.Git as G
 import qualified Data.List.NonEmpty as N (toList)
-import qualified Data.Set as S (member, mapMonotonic)
+import qualified Data.Set as S (member, mapMonotonic, toList)
 import qualified Data.Text as T (pack, unpack, break, strip)
 import qualified Data.Text.Encoding as TE (decodeUtf8With)
 import qualified Data.Text.Encoding.Error as TE (lenientDecode)
@@ -77,7 +82,7 @@ matchReadme _                        = False
 
 -- | Find a README file in a directory. Return the filename and the file
 -- content.
-findReadme :: Git -> TreeRows -> IO (Maybe (Text, BL.ByteString))
+findReadme :: Git SHA1 -> TreeRows -> IO (Maybe (Text, BL.ByteString))
 findReadme git rows =
     case find matchReadme rows of
         Nothing                         -> return Nothing
@@ -95,23 +100,23 @@ rowToEntry :: (ModePerm, ObjId, Text, EntObjType) -> DirEntry
 rowToEntry (_, _, name, etype) = DirEntry (matchType etype) name
 
 loadSourceView
-    :: Git
+    :: Git SHA1
     -> Text
     -> [Text]
     -> IO (Set RefName, Set RefName, Maybe (SourceView BL.ByteString))
 loadSourceView git refT dir = do
-    branches <- branchList git
+    branches <- G.branchList git
-    tags <- tagList git
+    tags <- G.tagList git
     let refS = T.unpack refT
         refN = RefName refS
     msv <- if refN `S.member` branches || refN `S.member` tags
         then do
             tipOid <- resolveName git refS
-            mtree <- resolveTreeish git $ unObjId tipOid
+            mtree <- G.resolveTreeish git $ unObjId tipOid
             case mtree of
                 Nothing   -> return Nothing
                 Just tree -> do
-                    let dir' = map (entName . encodeUtf8) dir
+                    let dir' = map (G.entName . encodeUtf8) dir
                     view <- viewPath git tree dir'
                     Just <$> case view of
                         RootView rows -> do
@@ -140,7 +145,7 @@ readSourceView
     -- ^ Branches, tags, view of the selected item
 readSourceView path ref dir = do
     (bs, ts, msv) <-
-        withRepo (fromString path) $ \ git -> loadSourceView git ref dir
+        G.withRepo (fromString path) $ \ git -> loadSourceView git ref dir
     let toTexts = S.mapMonotonic $ T.pack . refNameRaw
     return (toTexts bs, toTexts ts, renderSources dir <$> msv)
 
@@ -159,7 +164,7 @@ readChangesView
     -- ^ Limit, i.e. how many latest commits to take after the offset
     -> IO (Int, [LogEntry])
     -- ^ Total number of ref's changes, and view of selected ref's change log
-readChangesView path ref off lim = withRepo (fromString path) $ \ git -> do
+readChangesView path ref off lim = G.withRepo (fromString path) $ \ git -> do
     oid <- resolveName git $ T.unpack ref
     graph <- loadCommitGraphPT git [oid]
     let mnodes = topsortUnmixOrder graph (NodeStack [noNodes graph])
@@ -187,10 +192,10 @@ readChangesView path ref off lim = withRepo (fromString path) $ \ git -> do
     return (noNodes graph, map (uncurry mkrow) pairs')
 
 listRefs :: FilePath -> IO (Set Text, Set Text)
-listRefs path = withRepo (fromString path) $ \ git ->
+listRefs path = G.withRepo (fromString path) $ \ git ->
     (,) <$> listBranches git <*> listTags git
 
-patch :: [Edit] -> Commit -> Patch
+patch :: [Edit] -> Commit SHA1 -> Patch
 patch edits c = Patch
     { patchAuthorName  = decodeUtf8 $ personName $ commitAuthor c
     , patchAuthorEmail =
@@ -251,7 +256,7 @@ mkdiff old new =
         map eitherOldNew $
         diff (zipWith Line [1..] old) (zipWith Line [1..] new)
 
-accumEdits :: BlobStateDiff -> [Edit] -> [Edit]
+accumEdits :: BlobStateDiff SHA1 -> [Edit] -> [Edit]
 accumEdits (OnlyOld bs) es =
     case bsContent bs of
         FileContent lines -> RemoveTextFile (ep2fp $ bsFilename bs) (unModePerm $ bsMode bs) (map (decodeUtf8 . BL.toStrict) lines) : es
@@ -277,14 +282,36 @@ accumEdits (OldAndNew old new) es =
         else error "getDiffWith gave OldAndNew with different file paths"
 
 readPatch :: FilePath -> Text -> IO (Patch, [Text])
-readPatch path hash = withRepo (fromString path) $ \ git -> do
+readPatch path hash = G.withRepo (fromString path) $ \ git -> do
     let ref = fromHex $ encodeUtf8 hash
-    c <- getCommit git ref
+    c <- G.getCommit git ref
     medits <- case commitParents c of
         []  -> error "Use the tree to generate list of AddFile diff parts?"
         [p] -> Right <$> getDiffWith accumEdits [] p ref git
         ps  -> fmap Left $ for ps $ \ p ->
-                    decodeUtf8 . takeLine . commitMessage <$> getCommit git p
+                    decodeUtf8 . takeLine . commitMessage <$> G.getCommit git p
     return $ case medits of
         Left parents -> (patch []    c, parents)
         Right edits  -> (patch edits c, [])
+
+lastCommitTime :: FilePath -> IO (Maybe UTCTime)
+lastCommitTime repo =
+    (either fail return =<<) $ fmap join $ withRepo (fromString repo) $ runExceptT $ do
+        branches <- S.toList <$> lift branchList
+        lct <- foldlM' utc0 branches $ \ time branch -> do
+            mcommit <- lift $ getCommit branch
+            case mcommit of
+                Nothing ->
+                    throwE $
+                        "lastCommitTime: Failed to get commit for branch " ++
+                        refNameRaw branch
+                Just c ->
+                    return $ max time $
+                    utc $ gitTimeUTC $ personTime $ commitCommitter c
+        return $ if null branches
+            then Nothing
+            else Just lct
+    where
+    utc (Elapsed (Seconds i)) = posixSecondsToUTCTime $ fromIntegral i
+    utc0 = UTCTime (ModifiedJulianDay 0) 0
+    foldlM' i l f = foldlM f i l

src/Vervis/Handler/Home.hs

@@ -34,7 +34,7 @@ import Vervis.Model.Repo
 import Vervis.Path
 
 import Data.EventTime.Local
-import qualified Vervis.GitOld as G
+import qualified Vervis.Git as G
 import qualified Vervis.Darcs as D
 
 intro :: Handler Html
@@ -56,20 +56,19 @@ intro = do
                     , repo ^. RepoVcs
                     )
         now <- liftIO getCurrentTime
-        let utc (Seconds i) = posixSecondsToUTCTime $ fromIntegral i
         forM repos $
             \ (Value sharer, Value mproj, Value repo, Value vcs) -> do
                 path <- askRepoDir sharer repo
                 mlast <- case vcs of
                     VCSDarcs -> liftIO $ D.lastChange path now
                     VCSGit -> do
-                        mel <- liftIO $ G.lastChange path
+                        mt <- liftIO $ G.lastCommitTime path
-                        return $ Just $ case mel of
+                        return $ Just $ case mt of
                             Nothing -> Never
-                            Just (Elapsed t) ->
+                            Just t ->
                                 intervalToEventTime $
                                 FriendlyConvert $
-                                now `diffUTCTime` utc t
+                                now `diffUTCTime` t
                 return (sharer, mproj, repo, vcs, mlast)
     defaultLayout $ do
         setTitle "Welcome to Vervis!"

src/Yesod/Auth/Unverified.hs

@@ -120,11 +120,10 @@ maybeUnverifiedAuth
 maybeUnverifiedAuth =
     maybeEntity unverifiedLoginKey CachedUnverifiedLogin unCachedUnverifiedLogin
 
--- TODO fix signatures when moving to GHC 8
 maybeAuthIdAllowUnverified
-    :: ( -- MonadHandler m
+    :: ( MonadHandler m
-       -- , HandlerSite m ~ master
+       , HandlerSite m ~ master
-         YesodPersist master
+       , YesodPersist master
        , YesodPersistBackend master ~ backend
        , PersistStoreRead backend
        , YesodAuth master
@@ -132,16 +131,15 @@ maybeAuthIdAllowUnverified
        , PersistRecordBackend record backend
        , Typeable record
        )
-    -- => m (Maybe (Key record, Bool))
+    => m (Maybe (Key record, Bool))
-    => HandlerT master IO (Maybe (Key record, Bool))
 maybeAuthIdAllowUnverified = runMaybeT $
         (, True)  <$> MaybeT maybeVerifiedAuthId
     <|> (, False) <$> MaybeT maybeUnverifiedAuthId
 
 maybeAuthAllowUnverified
-    :: ( -- MonadHandler m
+    :: ( MonadHandler m
-       -- , HandlerSite m ~ master
+       , HandlerSite m ~ master
-         YesodPersist master
+       , YesodPersist master
        , YesodPersistBackend master ~ backend
        , PersistStoreRead backend
        , YesodAuthPersist master
@@ -150,25 +148,20 @@ maybeAuthAllowUnverified
        , PersistRecordBackend record backend
        , Typeable record
        )
-    -- => m (Maybe (Entity record, Bool))
+    => m (Maybe (Entity record, Bool))
-    => HandlerT master IO (Maybe (Entity record, Bool))
 maybeAuthAllowUnverified = runMaybeT $
         (, True)  <$> MaybeT maybeVerifiedAuth
     <|> (, False) <$> MaybeT maybeUnverifiedAuth
 
 maybeVerifiedAuthId
-    {-
     :: ( MonadHandler m
        , HandlerSite m ~ master
        , YesodAuth master
        )
     => m (Maybe (AuthId master))
-    -}
-    :: YesodAuth master => HandlerT master IO (Maybe (AuthId master))
 maybeVerifiedAuthId = maybeAuthId
 
 maybeVerifiedAuth
-    {-
     :: ( MonadHandler m
        , HandlerSite m ~ master
        , YesodAuthPersist master
@@ -178,14 +171,6 @@ maybeVerifiedAuth
        , Typeable record
        )
     => m (Maybe (Entity record))
-    -}
-    :: ( YesodAuthPersist master
-       , AuthId master ~ Key record
-       , AuthEntity master ~ record
-       , PersistEntity record
-       , Typeable record
-       )
-    => HandlerT master IO (Maybe (Entity record))
 maybeVerifiedAuth = maybeAuth
 
 handleAuthLack :: (YesodAuth (HandlerSite m), MonadHandler m) => m a
@@ -201,7 +186,8 @@ handleAuthLack = do
                 Nothing -> permissionDenied "Please configure authRoute"
 
 handleUnverified
-    :: YesodAuthVerify master => (a, Bool) -> HandlerT master IO a
+    :: (MonadHandler m, YesodAuthVerify (HandlerSite m))
+    => (a, Bool) -> m a
 handleUnverified (v,  True)  = return v
 handleUnverified (_v, False) = do
     aj <- acceptsJson
@@ -213,7 +199,9 @@ handleUnverified (_v, False) = do
             when (redirectToCurrent y) setUltDestCurrent
             redirect $ verificationRoute y
 
-handleVerified :: YesodAuth master => (a, Bool) -> HandlerT master IO a
+handleVerified
+    :: (MonadHandler m, YesodAuth (HandlerSite m))
+    => (a, Bool) -> m a
 handleVerified (v,  False) = return v
 handleVerified (_v, True)  = do
     aj <- acceptsJson
@@ -230,9 +218,9 @@ handleVerified (_v, True)  = do
 -- @since 1.1.0
 
 requireUnverifiedAuthId
-    :: ( -- MonadHandler m
+    :: ( MonadHandler m
-       -- , HandlerSite m ~ master
+       , HandlerSite m ~ master
-         YesodPersist master
+       , YesodPersist master
        , YesodPersistBackend master ~ backend
        , PersistStoreRead backend
        , YesodAuth master
@@ -240,8 +228,7 @@ requireUnverifiedAuthId
        , PersistRecordBackend record backend
        , Typeable record
        )
-    -- => m (Key record)
+    => m (Key record)
-    => HandlerT master IO (Key record)
 requireUnverifiedAuthId =
     maybeAuthIdAllowUnverified >>= maybe handleAuthLack handleVerified
 
@@ -251,9 +238,9 @@ requireUnverifiedAuthId =
 -- @since 1.1.0
 
 requireUnverifiedAuth
-    :: ( -- MonadHandler m
+    :: ( MonadHandler m
-       -- , HandlerSite m ~ master
+       , HandlerSite m ~ master
-         YesodPersist master
+       , YesodPersist master
        , YesodPersistBackend master ~ backend
        , PersistStoreRead backend
        , YesodAuthPersist master
@@ -262,15 +249,14 @@ requireUnverifiedAuth
        , PersistRecordBackend record backend
        , Typeable record
        )
-    -- => m (Entity record)
+    => m (Entity record)
-    => HandlerT master IO (Entity record)
 requireUnverifiedAuth =
     maybeAuthAllowUnverified >>= maybe handleAuthLack handleVerified
 
 requireAuthIdAllowUnverified
-    :: ( -- MonadHandler m
+    :: ( MonadHandler m
-       -- , HandlerSite m ~ master
+       , HandlerSite m ~ master
-         YesodPersist master
+       , YesodPersist master
        , YesodPersistBackend master ~ backend
        , PersistStoreRead backend
        , YesodAuth master
@@ -278,15 +264,14 @@ requireAuthIdAllowUnverified
        , PersistRecordBackend record backend
        , Typeable record
        )
-    -- => m (Key record, Bool)
+    => m (Key record, Bool)
-    => HandlerT master IO (Key record, Bool)
 requireAuthIdAllowUnverified =
     maybeAuthIdAllowUnverified >>= maybe handleAuthLack return
 
 requireAuthAllowUnverified
-    :: ( -- MonadHandler m
+    :: ( MonadHandler m
-       -- , HandlerSite m ~ master
+       , HandlerSite m ~ master
-         YesodPersist master
+       , YesodPersist master
        , YesodPersistBackend master ~ backend
        , PersistStoreRead backend
        , YesodAuthPersist master
@@ -295,15 +280,14 @@ requireAuthAllowUnverified
        , PersistRecordBackend record backend
        , Typeable record
        )
-    -- => m (Entity record, Bool)
+    => m (Entity record, Bool)
-    => HandlerT master IO (Entity record, Bool)
 requireAuthAllowUnverified =
     maybeAuthAllowUnverified >>= maybe handleAuthLack return
 
 requireVerifiedAuthId
-    :: ( -- MonadHandler m
+    :: ( MonadHandler m
-       -- , HandlerSite m ~ master
+       , HandlerSite m ~ master
-         YesodPersist master
+       , YesodPersist master
        , YesodPersistBackend master ~ backend
        , PersistStoreRead backend
        , YesodAuthVerify master
@@ -311,15 +295,14 @@ requireVerifiedAuthId
        , PersistRecordBackend record backend
        , Typeable record
        )
-    -- => m (Key record)
+    => m (Key record)
-    => HandlerT master IO (Key record)
 requireVerifiedAuthId =
     maybeAuthIdAllowUnverified >>= maybe handleAuthLack handleUnverified
 
 requireVerifiedAuth
-    :: ( -- MonadHandler m
+    :: ( MonadHandler m
-       -- , HandlerSite m ~ master
+       , HandlerSite m ~ master
-         YesodPersist master
+       , YesodPersist master
        , YesodPersistBackend master ~ backend
        , PersistStoreRead backend
        , YesodAuthPersist master
@@ -329,7 +312,6 @@ requireVerifiedAuth
        , PersistRecordBackend record backend
        , Typeable record
        )
-    -- => m (Entity record)
+    => m (Entity record)
-    => HandlerT master IO (Entity record)
 requireVerifiedAuth =
     maybeAuthAllowUnverified >>= maybe handleAuthLack handleUnverified

src/Yesod/Auth/Unverified/Creds.hs

@@ -113,7 +113,6 @@ import Yesod.Auth.Unverified.Internal
 
 credsKey = unverifiedLoginKey
 
-{-
 loginErrorMessageI
   :: Route Auth
   -> AuthMessage
@@ -121,16 +120,7 @@ loginErrorMessageI
 loginErrorMessageI dest msg = do
   toParent <- getRouteToParent
   loginErrorMessageMasterI (toParent dest) msg
--}
-loginErrorMessageI :: (MonadResourceBase m, YesodAuth master)
-                   => Route child
-                   -> AuthMessage
-                   -> HandlerT child (HandlerT master m) TypedContent
-loginErrorMessageI dest msg = do
-  toParent <- getRouteToParent
-  lift $ loginErrorMessageMasterI (toParent dest) msg
 
-{-
 loginErrorMessageMasterI
   :: (MonadHandler m, HandlerSite m ~ master, YesodAuth master)
   => Route master
@@ -139,14 +129,6 @@ loginErrorMessageMasterI
 loginErrorMessageMasterI dest msg = do
   mr <- getMessageRender
   loginErrorMessage dest (mr msg)
--}
-loginErrorMessageMasterI :: (YesodAuth master, MonadResourceBase m, RenderMessage master AuthMessage)
-         => Route master
-         -> AuthMessage
-         -> HandlerT master m TypedContent
-loginErrorMessageMasterI dest msg = do
-  mr <- getMessageRender
-  loginErrorMessage dest (mr msg)
 
 {-
 -- | For HTML, set the message and redirect to the route.
@@ -189,15 +171,10 @@ provideJsonMessage :: Monad m => Text -> Writer.Writer (Endo [ProvidedRep m]) ()
 provideJsonMessage msg = provideRep $ return $ object ["message" .= msg]
 -}
 
-{-
 setUnverifiedCredsRedirect
-  :: (MonadHandler m, YesodAuth (HandlerSite m))
+  :: (MonadHandler m, YesodAuthVerify (HandlerSite m))
   => Creds (HandlerSite m) -- ^ new credentials
   -> m TypedContent
--}
-setUnverifiedCredsRedirect :: YesodAuthVerify master
-         => Creds master -- ^ new credentials
-         -> HandlerT master IO TypedContent
 setUnverifiedCredsRedirect creds = do
     y    <- getYesod
     auth <- authenticate creds
@@ -236,16 +213,10 @@ setUnverifiedCredsRedirect creds = do
         return $ renderAuthMessage master langs msg
 
 -- | Sets user credentials for the session after checking them with authentication backends.
-{-
+setUnverifiedCreds :: (MonadHandler m, YesodAuthVerify (HandlerSite m))
-setUnverifiedCreds :: (MonadHandler m, YesodAuth (HandlerSite m))
          => Bool                  -- ^ if HTTP redirects should be done
          -> Creds (HandlerSite m) -- ^ new credentials
          -> m ()
--}
-setUnverifiedCreds :: YesodAuthVerify master
-         => Bool         -- ^ if HTTP redirects should be done
-         -> Creds master -- ^ new credentials
-         -> HandlerT master IO ()
 setUnverifiedCreds doRedirects creds =
     if doRedirects
       then void $ setUnverifiedCredsRedirect creds
@@ -269,14 +240,9 @@ authLayoutJson w json = selectRep $ do
 -- | Clears current user credentials for the session.
 --
 -- @since 1.1.7
-{-
 clearUnverifiedCreds :: (MonadHandler m, YesodAuth (HandlerSite m))
            => Bool -- ^ if HTTP redirect to 'logoutDest' should be done
            -> m ()
--}
-clearUnverifiedCreds :: YesodAuth master
-           => Bool -- ^ if HTTP redirect to 'logoutDest' should be done
-           -> HandlerT master IO ()
 clearUnverifiedCreds doRedirects = do
     y <- getYesod
     -- onLogout

src/Yesod/Auth/Unverified/Internal.hs

@@ -26,8 +26,7 @@ import Prelude
 
 import Data.Text (Text)
 import Yesod.Auth (YesodAuth (..))
-import Yesod.Core (Route)
+import Yesod.Core (MonadHandler (..), Route)
-import Yesod.Core.Handler (HandlerT)
 
 class YesodAuth site => YesodAuthVerify site where
 
@@ -43,8 +42,7 @@ class YesodAuth site => YesodAuthVerify site where
     unverifiedLoginDest = verificationRoute
 
     -- | Called on a successful unverified login. Default: 'onLogin'
-    --onUnverifiedLogin :: (MonadHandler m, site ~ HandlerSite m) => m ()
+    onUnverifiedLogin :: (MonadHandler m, site ~ HandlerSite m) => m ()
-    onUnverifiedLogin :: HandlerT site IO ()
     onUnverifiedLogin = onLogin
 
 -- | Session key used to hold the ID of the unverified logged-in user

src/Yesod/SessionEntity.hs

@@ -75,7 +75,7 @@ cachedRecord wrap unwrap
     = fmap unwrap
     . cached
     . fmap wrap
-    . liftHandlerT
+    . liftHandler
     . runDB
     . get
 

stack.yaml

@@ -3,10 +3,14 @@
 
 # Specifies the GHC version and set of packages available (e.g., lts-3.5,
 # nightly-2015-09-21, ghc-7.10.2)
-resolver: lts-10.10
+resolver: lts-12.20
 
 # Local packages, usually specified by relative directory name
 packages:
+  - location:
+     git: https://github.com/bitemyapp/esqueleto.git
+     commit: 434f81ed41795e3dd0754dbc5c75c4ed098631b3
+    extra-dep: true
   - .
   - lib/darcs-lights
   - lib/darcs-rev
@@ -20,23 +24,26 @@ packages:
 # - lib/yesod-auth-account
   - location:
      git: https://dev.angeley.es/s/fr33domlover/r/yesod-auth-account
-     commit: cc9d6a5d4e0d5fb3b061a5a9ccc0ab03eea89811
+     commit: c14795264c3d63b2126e91e98107a631405cea74
     extra-dep: true
   - lib/yesod-mail-send
 
 # Packages to be pulled from upstream that are not in the resolver (e.g.,
 # acme-missiles-0.3)
 extra-deps:
-  - darcs-2.14.0
+  - SimpleAES-0.4.2
   - data-default-instances-bytestring-0.0.1
+  - git-0.2.2
   - highlighter2-0.2.5
   - libravatar-0.4.0.2
   - monad-hash-0.1.0.2
+  - monadcryptorandom-0.7.2.1
+  - patience-0.1.1
   - persistent-parser-0.1.0.2
-  - SimpleAES-0.4.2
+  - pwstore-fast-2.4.4
-  - RSA-2.2.0
   - time-interval-0.1.1
   - time-units-1.0.0
+  - url-2.1.3
 
 # Override default flag values for local packages and extra-deps
 flags:

vervis.cabal

@@ -125,7 +125,6 @@ library
                        Vervis.Formatting
                        Vervis.Foundation
                        Vervis.Git
-                       Vervis.GitOld
                        Vervis.GraphProxy
                        Vervis.Handler.Common
                        Vervis.Handler.Discussion
@@ -256,13 +255,13 @@ library
                      , hashable
                        -- for source file highlighting
                      , highlighter2
-                     , hit
+                     , git
-                     , hit-graph >= 0.1
+                     , hit-graph
-                     , hit-harder >= 0.1
+                     , hit-harder
-                     , hit-network >= 0.1
+                     , hit-network
                      -- currently discarding all JS so no need for minifier
                      --, hjsmin
-                     -- 'hit' uses it for 'GitTime'
+                     -- 'git' uses it for 'GitTime'
                      , hourglass
                      , http-conduit
                      , http-types