{-# 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. 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 -> FilePath -> FilePath
[Command] -> FilePath -> FilePath
Command -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Command] -> FilePath -> FilePath
$cshowList :: [Command] -> FilePath -> FilePath
show :: Command -> FilePath
$cshow :: Command -> FilePath
showsPrec :: Int -> Command -> FilePath -> FilePath
$cshowsPrec :: Int -> Command -> FilePath -> FilePath
Show)

instance Options.ParseRecord Command

main :: IO ()
main :: IO ()
main = do
  Command
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 <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> IO FilePath
Environment.getEnv FilePath
"GITHUB_TOKEN") forall (f :: * -> *) a. Applicative f => a -> f a
pure
      forall a b. (a -> b) -> a -> b
$ 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
      (forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful Maybe FilePath
<?> "The GitHub owner, either a user or organization."
anOwner)
      (forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful FilePath <?> "The GitHub repository name."
aRepo)
      (forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful FilePath <?> "The tag name."
aTag)
      (forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful FilePath <?> "The path to the local file to upload."
aFile)
      (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 <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> IO FilePath
Environment.getEnv FilePath
"GITHUB_TOKEN") forall (f :: * -> *) a. Applicative f => a -> f a
pure
        forall a b. (a -> b) -> a -> b
$ 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
        (forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful Maybe FilePath
<?> "The GitHub owner, either a user or organization."
anOwner)
        (forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful FilePath <?> "The GitHub repository name."
aRepo)
        (forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful FilePath <?> "The tag name."
aTag)
        (forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful FilePath <?> "The name of the release"
aTitle)
        (forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful Maybe FilePath <?> "Release description."
aDescription)
        (forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful Maybe Bool <?> "Indicates if this is a pre-release."
aPreRelease)
        (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 <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> IO FilePath
Environment.getEnv FilePath
"GITHUB_TOKEN") forall (f :: * -> *) a. Applicative f => a -> f a
pure
      forall a b. (a -> b) -> a -> b
$ forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful Maybe FilePath <?> "Your OAuth2 token."
helpfulToken
    FilePath
-> Maybe FilePath -> FilePath -> FilePath -> FilePath -> IO ()
delete
      (forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful FilePath <?> "The name to give the file on the release."
aName)
      (forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful Maybe FilePath
<?> "The GitHub owner, either a user or organization."
anOwner)
      (forall field (help :: Symbol). (field <?> help) -> field
Options.unHelpful FilePath <?> "The GitHub repository name."
aRepo)
      (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 (forall body. Response body -> Status
Client.responseStatus Response ByteString
response) of
    Int
201 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Int
_ -> 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 = 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 =
      forall a. FromJSON a => ByteString -> Either FilePath a
Aeson.eitherDecode forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
Client.responseBody Response ByteString
response :: Either
          String
          Aeson.Object
  case Status -> Int
HTTP.statusCode (forall body. Response body -> Status
Client.responseStatus Response ByteString
response) of
    Int
201 -> 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
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to create release! Reason: " forall a. Semigroup a => a -> a -> a
<> 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 <- 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 -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to get tag JSON: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
problem
      Right GHRelease
json -> forall (f :: * -> *) a. Applicative f => a -> f a
pure GHRelease
json
  case forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== FilePath
aName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. GHAsset -> FilePath
ghAssetName) forall a b. (a -> b) -> a -> b
$ GHRelease -> [GHAsset]
ghReleaseAssets GHRelease
ghRelease of
    [] -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Failed to find asset on release."
    GHAsset
ghAsset : [GHAsset]
_ -> do
      Request
request <- forall (m :: * -> *). MonadThrow m => FilePath -> m Request
Client.parseRequest 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 forall a b. (a -> b) -> a -> b
$ forall body. Response body -> Status
Client.responseStatus Response ByteString
response of
        Int
204 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Int
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to delete asset from release! " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Response ByteString
response

newtype GHRelease = GHRelease
  { GHRelease -> [GHAsset]
ghReleaseAssets :: [GHAsset]
  } deriving (GHRelease -> GHRelease -> Bool
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 -> FilePath -> FilePath
[GHRelease] -> FilePath -> FilePath
GHRelease -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [GHRelease] -> FilePath -> FilePath
$cshowList :: [GHRelease] -> FilePath -> FilePath
show :: GHRelease -> FilePath
$cshow :: GHRelease -> FilePath
showsPrec :: Int -> GHRelease -> FilePath -> FilePath
$cshowsPrec :: Int -> GHRelease -> FilePath -> FilePath
Show)

instance Aeson.FromJSON GHRelease where
  parseJSON :: Value -> Parser GHRelease
parseJSON =
    forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject FilePath
"GHRelease" forall a b. (a -> b) -> a -> b
$ \Object
obj -> [GHAsset] -> GHRelease
GHRelease forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj 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
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 -> FilePath -> FilePath
[GHAsset] -> FilePath -> FilePath
GHAsset -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [GHAsset] -> FilePath -> FilePath
$cshowList :: [GHAsset] -> FilePath -> FilePath
show :: GHAsset -> FilePath
$cshow :: GHAsset -> FilePath
showsPrec :: Int -> GHAsset -> FilePath -> FilePath
$cshowsPrec :: Int -> GHAsset -> FilePath -> FilePath
Show)

instance Aeson.FromJSON GHAsset where
  parseJSON :: Value -> Parser GHAsset
parseJSON = forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject FilePath
"GHAsset"
    forall a b. (a -> b) -> a -> b
$ \Object
obj -> FilePath -> FilePath -> GHAsset
GHAsset forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"name" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj 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 <- 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 -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"Failed to get tag JSON: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
problem)
      Right HashMap Text Value
json -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap Text Value
json
  Text
text <- case 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) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
text
    Maybe Value
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"Failed to get upload URL: " forall a. Semigroup a => a -> a -> a
<> 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 -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"Failed to parse URL template: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
uploadUrl)
    Just Template
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 forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'/') FilePath
rawRepo of
    (FilePath
aRepo, FilePath
"") -> case Maybe FilePath
rawOwner of
      Maybe FilePath
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Missing required option --owner."
      Just FilePath
anOwner -> 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just FilePath
_ -> Handle -> FilePath -> IO ()
IO.hPutStrLn Handle
IO.stderr FilePath
"Ignoring --owner option."
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
anOwner, forall a. Int -> [a] -> [a]
drop Int
1 FilePath
aRepo)
  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 :: forall a.
FromJSON a =>
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 = forall r. PrintfType r => FilePath -> r
Printf.printf FilePath
format FilePath
anOwner FilePath
aRepo FilePath
aTag
  Request
initialRequest <- 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 = forall body. Response body -> body
Client.responseBody Response ByteString
response
  forall (m :: * -> *) a. Monad m => a -> m a
return (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 (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 = 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 <- 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 <- forall (m :: * -> *). MonadThrow m => FilePath -> m Request
Client.parseRequest FilePath
url
  let
    requestObject :: Value
requestObject = [Pair] -> Value
object
      [ Key
"tag_name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FilePath
aTag
      , Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FilePath
aTitle
      , Key
"body" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. a -> Maybe a -> a
Maybe.fromMaybe FilePath
"" Maybe FilePath
aDescription
      , Key
"prerelease" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. a -> Maybe a -> a
Maybe.fromMaybe Bool
False Maybe Bool
aPreRelease
      , Key
"draft" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= 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 forall a b. (a -> b) -> a -> b
$ 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