{-# 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
authorizationHeader :: FilePath -> Header
authorizationHeader 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
userAgentHeader :: Header
userAgentHeader = (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