add querying for commits

Application.hs

@@ -41,6 +41,7 @@ import Handler.Graph
 import Handler.Home
 import Handler.CreateChallenge
 import Handler.ListChallenges
+import Handler.Query
 import Handler.ShowChallenge
 import Handler.Shared
 import Handler.YourAccount

Handler/Query.hs

@@ -0,0 +1,71 @@
+module Handler.Query where
+
+import Import
+
+import Handler.Tables (formatSubmitter)
+import PersistSHA1
+
+import Database.Persist.Sql
+import Data.Text as T(pack)
+
+import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3,
+                              withSmallInput)
+
+data FullSubmissionInfo = FullSubmissionInfo {
+  fsiSubmission :: Submission,
+  fsiUser :: User,
+  fsiRepo :: Repo }
+
+getFullInfo :: Entity Submission -> Handler FullSubmissionInfo
+getFullInfo (Entity submissionId submission) = do
+  repo <- runDB $ get404 $ submissionRepo submission
+  user <- runDB $ get404 $ submissionSubmitter submission
+  return $ FullSubmissionInfo {
+    fsiSubmission = submission,
+    fsiUser = user,
+    fsiRepo = repo }
+
+findSubmissions :: Text -> Handler [FullSubmissionInfo]
+findSubmissions sha1Prefix = do
+  submissions <- runDB $ rawSql "SELECT ?? FROM  submission WHERE cast(commit as text) like ?" [PersistText $ "\\\\x" ++ sha1Prefix ++ "%"]
+  mapM getFullInfo submissions
+
+getQueryFormR :: Handler Html
+getQueryFormR = do
+  (formWidget, formEnctype) <- generateFormPost queryForm
+  let submission = Nothing :: Maybe Text
+      handlerName = "getQueryFormR" :: Text
+  defaultLayout $ do
+      aDomId <- newIdent
+      setTitle "Searching for submissions"
+      $(widgetFile "query-form")
+
+postQueryFormR :: Handler Html
+postQueryFormR = do
+    ((result, formWidget), formEnctype) <- runFormPost queryForm
+    let handlerName = "postQueryFormR" :: Text
+    case result of
+      FormSuccess query -> processQuery query
+      _ -> defaultLayout $ do
+        aDomId <- newIdent
+        setTitle "Searching for submissions"
+        $(widgetFile "query-form")
+
+getQueryResultsR :: Text -> Handler Html
+getQueryResultsR = processQuery
+
+processQuery :: Text -> Handler Html
+processQuery query = do
+  submissions <- findSubmissions query
+  defaultLayout $ do
+    aDomId <- newIdent
+    setTitle "query results"
+    $(widgetFile "query-results")
+
+queryResult submission = $(widgetFile "query-result")
+    where commitSha1AsText = fromSHA1ToText $ submissionCommit $ fsiSubmission submission
+          submitter = formatSubmitter $ fsiUser submission
+          stamp = T.pack $ show $ submissionStamp $ fsiSubmission submission
+
+queryForm :: Form Text
+queryForm = renderBootstrap3 BootstrapBasicForm $ areq textField (fieldSettingsLabel MsgGitCommitSha1) Nothing

PersistSHA1.hs

@@ -20,9 +20,18 @@ toSHA1 x = SHA1 $ B.concat ["E'\\\\x", x, "'"]
 fromTextToSHA1 :: Text -> SHA1
 fromTextToSHA1 = SHA1 . B.pack . (map hexByteToWord8) . (T.chunksOf 2)
 
+fromSHA1ToText :: SHA1 -> Text
+fromSHA1ToText (SHA1 bs) = T.pack $ concat $ map word8ToHex $ B.unpack bs
+
 hexByteToWord8 :: Text -> Word8
 hexByteToWord8 t = (hexNibbleToWord8 $ T.head t) * 16 + (hexNibbleToWord8 $ T.index t 1)
 
+word8ToHex :: Word8 -> String
+word8ToHex e = case h of
+   [c] -> ['0', c]
+   s -> s
+  where h = showHex e ""
+
 hexNibbleToWord8 :: Char -> Word8
 hexNibbleToWord8 '0' = 0
 hexNibbleToWord8 '1' = 1
@@ -47,7 +56,6 @@ hexNibbleToWord8 'e' = 14
 hexNibbleToWord8 'F' = 15
 hexNibbleToWord8 'f' = 15
 
-
 instance PersistField SHA1 where
   toPersistValue (SHA1 t) = PersistByteString t
 

config/routes

@@ -19,4 +19,8 @@
 /challenge-how-to/#Text ChallengeHowToR GET
 /challenge-graph-data/#Text ChallengeGraphDataR GET
 
+/q QueryFormR GET POST
+/q/#Text QueryResultsR  GET
+
+
 /account YourAccountR GET POST

gonito.cabal

@@ -38,6 +38,7 @@ library
                      Handler.Shared
                      Handler.ShowChallenge
                      Handler.Extract
+                     Handler.Query
                      Handler.Tables
                      Handler.YourAccount
 

messages/en.msg

@@ -19,3 +19,5 @@ AccountName: name
 Id: ID
 SshPubKey: your SSH public key
 Home: home
+Search: search
+GitCommitSha1: Git commit SHA1 hash

templates/query-form.hamlet

@@ -0,0 +1,7 @@
+<h2>Search for submission by Git commit SHA1 hashes:
+
+<p>
+  <form method=post action=@{QueryFormR}#form enctype=#{formEnctype}>
+    ^{formWidget}
+    <button .btn .btn-primary type="submit">
+       _{MsgSearch} <span class="glyphicon glyphicon-upload"></span>

templates/query-result.hamlet

@@ -0,0 +1,6 @@
+<div .subm-commit>#{commitSha1AsText}
+<div .subm-description>#{submissionDescription $ fsiSubmission submission}
+<div .subm-user>#{submitter}
+<div .subm-stamp>#{stamp}
+<div .subm-repo>#{repoUrl $ fsiRepo submission} / #{repoBranch $ fsiRepo submission}
+<hr>

templates/query-results.hamlet

@@ -0,0 +1,7 @@
+<h2>Query results
+
+$if null submissions
+   <p>No results found.
+$else
+   $forall submission <- submissions
+      ^{queryResult submission}