{-# OPTIONS_GHC -Wno-partial-fields #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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.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 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 -> FilePath <?> "The path to the local file to upload."
file :: FilePath <?> "The path to the local file to upload."
, Command -> FilePath <?> "The name to give the file on the release."
name :: String <?> "The name to give the file on the release."
, Command
-> Maybe FilePath
<?> "The GitHub owner, either a user or organization."
owner :: Maybe String <?> "The GitHub owner, either a user or organization."
, Command -> FilePath <?> "The GitHub repository name."
repo :: String <?> "The GitHub repository name."
, Command -> FilePath <?> "The tag name."
tag :: String <?> "The tag name."
, Command -> Maybe FilePath <?> "Your OAuth2 token."
token :: Maybe String <?> "Your OAuth2 token."}
| Release { Command -> FilePath <?> "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 FilePath <?> "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
$cto :: forall x. Rep Command x -> Command
$cfrom :: forall x. Command -> Rep Command x
Generics.Generic, Int -> Command -> ShowS
[Command] -> ShowS
Command -> FilePath
(Int -> Command -> ShowS)
-> (Command -> FilePath) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> FilePath
$cshow :: Command -> FilePath
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
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 (FilePath -> Text
Text.pack FilePath
"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 FilePath <?> "The path to the local file to upload."
aFile FilePath <?> "The name to give the file on the release."
aName Maybe FilePath
<?> "The GitHub owner, either a user or organization."
anOwner FilePath <?> "The GitHub repository name."
aRepo FilePath <?> "The tag name."
aTag Maybe FilePath <?> "Your OAuth2 token."
helpfulToken -> do
FilePath
aToken <- IO FilePath
-> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> IO FilePath
Environment.getEnv FilePath
"GITHUB_TOKEN") FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Maybe FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ (Maybe FilePath <?> "Your OAuth2 token.") -> Maybe FilePath
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful Maybe FilePath <?> "Your OAuth2 token."
helpfulToken
FilePath
-> Maybe FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> IO ()
upload
FilePath
aToken
((Maybe FilePath
<?> "The GitHub owner, either a user or organization.")
-> Maybe FilePath
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful Maybe FilePath
<?> "The GitHub owner, either a user or organization."
anOwner)
((FilePath <?> "The GitHub repository name.") -> FilePath
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful FilePath <?> "The GitHub repository name."
aRepo)
((FilePath <?> "The tag name.") -> FilePath
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful FilePath <?> "The tag name."
aTag)
((FilePath <?> "The path to the local file to upload.") -> FilePath
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful FilePath <?> "The path to the local file to upload."
aFile)
((FilePath <?> "The name to give the file on the release.")
-> FilePath
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful FilePath <?> "The name to give the file on the release."
aName)
Release FilePath <?> "The name of the release"
aTitle Maybe FilePath
<?> "The GitHub owner, either a user or organization."
anOwner FilePath <?> "The GitHub repository name."
aRepo FilePath <?> "The tag name."
aTag Maybe FilePath <?> "Release description."
aDescription Maybe FilePath <?> "Your OAuth2 token."
helpfulToken Maybe Bool <?> "Indicates if this is a pre-release."
aPreRelease Maybe Bool <?> "Indicates if this is a draft."
aDraft
-> do
FilePath
aToken <- IO FilePath
-> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> IO FilePath
Environment.getEnv FilePath
"GITHUB_TOKEN") FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Maybe FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ (Maybe FilePath <?> "Your OAuth2 token.") -> Maybe FilePath
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful Maybe FilePath <?> "Your OAuth2 token."
helpfulToken
FilePath
-> Maybe FilePath
-> FilePath
-> FilePath
-> FilePath
-> Maybe FilePath
-> Maybe Bool
-> Maybe Bool
-> IO ()
release
FilePath
aToken
((Maybe FilePath
<?> "The GitHub owner, either a user or organization.")
-> Maybe FilePath
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful Maybe FilePath
<?> "The GitHub owner, either a user or organization."
anOwner)
((FilePath <?> "The GitHub repository name.") -> FilePath
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful FilePath <?> "The GitHub repository name."
aRepo)
((FilePath <?> "The tag name.") -> FilePath
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful FilePath <?> "The tag name."
aTag)
((FilePath <?> "The name of the release") -> FilePath
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful FilePath <?> "The name of the release"
aTitle)
((Maybe FilePath <?> "Release description.") -> Maybe FilePath
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful Maybe FilePath <?> "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 FilePath <?> "The name to give the file on the release."
aName Maybe FilePath
<?> "The GitHub owner, either a user or organization."
anOwner FilePath <?> "The GitHub repository name."
aRepo FilePath <?> "The tag name."
aTag Maybe FilePath <?> "Your OAuth2 token."
helpfulToken -> do
FilePath
aToken <- IO FilePath
-> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> IO FilePath
Environment.getEnv FilePath
"GITHUB_TOKEN") FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Maybe FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ (Maybe FilePath <?> "Your OAuth2 token.") -> Maybe FilePath
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful Maybe FilePath <?> "Your OAuth2 token."
helpfulToken
FilePath
-> Maybe FilePath -> FilePath -> FilePath -> FilePath -> IO ()
delete
((FilePath <?> "The name to give the file on the release.")
-> FilePath
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful FilePath <?> "The name to give the file on the release."
aName)
((Maybe FilePath
<?> "The GitHub owner, either a user or organization.")
-> Maybe FilePath
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful Maybe FilePath
<?> "The GitHub owner, either a user or organization."
anOwner)
((FilePath <?> "The GitHub repository name.") -> FilePath
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful FilePath <?> "The GitHub repository name."
aRepo)
((FilePath <?> "The tag name.") -> FilePath
forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful FilePath <?> "The tag name."
aTag)
FilePath
aToken
Command
Version -> FilePath -> IO ()
putStrLn FilePath
versionString
upload
:: String -> Maybe String -> String -> String -> FilePath -> String -> IO ()
upload :: FilePath
-> Maybe FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> IO ()
upload FilePath
aToken Maybe FilePath
anOwner FilePath
aRepo FilePath
aTag FilePath
aFile FilePath
aName = do
Manager
manager <- ManagerSettings -> IO Manager
Client.newManager ManagerSettings
TLS.tlsManagerSettings
Template
uploadUrl <- Manager
-> FilePath
-> Maybe FilePath
-> FilePath
-> FilePath
-> IO Template
getUploadUrl Manager
manager FilePath
aToken Maybe FilePath
anOwner FilePath
aRepo FilePath
aTag
Response ByteString
response <- Manager
-> Template
-> FilePath
-> FilePath
-> FilePath
-> IO (Response ByteString)
uploadFile Manager
manager Template
uploadUrl FilePath
aToken FilePath
aFile FilePath
aName
case Status -> Int
HTTP.statusCode (Response ByteString -> Status
forall body. Response body -> Status
Client.responseStatus Response ByteString
response) of
Int
201 -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Int
_ -> FilePath -> IO ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Failed to upload file to release!"
release
:: String
-> Maybe String
-> String
-> String
-> String
-> Maybe String
-> Maybe Bool
-> Maybe Bool
-> IO ()
release :: FilePath
-> Maybe FilePath
-> FilePath
-> FilePath
-> FilePath
-> Maybe FilePath
-> Maybe Bool
-> Maybe Bool
-> IO ()
release FilePath
aToken Maybe FilePath
anOwner FilePath
aRepo FilePath
aTag FilePath
aTitle Maybe FilePath
aDescription Maybe Bool
aPreRelease Maybe Bool
aDraft = do
Manager
manager <- ManagerSettings -> IO Manager
Client.newManager ManagerSettings
TLS.tlsManagerSettings
(FilePath
owner', FilePath
repo') <- Maybe FilePath -> FilePath -> IO (FilePath, FilePath)
getOwnerRepo Maybe FilePath
anOwner FilePath
aRepo
let format :: FilePath
format = FilePath
"https://api.github.com/repos/%s/%s/releases" :: String
let
url :: String
url :: FilePath
url = FilePath -> FilePath -> ShowS
forall r. PrintfType r => FilePath -> r
Printf.printf FilePath
format FilePath
owner' FilePath
repo'
Response ByteString
response <- Manager
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> Maybe FilePath
-> Maybe Bool
-> Maybe Bool
-> IO (Response ByteString)
mkRelease
Manager
manager
FilePath
url
FilePath
aToken
FilePath
aTag
FilePath
aTitle
Maybe FilePath
aDescription
Maybe Bool
aPreRelease
Maybe Bool
aDraft
let
body :: Either FilePath Object
body =
ByteString -> Either FilePath Object
forall a. FromJSON a => ByteString -> Either FilePath a
Aeson.eitherDecode (ByteString -> Either FilePath Object)
-> ByteString -> Either FilePath 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 (f :: * -> *) a. Applicative f => a -> f a
pure ()
Int
422 -> Handle -> FilePath -> IO ()
IO.hPutStrLn Handle
IO.stderr FilePath
"Release aready exists. Ignoring."
Int
_ -> FilePath -> IO ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to create release! Reason: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Either FilePath Object -> FilePath
forall a. Show a => a -> FilePath
show Either FilePath Object
body
delete :: String -> Maybe String -> String -> String -> String -> IO ()
delete :: FilePath
-> Maybe FilePath -> FilePath -> FilePath -> FilePath -> IO ()
delete FilePath
aName Maybe FilePath
rawOwner FilePath
rawRepo FilePath
aTag FilePath
aToken = do
Manager
manager <- ManagerSettings -> IO Manager
Client.newManager ManagerSettings
TLS.tlsManagerSettings
(FilePath
anOwner, FilePath
aRepo) <- Maybe FilePath -> FilePath -> IO (FilePath, FilePath)
getOwnerRepo Maybe FilePath
rawOwner FilePath
rawRepo
GHRelease
ghRelease <- do
Either FilePath GHRelease
result <- Manager
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> IO (Either FilePath GHRelease)
forall a.
FromJSON a =>
Manager
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> IO (Either FilePath a)
getTag Manager
manager FilePath
aToken FilePath
anOwner FilePath
aRepo FilePath
aTag
case Either FilePath GHRelease
result of
Left FilePath
problem -> FilePath -> IO GHRelease
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO GHRelease) -> FilePath -> IO GHRelease
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to get tag JSON: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> FilePath
show FilePath
problem
Right GHRelease
json -> GHRelease -> IO GHRelease
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHRelease
json
case (GHAsset -> Bool) -> [GHAsset] -> [GHAsset]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
aName) (FilePath -> Bool) -> (GHAsset -> FilePath) -> GHAsset -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GHAsset -> FilePath
ghAssetName) ([GHAsset] -> [GHAsset]) -> [GHAsset] -> [GHAsset]
forall a b. (a -> b) -> a -> b
$ GHRelease -> [GHAsset]
ghReleaseAssets GHRelease
ghRelease of
[] -> FilePath -> IO ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Failed to find asset on release."
GHAsset
ghAsset : [GHAsset]
_ -> do
Request
request <- FilePath -> IO Request
forall (m :: * -> *). MonadThrow m => FilePath -> m Request
Client.parseRequest (FilePath -> IO Request) -> FilePath -> IO Request
forall a b. (a -> b) -> a -> b
$ GHAsset -> FilePath
ghAssetUrl GHAsset
ghAsset
Response ByteString
response <- Request -> Manager -> IO (Response ByteString)
Client.httpLbs
Request
request
{ method :: Method
Client.method = Method
HTTP.methodDelete
, requestHeaders :: RequestHeaders
Client.requestHeaders =
[FilePath -> Header
authorizationHeader FilePath
aToken, Header
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 (f :: * -> *) a. Applicative f => a -> f a
pure ()
Int
_ -> FilePath -> IO ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to delete asset from release! " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Response ByteString -> FilePath
forall a. Show a => a -> FilePath
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
/= :: GHRelease -> GHRelease -> Bool
$c/= :: GHRelease -> GHRelease -> Bool
== :: GHRelease -> GHRelease -> Bool
$c== :: GHRelease -> GHRelease -> Bool
Eq, Int -> GHRelease -> ShowS
[GHRelease] -> ShowS
GHRelease -> FilePath
(Int -> GHRelease -> ShowS)
-> (GHRelease -> FilePath)
-> ([GHRelease] -> ShowS)
-> Show GHRelease
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [GHRelease] -> ShowS
$cshowList :: [GHRelease] -> ShowS
show :: GHRelease -> FilePath
$cshow :: GHRelease -> FilePath
showsPrec :: Int -> GHRelease -> ShowS
$cshowsPrec :: Int -> GHRelease -> ShowS
Show)
instance Aeson.FromJSON GHRelease where
parseJSON :: Value -> Parser GHRelease
parseJSON =
FilePath
-> (Object -> Parser GHRelease) -> Value -> Parser GHRelease
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject FilePath
"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 -> FilePath
ghAssetName :: String
, GHAsset -> FilePath
ghAssetUrl :: String
}
deriving (GHAsset -> GHAsset -> Bool
(GHAsset -> GHAsset -> Bool)
-> (GHAsset -> GHAsset -> Bool) -> Eq GHAsset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GHAsset -> GHAsset -> Bool
$c/= :: GHAsset -> GHAsset -> Bool
== :: GHAsset -> GHAsset -> Bool
$c== :: GHAsset -> GHAsset -> Bool
Eq, Int -> GHAsset -> ShowS
[GHAsset] -> ShowS
GHAsset -> FilePath
(Int -> GHAsset -> ShowS)
-> (GHAsset -> FilePath) -> ([GHAsset] -> ShowS) -> Show GHAsset
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [GHAsset] -> ShowS
$cshowList :: [GHAsset] -> ShowS
show :: GHAsset -> FilePath
$cshow :: GHAsset -> FilePath
showsPrec :: Int -> GHAsset -> ShowS
$cshowsPrec :: Int -> GHAsset -> ShowS
Show)
instance Aeson.FromJSON GHAsset where
parseJSON :: Value -> Parser GHAsset
parseJSON = FilePath -> (Object -> Parser GHAsset) -> Value -> Parser GHAsset
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject FilePath
"GHAsset"
((Object -> Parser GHAsset) -> Value -> Parser GHAsset)
-> (Object -> Parser GHAsset) -> Value -> Parser GHAsset
forall a b. (a -> b) -> a -> b
$ \Object
obj -> FilePath -> FilePath -> GHAsset
GHAsset (FilePath -> FilePath -> GHAsset)
-> Parser FilePath -> Parser (FilePath -> GHAsset)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser FilePath
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"name" Parser (FilePath -> GHAsset) -> Parser FilePath -> Parser GHAsset
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser FilePath
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"url"
getUploadUrl
:: Client.Manager
-> String
-> Maybe String
-> String
-> String
-> IO Burrito.Template
getUploadUrl :: Manager
-> FilePath
-> Maybe FilePath
-> FilePath
-> FilePath
-> IO Template
getUploadUrl Manager
manager FilePath
aToken Maybe FilePath
rawOwner FilePath
rawRepo FilePath
aTag = do
HashMap Text Value
json <- do
(FilePath
anOwner, FilePath
aRepo) <- Maybe FilePath -> FilePath -> IO (FilePath, FilePath)
getOwnerRepo Maybe FilePath
rawOwner FilePath
rawRepo
Either FilePath (HashMap Text Value)
result <- Manager
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> IO (Either FilePath (HashMap Text Value))
forall a.
FromJSON a =>
Manager
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> IO (Either FilePath a)
getTag Manager
manager FilePath
aToken FilePath
anOwner FilePath
aRepo FilePath
aTag
case Either FilePath (HashMap Text Value)
result of
Left FilePath
problem -> FilePath -> IO (HashMap Text Value)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"Failed to get tag JSON: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> FilePath
show FilePath
problem)
Right HashMap Text Value
json -> HashMap Text Value -> IO (HashMap Text Value)
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 (FilePath -> Text
Text.pack FilePath
"upload_url") HashMap Text Value
json of
Just (Aeson.String Text
text) -> Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
text
Maybe Value
_ -> FilePath -> IO Text
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"Failed to get upload URL: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> HashMap Text Value -> FilePath
forall a. Show a => a -> FilePath
show HashMap Text Value
json)
let uploadUrl :: FilePath
uploadUrl = Text -> FilePath
Text.unpack Text
text
case FilePath -> Maybe Template
Burrito.parse FilePath
uploadUrl of
Maybe Template
Nothing -> FilePath -> IO Template
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"Failed to parse URL template: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> FilePath
show FilePath
uploadUrl)
Just Template
template -> Template -> IO Template
forall (f :: * -> *) a. Applicative f => a -> f a
pure Template
template
getOwnerRepo :: Maybe String -> String -> IO (String, String)
getOwnerRepo :: Maybe FilePath -> FilePath -> IO (FilePath, FilePath)
getOwnerRepo Maybe FilePath
rawOwner FilePath
rawRepo = do
(FilePath
anOwner, FilePath
aRepo) <- case (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') FilePath
rawRepo of
(FilePath
aRepo, FilePath
"") -> case Maybe FilePath
rawOwner of
Maybe FilePath
Nothing -> FilePath -> IO (FilePath, FilePath)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Missing required option --owner."
Just FilePath
anOwner -> (FilePath, FilePath) -> IO (FilePath, FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
anOwner, FilePath
aRepo)
(FilePath
anOwner, FilePath
aRepo) -> do
case Maybe FilePath
rawOwner of
Maybe FilePath
Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just FilePath
_ -> Handle -> FilePath -> IO ()
IO.hPutStrLn Handle
IO.stderr FilePath
"Ignoring --owner option."
(FilePath, FilePath) -> IO (FilePath, FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
anOwner, Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
aRepo)
(FilePath, FilePath) -> IO (FilePath, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
anOwner, FilePath
aRepo)
getTag
:: Aeson.FromJSON a
=> Client.Manager
-> String
-> String
-> String
-> String
-> IO (Either String a)
getTag :: Manager
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> IO (Either FilePath a)
getTag Manager
manager FilePath
aToken FilePath
anOwner FilePath
aRepo FilePath
aTag = do
let format :: FilePath
format = FilePath
"https://api.github.com/repos/%s/%s/releases/tags/%s" :: String
let
url :: String
url :: FilePath
url = FilePath -> FilePath -> FilePath -> ShowS
forall r. PrintfType r => FilePath -> r
Printf.printf FilePath
format FilePath
anOwner FilePath
aRepo FilePath
aTag
Request
initialRequest <- FilePath -> IO Request
forall (m :: * -> *). MonadThrow m => FilePath -> m Request
Client.parseRequest FilePath
url
let
request :: Request
request = Request
initialRequest
{ requestHeaders :: RequestHeaders
Client.requestHeaders = [FilePath -> Header
authorizationHeader FilePath
aToken, Header
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 FilePath a -> IO (Either FilePath a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Either FilePath a
forall a. FromJSON a => ByteString -> Either FilePath a
Aeson.eitherDecode ByteString
body)
authorizationHeader :: String -> HTTP.Header
FilePath
aToken =
(HeaderName
HTTP.hAuthorization, FilePath -> Method
BS8.pack (FilePath -> ShowS
forall r. PrintfType r => FilePath -> r
Printf.printf FilePath
"token %s" FilePath
aToken))
userAgentHeader :: HTTP.Header
= (HeaderName
HTTP.hUserAgent, FilePath -> Method
BS8.pack FilePath
userAgent)
userAgent :: String
userAgent :: FilePath
userAgent = FilePath -> FilePath -> FilePath -> ShowS
forall r. PrintfType r => FilePath -> r
Printf.printf
FilePath
"%s/%s-%s"
(FilePath
"tfausak" :: String)
(FilePath
"github-release" :: String)
FilePath
versionString
versionString :: String
versionString :: FilePath
versionString = Version -> FilePath
Version.showVersion Version
This.version
uploadFile
:: Client.Manager
-> Burrito.Template
-> String
-> FilePath
-> String
-> IO (Client.Response BSL.ByteString)
uploadFile :: Manager
-> Template
-> FilePath
-> FilePath
-> FilePath
-> IO (Response ByteString)
uploadFile Manager
manager Template
template FilePath
aToken FilePath
aFile FilePath
aName = do
ByteString
contents <- FilePath -> IO ByteString
BSL.readFile FilePath
aFile
let body :: RequestBody
body = ByteString -> RequestBody
Client.RequestBodyLBS ByteString
contents
Manager
-> Template
-> FilePath
-> RequestBody
-> FilePath
-> IO (Response ByteString)
uploadBody Manager
manager Template
template FilePath
aToken RequestBody
body FilePath
aName
uploadBody
:: Client.Manager
-> Burrito.Template
-> String
-> Client.RequestBody
-> String
-> IO (Client.Response BSL.ByteString)
uploadBody :: Manager
-> Template
-> FilePath
-> RequestBody
-> FilePath
-> IO (Response ByteString)
uploadBody Manager
manager Template
template FilePath
aToken RequestBody
body FilePath
aName = do
let
url :: String
url :: FilePath
url = [(FilePath, Value)] -> Template -> FilePath
Burrito.expand [(FilePath
"name", FilePath -> Value
Burrito.stringValue FilePath
aName)] Template
template
Request
initialRequest <- FilePath -> IO Request
forall (m :: * -> *). MonadThrow m => FilePath -> m Request
Client.parseRequest FilePath
url
let
request :: Request
request = Request
initialRequest
{ method :: Method
Client.method = FilePath -> Method
BS8.pack FilePath
"POST"
, requestBody :: RequestBody
Client.requestBody = RequestBody
body
, requestHeaders :: RequestHeaders
Client.requestHeaders =
[ FilePath -> Header
authorizationHeader FilePath
aToken
, (HeaderName
HTTP.hContentType, Text -> Method
MIME.defaultMimeLookup (FilePath -> Text
Text.pack FilePath
aName))
, Header
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
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> Maybe FilePath
-> Maybe Bool
-> Maybe Bool
-> IO (Response ByteString)
mkRelease Manager
manager FilePath
url FilePath
aToken FilePath
aTag FilePath
aTitle Maybe FilePath
aDescription Maybe Bool
aPreRelease Maybe Bool
aDraft = do
Request
initialRequest <- FilePath -> IO Request
forall (m :: * -> *). MonadThrow m => FilePath -> m Request
Client.parseRequest FilePath
url
let
requestObject :: Value
requestObject = [Pair] -> Value
object
[ Key
"tag_name" Key -> FilePath -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FilePath
aTag
, Key
"name" Key -> FilePath -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FilePath
aTitle
, Key
"body" Key -> FilePath -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
Maybe.fromMaybe FilePath
"" Maybe FilePath
aDescription
, Key
"prerelease" Key -> Bool -> Pair
forall kv v. (KeyValue 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 kv v. (KeyValue 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
{ method :: Method
Client.method = FilePath -> Method
BS8.pack FilePath
"POST"
, requestBody :: RequestBody
Client.requestBody = ByteString -> RequestBody
Client.RequestBodyLBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode Value
requestObject
, requestHeaders :: RequestHeaders
Client.requestHeaders = [FilePath -> Header
authorizationHeader FilePath
aToken, Header
userAgentHeader]
}
Request -> Manager -> IO (Response ByteString)
Client.httpLbs Request
request Manager
manager