packages feed

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
@@ -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