github-release 1.2.6 → 1.3.0
raw patch · 6 files changed
+365/−322 lines, 6 filesdep ~basesetup-changedPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
+ GitHubRelease: Delete :: (String <?> "The name to give the file on the release.") -> (Maybe String <?> "The GitHub owner, either a user or organization.") -> (String <?> "The GitHub repository name.") -> (String <?> "The tag name.") -> (Maybe String <?> "Your OAuth2 token.") -> Command
+ GitHubRelease: instance Data.Aeson.Types.FromJSON.FromJSON GitHubRelease.GHAsset
+ GitHubRelease: instance Data.Aeson.Types.FromJSON.FromJSON GitHubRelease.GHRelease
+ GitHubRelease: instance GHC.Classes.Eq GitHubRelease.GHAsset
+ GitHubRelease: instance GHC.Classes.Eq GitHubRelease.GHRelease
+ GitHubRelease: instance GHC.Show.Show GitHubRelease.GHAsset
+ GitHubRelease: instance GHC.Show.Show GitHubRelease.GHRelease
- GitHubRelease: Release :: (String <?> "The name of the release") -> (Maybe String <?> "The GitHub owner, either a user or organization.") -> (String <?> "The GitHub repository name.") -> (String <?> "The tag name.") -> (Maybe String <?> "Release description.") -> (String <?> "Your OAuth2 token.") -> (Maybe Bool <?> "Indicates if this is a pre-release.") -> (Maybe Bool <?> "Indicates if this is a draft.") -> Command
+ GitHubRelease: Release :: (String <?> "The name of the release") -> (Maybe String <?> "The GitHub owner, either a user or organization.") -> (String <?> "The GitHub repository name.") -> (String <?> "The tag name.") -> (Maybe String <?> "Release description.") -> (Maybe String <?> "Your OAuth2 token.") -> (Maybe Bool <?> "Indicates if this is a pre-release.") -> (Maybe Bool <?> "Indicates if this is a draft.") -> Command
- GitHubRelease: Upload :: (FilePath <?> "The path to the local file to upload.") -> (String <?> "The name to give the file on the release.") -> (Maybe String <?> "The GitHub owner, either a user or organization.") -> (String <?> "The GitHub repository name.") -> (String <?> "The tag name.") -> (String <?> "Your OAuth2 token.") -> Command
+ GitHubRelease: Upload :: (FilePath <?> "The path to the local file to upload.") -> (String <?> "The name to give the file on the release.") -> (Maybe String <?> "The GitHub owner, either a user or organization.") -> (String <?> "The GitHub repository name.") -> (String <?> "The tag name.") -> (Maybe String <?> "Your OAuth2 token.") -> Command
- GitHubRelease: [token] :: Command -> String <?> "Your OAuth2 token."
+ GitHubRelease: [token] :: Command -> Maybe String <?> "Your OAuth2 token."
- GitHubRelease: getTag :: Manager -> String -> Maybe String -> String -> String -> IO (Either String Object)
+ GitHubRelease: getTag :: FromJSON a => Manager -> String -> String -> String -> String -> IO (Either String a)
Files
- Setup.hs +0/−4
- executables/Main.hs +0/−5
- github-release.cabal +49/−63
- library/GitHubRelease.hs +0/−250
- src/exe/Main.hs +5/−0
- src/lib/GitHubRelease.hs +311/−0
− Setup.hs
@@ -1,4 +0,0 @@-import qualified Distribution.Simple as Cabal--main :: IO ()-main = Cabal.defaultMain
− executables/Main.hs
@@ -1,5 +0,0 @@-module Main- ( module GitHubRelease- ) where--import GitHubRelease (main)
github-release.cabal view
@@ -1,75 +1,61 @@-cabal-version: 1.12+name: github-release+version: 1.3.0 --- This file has been generated from package.yaml by hpack version 0.33.0.------ see: https://github.com/sol/hpack------ hash: 0c4d86aac76bfa8e5e35f0952319b765c787a2aec5166991188b5a9b96e9d189+synopsis: Upload files to GitHub releases.+description: GitHub Release uploads files to GitHub releases. -name: github-release-version: 1.2.6-synopsis: Upload files to GitHub releases.-description: GitHub Release uploads files to GitHub releases.-category: Utility-homepage: https://github.com/tfausak/github-release#readme-bug-reports: https://github.com/tfausak/github-release/issues-maintainer: Taylor Fausak-license: MIT-license-file: LICENSE.markdown-build-type: Simple+build-type: Simple+cabal-version: >= 1.10+category: Utility+license-file: LICENSE.markdown+license: MIT+maintainer: Taylor Fausak source-repository head- type: git location: https://github.com/tfausak/github-release+ type: git library- exposed-modules:- GitHubRelease- other-modules:- Paths_github_release- hs-source-dirs:- library- ghc-options: -Weverything -Wno-implicit-prelude -Wno-safe -Wno-unsafe+ autogen-modules: Paths_github_release build-depends:- aeson >=0.11.2 && <0.12 || >=1.0.2 && <1.5- , base >=4.9.0 && <4.15- , burrito >=1.0.0 && <1.1- , bytestring >=0.10.8 && <0.11- , http-client >=0.4.31 && <0.7- , http-client-tls >=0.2.4 && <0.4- , http-types >=0.9.1 && <0.13- , mime-types >=0.1.0 && <0.2- , optparse-generic >=1.1.1 && <1.4- , text >=1.2.2 && <1.3- , unordered-containers >=0.2.7 && <0.3- if impl(ghc >= 8.4)- ghc-options: -Wno-partial-fields- if impl(ghc >= 8.8.1)- ghc-options: -Wno-missing-deriving-strategies+ base >= 4.9.0 && < 4.15+ , aeson >= 0.11.2 && < 0.12 || >= 1.0.2 && < 1.5+ , burrito >= 1.0.0 && < 1.1+ , bytestring >= 0.10.8 && < 0.11+ , http-client >= 0.4.31 && < 0.7+ , http-client-tls >= 0.2.4 && < 0.4+ , http-types >= 0.9.1 && < 0.13+ , mime-types >= 0.1.0 && < 0.2+ , optparse-generic >= 1.1.1 && < 1.4+ , text >= 1.2.2 && < 1.3+ , unordered-containers >= 0.2.7 && < 0.3 default-language: Haskell2010+ exposed-modules: GitHubRelease+ ghc-options:+ -Weverything+ -Wno-implicit-prelude+ -Wno-safe+ -Wno-unsafe+ hs-source-dirs: src/lib+ other-modules: Paths_github_release + if impl(ghc >= 8.4)+ ghc-options:+ -Wno-partial-fields++ if impl(ghc >= 8.8)+ ghc-options:+ -Wno-missing-deriving-strategies++ if impl(ghc >= 8.10)+ ghc-options:+ -Wno-missing-safe-haskell-mode+ -Wno-prepositive-qualified-module+ executable github-release- main-is: Main.hs- other-modules:- Paths_github_release- hs-source-dirs:- executables- ghc-options: -Weverything -Wno-implicit-prelude -Wno-safe -Wno-unsafe -rtsopts -threaded build-depends:- aeson >=0.11.2 && <0.12 || >=1.0.2 && <1.5- , base >=4.9.0 && <4.15- , burrito >=1.0.0 && <1.1- , bytestring >=0.10.8 && <0.11- , github-release- , http-client >=0.4.31 && <0.7- , http-client-tls >=0.2.4 && <0.4- , http-types >=0.9.1 && <0.13- , mime-types >=0.1.0 && <0.2- , optparse-generic >=1.1.1 && <1.4- , text >=1.2.2 && <1.3- , unordered-containers >=0.2.7 && <0.3- if impl(ghc >= 8.4)- ghc-options: -Wno-partial-fields- if impl(ghc >= 8.8.1)- ghc-options: -Wno-missing-deriving-strategies- default-language: Haskell2010+ base -any+ , github-release -any+ default-language: Haskell98+ hs-source-dirs: src/exe+ main-is: Main.hs
− library/GitHubRelease.hs
@@ -1,250 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE ExplicitNamespaces #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators #-}--module GitHubRelease- ( Command(..)- , main- , runCommand- , upload- , getUploadUrl- , getTag- , authorizationHeader- , userAgentHeader- , userAgent- , versionString- , uploadFile- , uploadBody- ) where--import Options.Generic (type (<?>))--import qualified Burrito-import Data.Aeson (object, (.=))-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 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 :: Maybe 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."}- | Release { title :: String <?> "The name of the release"- , owner :: Maybe String <?> "The GitHub owner, either a user or organization."- , repo :: String <?> "The GitHub repository name."- , tag :: String <?> "The tag name."- , description :: Maybe String <?> "Release description."- , token :: String <?> "Your OAuth2 token."- , preRelease :: Maybe Bool <?> "Indicates if this is a pre-release."- , draft :: Maybe Bool <?> "Indicates if this is a draft."- }- | 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)- Release aTitle anOwner aRepo aTag aDescription aToken aPreRelease aDraft ->- release- (Options.unHelpful aToken)- (Options.unHelpful anOwner)- (Options.unHelpful aRepo)- (Options.unHelpful aTag)- (Options.unHelpful aTitle)- (Options.unHelpful aDescription)- (Options.unHelpful aPreRelease)- (Options.unHelpful aDraft)- Version -> putStrLn versionString--upload :: String -> Maybe 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 ()- _ -> fail "Failed to upload file to release!"--release :: String -> Maybe String -> String -> String -> String -> Maybe String -> Maybe Bool -> Maybe Bool -> IO ()-release aToken anOwner aRepo aTag aTitle aDescription aPreRelease aDraft = do- manager <- Client.newManager TLS.tlsManagerSettings- (owner', repo') <- getOwnerRepo anOwner aRepo- let format = "https://api.github.com/repos/%s/%s/releases"- let- url :: String- url = Printf.printf format owner' repo'- response <- mkRelease manager url aToken aTag aTitle aDescription aPreRelease aDraft- let body = Aeson.eitherDecode $ Client.responseBody response :: Either String Aeson.Object- case HTTP.statusCode (Client.responseStatus response) of- 201 -> pure ()- 422 -> IO.hPutStrLn IO.stderr "Release aready exists. Ignoring."- _ -> fail $ "Failed to create release! Reason: " <> (show body)--getUploadUrl- :: Client.Manager- -> String- -> Maybe String- -> String- -> String- -> IO Burrito.Template-getUploadUrl manager aToken anOwner aRepo aTag = do- json <- do- result <- getTag manager aToken anOwner aRepo aTag- case result of- Left problem -> fail ("Failed to get tag JSON: " ++ show problem)- Right json -> pure json- text <- case HashMap.lookup (Text.pack "upload_url") json of- Just (Aeson.String text) -> pure text- _ -> fail ("Failed to get upload URL: " ++ show json)- let uploadUrl = Text.unpack text- template <- case Burrito.parse uploadUrl of- Nothing -> fail ("Failed to parse URL template: " ++ show uploadUrl)- Just template -> pure template- pure template--getOwnerRepo :: Maybe String -> String -> IO ((String, String))-getOwnerRepo rawOwner rawRepo = do- (anOwner, aRepo) <- case break (== '/') rawRepo of- (aRepo, "") -> case rawOwner of- Nothing -> fail "Missing required option --owner."- Just anOwner -> pure (anOwner, aRepo)- (anOwner, aRepo) -> do- case rawOwner of- Nothing -> pure ()- Just _ -> IO.hPutStrLn IO.stderr "Ignoring --owner option."- pure (anOwner, drop 1 aRepo)- return (anOwner, aRepo)--getTag- :: Client.Manager- -> String- -> Maybe String- -> String- -> String- -> IO (Either String Aeson.Object)-getTag manager aToken rawOwner rawRepo aTag = do- (anOwner, aRepo) <- getOwnerRepo rawOwner rawRepo- let format = "https://api.github.com/repos/%s/%s/releases/tags/%s"- let- url :: String- url = Printf.printf format anOwner aRepo aTag- initialRequest <- Client.parseRequest url- let request =- initialRequest- {Client.requestHeaders = [authorizationHeader aToken, userAgentHeader]}- response <- Client.httpLbs request manager- let body = Client.responseBody response- return (Aeson.eitherDecode body)--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- -> Burrito.Template- -> 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- -> Burrito.Template- -> String- -> Client.RequestBody- -> String- -> IO (Client.Response BSL.ByteString)-uploadBody manager template aToken body aName = do- let- url :: String- url = Burrito.expand- [("name", Burrito.stringValue aName)]- template- initialRequest <- Client.parseRequest 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--mkRelease- :: Client.Manager- -> String- -> String- -> String- -> String- -> Maybe String- -> Maybe Bool- -> Maybe Bool- -> IO (Client.Response BSL.ByteString)-mkRelease manager url aToken aTag aTitle aDescription aPreRelease aDraft = do- initialRequest <- Client.parseRequest url- let requestObject = object- [ Text.pack "tag_name" .= aTag- , Text.pack "name" .= aTitle- , Text.pack "body" .= maybe "" id aDescription- , Text.pack "prerelease" .= maybe False id aPreRelease- , Text.pack "draft" .= maybe False id aDraft- ]- let request =- initialRequest- { Client.method = BS8.pack "POST"- , Client.requestBody = Client.RequestBodyLBS $ Aeson.encode requestObject- , Client.requestHeaders =- [ authorizationHeader aToken- , userAgentHeader- ]- }- Client.httpLbs request manager
+ src/exe/Main.hs view
@@ -0,0 +1,5 @@+module Main+ ( module GitHubRelease+ ) where++import GitHubRelease (main)
+ src/lib/GitHubRelease.hs view
@@ -0,0 +1,311 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}++module GitHubRelease+ ( Command(..)+ , main+ , runCommand+ , upload+ , getUploadUrl+ , getTag+ , authorizationHeader+ , userAgentHeader+ , userAgent+ , versionString+ , uploadFile+ , uploadBody+ ) where++import Options.Generic (type (<?>))++import qualified Burrito+import Data.Aeson (object, (.=))+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 Options.Generic as Options+import qualified Paths_github_release as This+import qualified System.Environment as Environment+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 :: Maybe String <?> "The GitHub owner, either a user or organization."+ , repo :: String <?> "The GitHub repository name."+ , tag :: String <?> "The tag name."+ , token :: Maybe String <?> "Your OAuth2 token."}+ | Release { title :: String <?> "The name of the release"+ , owner :: Maybe String <?> "The GitHub owner, either a user or organization."+ , repo :: String <?> "The GitHub repository name."+ , tag :: String <?> "The tag name."+ , description :: Maybe String <?> "Release description."+ , token :: Maybe String <?> "Your OAuth2 token."+ , preRelease :: Maybe Bool <?> "Indicates if this is a pre-release."+ , draft :: Maybe Bool <?> "Indicates if this is a draft."+ }+ | Delete+ { name :: String <?> "The name to give the file on the release."+ , owner :: Maybe String <?> "The GitHub owner, either a user or organization."+ , repo :: String <?> "The GitHub repository name."+ , tag :: String <?> "The tag name."+ , token :: Maybe 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 helpfulToken -> do+ aToken <- maybe (Environment.getEnv "GITHUB_TOKEN") pure+ $ Options.unHelpful helpfulToken+ upload+ aToken+ (Options.unHelpful anOwner)+ (Options.unHelpful aRepo)+ (Options.unHelpful aTag)+ (Options.unHelpful aFile)+ (Options.unHelpful aName)+ Release aTitle anOwner aRepo aTag aDescription helpfulToken aPreRelease aDraft -> do+ aToken <- maybe (Environment.getEnv "GITHUB_TOKEN") pure+ $ Options.unHelpful helpfulToken+ release+ aToken+ (Options.unHelpful anOwner)+ (Options.unHelpful aRepo)+ (Options.unHelpful aTag)+ (Options.unHelpful aTitle)+ (Options.unHelpful aDescription)+ (Options.unHelpful aPreRelease)+ (Options.unHelpful aDraft)+ Delete aName anOwner aRepo aTag helpfulToken -> do+ aToken <- maybe (Environment.getEnv "GITHUB_TOKEN") pure+ $ Options.unHelpful helpfulToken+ delete+ (Options.unHelpful aName)+ (Options.unHelpful anOwner)+ (Options.unHelpful aRepo)+ (Options.unHelpful aTag)+ aToken+ Version -> putStrLn versionString++upload :: String -> Maybe 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 ()+ _ -> fail "Failed to upload file to release!"++release :: String -> Maybe String -> String -> String -> String -> Maybe String -> Maybe Bool -> Maybe Bool -> IO ()+release aToken anOwner aRepo aTag aTitle aDescription aPreRelease aDraft = do+ manager <- Client.newManager TLS.tlsManagerSettings+ (owner', repo') <- getOwnerRepo anOwner aRepo+ let format = "https://api.github.com/repos/%s/%s/releases"+ let+ url :: String+ url = Printf.printf format owner' repo'+ response <- mkRelease manager url aToken aTag aTitle aDescription aPreRelease aDraft+ let body = Aeson.eitherDecode $ Client.responseBody response :: Either String Aeson.Object+ case HTTP.statusCode (Client.responseStatus response) of+ 201 -> pure ()+ 422 -> IO.hPutStrLn IO.stderr "Release aready exists. Ignoring."+ _ -> fail $ "Failed to create release! Reason: " <> (show body)++delete :: String -> Maybe String -> String -> String -> String -> IO ()+delete aName rawOwner rawRepo aTag aToken = do+ manager <- Client.newManager TLS.tlsManagerSettings+ (anOwner, aRepo) <- getOwnerRepo rawOwner rawRepo+ ghRelease <- do+ result <- getTag manager aToken anOwner aRepo aTag+ case result of+ Left problem -> fail $ "Failed to get tag JSON: " ++ show problem+ Right json -> pure json+ case filter ((== aName) . ghAssetName) $ ghReleaseAssets ghRelease of+ [] -> fail $ "Failed to find asset on release."+ ghAsset : _ -> do+ request <- Client.parseRequest $ ghAssetUrl ghAsset+ response <- Client.httpLbs request+ { Client.method = HTTP.methodDelete+ , Client.requestHeaders = [authorizationHeader aToken, userAgentHeader]+ } manager+ case HTTP.statusCode $ Client.responseStatus response of+ 204 -> pure ()+ _ -> fail $ "Failed to delete asset from release! " <> show response++newtype GHRelease = GHRelease+ { ghReleaseAssets :: [GHAsset]+ } deriving (Eq, Show)++instance Aeson.FromJSON GHRelease where+ parseJSON = Aeson.withObject "GHRelease" $ \ obj -> GHRelease+ <$> obj Aeson..: Text.pack "assets"++data GHAsset = GHAsset+ { ghAssetName :: String+ , ghAssetUrl :: String+ } deriving (Eq, Show)++instance Aeson.FromJSON GHAsset where+ parseJSON = Aeson.withObject "GHAsset" $ \ obj -> GHAsset+ <$> obj Aeson..: Text.pack "name"+ <*> obj Aeson..: Text.pack "url"++getUploadUrl+ :: Client.Manager+ -> String+ -> Maybe String+ -> String+ -> String+ -> IO Burrito.Template+getUploadUrl manager aToken rawOwner rawRepo aTag = do+ json <- do+ (anOwner, aRepo) <- getOwnerRepo rawOwner rawRepo+ result <- getTag manager aToken anOwner aRepo aTag+ case result of+ Left problem -> fail ("Failed to get tag JSON: " ++ show problem)+ Right json -> pure json+ text <- case HashMap.lookup (Text.pack "upload_url") json of+ Just (Aeson.String text) -> pure text+ _ -> fail ("Failed to get upload URL: " ++ show json)+ let uploadUrl = Text.unpack text+ template <- case Burrito.parse uploadUrl of+ Nothing -> fail ("Failed to parse URL template: " ++ show uploadUrl)+ Just template -> pure template+ pure template++getOwnerRepo :: Maybe String -> String -> IO ((String, String))+getOwnerRepo rawOwner rawRepo = do+ (anOwner, aRepo) <- case break (== '/') rawRepo of+ (aRepo, "") -> case rawOwner of+ Nothing -> fail "Missing required option --owner."+ Just anOwner -> pure (anOwner, aRepo)+ (anOwner, aRepo) -> do+ case rawOwner of+ Nothing -> pure ()+ Just _ -> IO.hPutStrLn IO.stderr "Ignoring --owner option."+ pure (anOwner, drop 1 aRepo)+ return (anOwner, aRepo)++getTag+ :: Aeson.FromJSON a+ => Client.Manager+ -> String+ -> String+ -> String+ -> String+ -> IO (Either String a)+getTag manager aToken anOwner aRepo aTag = do+ let format = "https://api.github.com/repos/%s/%s/releases/tags/%s"+ let+ url :: String+ url = Printf.printf format anOwner aRepo aTag+ initialRequest <- Client.parseRequest url+ let request =+ initialRequest+ {Client.requestHeaders = [authorizationHeader aToken, userAgentHeader]}+ response <- Client.httpLbs request manager+ let body = Client.responseBody response+ return (Aeson.eitherDecode body)++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+ -> Burrito.Template+ -> 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+ -> Burrito.Template+ -> String+ -> Client.RequestBody+ -> String+ -> IO (Client.Response BSL.ByteString)+uploadBody manager template aToken body aName = do+ let+ url :: String+ url = Burrito.expand+ [("name", Burrito.stringValue aName)]+ template+ initialRequest <- Client.parseRequest 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++mkRelease+ :: Client.Manager+ -> String+ -> String+ -> String+ -> String+ -> Maybe String+ -> Maybe Bool+ -> Maybe Bool+ -> IO (Client.Response BSL.ByteString)+mkRelease manager url aToken aTag aTitle aDescription aPreRelease aDraft = do+ initialRequest <- Client.parseRequest url+ let requestObject = object+ [ Text.pack "tag_name" .= aTag+ , Text.pack "name" .= aTitle+ , Text.pack "body" .= maybe "" id aDescription+ , Text.pack "prerelease" .= maybe False id aPreRelease+ , Text.pack "draft" .= maybe False id aDraft+ ]+ let request =+ initialRequest+ { Client.method = BS8.pack "POST"+ , Client.requestBody = Client.RequestBodyLBS $ Aeson.encode requestObject+ , Client.requestHeaders =+ [ authorizationHeader aToken+ , userAgentHeader+ ]+ }+ Client.httpLbs request manager