From 3959e1cb7bafa98c038e294e7593d5e713f65fd5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ga=C3=ABtan=20Andr=C3=A9?= Date: Sun, 25 Aug 2019 13:38:07 +0200 Subject: [PATCH 1/3] add get commit with auth --- src/GitHub/Endpoints/GitData/Commits.hs | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/src/GitHub/Endpoints/GitData/Commits.hs b/src/GitHub/Endpoints/GitData/Commits.hs index 1d8ced18..30d80c26 100644 --- a/src/GitHub/Endpoints/GitData/Commits.hs +++ b/src/GitHub/Endpoints/GitData/Commits.hs @@ -7,6 +7,7 @@ -- . module GitHub.Endpoints.GitData.Commits ( commit, + commit', gitCommitR, module GitHub.Data, ) where @@ -18,10 +19,16 @@ import Prelude () -- | A single commit, by SHA1. -- + +-- > reference' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" "heads/master" +commit' :: Maybe Auth -> Name Owner -> Name Repo -> Name GitCommit -> IO (Either Error GitCommit) +commit' auth user repo sha = + executeRequestMaybe auth $ gitCommitR user repo sha + -- > commit "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" commit :: Name Owner -> Name Repo -> Name GitCommit -> IO (Either Error GitCommit) -commit user repo sha = - executeRequest' $ gitCommitR user repo sha +commit = + commit' Nothing -- | Query a commit. -- See From eef27826eb15c22dd754a3b54c0a85c062a5dd4c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ga=C3=ABtan=20Andr=C3=A9?= Date: Sun, 25 Aug 2019 14:37:09 +0200 Subject: [PATCH 2/3] add endpoint new tree --- src/GitHub/Data/GitData.hs | 26 ++++++++++++++++++++++++++ src/GitHub/Endpoints/GitData/Trees.hs | 13 +++++++++++++ 2 files changed, 39 insertions(+) diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index edeef245..39de64fc 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -71,6 +71,25 @@ data GitTree = GitTree instance NFData GitTree where rnf = genericRnf instance Binary GitTree +data NewTree = NewTree + { newBaseTree :: !(Name Tree) + , newTreeGitTrees :: !(Vector NewGitTree) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData NewTree where rnf = genericRnf +instance Binary NewTree + +data NewGitTree = NewGitTree + { newGitTreePath :: !Text + , newGitTreeMode :: !Text + , newGitTreeContent :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData NewGitTree where rnf = genericRnf +instance Binary NewGitTree + data GitCommit = GitCommit { gitCommitMessage :: !Text , gitCommitUrl :: !URL @@ -233,6 +252,13 @@ instance FromJSON GitTree where <*> o .: "path" <*> o .: "mode" + +instance ToJSON NewTree where + toJSON (NewTree b tree) = object [ "base_tree" .= b, "tree" .= tree ] + +instance ToJSON NewGitTree where + toJSON (NewGitTree path mode content) = object [ "path" .= path, "mode" .= mode, "content" .= content ] + instance FromJSON GitCommit where parseJSON = withObject "GitCommit" $ \o -> GitCommit <$> o .: "message" diff --git a/src/GitHub/Endpoints/GitData/Trees.hs b/src/GitHub/Endpoints/GitData/Trees.hs index b6bc550a..c4b8f682 100644 --- a/src/GitHub/Endpoints/GitData/Trees.hs +++ b/src/GitHub/Endpoints/GitData/Trees.hs @@ -12,6 +12,8 @@ module GitHub.Endpoints.GitData.Trees ( nestedTree, nestedTree', nestedTreeR, + createTree, + createTreeR, module GitHub.Data, ) where @@ -57,3 +59,14 @@ nestedTree = nestedTree' Nothing nestedTreeR :: Name Owner -> Name Repo -> Name Tree -> Request k Tree nestedTreeR user repo sha = query ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [("recursive", Just "1")] + +-- | Create a tree. +createTree :: Auth -> Name Owner -> Name Repo -> NewTree -> IO (Either Error Tree) +createTree auth user repo newTree = + executeRequest auth $ createTreeR user repo newTree + +-- | Create a teference. +-- See +createTreeR :: Name Owner -> Name Repo -> NewTree -> Request 'RW Tree +createTreeR user repo newTree = + command Post ["repos", toPathPart user, toPathPart repo , "git", "trees"] (encode newTree) \ No newline at end of file From 8a41b9234b270b4d3ac5865e7ec23f0f23ff5728 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ga=C3=ABtan=20Andr=C3=A9?= Date: Sun, 25 Aug 2019 15:14:43 +0200 Subject: [PATCH 3/3] add create commit request --- src/GitHub/Data/GitData.hs | 14 +++++++++++++- src/GitHub/Endpoints/GitData/Commits.hs | 13 +++++++++++++ src/GitHub/Endpoints/GitData/Trees.hs | 2 +- 3 files changed, 27 insertions(+), 2 deletions(-) diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index 39de64fc..b45ec202 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -104,6 +104,16 @@ data GitCommit = GitCommit instance NFData GitCommit where rnf = genericRnf instance Binary GitCommit +data NewGitCommit = NewGitCommit + { newGitCommitMessage :: !Text + , newGitCommitTree :: !(Name Tree) + , newGitCommitParents :: !(Vector (Name GitCommit)) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData NewGitCommit where rnf = genericRnf +instance Binary NewGitCommit + data Blob = Blob { blobUrl :: !URL , blobEncoding :: !Text @@ -237,6 +247,9 @@ instance FromJSON Commit where <*> o .:? "files" .!= V.empty <*> o .:? "stats" +instance ToJSON NewGitCommit where + toJSON (NewGitCommit message tree parents) = object [ "message" .= message, "tree" .= tree, "parents" .= parents ] + instance FromJSON Tree where parseJSON = withObject "Tree" $ \o -> Tree <$> o .: "sha" @@ -252,7 +265,6 @@ instance FromJSON GitTree where <*> o .: "path" <*> o .: "mode" - instance ToJSON NewTree where toJSON (NewTree b tree) = object [ "base_tree" .= b, "tree" .= tree ] diff --git a/src/GitHub/Endpoints/GitData/Commits.hs b/src/GitHub/Endpoints/GitData/Commits.hs index 30d80c26..ae4af165 100644 --- a/src/GitHub/Endpoints/GitData/Commits.hs +++ b/src/GitHub/Endpoints/GitData/Commits.hs @@ -9,6 +9,8 @@ module GitHub.Endpoints.GitData.Commits ( commit, commit', gitCommitR, + createCommit, + createCommitR, module GitHub.Data, ) where @@ -35,3 +37,14 @@ commit = gitCommitR :: Name Owner -> Name Repo -> Name GitCommit -> Request k GitCommit gitCommitR user repo sha = query ["repos", toPathPart user, toPathPart repo, "git", "commits", toPathPart sha] [] + +-- | Create a tree. +createCommit :: Auth -> Name Owner -> Name Repo -> NewGitCommit -> IO (Either Error GitCommit) +createCommit auth user repo newTree = + executeRequest auth $ createCommitR user repo newTree + +-- | Create a commit. +-- See +createCommitR :: Name Owner -> Name Repo -> NewGitCommit -> Request 'RW GitCommit +createCommitR user repo newCommit = + command Post ["repos", toPathPart user, toPathPart repo , "git", "commits"] (encode newCommit) \ No newline at end of file diff --git a/src/GitHub/Endpoints/GitData/Trees.hs b/src/GitHub/Endpoints/GitData/Trees.hs index c4b8f682..89ba9487 100644 --- a/src/GitHub/Endpoints/GitData/Trees.hs +++ b/src/GitHub/Endpoints/GitData/Trees.hs @@ -65,7 +65,7 @@ createTree :: Auth -> Name Owner -> Name Repo -> NewTree -> IO (Either Error Tre createTree auth user repo newTree = executeRequest auth $ createTreeR user repo newTree --- | Create a teference. +-- | Create a tree. -- See createTreeR :: Name Owner -> Name Repo -> NewTree -> Request 'RW Tree createTreeR user repo newTree =