cntd.

Handler/CreateChallenge.hs

@@ -23,8 +23,9 @@ postCreateChallengeR = do
         challengeData = case result of
             FormSuccess res -> Just res
             _ -> Nothing
+        Just (name, publicUrl, publicBranch, privateUrl, privateBranch) = challengeData
 
-    runViewProgress doSomething
+    runViewProgress $ doRepoCloning publicUrl publicBranch
 
 sampleForm :: Form (Text, Text, Text, Text, Text)
 sampleForm = renderBootstrap3 BootstrapBasicForm $ (,,,,)

Handler/Shared.hs

@@ -9,6 +9,11 @@ import           Control.Concurrent.STM
 import           Data.IntMap            (IntMap)
 import qualified Data.IntMap            as IntMap
 
+import Network.URI
+import qualified Data.Text as T
+
+import Database.Persist.Sql (ConnectionPool, runSqlPool)
+
 atom = Control.Concurrent.STM.atomically
 
 type Channel = TChan (Maybe Text)
@@ -24,6 +29,7 @@ runViewProgress action = do
     writeTVar jobs $ IntMap.insert jobId chan m
     return (jobId, chan)
   liftIO $ forkIO $ do
+    threadDelay 1000000
     action chan
     atom $ do
       writeTChan chan $ Just "All done\n"
@@ -33,16 +39,51 @@ runViewProgress action = do
   redirect $ ViewProgressR jobId
 
 msg :: Channel -> Text -> IO ()
-msg chan m = atom $ writeTChan chan $ Just m
+msg chan m = atom $ writeTChan chan $ Just (m ++ "\n")
+
+err :: Channel -> Text -> IO ()
+err = msg
 
 doSomething :: Channel -> IO ()
 doSomething chan = do
+  msg chan "Did something"
   threadDelay 1000000
-  msg chan "Did something\n"
+  msg chan "Did something else"
-  threadDelay 1000000
-  msg chan "Did something else\n"
   threadDelay 1000000
 
+doRepoCloning :: Text -> Text -> Channel -> IO ()
+doRepoCloning url branch chan = do
+  msg chan "Did something"
+  _ <- cloneRepo url branch chan
+  return ()
+
+validGitProtocols :: [String]
+validGitProtocols = ["git", "http", "https", "ssh"]
+
+validGitProtocolsAsText :: Text
+validGitProtocolsAsText = T.pack $ intercalate ", " $ map (++"://") validGitProtocols
+
+cloneRepo :: Text -> Text -> Channel -> IO (Maybe Repo)
+cloneRepo url branch chan = do
+  let maybeRepo = Nothing
+  case maybeRepo of
+    Just _ -> do
+      err chan "Repo already there"
+      return Nothing
+    Nothing -> do
+      msg chan $ concat ["Preparing to clone repo ", url]
+      if checkRepoUrl url
+       then
+        return Nothing
+       else do
+        err chan $ concat ["Wrong URL to a Git repo (note that one of the following protocols must be specified: ", validGitProtocolsAsText]
+        return Nothing
+
+checkRepoUrl :: Text -> Bool
+checkRepoUrl url = case parsedURI of
+                      Just uri -> (uriScheme uri) `elem` (map (++":") validGitProtocols)
+                      Nothing -> False
+                   where parsedURI = parseURI $ T.unpack url
 
 getViewProgressR :: Int -> Handler TypedContent
 getViewProgressR jobId = do

gonito.cabal

@@ -90,6 +90,7 @@ library
                  , vector
                  , time
                  , stm
+                 , network-uri
 
 executable         gonito
     if flag(library-only)