add background image

Foundation.hs

@@ -146,6 +146,7 @@ instance Yesod App where
     isAuthorized (ResetPasswordR _) _ = return Authorized
     isAuthorized (ToggleSubmissionTagR _) _ = return Authorized
 
+    isAuthorized (ChallengeImageR _) _ = return Authorized
 
     -- Default to Authorized for now.
     isAuthorized _ _ = isTrustedAuthorized

Handler/CreateChallenge.hs

@@ -17,6 +17,11 @@ import qualified Data.Text as T
 
 import PersistSHA1
 
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Lazy as L
+
+import Data.Conduit.Binary (sinkLbs, sourceFile)
+
 getCreateChallengeR :: Handler Html
 getCreateChallengeR = do
     (formWidget, formEnctype) <- generateFormPost sampleForm
@@ -69,6 +74,16 @@ addChallenge name publicRepoId privateRepoId chan = do
                            else do
                             err chan "README was not found"
                             return (defaultTitle, defaultDescription)
+
+  let imageFilePath = publicRepoDir </> imageFile
+  doesImageFileExists <- liftIO $ doesFileExist imageFilePath
+  mImage <- if doesImageFileExists
+             then do
+               fileBytes <- liftIO $ runResourceT $ sourceFile imageFilePath $$ sinkLbs
+               return $ Just (S.pack . L.unpack $ fileBytes)
+             else do
+               return Nothing
+
   time <- liftIO getCurrentTime
   challengeId <- runDB $ insert $ Challenge {
     challengePublicRepo=publicRepoId,
@@ -76,7 +91,8 @@ addChallenge name publicRepoId privateRepoId chan = do
     challengeName=name,
     challengeTitle=(T.pack $ title),
     challengeDescription=(T.pack $ description),
-    challengeStamp=time}
+    challengeStamp=time,
+    challengeImage=mImage }
   updateTests challengeId chan
   return ()
 

Handler/Extract.hs

@@ -42,6 +42,9 @@ defaultDescription = ""
 readmeFile :: FilePath
 readmeFile = "README.md"
 
+imageFile :: FilePath
+imageFile = ".seeme.png"
+
 getTitleAndDescription :: String -> (String, String)
 getTitleAndDescription contents = (title, description)
                        where title = fromMaybe defaultTitle $ extractFirstHeader doc

Handler/ListChallenges.hs

@@ -4,10 +4,18 @@ import Import
 
 getListChallengesR :: Handler Html
 getListChallengesR = do
-  challenges' <- runDB $ selectList [] [Desc ChallengeStamp]
-  let challenges = map (\(Entity _ v) -> v) challenges'
+  challenges <- runDB $ selectList [] [Desc ChallengeStamp]
   defaultLayout $ do
     setTitle "List challenges"
     $(widgetFile "list-challenges")
 
 listChallengesCore challenges = $(widgetFile "list-challenges-core")
+
+getChallengeImageR :: ChallengeId -> Handler Html
+getChallengeImageR challengeId = do
+   challenge <- runDB $ get404 challengeId
+   case challengeImage challenge of
+     Just image -> do
+       addHeader "Content-Disposition" "attachment; filename=\"image.png\""
+       sendResponse (typePng, toContent image)
+     Nothing -> sendResponseStatus status202 ()

config/models

@@ -36,6 +36,7 @@ Challenge
     title Text
     description Text
     stamp UTCTime default=now()
+    image ByteString Maybe
 Test
     challenge ChallengeId
     metric Metric

config/routes

@@ -10,6 +10,7 @@
 /view-progress/#Int ViewProgressR GET
 /open-view-progress/#Int OpenViewProgressR GET
 /list-challenges ListChallengesR GET
+/challenge-image/#ChallengeId ChallengeImageR GET
 
 /challenge/#Text ShowChallengeR GET
 /challenge-readme/#Text ChallengeReadmeR GET

templates/list-challenges-core.hamlet

@@ -1,4 +1,7 @@
-$forall challenge <- challenges
+$forall (Entity challengeId challenge) <- challenges
   <div class="panel panel-success">
      <div class="panel-heading"><a .challenge-link  href="@{ShowChallengeR (challengeName challenge)}">#{challengeTitle challenge}</a>
+     $if isJust (challengeImage challenge)
+        <div class="panel-body" style="background-image:url(@{ChallengeImageR challengeId}); background-color:lightgrey; background-blend-mode:screen;background-size: 100%;">#{challengeDescription challenge}
+     $else
         <div class="panel-body">#{challengeDescription challenge}