github-release 2.0.0.2 → 2.0.0.3
raw patch · 4 files changed
+190/−186 lines, 4 filesdep ~basedep ~bytestringdep ~textPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, bytestring, text
API changes (from Hackage documentation)
Files
- LICENSE.markdown +1/−1
- github-release.cabal +10/−13
- source/executable/Main.hs +3/−2
- source/library/GitHubRelease.hs +176/−170
LICENSE.markdown view
@@ -1,6 +1,6 @@ MIT License -Copyright (c) 2022 Taylor Fausak+Copyright (c) 2023 Taylor Fausak Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal
github-release.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.2 name: github-release-version: 2.0.0.2+version: 2.0.0.3 synopsis: Upload files to GitHub releases. description: GitHub Release uploads files to GitHub releases.@@ -24,38 +24,35 @@ common library build-depends:- , base >= 4.13.0 && < 4.18+ , base >= 4.15.0 && < 4.18 , aeson >= 1.4.7 && < 1.6 || >= 2.0.0 && < 2.2 , burrito >= 1.2.0 && < 1.3 || >= 2.0.0 && < 2.1- , bytestring >= 0.10.10 && < 0.12+ , bytestring >= 0.10.12 && < 0.12 , http-client >= 0.6.4 && < 0.8 , http-client-tls >= 0.3.5 && < 0.4 , http-types >= 0.12.3 && < 0.13 , mime-types >= 0.1.0 && < 0.2 , optparse-generic >= 1.3.1 && < 1.5- , text >= 1.2.4 && < 1.3 || >= 2.0 && < 2.1+ , text >= 1.2.5 && < 1.3 || >= 2.0 && < 2.1 , unordered-containers >= 0.2.10 && < 0.3 default-language: Haskell2010 ghc-options: -Weverything+ -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missing-deriving-strategies -Wno-missing-exported-signatures+ -Wno-missing-safe-haskell-mode+ -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe- -Wno-all-missed-specialisations - if flag(pedantic)- ghc-options: -Werror-- if impl(ghc >= 8.10)- ghc-options:- -Wno-missing-safe-haskell-mode- -Wno-prepositive-qualified-module- if impl(ghc >= 9.2) ghc-options: -Wno-missing-kind-signatures++ if flag(pedantic)+ ghc-options: -Werror common executable import: library
source/executable/Main.hs view
@@ -1,5 +1,6 @@ module Main- ( module GitHubRelease- ) where+ ( module GitHubRelease,+ )+where import GitHubRelease (main)
source/library/GitHubRelease.hs view
@@ -1,30 +1,28 @@-{-# OPTIONS_GHC -Wno-partial-fields #-}--{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -Wno-partial-fields #-} module GitHubRelease- ( Command(..)- , main- , runCommand- , upload- , getUploadUrl- , getTag- , authorizationHeader- , userAgentHeader- , userAgent- , versionString- , uploadFile- , uploadBody- ) where--import Options.Generic (type (<?>))+ ( Command (..),+ main,+ runCommand,+ upload,+ getUploadUrl,+ getTag,+ authorizationHeader,+ userAgentHeader,+ userAgent,+ versionString,+ uploadFile,+ uploadBody,+ )+where import qualified Burrito-import Data.Aeson ((.=), object)+import Data.Aeson (object, (.=)) import qualified Data.Aeson as Aeson import qualified Data.ByteString.Char8 as BS8 import qualified Data.ByteString.Lazy as BSL@@ -37,6 +35,7 @@ import qualified Network.HTTP.Client.TLS as TLS import qualified Network.HTTP.Types as HTTP import qualified Network.Mime as MIME+import Options.Generic (type (<?>)) import qualified Options.Generic as Options import qualified Paths_github_release as This import qualified System.Environment as Environment@@ -44,28 +43,31 @@ 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."- }+ = 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."- }+ { 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) @@ -79,8 +81,9 @@ 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+ aToken <-+ maybe (Environment.getEnv "GITHUB_TOKEN") pure $+ Options.unHelpful helpfulToken upload aToken (Options.unHelpful anOwner)@@ -88,10 +91,11 @@ (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 aTitle anOwner aRepo aTag aDescription helpfulToken aPreRelease aDraft ->+ do+ aToken <-+ maybe (Environment.getEnv "GITHUB_TOKEN") pure $+ Options.unHelpful helpfulToken release aToken (Options.unHelpful anOwner)@@ -102,8 +106,9 @@ (Options.unHelpful aPreRelease) (Options.unHelpful aDraft) Delete aName anOwner aRepo aTag helpfulToken -> do- aToken <- maybe (Environment.getEnv "GITHUB_TOKEN") pure- $ Options.unHelpful helpfulToken+ aToken <-+ maybe (Environment.getEnv "GITHUB_TOKEN") pure $+ Options.unHelpful helpfulToken delete (Options.unHelpful aName) (Options.unHelpful anOwner)@@ -112,8 +117,8 @@ aToken Version -> putStrLn versionString -upload- :: String -> Maybe String -> String -> String -> FilePath -> String -> IO ()+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@@ -122,37 +127,37 @@ 201 -> pure () _ -> fail "Failed to upload file to release!" -release- :: String- -> Maybe String- -> String- -> String- -> String- -> Maybe String- -> Maybe Bool- -> Maybe Bool- -> IO ()+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" :: String- 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+ 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."@@ -171,42 +176,44 @@ [] -> 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+ 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)+ }+ deriving (Eq, Show) instance Aeson.FromJSON GHRelease where parseJSON = Aeson.withObject "GHRelease" $ \obj -> GHRelease <$> obj Aeson..: "assets" data GHAsset = GHAsset- { ghAssetName :: String- , ghAssetUrl :: String+ { ghAssetName :: String,+ ghAssetUrl :: String } deriving (Eq, Show) instance Aeson.FromJSON GHAsset where- parseJSON = Aeson.withObject "GHAsset"- $ \obj -> GHAsset <$> obj Aeson..: "name" <*> obj Aeson..: "url"+ parseJSON = Aeson.withObject "GHAsset" $+ \obj -> GHAsset <$> obj Aeson..: "name" <*> obj Aeson..: "url" -getUploadUrl- :: Client.Manager- -> String- -> Maybe String- -> String- -> String- -> IO Burrito.Template+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@@ -235,24 +242,23 @@ pure (anOwner, drop 1 aRepo) return (anOwner, aRepo) -getTag- :: Aeson.FromJSON a- => Client.Manager- -> String- -> String- -> String- -> String- -> IO (Either String a)+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" :: String- let- url :: String- url = Printf.printf format anOwner aRepo aTag+ let url :: String+ url = Printf.printf format anOwner aRepo aTag initialRequest <- Client.parseRequest url- let- request = initialRequest- { Client.requestHeaders = [authorizationHeader aToken, userAgentHeader]- }+ let request =+ initialRequest+ { Client.requestHeaders = [authorizationHeader aToken, userAgentHeader]+ } response <- Client.httpLbs request manager let body = Client.responseBody response return (Aeson.eitherDecode body)@@ -265,75 +271,75 @@ userAgentHeader = (HTTP.hUserAgent, BS8.pack userAgent) userAgent :: String-userAgent = Printf.printf- "%s/%s-%s"- ("tfausak" :: String)- ("github-release" :: String)- versionString+userAgent =+ Printf.printf+ "%s/%s-%s"+ ("tfausak" :: String)+ ("github-release" :: String)+ versionString versionString :: String versionString = Version.showVersion This.version -uploadFile- :: Client.Manager- -> Burrito.Template- -> String- -> FilePath- -> String- -> IO (Client.Response BSL.ByteString)+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 ::+ 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+ 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- ]- }+ 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 ::+ 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- [ "tag_name" .= aTag- , "name" .= aTitle- , "body" .= Maybe.fromMaybe "" aDescription- , "prerelease" .= Maybe.fromMaybe False aPreRelease- , "draft" .= Maybe.fromMaybe False aDraft- ]- let- request = initialRequest- { Client.method = BS8.pack "POST"- , Client.requestBody = Client.RequestBodyLBS $ Aeson.encode requestObject- , Client.requestHeaders = [authorizationHeader aToken, userAgentHeader]- }+ let requestObject =+ object+ [ "tag_name" .= aTag,+ "name" .= aTitle,+ "body" .= Maybe.fromMaybe "" aDescription,+ "prerelease" .= Maybe.fromMaybe False aPreRelease,+ "draft" .= Maybe.fromMaybe False 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