generated from tpl/purs
133 lines
4.7 KiB
Haskell
133 lines
4.7 KiB
Haskell
module Gitea.Repo where
|
|
|
|
import Prelude hiding ((/))
|
|
|
|
import Control.Monad.Reader (ask)
|
|
import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)
|
|
import Data.Array as Array
|
|
import Data.Tuple.Nested ((/\))
|
|
import Data.URL (URL, (/), (?), (&))
|
|
import Effect.Aff.Class (class MonadAff)
|
|
import Effect.Class (liftEffect)
|
|
import Gitea.Auth as Auth
|
|
import Gitea.Error as Error
|
|
import Gitea.Trans (GiteaT)
|
|
import Gitea.Types (OrgName(..), Repo, RepoName(..), RepoUpdate, TopicName(..), Username(..))
|
|
import HTTP (Method(..), fetch) as HTTP
|
|
import HTTP.Request (json) as HTTP
|
|
import Node.Buffer (Buffer)
|
|
import Node.Buffer as Buffer
|
|
import Node.Encoding (Encoding(..))
|
|
import Simple.JSON (class WriteForeign)
|
|
import Type.Row.Subset (class Subset)
|
|
|
|
reposURL :: forall m. Monad m => Username -> RepoName -> GiteaT m URL
|
|
reposURL (Username owner) (RepoName repo) =
|
|
let
|
|
build { baseURI } = baseURI / "repos" / owner / repo
|
|
in
|
|
build <$> ask
|
|
|
|
repoTopicsPageURL :: forall m. Monad m => Username -> RepoName -> { page :: Int, limit :: Int } -> GiteaT m URL
|
|
repoTopicsPageURL o repo { page, limit } = (\repos -> repos / "topics" ? "limit" /\ show limit & "page" /\ show page) <$> reposURL o repo
|
|
|
|
repoTopicsOneURL :: forall m. Monad m => Username -> RepoName -> TopicName -> GiteaT m URL
|
|
repoTopicsOneURL o repo (TopicName topic) = (\repos -> repos / "topics" / topic) <$> reposURL o repo
|
|
|
|
orgReposURL :: forall m. Monad m => OrgName -> { page :: Int, limit :: Int } -> GiteaT m URL
|
|
orgReposURL (OrgName org) { page, limit } = (\{ baseURI } -> baseURI / "orgs" / org / "repos" ? "limit" /\ show limit & "page" /\ show page) <$> ask
|
|
|
|
get :: forall m. MonadAff m => Username -> RepoName -> GiteaT m (Record Repo)
|
|
get owner repo = do
|
|
{ auth } <- ask
|
|
url <- reposURL owner repo
|
|
rep <- HTTP.fetch $ HTTP.GET /\ url /\ Auth.headers auth
|
|
Error.tryGetRepJSON rep
|
|
|
|
listForOrg :: forall m. MonadAff m => MonadRec m => OrgName -> GiteaT m (Array (Record Repo))
|
|
listForOrg o =
|
|
let
|
|
limit = 10
|
|
|
|
maybeFetchMore repos n newRepos
|
|
| Array.length newRepos < limit = Done $ repos <> newRepos
|
|
| otherwise = Loop $ (repos <> newRepos) /\ (n + 1)
|
|
paginate (repos /\ n) = maybeFetchMore repos n <$> getPage n
|
|
|
|
getPage n = do
|
|
{ auth } <- ask
|
|
url <- orgReposURL o { limit, page: n }
|
|
rep <- HTTP.fetch $ HTTP.GET /\ url /\ Auth.headers auth
|
|
Error.tryGetRepJSON rep
|
|
in
|
|
tailRecM paginate ([] /\ 1)
|
|
|
|
update
|
|
:: forall m patch
|
|
. MonadAff m
|
|
=> WriteForeign (Record patch)
|
|
=> Subset RepoUpdate patch
|
|
=> Username
|
|
-> RepoName
|
|
-> Record patch
|
|
-> GiteaT m (Record Repo)
|
|
update owner repo patch = do
|
|
{ auth } <- ask
|
|
url <- reposURL owner repo
|
|
rep <- HTTP.fetch $ HTTP.PATCH /\ url /\ HTTP.json patch /\ Auth.headers auth
|
|
Error.tryGetRepJSON rep
|
|
|
|
delete :: forall m. MonadAff m => Username -> RepoName -> GiteaT m Unit
|
|
delete owner repo = do
|
|
{ auth } <- ask
|
|
url <- reposURL owner repo
|
|
rep <- HTTP.fetch $ HTTP.DELETE /\ url /\ Auth.headers auth
|
|
Error.guardStatusOk rep
|
|
|
|
updateAvatar :: forall m. MonadAff m => Username -> RepoName -> Buffer -> GiteaT m Unit
|
|
updateAvatar owner repo avatar = do
|
|
{ auth } <- ask
|
|
url <- map (_ / "avatar") $ reposURL owner repo
|
|
b64 <- liftEffect $ Buffer.toString Base64 avatar
|
|
rep <- HTTP.fetch $ HTTP.POST /\ url /\ HTTP.json { image: b64 } /\ Auth.headers auth
|
|
Error.guardStatusOk rep
|
|
|
|
removeAvatar :: forall m. MonadAff m => Username -> RepoName -> GiteaT m Unit
|
|
removeAvatar owner repo = do
|
|
{ auth } <- ask
|
|
url <- map (_ / "avatar") $ reposURL owner repo
|
|
rep <- HTTP.fetch $ HTTP.DELETE /\ url /\ Auth.headers auth
|
|
Error.guardStatusOk rep
|
|
|
|
addTopic :: forall m. MonadAff m => Username -> RepoName -> TopicName -> GiteaT m Unit
|
|
addTopic owner repo topic = do
|
|
{ auth } <- ask
|
|
url <- repoTopicsOneURL owner repo topic
|
|
rep <- HTTP.fetch $ HTTP.PUT /\ url /\ Auth.headers auth
|
|
Error.guardStatusOk rep
|
|
|
|
getTopics :: forall m. MonadAff m => MonadRec m => Username -> RepoName -> GiteaT m (Array TopicName)
|
|
getTopics owner repo =
|
|
let
|
|
limit = 10
|
|
|
|
maybeFetchMore topics n newTopics
|
|
| Array.length newTopics < limit = Done $ topics <> newTopics
|
|
| otherwise = Loop $ (topics <> newTopics) /\ (n + 1)
|
|
paginate (topics /\ n) = maybeFetchMore topics n <$> getPage n
|
|
|
|
getPage n = do
|
|
{ auth } <- ask
|
|
url <- repoTopicsPageURL owner repo { limit, page: n }
|
|
rep <- HTTP.fetch $ HTTP.GET /\ url /\ Auth.headers auth
|
|
Error.tryGetRepJSON rep
|
|
in
|
|
tailRecM paginate ([] /\ 1)
|
|
|
|
removeTopic :: forall m. MonadAff m => Username -> RepoName -> TopicName -> GiteaT m Unit
|
|
removeTopic owner repo topic = do
|
|
{ auth } <- ask
|
|
url <- repoTopicsOneURL owner repo topic
|
|
rep <- HTTP.fetch $ HTTP.DELETE /\ url /\ Auth.headers auth
|
|
Error.guardStatusOk rep
|