{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-partial-fields #-}

module GitHubRelease
  ( Command (..),
    main,
    runCommand,
    upload,
    getUploadUrl,
    getTag,
    authorizationHeader,
    userAgentHeader,
    userAgent,
    versionString,
    uploadFile,
    uploadBody,
  )
where

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.Maybe as Maybe
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 Options.Generic (type (<?>))
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
      { Command -> String <?> "The path to the local file to upload."
file :: FilePath <?> "The path to the local file to upload.",
        Command -> String <?> "The name to give the file on the release."
name :: String <?> "The name to give the file on the release.",
        Command
-> Maybe String
   <?> "The GitHub owner, either a user or organization."
owner :: Maybe String <?> "The GitHub owner, either a user or organization.",
        Command -> String <?> "The GitHub repository name."
repo :: String <?> "The GitHub repository name.",
        Command -> String <?> "The tag name."
tag :: String <?> "The tag name.",
        Command -> Maybe String <?> "Your OAuth2 token."
token :: Maybe String <?> "Your OAuth2 token."
      }
  | Release
      { Command -> String <?> "The name of the 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.",
        Command -> Maybe String <?> "Release description."
description :: Maybe String <?> "Release description.",
        token :: Maybe String <?> "Your OAuth2 token.",
        Command -> Maybe Bool <?> "Indicates if this is a pre-release."
preRelease :: Maybe Bool <?> "Indicates if this is a pre-release.",
        Command -> Maybe Bool <?> "Indicates if this is a draft."
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 ((forall x. Command -> Rep Command x)
-> (forall x. Rep Command x -> Command) -> Generic Command
forall x. Rep Command x -> Command
forall x. Command -> Rep Command x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Command -> Rep Command x
from :: forall x. Command -> Rep Command x
$cto :: forall x. Rep Command x -> Command
to :: forall x. Rep Command x -> Command
Generics.Generic, Int -> Command -> String -> String
[Command] -> String -> String
Command -> String
(Int -> Command -> String -> String)
-> (Command -> String)
-> ([Command] -> String -> String)
-> Show Command
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Command -> String -> String
showsPrec :: Int -> Command -> String -> String
$cshow :: Command -> String
show :: Command -> String
$cshowList :: [Command] -> String -> String
showList :: [Command] -> String -> String
Show)

instance Options.ParseRecord Command

main :: IO ()
main :: IO ()
main = do
  Command
command <- Text -> IO Command
forall (io :: * -> *) a.
(MonadIO io, ParseRecord a) =>
Text -> io a
Options.getRecord (String -> Text
Text.pack String
"Upload a file to a GitHub release.")
  Command -> IO ()
runCommand Command
command

runCommand :: Command -> IO ()
runCommand :: Command -> IO ()
runCommand Command
command = case Command
command of
  Upload String <?> "The path to the local file to upload."
aFile String <?> "The name to give the file on the release."
aName Maybe String <?> "The GitHub owner, either a user or organization."
anOwner String <?> "The GitHub repository name."
aRepo String <?> "The tag name."
aTag Maybe String <?> "Your OAuth2 token."
helpfulToken -> do
    String
aToken <-
      IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO String
Environment.getEnv String
"GITHUB_TOKEN") String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String -> IO String) -> Maybe String -> IO String
forall a b. (a -> b) -> a -> b
$
        (Maybe String <?> "Your OAuth2 token.") -> Maybe String
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful Maybe String <?> "Your OAuth2 token."
helpfulToken
    String
-> Maybe String -> String -> String -> String -> String -> IO ()
upload
      String
aToken
      ((Maybe String
 <?> "The GitHub owner, either a user or organization.")
-> Maybe String
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful Maybe String <?> "The GitHub owner, either a user or organization."
anOwner)
      ((String <?> "The GitHub repository name.") -> String
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful String <?> "The GitHub repository name."
aRepo)
      ((String <?> "The tag name.") -> String
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful String <?> "The tag name."
aTag)
      ((String <?> "The path to the local file to upload.") -> String
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful String <?> "The path to the local file to upload."
aFile)
      ((String <?> "The name to give the file on the release.") -> String
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful String <?> "The name to give the file on the release."
aName)
  Release String <?> "The name of the release"
aTitle Maybe String <?> "The GitHub owner, either a user or organization."
anOwner String <?> "The GitHub repository name."
aRepo String <?> "The tag name."
aTag Maybe String <?> "Release description."
aDescription Maybe String <?> "Your OAuth2 token."
helpfulToken Maybe Bool <?> "Indicates if this is a pre-release."
aPreRelease Maybe Bool <?> "Indicates if this is a draft."
aDraft ->
    do
      String
aToken <-
        IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO String
Environment.getEnv String
"GITHUB_TOKEN") String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String -> IO String) -> Maybe String -> IO String
forall a b. (a -> b) -> a -> b
$
          (Maybe String <?> "Your OAuth2 token.") -> Maybe String
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful Maybe String <?> "Your OAuth2 token."
helpfulToken
      String
-> Maybe String
-> String
-> String
-> String
-> Maybe String
-> Maybe Bool
-> Maybe Bool
-> IO ()
release
        String
aToken
        ((Maybe String
 <?> "The GitHub owner, either a user or organization.")
-> Maybe String
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful Maybe String <?> "The GitHub owner, either a user or organization."
anOwner)
        ((String <?> "The GitHub repository name.") -> String
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful String <?> "The GitHub repository name."
aRepo)
        ((String <?> "The tag name.") -> String
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful String <?> "The tag name."
aTag)
        ((String <?> "The name of the release") -> String
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful String <?> "The name of the release"
aTitle)
        ((Maybe String <?> "Release description.") -> Maybe String
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful Maybe String <?> "Release description."
aDescription)
        ((Maybe Bool <?> "Indicates if this is a pre-release.")
-> Maybe Bool
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful Maybe Bool <?> "Indicates if this is a pre-release."
aPreRelease)
        ((Maybe Bool <?> "Indicates if this is a draft.") -> Maybe Bool
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful Maybe Bool <?> "Indicates if this is a draft."
aDraft)
  Delete String <?> "The name to give the file on the release."
aName Maybe String <?> "The GitHub owner, either a user or organization."
anOwner String <?> "The GitHub repository name."
aRepo String <?> "The tag name."
aTag Maybe String <?> "Your OAuth2 token."
helpfulToken -> do
    String
aToken <-
      IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO String
Environment.getEnv String
"GITHUB_TOKEN") String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String -> IO String) -> Maybe String -> IO String
forall a b. (a -> b) -> a -> b
$
        (Maybe String <?> "Your OAuth2 token.") -> Maybe String
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful Maybe String <?> "Your OAuth2 token."
helpfulToken
    String -> Maybe String -> String -> String -> String -> IO ()
delete
      ((String <?> "The name to give the file on the release.") -> String
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful String <?> "The name to give the file on the release."
aName)
      ((Maybe String
 <?> "The GitHub owner, either a user or organization.")
-> Maybe String
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful Maybe String <?> "The GitHub owner, either a user or organization."
anOwner)
      ((String <?> "The GitHub repository name.") -> String
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful String <?> "The GitHub repository name."
aRepo)
      ((String <?> "The tag name.") -> String
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful String <?> "The tag name."
aTag)
      String
aToken
  Command
Version -> String -> IO ()
putStrLn String
versionString

upload ::
  String -> Maybe String -> String -> String -> FilePath -> String -> IO ()
upload :: String
-> Maybe String -> String -> String -> String -> String -> IO ()
upload String
aToken Maybe String
anOwner String
aRepo String
aTag String
aFile String
aName = do
  Manager
manager <- ManagerSettings -> IO Manager
Client.newManager ManagerSettings
TLS.tlsManagerSettings
  Template
uploadUrl <- Manager
-> String -> Maybe String -> String -> String -> IO Template
getUploadUrl Manager
manager String
aToken Maybe String
anOwner String
aRepo String
aTag
  Response ByteString
response <- Manager
-> Template
-> String
-> String
-> String
-> IO (Response ByteString)
uploadFile Manager
manager Template
uploadUrl String
aToken String
aFile String
aName
  case Status -> Int
HTTP.statusCode (Response ByteString -> Status
forall body. Response body -> Status
Client.responseStatus Response ByteString
response) of
    Int
201 -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Int
_ -> String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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 String
aToken Maybe String
anOwner String
aRepo String
aTag String
aTitle Maybe String
aDescription Maybe Bool
aPreRelease Maybe Bool
aDraft = do
  Manager
manager <- ManagerSettings -> IO Manager
Client.newManager ManagerSettings
TLS.tlsManagerSettings
  (String
owner', String
repo') <- Maybe String -> String -> IO (String, String)
getOwnerRepo Maybe String
anOwner String
aRepo
  let format :: String
format = String
"https://api.github.com/repos/%s/%s/releases" :: String
  let url :: String
      url :: String
url = String -> String -> String -> String
forall r. PrintfType r => String -> r
Printf.printf String
format String
owner' String
repo'
  Response ByteString
response <-
    Manager
-> String
-> String
-> String
-> String
-> Maybe String
-> Maybe Bool
-> Maybe Bool
-> IO (Response ByteString)
mkRelease
      Manager
manager
      String
url
      String
aToken
      String
aTag
      String
aTitle
      Maybe String
aDescription
      Maybe Bool
aPreRelease
      Maybe Bool
aDraft
  let body :: Either String Object
body =
        ByteString -> Either String Object
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode (ByteString -> Either String Object)
-> ByteString -> Either String Object
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
Client.responseBody Response ByteString
response ::
          Either
            String
            Aeson.Object
  case Status -> Int
HTTP.statusCode (Response ByteString -> Status
forall body. Response body -> Status
Client.responseStatus Response ByteString
response) of
    Int
201 -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Int
422 -> Handle -> String -> IO ()
IO.hPutStrLn Handle
IO.stderr String
"Release aready exists. Ignoring."
    Int
_ -> String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Failed to create release! Reason: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Either String Object -> String
forall a. Show a => a -> String
show Either String Object
body

delete :: String -> Maybe String -> String -> String -> String -> IO ()
delete :: String -> Maybe String -> String -> String -> String -> IO ()
delete String
aName Maybe String
rawOwner String
rawRepo String
aTag String
aToken = do
  Manager
manager <- ManagerSettings -> IO Manager
Client.newManager ManagerSettings
TLS.tlsManagerSettings
  (String
anOwner, String
aRepo) <- Maybe String -> String -> IO (String, String)
getOwnerRepo Maybe String
rawOwner String
rawRepo
  GHRelease
ghRelease <- do
    Either String GHRelease
result <- Manager
-> String
-> String
-> String
-> String
-> IO (Either String GHRelease)
forall a.
FromJSON a =>
Manager
-> String -> String -> String -> String -> IO (Either String a)
getTag Manager
manager String
aToken String
anOwner String
aRepo String
aTag
    case Either String GHRelease
result of
      Left String
problem -> String -> IO GHRelease
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO GHRelease) -> String -> IO GHRelease
forall a b. (a -> b) -> a -> b
$ String
"Failed to get tag JSON: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
problem
      Right GHRelease
json -> GHRelease -> IO GHRelease
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHRelease
json
  case (GHAsset -> Bool) -> [GHAsset] -> [GHAsset]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
aName) (String -> Bool) -> (GHAsset -> String) -> GHAsset -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GHAsset -> String
ghAssetName) ([GHAsset] -> [GHAsset]) -> [GHAsset] -> [GHAsset]
forall a b. (a -> b) -> a -> b
$ GHRelease -> [GHAsset]
ghReleaseAssets GHRelease
ghRelease of
    [] -> String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Failed to find asset on release."
    GHAsset
ghAsset : [GHAsset]
_ -> do
      Request
request <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
Client.parseRequest (String -> IO Request) -> String -> IO Request
forall a b. (a -> b) -> a -> b
$ GHAsset -> String
ghAssetUrl GHAsset
ghAsset
      Response ByteString
response <-
        Request -> Manager -> IO (Response ByteString)
Client.httpLbs
          Request
request
            { Client.method = HTTP.methodDelete,
              Client.requestHeaders =
                [authorizationHeader aToken, userAgentHeader]
            }
          Manager
manager
      case Status -> Int
HTTP.statusCode (Status -> Int) -> Status -> Int
forall a b. (a -> b) -> a -> b
$ Response ByteString -> Status
forall body. Response body -> Status
Client.responseStatus Response ByteString
response of
        Int
204 -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Int
_ -> String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Failed to delete asset from release! " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Response ByteString -> String
forall a. Show a => a -> String
show Response ByteString
response

newtype GHRelease = GHRelease
  { GHRelease -> [GHAsset]
ghReleaseAssets :: [GHAsset]
  }
  deriving (GHRelease -> GHRelease -> Bool
(GHRelease -> GHRelease -> Bool)
-> (GHRelease -> GHRelease -> Bool) -> Eq GHRelease
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GHRelease -> GHRelease -> Bool
== :: GHRelease -> GHRelease -> Bool
$c/= :: GHRelease -> GHRelease -> Bool
/= :: GHRelease -> GHRelease -> Bool
Eq, Int -> GHRelease -> String -> String
[GHRelease] -> String -> String
GHRelease -> String
(Int -> GHRelease -> String -> String)
-> (GHRelease -> String)
-> ([GHRelease] -> String -> String)
-> Show GHRelease
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> GHRelease -> String -> String
showsPrec :: Int -> GHRelease -> String -> String
$cshow :: GHRelease -> String
show :: GHRelease -> String
$cshowList :: [GHRelease] -> String -> String
showList :: [GHRelease] -> String -> String
Show)

instance Aeson.FromJSON GHRelease where
  parseJSON :: Value -> Parser GHRelease
parseJSON =
    String -> (Object -> Parser GHRelease) -> Value -> Parser GHRelease
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"GHRelease" ((Object -> Parser GHRelease) -> Value -> Parser GHRelease)
-> (Object -> Parser GHRelease) -> Value -> Parser GHRelease
forall a b. (a -> b) -> a -> b
$ \Object
obj -> [GHAsset] -> GHRelease
GHRelease ([GHAsset] -> GHRelease) -> Parser [GHAsset] -> Parser GHRelease
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser [GHAsset]
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"assets"

data GHAsset = GHAsset
  { GHAsset -> String
ghAssetName :: String,
    GHAsset -> String
ghAssetUrl :: String
  }
  deriving (GHAsset -> GHAsset -> Bool
(GHAsset -> GHAsset -> Bool)
-> (GHAsset -> GHAsset -> Bool) -> Eq GHAsset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GHAsset -> GHAsset -> Bool
== :: GHAsset -> GHAsset -> Bool
$c/= :: GHAsset -> GHAsset -> Bool
/= :: GHAsset -> GHAsset -> Bool
Eq, Int -> GHAsset -> String -> String
[GHAsset] -> String -> String
GHAsset -> String
(Int -> GHAsset -> String -> String)
-> (GHAsset -> String)
-> ([GHAsset] -> String -> String)
-> Show GHAsset
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> GHAsset -> String -> String
showsPrec :: Int -> GHAsset -> String -> String
$cshow :: GHAsset -> String
show :: GHAsset -> String
$cshowList :: [GHAsset] -> String -> String
showList :: [GHAsset] -> String -> String
Show)

instance Aeson.FromJSON GHAsset where
  parseJSON :: Value -> Parser GHAsset
parseJSON = String -> (Object -> Parser GHAsset) -> Value -> Parser GHAsset
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"GHAsset" ((Object -> Parser GHAsset) -> Value -> Parser GHAsset)
-> (Object -> Parser GHAsset) -> Value -> Parser GHAsset
forall a b. (a -> b) -> a -> b
$
    \Object
obj -> String -> String -> GHAsset
GHAsset (String -> String -> GHAsset)
-> Parser String -> Parser (String -> GHAsset)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"name" Parser (String -> GHAsset) -> Parser String -> Parser GHAsset
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"url"

getUploadUrl ::
  Client.Manager ->
  String ->
  Maybe String ->
  String ->
  String ->
  IO Burrito.Template
getUploadUrl :: Manager
-> String -> Maybe String -> String -> String -> IO Template
getUploadUrl Manager
manager String
aToken Maybe String
rawOwner String
rawRepo String
aTag = do
  HashMap Text Value
json <- do
    (String
anOwner, String
aRepo) <- Maybe String -> String -> IO (String, String)
getOwnerRepo Maybe String
rawOwner String
rawRepo
    Either String (HashMap Text Value)
result <- Manager
-> String
-> String
-> String
-> String
-> IO (Either String (HashMap Text Value))
forall a.
FromJSON a =>
Manager
-> String -> String -> String -> String -> IO (Either String a)
getTag Manager
manager String
aToken String
anOwner String
aRepo String
aTag
    case Either String (HashMap Text Value)
result of
      Left String
problem -> String -> IO (HashMap Text Value)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Failed to get tag JSON: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
problem)
      Right HashMap Text Value
json -> HashMap Text Value -> IO (HashMap Text Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap Text Value
json
  Text
text <- case Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (String -> Text
Text.pack String
"upload_url") HashMap Text Value
json of
    Just (Aeson.String Text
text) -> Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
text
    Maybe Value
_ -> String -> IO Text
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Failed to get upload URL: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> HashMap Text Value -> String
forall a. Show a => a -> String
show HashMap Text Value
json)
  let uploadUrl :: String
uploadUrl = Text -> String
Text.unpack Text
text
  case String -> Maybe Template
Burrito.parse String
uploadUrl of
    Maybe Template
Nothing -> String -> IO Template
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Failed to parse URL template: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
uploadUrl)
    Just Template
template -> Template -> IO Template
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Template
template

getOwnerRepo :: Maybe String -> String -> IO (String, String)
getOwnerRepo :: Maybe String -> String -> IO (String, String)
getOwnerRepo Maybe String
rawOwner String
rawRepo = do
  (String
anOwner, String
aRepo) <- case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') String
rawRepo of
    (String
aRepo, String
"") -> case Maybe String
rawOwner of
      Maybe String
Nothing -> String -> IO (String, String)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Missing required option --owner."
      Just String
anOwner -> (String, String) -> IO (String, String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
anOwner, String
aRepo)
    (String
anOwner, String
aRepo) -> do
      case Maybe String
rawOwner of
        Maybe String
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just String
_ -> Handle -> String -> IO ()
IO.hPutStrLn Handle
IO.stderr String
"Ignoring --owner option."
      (String, String) -> IO (String, String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
anOwner, Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
aRepo)
  (String, String) -> IO (String, String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
anOwner, String
aRepo)

getTag ::
  (Aeson.FromJSON a) =>
  Client.Manager ->
  String ->
  String ->
  String ->
  String ->
  IO (Either String a)
getTag :: forall a.
FromJSON a =>
Manager
-> String -> String -> String -> String -> IO (Either String a)
getTag Manager
manager String
aToken String
anOwner String
aRepo String
aTag = do
  let format :: String
format = String
"https://api.github.com/repos/%s/%s/releases/tags/%s" :: String
  let url :: String
      url :: String
url = String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
Printf.printf String
format String
anOwner String
aRepo String
aTag
  Request
initialRequest <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
Client.parseRequest String
url
  let request :: Request
request =
        Request
initialRequest
          { Client.requestHeaders = [authorizationHeader aToken, userAgentHeader]
          }
  Response ByteString
response <- Request -> Manager -> IO (Response ByteString)
Client.httpLbs Request
request Manager
manager
  let body :: ByteString
body = Response ByteString -> ByteString
forall body. Response body -> body
Client.responseBody Response ByteString
response
  Either String a -> IO (Either String a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode ByteString
body)

authorizationHeader :: String -> HTTP.Header
authorizationHeader :: String -> Header
authorizationHeader String
aToken =
  (HeaderName
HTTP.hAuthorization, String -> Method
BS8.pack (String -> String -> String
forall r. PrintfType r => String -> r
Printf.printf String
"token %s" String
aToken))

userAgentHeader :: HTTP.Header
userAgentHeader :: Header
userAgentHeader = (HeaderName
HTTP.hUserAgent, String -> Method
BS8.pack String
userAgent)

userAgent :: String
userAgent :: String
userAgent =
  String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
Printf.printf
    String
"%s/%s-%s"
    (String
"tfausak" :: String)
    (String
"github-release" :: String)
    String
versionString

versionString :: String
versionString :: String
versionString = Version -> String
Version.showVersion Version
This.version

uploadFile ::
  Client.Manager ->
  Burrito.Template ->
  String ->
  FilePath ->
  String ->
  IO (Client.Response BSL.ByteString)
uploadFile :: Manager
-> Template
-> String
-> String
-> String
-> IO (Response ByteString)
uploadFile Manager
manager Template
template String
aToken String
aFile String
aName = do
  ByteString
contents <- String -> IO ByteString
BSL.readFile String
aFile
  let body :: RequestBody
body = ByteString -> RequestBody
Client.RequestBodyLBS ByteString
contents
  Manager
-> Template
-> String
-> RequestBody
-> String
-> IO (Response ByteString)
uploadBody Manager
manager Template
template String
aToken RequestBody
body String
aName

uploadBody ::
  Client.Manager ->
  Burrito.Template ->
  String ->
  Client.RequestBody ->
  String ->
  IO (Client.Response BSL.ByteString)
uploadBody :: Manager
-> Template
-> String
-> RequestBody
-> String
-> IO (Response ByteString)
uploadBody Manager
manager Template
template String
aToken RequestBody
body String
aName = do
  let url :: String
      url :: String
url = [(String, Value)] -> Template -> String
Burrito.expand [(String
"name", String -> Value
Burrito.stringValue String
aName)] Template
template
  Request
initialRequest <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
Client.parseRequest String
url
  let request :: Request
request =
        Request
initialRequest
          { Client.method = BS8.pack "POST",
            Client.requestBody = body,
            Client.requestHeaders =
              [ authorizationHeader aToken,
                (HTTP.hContentType, MIME.defaultMimeLookup (Text.pack aName)),
                userAgentHeader
              ]
          }
  Request -> Manager -> IO (Response ByteString)
Client.httpLbs Request
request Manager
manager

mkRelease ::
  Client.Manager ->
  String ->
  String ->
  String ->
  String ->
  Maybe String ->
  Maybe Bool ->
  Maybe Bool ->
  IO (Client.Response BSL.ByteString)
mkRelease :: Manager
-> String
-> String
-> String
-> String
-> Maybe String
-> Maybe Bool
-> Maybe Bool
-> IO (Response ByteString)
mkRelease Manager
manager String
url String
aToken String
aTag String
aTitle Maybe String
aDescription Maybe Bool
aPreRelease Maybe Bool
aDraft = do
  Request
initialRequest <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
Client.parseRequest String
url
  let requestObject :: Value
requestObject =
        [Pair] -> Value
object
          [ Key
"tag_name" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
aTag,
            Key
"name" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
aTitle,
            Key
"body" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String -> Maybe String -> String
forall a. a -> Maybe a -> a
Maybe.fromMaybe String
"" Maybe String
aDescription,
            Key
"prerelease" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
Maybe.fromMaybe Bool
False Maybe Bool
aPreRelease,
            Key
"draft" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
Maybe.fromMaybe Bool
False Maybe Bool
aDraft
          ]
  let request :: Request
request =
        Request
initialRequest
          { Client.method = BS8.pack "POST",
            Client.requestBody = Client.RequestBodyLBS $ Aeson.encode requestObject,
            Client.requestHeaders = [authorizationHeader aToken, userAgentHeader]
          }
  Request -> Manager -> IO (Response ByteString)
Client.httpLbs Request
request Manager
manager