github-release 1.0.7 → 1.1.0

raw patch · 2 files changed

+46/−28 lines, 2 filesdep ~http-typesPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: http-types

API changes (from Hackage documentation)

Files

• github-release.cabal +18/−14
• library/GitHubRelease.hs +28/−14

@@ -1,9 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.17.1.+-- This file has been generated from package.yaml by hpack version 0.20.0. -- -- see: https://github.com/sol/hpack+--+-- hash: 3fbc1e82d7fb70ab4ded5d5059498d0a2ba182764767e2275f0817d5aabb50c6  name:           github-release-version:        1.0.7+version:        1.1.0 synopsis:       Upload files to GitHub releases. description:    GitHub Release uploads files to GitHub releases. category:       Utility@@ -24,17 +26,17 @@       library   ghc-options: -Wall   build-depends:-      base >= 4.8.2 && < 4.11-    , aeson >= 0.9 && < 1.3-    , 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.11-    , mime-types >= 0.1 && < 0.2-    , optparse-generic >= 1.1 && < 1.3-    , text >= 1.2.2 && < 1.3-    , unordered-containers >= 0.2.5 && < 0.3-    , uri-templater >= 0.2 && < 0.4+      aeson >=0.9 && <1.3+    , base >=4.8.2 && <4.11+    , 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.12+    , mime-types >=0.1 && <0.2+    , optparse-generic >=1.1 && <1.3+    , text >=1.2.2 && <1.3+    , unordered-containers >=0.2.5 && <0.3+    , uri-templater >=0.2 && <0.4   exposed-modules:       GitHubRelease   other-modules:@@ -47,6 +49,8 @@       executables   ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N   build-depends:-      base >= 4.8.2 && < 4.11+      base >=4.8.2 && <4.11     , github-release+  other-modules:+      Paths_github_release   default-language: Haskell2010

@@ -28,7 +28,7 @@ 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."+          ,  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."}@@ -55,43 +55,57 @@         (Options.unHelpful aName)     Version -> putStrLn versionString -upload :: String -> 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   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!"+    _ -> fail "Failed to upload file to release!"  getUploadUrl   :: Client.Manager   -> String-  -> String+  -> Maybe 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+  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-  let (Right template) = Template.parseTemplate uploadUrl+  template <- case Template.parseTemplate uploadUrl of+    Left problem -> fail ("Failed to parse URL template: " ++ show problem)+    Right template -> pure template   pure template  getTag   :: Client.Manager   -> String-  -> String+  -> Maybe String   -> String   -> String   -> IO (Either String Aeson.Object)-getTag manager aToken anOwner aRepo aTag = do+getTag manager aToken rawOwner rawRepo aTag = 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)   let format = "https://api.github.com/repos/%s/%s/releases/tags/%s"   let url = Printf.printf format anOwner aRepo aTag-  initialRequest <- Client.parseUrlThrow url+  initialRequest <- Client.parseRequest url   let request =         initialRequest         {Client.requestHeaders = [authorizationHeader aToken, userAgentHeader]}@@ -137,7 +151,7 @@         Template.render           template           [("name", Template.WrappedValue (Template.Single aName))]-  initialRequest <- Client.parseUrlThrow url+  initialRequest <- Client.parseRequest url   let request =         initialRequest         { Client.method = BS8.pack "POST"