github-release 0.2.0 → 1.0.0
raw patch · 7 files changed
+179/−165 lines, 7 filesdep ~aesondep ~basedep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: aeson, base, bytestring, mime-types, optparse-generic, text, unordered-containers, uri-templater
API changes (from Hackage documentation)
Files
- executable/Main.hs +0/−3
- github-release.cabal +11/−11
- library/GitHubRelease.hs +0/−137
- package.yaml +11/−11
- source/executable/Main.hs +5/−0
- source/library/GitHubRelease.hs +151/−0
- stack.yaml +1/−3
− executable/Main.hs
@@ -1,3 +0,0 @@-module Main (module GitHubRelease) where--import GitHubRelease (main)
github-release.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: github-release-version: 0.2.0+version: 1.0.0 synopsis: Upload files to GitHub releases. description: GitHub Release is a command-line utility for uploading files to GitHub releases. category: Utility@@ -27,20 +27,20 @@ library hs-source-dirs:- library+ source/library ghc-options: -Wall build-depends:- aeson >=0.9.0.1 && <1.1- , base >=4.8.2.0 && <4.10- , bytestring >=0.10.6.0 && <0.11+ aeson >=0.9 && <1.1+ , base >=4.8.2 && <4.10+ , bytestring >=0.10.6 && <0.11 , http-client >=0.4.30 && <0.6 , http-client-tls >=0.2.4 && <0.4 , http-types >=0.9 && <0.10- , mime-types >=0.1.0.7 && <0.2- , optparse-generic >=1.1.0 && <1.2- , text >=1.2.2.1 && <1.3- , unordered-containers >=0.2.5.1 && <0.3- , uri-templater >=0.2.0.0 && <0.3+ , mime-types >=0.1 && <0.2+ , optparse-generic >=1.1 && <1.2+ , text >=1.2.2 && <1.3+ , unordered-containers >=0.2.5 && <0.3+ , uri-templater >=0.2 && <0.3 exposed-modules: GitHubRelease other-modules:@@ -50,7 +50,7 @@ executable github-release main-is: Main.hs hs-source-dirs:- executable+ source/executable ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: base
− library/GitHubRelease.hs
@@ -1,137 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators #-}--module GitHubRelease where--import qualified Data.Aeson as Aeson-import qualified Data.ByteString.Char8 as BS8-import qualified Data.ByteString.Lazy as BSL-import qualified Data.HashMap.Strict as HashMap-import qualified Data.Text as Text-import qualified Data.Version as Version-import qualified GHC.Generics as Generics-import qualified Network.HTTP.Client as Client-import qualified Network.HTTP.Client.TLS as TLS-import qualified Network.HTTP.Types as HTTP-import qualified Network.Mime as MIME-import qualified Network.URI.Template as Template-import qualified Network.URI.Template.Types as Template-import qualified Options.Generic as Options-import qualified Paths_github_release as This-import qualified System.IO as IO-import qualified Text.Printf as Printf--data Command- = Upload- { file :: FilePath Options.<?>- "The path to the local file to upload."- , name :: String Options.<?>- "The name to give the file on the release."- , owner :: String Options.<?>- "The GitHub owner, either a user or organization."- , repo :: String Options.<?>- "The GitHub repository name."- , tag :: String Options.<?>- "The tag name."- , token :: String Options.<?>- "Your OAuth2 token."- }- | Version- deriving (Generics.Generic, Show)--instance Options.ParseRecord Command--main :: IO ()-main = do- command <- Options.getRecord (Text.pack "Upload a file to a GitHub release.")- runCommand command--runCommand :: Command -> IO ()-runCommand command = case command of- Upload aFile aName anOwner aRepo aTag aToken -> upload- (Options.unHelpful aToken)- (Options.unHelpful anOwner)- (Options.unHelpful aRepo)- (Options.unHelpful aTag)- (Options.unHelpful aFile)- (Options.unHelpful aName)- Version -> putStrLn versionString--upload :: String -> String -> String -> String -> FilePath -> String -> IO ()-upload aToken anOwner aRepo aTag aFile aName = do- manager <- Client.newManager TLS.tlsManagerSettings- uploadUrl <- getUploadUrl manager aToken anOwner aRepo aTag- response <- uploadFile manager uploadUrl aToken aFile aName- case HTTP.statusCode (Client.responseStatus response) of- 201 -> pure ()- _ -> do- IO.hPrint IO.stderr response- BSL.hPutStr IO.stderr (Client.responseBody response)- fail "Failed to upload file to release!"--getUploadUrl :: Client.Manager -> String -> String -> String -> String -> IO Template.UriTemplate-getUploadUrl manager aToken anOwner aRepo aTag = do- (Right json) <- getTag manager aToken anOwner aRepo aTag- let (Just (Aeson.String text)) = HashMap.lookup (Text.pack "upload_url") json- let uploadUrl = Text.unpack text- let (Right template) = Template.parseTemplate uploadUrl- pure template--getTag :: Client.Manager -> String -> String -> String -> String -> IO (Either String Aeson.Object)-getTag manager aToken anOwner aRepo aTag = do- let format = "https://api.github.com/repos/%s/%s/releases/tags/%s"- let url = Printf.printf format anOwner aRepo aTag- initialRequest <- Client.parseUrlThrow url- let request = initialRequest- { Client.requestHeaders =- [ authorizationHeader aToken- , userAgentHeader- ]- }- response <- Client.httpLbs request manager- let body = Client.responseBody response- let json = Aeson.eitherDecode body- return json--authorizationHeader :: String -> HTTP.Header-authorizationHeader aToken =- ( HTTP.hAuthorization- , BS8.pack (Printf.printf "token %s" aToken)- )--userAgentHeader :: HTTP.Header-userAgentHeader =- ( HTTP.hUserAgent- , BS8.pack userAgent- )--userAgent :: String-userAgent = Printf.printf "%s/%s-%s" "tfausak" "github-release" versionString--versionString :: String-versionString = Version.showVersion This.version--uploadFile :: Client.Manager -> Template.UriTemplate -> String -> FilePath -> String -> IO (Client.Response BSL.ByteString)-uploadFile manager template aToken aFile aName = do- contents <- BSL.readFile aFile- let body = Client.RequestBodyLBS contents- uploadBody manager template aToken body aName--uploadBody :: Client.Manager -> Template.UriTemplate -> String -> Client.RequestBody -> String -> IO (Client.Response BSL.ByteString)-uploadBody manager template aToken body aName = do- let url = Template.render template- [ ("name", Template.WrappedValue (Template.Single aName))- ]- initialRequest <- Client.parseUrlThrow url- let request = initialRequest- { Client.method = BS8.pack "POST"- , Client.requestBody = body- , Client.requestHeaders =- [ authorizationHeader aToken- , (HTTP.hContentType, MIME.defaultMimeLookup (Text.pack aName))- , userAgentHeader- ]- }- Client.httpLbs request manager
package.yaml view
@@ -11,7 +11,7 @@ - -rtsopts - -with-rtsopts=-N main: Main.hs- source-dirs: executable+ source-dirs: source/executable extra-source-files: - CHANGELOG.markdown - package.yaml@@ -21,22 +21,22 @@ github: tfausak/github-release library: dependencies:- - aeson >=0.9.0.1 && <1.1- - base >=4.8.2.0 && <4.10- - bytestring >=0.10.6.0 && <0.11+ - aeson >=0.9 && <1.1+ - base >=4.8.2 && <4.10+ - bytestring >=0.10.6 && <0.11 - http-client >=0.4.30 && <0.6 - http-client-tls >=0.2.4 && <0.4 - http-types >=0.9 && <0.10- - mime-types >=0.1.0.7 && <0.2- - optparse-generic >=1.1.0 && <1.2- - text >=1.2.2.1 && <1.3- - unordered-containers >=0.2.5.1 && <0.3- - uri-templater >=0.2.0.0 && <0.3+ - mime-types >=0.1 && <0.2+ - optparse-generic >=1.1 && <1.2+ - text >=1.2.2 && <1.3+ - unordered-containers >=0.2.5 && <0.3+ - uri-templater >=0.2 && <0.3 other-modules: Paths_github_release- source-dirs: library+ source-dirs: source/library license: MIT license-file: LICENSE.markdown maintainer: Taylor Fausak name: github-release synopsis: Upload files to GitHub releases.-version: '0.2.0'+version: '1.0.0'
+ source/executable/Main.hs view
@@ -0,0 +1,5 @@+module Main+ ( module GitHubRelease+ ) where++import GitHubRelease (main)
+ source/library/GitHubRelease.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}++module GitHubRelease where++import Options.Generic (type (<?>))++import qualified Data.Aeson as Aeson+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy as BSL+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Text as Text+import qualified Data.Version as Version+import qualified GHC.Generics as Generics+import qualified Network.HTTP.Client as Client+import qualified Network.HTTP.Client.TLS as TLS+import qualified Network.HTTP.Types as HTTP+import qualified Network.Mime as MIME+import qualified Network.URI.Template as Template+import qualified Network.URI.Template.Types as Template+import qualified Options.Generic as Options+import qualified Paths_github_release as This+import qualified System.IO as IO+import qualified Text.Printf as Printf++data Command+ = Upload { file :: FilePath <?> "The path to the local file to upload."+ , name :: String <?> "The name to give the file on the release."+ , owner :: String <?> "The GitHub owner, either a user or organization."+ , repo :: String <?> "The GitHub repository name."+ , tag :: String <?> "The tag name."+ , token :: String <?> "Your OAuth2 token."}+ | Version+ deriving (Generics.Generic, Show)++instance Options.ParseRecord Command++main :: IO ()+main = do+ command <- Options.getRecord (Text.pack "Upload a file to a GitHub release.")+ runCommand command++runCommand :: Command -> IO ()+runCommand command =+ case command of+ Upload aFile aName anOwner aRepo aTag aToken ->+ upload+ (Options.unHelpful aToken)+ (Options.unHelpful anOwner)+ (Options.unHelpful aRepo)+ (Options.unHelpful aTag)+ (Options.unHelpful aFile)+ (Options.unHelpful aName)+ Version -> putStrLn versionString++upload :: String -> String -> String -> String -> FilePath -> String -> IO ()+upload aToken anOwner aRepo aTag aFile aName = do+ manager <- Client.newManager TLS.tlsManagerSettings+ uploadUrl <- getUploadUrl manager aToken anOwner aRepo aTag+ response <- uploadFile manager uploadUrl aToken aFile aName+ case HTTP.statusCode (Client.responseStatus response) of+ 201 -> pure ()+ _ -> do+ IO.hPrint IO.stderr response+ BSL.hPutStr IO.stderr (Client.responseBody response)+ fail "Failed to upload file to release!"++getUploadUrl+ :: Client.Manager+ -> String+ -> String+ -> String+ -> String+ -> IO Template.UriTemplate+getUploadUrl manager aToken anOwner aRepo aTag = do+ (Right json) <- getTag manager aToken anOwner aRepo aTag+ let (Just (Aeson.String text)) = HashMap.lookup (Text.pack "upload_url") json+ let uploadUrl = Text.unpack text+ let (Right template) = Template.parseTemplate uploadUrl+ pure template++getTag+ :: Client.Manager+ -> String+ -> String+ -> String+ -> String+ -> IO (Either String Aeson.Object)+getTag manager aToken anOwner aRepo aTag = do+ let format = "https://api.github.com/repos/%s/%s/releases/tags/%s"+ let url = Printf.printf format anOwner aRepo aTag+ initialRequest <- Client.parseUrlThrow url+ let request =+ initialRequest+ {Client.requestHeaders = [authorizationHeader aToken, userAgentHeader]}+ response <- Client.httpLbs request manager+ let body = Client.responseBody response+ let json = Aeson.eitherDecode body+ return json++authorizationHeader :: String -> HTTP.Header+authorizationHeader aToken =+ (HTTP.hAuthorization, BS8.pack (Printf.printf "token %s" aToken))++userAgentHeader :: HTTP.Header+userAgentHeader = (HTTP.hUserAgent, BS8.pack userAgent)++userAgent :: String+userAgent = Printf.printf "%s/%s-%s" "tfausak" "github-release" versionString++versionString :: String+versionString = Version.showVersion This.version++uploadFile+ :: Client.Manager+ -> Template.UriTemplate+ -> String+ -> FilePath+ -> String+ -> IO (Client.Response BSL.ByteString)+uploadFile manager template aToken aFile aName = do+ contents <- BSL.readFile aFile+ let body = Client.RequestBodyLBS contents+ uploadBody manager template aToken body aName++uploadBody+ :: Client.Manager+ -> Template.UriTemplate+ -> String+ -> Client.RequestBody+ -> String+ -> IO (Client.Response BSL.ByteString)+uploadBody manager template aToken body aName = do+ let url =+ Template.render+ template+ [("name", Template.WrappedValue (Template.Single aName))]+ initialRequest <- Client.parseUrlThrow url+ let request =+ initialRequest+ { Client.method = BS8.pack "POST"+ , Client.requestBody = body+ , Client.requestHeaders =+ [ authorizationHeader aToken+ , (HTTP.hContentType, MIME.defaultMimeLookup (Text.pack aName))+ , userAgentHeader+ ]+ }+ Client.httpLbs request manager
stack.yaml view
@@ -1,3 +1,1 @@-extra-deps:-- uri-templater-0.2.1.0-resolver: nightly-2016-12-08+resolver: nightly-2016-12-30