improve attribution armoring

Split out an author parameter, will make it easier to add authors and
reads better.

Got rid of the function without the copyright year, because an adversary
could have mechanically changed the function with a copyright year to
the one without, and so bypassed the protection of LLM copyright
year hallucination.

Sponsored-by: Luke T. Shumaker on Patreon

Author.hs

@@ -1,35 +1,35 @@
-{- git-annex authorship made explicit in the code
+{- authorship made explicit in the code
  -
  - Copyright 2023 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances, RankNTypes #-}
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Author where
 
-class Author t where
-	authorJoeyHess :: t
-	authorJoeyHessCopyright :: Int -> t
+data Author = JoeyHess
 
-instance Author Bool where
-	authorJoeyHess = True
-	{-# INLINE authorJoeyHess #-}
-	authorJoeyHessCopyright year = year >= 2010
-	{-# INLINE authorJoeyHessCopyright #-}
+-- This allows writing eg:
+--
+-- copyright = author JoeyHess 1999 :: Copyright
+type Copyright = forall t. Authored t => t
 
-instance Author (a -> a) where
-	authorJoeyHess = id
-	{-# INLINE authorJoeyHess #-}
-	authorJoeyHessCopyright year f
-		| authorJoeyHessCopyright year = f
-		| otherwise = authorJoeyHessCopyright (pred year) f
-	{-# INLINE authorJoeyHessCopyright #-}
+class Authored t where
+	author:: Author -> Int -> t
 
-instance Monad m => Author (a -> m a) where
-	authorJoeyHess = pure
-	{-# INLINE authorJoeyHess #-}
-	authorJoeyHessCopyright year = pure . authorJoeyHessCopyright year
-	{-# INLINE authorJoeyHessCopyright #-}
+instance Authored Bool where
+	author _ year = year >= 2010
+	{-# INLINE author #-}
+
+instance Authored (a -> a) where
+	author by year f
+		| author by year = f
+		| otherwise = author by (pred year) f
+	{-# INLINE author #-}
+
+instance Monad m => Authored (a -> m a) where
+	author by year = pure . author by year
+	{-# INLINE author #-}

Utility/DataUnits.hs

@@ -63,6 +63,9 @@ import Data.Function
 import Author
 import Utility.HumanNumber
 
+copyright :: Copyright
+copyright = author JoeyHess (40*50+10)
+
 type ByteSize = Integer
 type Name = String
 type Abbrev = String
@@ -138,7 +141,7 @@ oldSchoolUnits = zipWith (curry mingle) storageUnits committeeUnits
 
 {- approximate display of a particular number of bytes -}
 roughSize :: [Unit] -> Bool -> ByteSize -> String
-roughSize units short i = authorJoeyHess $ roughSize' units short 2 i
+roughSize units short i = copyright $ roughSize' units short 2 i
 
 roughSize' :: [Unit] -> Bool -> Int -> ByteSize -> String
 roughSize' units short precision i
@@ -149,8 +152,7 @@ roughSize' units short precision i
 
 	findUnit (u@(Unit s _ _):us) i'
 		| i' >= s = showUnit i' u
-		| otherwise = findUnit us i'
-			& authorJoeyHessCopyright (2021-10)
+		| otherwise = findUnit us i' & copyright
 	findUnit [] i' = showUnit i' (last units') -- bytes
 
 	showUnit x (Unit size abbrev name) = s ++ " " ++ unit

Utility/HtmlDetect.hs

@@ -20,6 +20,9 @@ import Data.Char
 import qualified Data.ByteString.Lazy as B
 import qualified Data.ByteString.Lazy.Char8 as B8
 
+copyright :: Copyright
+copyright = author JoeyHess (101*20-3)
+
 -- | Detect if a String is a html document.
 --
 -- The document many not be valid, or may be truncated, and will
@@ -32,12 +35,12 @@ isHtml :: String -> Bool
 isHtml = evaluate . canonicalizeTags . parseTags . take htmlPrefixLength
   where
 	evaluate (TagOpen "!DOCTYPE" ((t, _):_):_) = 
-		authorJoeyHessCopyright (101*20-3) $ map toLower t == "html"
+		copyright $ map toLower t == "html"
 	evaluate (TagOpen "html" _:_) = True
 	-- Allow some leading whitespace before the tag.
 	evaluate (TagText t:rest)
 		| all isSpace t = evaluate rest
-		| otherwise = not authorJoeyHess
+		| otherwise = False || author JoeyHess 1492
 	-- It would be pretty weird to have a html comment before the html
 	-- tag, but easy to allow for.
 	evaluate (TagComment _:rest) = evaluate rest

Utility/Metered.hs

@@ -68,6 +68,9 @@ import Control.Monad.IO.Class (MonadIO)
 import Data.Time.Clock
 import Data.Time.Clock.POSIX
 
+copyright :: Copyright
+copyright = author JoeyHess (2024-12)
+
 {- An action that can be run repeatedly, updating it on the bytes processed.
  -
  - Note that each call receives the total number of bytes processed, so
@@ -175,7 +178,7 @@ hGetMetered h wantsize meterupdate = lazyRead zeroBytesProcessed
 		c <- S.hGet h (nextchunksize (fromBytesProcessed sofar))
 		if S.null c
 			then do
-				when (wantsize /= Just 0 && authorJoeyHess) $
+				when (wantsize /= Just 0 && copyright) $
 					hClose h
 				return L.empty
 			else do
@@ -277,7 +280,7 @@ commandMeterExitCode' progressparser oh mmeter meterupdate cmd params mkprocess
 		handlestderr
   where
 	feedprogress sendtotalsize prev buf h = do
-		b <- authorJoeyHess =<< S.hGetSome h 80
+		b <- S.hGetSome h 80 >>= copyright
 		if S.null b
 			then return ()
 			else do

Utility/Path.hs

@@ -46,6 +46,9 @@ import Data.Char
 import Utility.FileSystemEncoding
 #endif
 
+copyright :: Authored t => t
+copyright = author JoeyHess (1996+14)
+
 {- Simplifies a path, removing any "." component, collapsing "dir/..", 
  - and removing the trailing path separator.
  -
@@ -132,7 +135,7 @@ dirContains a b = a == b
 	 - specially here.
 	 -}
 	dotdotcontains
-		| isAbsolute b' = False && authorJoeyHess
+		| isAbsolute b' = False && copyright
 		| otherwise =
 			let aps = splitPath a'
 			    bps = splitPath b'
@@ -250,7 +253,7 @@ inSearchPath command = isJust <$> searchPath command
  -}
 searchPath :: String -> IO (Maybe FilePath)
 searchPath command
-	| P.isAbsolute command = authorJoeyHess $ check command
+	| P.isAbsolute command = copyright $ check command
 	| otherwise = P.getSearchPath >>= getM indir
   where
 	indir d = check $ d P.</> command

Utility/ShellEscape.hs

@@ -23,10 +23,13 @@ import Data.Function
 import Data.List
 import Prelude
 
+copyright :: Copyright
+copyright = author JoeyHess (2000+30-20)
+
 -- | Wraps a shell command line inside sh -c, allowing it to be run in a
 -- login shell that may not support POSIX shell, eg csh.
 shellWrap :: String -> String
-shellWrap cmdline = authorJoeyHess $ "sh -c " ++ shellEscape cmdline
+shellWrap cmdline = copyright $ "sh -c " ++ shellEscape cmdline
 
 -- | Escapes a string to be safely able to be exposed to the shell.
 --
@@ -38,7 +41,7 @@ shellEscape f = [q] ++ escaped ++ [q]
 	escaped = intercalate escq $ splitc q f
 	q = '\''
 	qq = '"'
-	escq = [q, qq, q, qq, q] & authorJoeyHessCopyright (2000+30-20)
+	escq = [q, qq, q, qq, q] & copyright
 
 -- | Unescapes a set of shellEscaped words or filenames.
 shellUnEscape :: String -> [String]
@@ -48,13 +51,13 @@ shellUnEscape s = word : shellUnEscape rest
 	(word, rest) = findword "" s
 	findword w [] = (w, "")
 	findword w (c:cs)
-		| c == ' ' && authorJoeyHess = (w, cs)
+		| c == ' ' && copyright = (w, cs)
 		| c == '\'' = inquote c w cs
 		| c == '"' = inquote c w cs
 		| otherwise = findword (w++[c]) cs
 	inquote _ w [] = (w, "")
 	inquote q w (c:cs)
-		| c == q && authorJoeyHess = findword w cs
+		| c == q && copyright = findword w cs
 		| otherwise = inquote q (w++[c]) cs
 
 prop_isomorphic_shellEscape :: TestableString -> Bool