filipg/gonito
1
0
Fork 1
Code Issues 1 Pull Requests Releases Wiki Activity

commits are correctly reflected in DB

Browse Source
This commit is contained in:
Filip Gralinski 2015-09-04 10:02:33 +02:00
parent d8a775a9ee
commit 62bd9a514f
2 changed files with 39 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
Handler/Shared.hs
View File

@ -104,12 +104,13 @@ cloneRepo url branch chan = do
repoId <- runDB $ insert $ Repo { repoId <- runDB $ insert $ Repo {
repoUrl=url, repoUrl=url,
repoBranch=branch, repoBranch=branch,
repoCurrentCommit=(toSHA1 (encodeUtf8 commitId)), repoCurrentCommit=commitRaw,
repoOwner=userId, repoOwner=userId,
repoReady=True, repoReady=True,
repoStamp=time } repoStamp=time }
return $ Just repoId return $ Just repoId
where commitId = T.replace "\n" "" out where commitId = T.replace "\n" "" out
commitRaw = fromTextToSHA1 commitId
ExitFailure _ -> do ExitFailure _ -> do
err chan "cannot determine HEAD commit" err chan "cannot determine HEAD commit"
return Nothing return Nothing
@ -120,34 +121,6 @@ cloneRepo url branch chan = do
err chan $ concat ["Wrong URL to a Git repo (note that one of the following protocols must be specified: ", validGitProtocolsAsText] err chan $ concat ["Wrong URL to a Git repo (note that one of the following protocols must be specified: ", validGitProtocolsAsText]
return Nothing return Nothing
hexByteToWord8 :: Text -> Word8
hexByteToWord8 t = (hexNibbleToWord8 $ T.head t) * 16 + (hexNibbleToWord8 $ T.index t 1)
hexNibbleToWord8 :: Char -> Word8
hexNibbleToWord8 '0' = 0
hexNibbleToWord8 '1' = 1
hexNibbleToWord8 '2' = 2
hexNibbleToWord8 '3' = 3
hexNibbleToWord8 '4' = 4
hexNibbleToWord8 '5' = 5
hexNibbleToWord8 '6' = 6
hexNibbleToWord8 '7' = 7
hexNibbleToWord8 '8' = 8
hexNibbleToWord8 '9' = 9
hexNibbleToWord8 'A' = 10
hexNibbleToWord8 'a' = 10
hexNibbleToWord8 'B' = 11
hexNibbleToWord8 'b' = 11
hexNibbleToWord8 'C' = 12
hexNibbleToWord8 'c' = 12
hexNibbleToWord8 'D' = 13
hexNibbleToWord8 'd' = 13
hexNibbleToWord8 'E' = 14
hexNibbleToWord8 'e' = 14
hexNibbleToWord8 'F' = 15
hexNibbleToWord8 'f' = 15
checkRepoUrl :: Text -> Bool checkRepoUrl :: Text -> Bool
checkRepoUrl url = case parsedURI of checkRepoUrl url = case parsedURI of
Just uri -> (uriScheme uri) `elem` (map (++":") validGitProtocols) Just uri -> (uriScheme uri) `elem` (map (++":") validGitProtocols)

42
PersistSHA1.hs
View File

@ -5,6 +5,7 @@ import Database.Persist.Sql
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Char8 as BC
import qualified Data.Text as T
import Numeric (showHex) import Numeric (showHex)
data SHA1 = SHA1 ByteString data SHA1 = SHA1 ByteString
@ -16,11 +17,42 @@ toHex = BC.pack . concat . (map ("\\x"++)) . (map (flip showHex "")) . B.unpack
toSHA1 :: ByteString -> SHA1 toSHA1 :: ByteString -> SHA1
toSHA1 x = SHA1 $ B.concat ["E'\\\\x", x, "'"] toSHA1 x = SHA1 $ B.concat ["E'\\\\x", x, "'"]
instance PersistField SHA1 where fromTextToSHA1 :: Text -> SHA1
toPersistValue (SHA1 t) = PersistDbSpecific t fromTextToSHA1 = SHA1 . B.pack . (map hexByteToWord8) . (T.chunksOf 2)
fromPersistValue (PersistDbSpecific t) = Right $ SHA1 t hexByteToWord8 :: Text -> Word8
fromPersistValue _ = Left "SHA1 values must be converted from PersistDbSpecific" hexByteToWord8 t = (hexNibbleToWord8 $ T.head t) * 16 + (hexNibbleToWord8 $ T.index t 1)
hexNibbleToWord8 :: Char -> Word8
hexNibbleToWord8 '0' = 0
hexNibbleToWord8 '1' = 1
hexNibbleToWord8 '2' = 2
hexNibbleToWord8 '3' = 3
hexNibbleToWord8 '4' = 4
hexNibbleToWord8 '5' = 5
hexNibbleToWord8 '6' = 6
hexNibbleToWord8 '7' = 7
hexNibbleToWord8 '8' = 8
hexNibbleToWord8 '9' = 9
hexNibbleToWord8 'A' = 10
hexNibbleToWord8 'a' = 10
hexNibbleToWord8 'B' = 11
hexNibbleToWord8 'b' = 11
hexNibbleToWord8 'C' = 12
hexNibbleToWord8 'c' = 12
hexNibbleToWord8 'D' = 13
hexNibbleToWord8 'd' = 13
hexNibbleToWord8 'E' = 14
hexNibbleToWord8 'e' = 14
hexNibbleToWord8 'F' = 15
hexNibbleToWord8 'f' = 15
instance PersistField SHA1 where
toPersistValue (SHA1 t) = PersistByteString t
fromPersistValue (PersistByteString t) = Right $ SHA1 t
fromPersistValue _ = Left "Unexpected value"
instance PersistFieldSql SHA1 where instance PersistFieldSql SHA1 where
sqlType _ = SqlOther "BYTEA" sqlType _ = SqlBlob