diff --git a/src/Gitea.Auth.purs b/src/Gitea.Auth.purs index d2190b4..d9e3abd 100644 --- a/src/Gitea.Auth.purs +++ b/src/Gitea.Auth.purs @@ -45,7 +45,7 @@ instance Eq Authenticated where instance Show Authenticated where show = genericShow -authHeaders :: Authenticated -> Effect HTTP.Headers -authHeaders (AuthBearer (BearerToken token)) = HTTP.headers $ HTTP.AuthBearer token -authHeaders (AuthBasic (Username un) (Password pw)) = HTTP.headers $ HTTP.AuthBasic { username: un, password: pw } -authHeaders (AuthAccessToken (AccessToken token)) = HTTP.headers $ HTTP.AuthCustom (HTTP.AuthScheme "token") token +headers :: Authenticated -> Effect HTTP.Headers +headers (AuthBearer (BearerToken token)) = HTTP.headers $ HTTP.AuthBearer token +headers (AuthBasic (Username un) (Password pw)) = HTTP.headers $ HTTP.AuthBasic { username: un, password: pw } +headers (AuthAccessToken (AccessToken token)) = HTTP.headers $ HTTP.AuthCustom (HTTP.AuthScheme "token") token diff --git a/src/Gitea.Error.purs b/src/Gitea.Error.purs new file mode 100644 index 0000000..cff9c4b --- /dev/null +++ b/src/Gitea.Error.purs @@ -0,0 +1,28 @@ +module Gitea.Error where + +import Prelude + +import Control.Monad.Error.Class (class MonadThrow, throwError) +import Effect.Aff.Class (class MonadAff) +import HTTP.Response as HTTP +import HTTP.Response as HTTP.Rep +import Simple.JSON (class ReadForeign) + +data Error + = EForbidden { message :: String, url :: String } + | ENotFound + | EValidation { message :: String, url :: String } + +guardStatusOk :: forall m. MonadThrow Error m => MonadAff m => HTTP.Response -> m Unit +guardStatusOk rep = do + status <- HTTP.Rep.status rep + case status of + 404 -> throwError ENotFound + 422 -> throwError =<< EValidation <$> HTTP.Rep.json rep + 403 -> throwError =<< EForbidden <$> HTTP.Rep.json rep + _ -> pure unit + +tryGetRepJSON :: forall m @a. ReadForeign a => MonadThrow Error m => MonadAff m => HTTP.Response -> m a +tryGetRepJSON rep = do + guardStatusOk rep + HTTP.Rep.json rep diff --git a/src/Gitea.Model.purs b/src/Gitea.Model.purs index a8e89a9..337badf 100644 --- a/src/Gitea.Model.purs +++ b/src/Gitea.Model.purs @@ -1,17 +1,117 @@ -module Gitea.Model where +module Gitea.Types where import Prelude +import Data.Newtype (class Newtype) import Foreign.Object (Object) +import Simple.JSON (class ReadForeign, class WriteForeign) import Type.Row (type (+)) +data Ref = RefBranch BranchName | RefCommit CommitId | RefTag TagName + +newtype RepoName = RepoName String + +derive instance Newtype RepoName _ +derive newtype instance Eq RepoName +derive newtype instance Show RepoName +derive newtype instance WriteForeign RepoName +derive newtype instance ReadForeign RepoName + +newtype TagName = TagName String + +derive instance Newtype TagName _ +derive newtype instance Eq TagName +derive newtype instance Show TagName +derive newtype instance WriteForeign TagName +derive newtype instance ReadForeign TagName + +newtype CommitId = CommitId String + +derive instance Newtype CommitId _ +derive newtype instance Eq CommitId +derive newtype instance Show CommitId +derive newtype instance WriteForeign CommitId +derive newtype instance ReadForeign CommitId + +newtype BranchName = BranchName String + +derive instance Newtype BranchName _ +derive newtype instance Eq BranchName +derive newtype instance Show BranchName +derive newtype instance WriteForeign BranchName +derive newtype instance ReadForeign BranchName + +newtype BranchProtectionName = BranchProtectionName String + +derive instance Newtype BranchProtectionName _ +derive newtype instance Eq BranchProtectionName +derive newtype instance Show BranchProtectionName +derive newtype instance WriteForeign BranchProtectionName +derive newtype instance ReadForeign BranchProtectionName + +newtype TeamName = TeamName String + +derive instance Newtype TeamName _ +derive newtype instance Eq TeamName +derive newtype instance Show TeamName +derive newtype instance WriteForeign TeamName +derive newtype instance ReadForeign TeamName + +newtype SecretName = SecretName String + +derive instance Newtype SecretName _ +derive newtype instance Eq SecretName +derive newtype instance Show SecretName +derive newtype instance WriteForeign SecretName +derive newtype instance ReadForeign SecretName + +newtype RepoId = RepoId Int + +derive instance Newtype RepoId _ +derive newtype instance Eq RepoId +derive newtype instance Show RepoId +derive newtype instance WriteForeign RepoId +derive newtype instance ReadForeign RepoId + +newtype Username = Username String + +derive instance Newtype Username _ +derive newtype instance Eq Username +derive newtype instance Show Username +derive newtype instance WriteForeign Username +derive newtype instance ReadForeign Username + +newtype UserId = UserId Int + +derive instance Newtype UserId _ +derive newtype instance Eq UserId +derive newtype instance Show UserId +derive newtype instance WriteForeign UserId +derive newtype instance ReadForeign UserId + +newtype OrgId = OrgId Int + +derive instance Newtype OrgId _ +derive newtype instance Eq OrgId +derive newtype instance Show OrgId +derive newtype instance WriteForeign OrgId +derive newtype instance ReadForeign OrgId + +newtype TeamId = TeamId Int + +derive instance Newtype TeamId _ +derive newtype instance Eq TeamId +derive newtype instance Show TeamId +derive newtype instance WriteForeign TeamId +derive newtype instance ReadForeign TeamId + type Permission = { "admin" :: Boolean , "pull" :: Boolean , "push" :: Boolean } -type Organization = +type Org = { "avatar_url" :: String , "description" :: String , "full_name" :: String @@ -27,10 +127,10 @@ type Organization = type Team = { "can_create_org_repo" :: Boolean , "description" :: String - , "id" :: Int + , "id" :: OrgId , "includes_all_repositories" :: Boolean , "name" :: String - , "organization" :: Organization + , "organization" :: Org , "permission" :: String , "units" :: Array String , "units_map" :: Object String @@ -45,12 +145,12 @@ type User = , "followers_count" :: Int , "following_count" :: Int , "full_name" :: String - , "id" :: Int + , "id" :: UserId , "is_admin" :: Boolean , "language" :: String , "last_login" :: String , "location" :: String - , "login" :: String + , "login" :: Username , "login_name" :: String , "prohibit_login" :: Boolean , "restricted" :: Boolean @@ -169,21 +269,21 @@ type RepoSectionGiteaStatsImmutable r = ) type RepoMeta = - { "id" :: Int + { "id" :: RepoId , "owner" :: String - , "name" :: String + , "name" :: RepoName , "full_name" :: String } type RepoSectionStatsMutable r = - ( "name" :: String + ( "name" :: RepoName , "full_name" :: String , "mirror_interval" :: String | r ) type RepoSectionStatsImmutable r = - ( "id" :: Int + ( "id" :: RepoId , "created_at" :: String , "empty" :: Boolean , "owner" :: User @@ -191,7 +291,6 @@ type RepoSectionStatsImmutable r = , "html_url" :: String , "clone_url" :: String , "ssh_url" :: String - , "mirror_interval" :: String | r ) @@ -206,9 +305,9 @@ type RepoSectionTrackerImmutable r = | r ) -type Repo = Record +type Repo = ( RepoSectionTrackerMutable - + RepoSectionTrackerImmutable + + RepoSectionTrackerImmutable + RepoSectionStatsMutable + RepoSectionStatsImmutable + RepoSectionGiteaStatsMutable @@ -220,3 +319,92 @@ type Repo = Record + RepoSectionVisibilityImmutable + RepoSectionMergeSettingsMutable () ) + +type RepoUpdate = + ( RepoSectionTrackerMutable + + RepoSectionStatsMutable + + RepoSectionGiteaStatsMutable + + RepoGiteaSettingsMutable + + RepoPermsMutable + + RepoSectionVisibilityMutable + + RepoSectionMergeSettingsMutable () + ) + +type CommitUser = + { "email" :: String + , "name" :: String + , "username" :: Username + } + +type CommitVerification = + { "signer" :: CommitUser + , "payload" :: String + , "reason" :: String + , "signature" :: String + , "verified" :: Boolean + } + +type Commit = + { "id" :: CommitId + , "added" :: Array String + , "author" :: CommitUser + , "committer" :: CommitUser + , "message" :: String + , "modified" :: Array String + , "removed" :: Array String + , "timestamp" :: String + , "url" :: String + , "verification" :: CommitVerification + } + +type Branch = + { "commit" :: Commit + , "effective_branch_protection_name" :: String + , "enable_status_check" :: Boolean + , "name" :: String + , "protected" :: Boolean + , "required_approvals" :: Int + , "status_check_contexts" :: Array String + , "user_can_merge" :: Boolean + , "user_can_push" :: Boolean + } + +type BranchProtectionMutable r = + ( "approvals_whitelist_teams" :: Array TeamName + , "approvals_whitelist_username" :: Array Username + , "block_on_official_review_requests" :: Boolean + , "block_on_outdated_branch" :: Boolean + , "block_on_rejected_reviews" :: Boolean + , "branch_name" :: String + , "dismiss_stale_approvals" :: Boolean + , "enable_approvals_whitelist" :: Boolean + , "enable_merge_whitelist" :: Boolean + , "enable_push" :: Boolean + , "enable_push_whitelist" :: Boolean + , "enable_status_check" :: Boolean + , "merge_whitelist_teams" :: Array String + , "merge_whitelist_usernames" :: Array String + , "protected_file_patterns" :: String + , "push_whitelist_deploy_keys" :: Boolean + , "push_whitelist_teams" :: Array String + , "push_whitelist_usernames" :: Array String + , "require_signed_commits" :: Boolean + , "required_approvals" :: Int + , "status_check_contexts" :: Array String + , "unprotected_file_patterns" :: String + | r + ) + +type BranchProtectionMutableOnCreate r = + ( "rule_name" :: BranchProtectionName + | r + ) + +type BranchProtectionImmutable r = + ( "updated_at" :: String + , "created_at" :: String + | r + ) + +type BranchProtectionUpdate = BranchProtectionMutable () +type BranchProtection = (BranchProtectionMutable + BranchProtectionImmutable + BranchProtectionMutableOnCreate ()) diff --git a/src/Gitea.Monad.purs b/src/Gitea.Monad.purs index 51821e2..59e1c29 100644 --- a/src/Gitea.Monad.purs +++ b/src/Gitea.Monad.purs @@ -2,50 +2,48 @@ module Gitea.Trans where import Prelude -import Control.Alt (class Alt) -import Control.Alternative (class Alternative, class Plus) -import Control.Monad.Error.Class (class MonadError, class MonadThrow) -import Control.Monad.Morph (class MFunctor, class MMonad) -import Control.Monad.Reader (class MonadAsk, class MonadReader, ReaderT(..), asks, runReaderT) -import Control.Monad.Trans.Class (class MonadTrans) -import Control.MonadPlus (class MonadPlus) -import Data.Newtype (class Newtype, unwrap) -import Data.URL (URL) +import Control.Monad.Error.Class (class MonadError, class MonadThrow, throwError) +import Control.Monad.Except (ExceptT, runExceptT) +import Control.Monad.Morph (class MFunctor, class MMonad, embed, hoist) +import Control.Monad.Reader (class MonadAsk, class MonadReader, ReaderT(..), ask, runReaderT) +import Control.Monad.Trans.Class (class MonadTrans, lift) +import Data.Either (Either) +import Data.Newtype (class Newtype, unwrap, wrap) import Effect.Aff.Class (class MonadAff) import Effect.Class (class MonadEffect) -import Gitea.Auth (Authenticated) +import Effect.Exception as Effect.Exception import Gitea.Config (Config) +import Gitea.Error as Gitea.Error newtype GiteaT :: (Type -> Type) -> Type -> Type -newtype GiteaT m a = GiteaT (ReaderT Config m a) +newtype GiteaT m a = GiteaT (ReaderT Config (ExceptT Gitea.Error.Error m) a) derive instance Newtype (GiteaT m a) _ -derive newtype instance MMonad GiteaT -derive newtype instance MFunctor GiteaT -derive newtype instance MonadTrans GiteaT + +instance MMonad GiteaT where + embed f (GiteaT rem) = GiteaT do + r <- ask + lift $ embed (flip runReaderT r <<< unwrap <<< f) $ runReaderT rem r + +instance MFunctor GiteaT where + hoist f = wrap <<< hoist (hoist f) <<< unwrap + +instance MonadTrans GiteaT where + lift = wrap <<< lift <<< lift + derive newtype instance Monad m => MonadAsk Config (GiteaT m) derive newtype instance Monad m => MonadReader Config (GiteaT m) -derive newtype instance MonadPlus m => MonadPlus (GiteaT m) derive newtype instance Monad m => Monad (GiteaT m) derive newtype instance MonadEffect m => MonadEffect (GiteaT m) derive newtype instance MonadAff m => MonadAff (GiteaT m) -derive newtype instance MonadThrow e m => MonadThrow e (GiteaT m) -derive newtype instance MonadError e m => MonadError e (GiteaT m) +derive newtype instance Monad m => MonadError Gitea.Error.Error (GiteaT m) +derive newtype instance Monad m => MonadThrow Gitea.Error.Error (GiteaT m) -derive newtype instance Plus m => Plus (GiteaT m) -derive newtype instance Alternative m => Alternative (GiteaT m) -derive newtype instance Alt m => Alt (GiteaT m) -derive newtype instance Functor m => Functor (GiteaT m) -derive newtype instance Apply m => Apply (GiteaT m) -derive newtype instance Applicative m => Applicative (GiteaT m) -derive newtype instance Bind m => Bind (GiteaT m) +derive newtype instance Monad m => Functor (GiteaT m) +derive newtype instance Monad m => Apply (GiteaT m) +derive newtype instance Monad m => Applicative (GiteaT m) +derive newtype instance Monad m => Bind (GiteaT m) -url :: forall m. Monad m => GiteaT m URL -url = asks _.baseURI - -auth :: forall m. Monad m => GiteaT m Authenticated -auth = asks _.auth - -runGitea :: forall m a. Config -> GiteaT m a -> m a -runGitea config m = runReaderT (unwrap m) config +runGitea :: forall m a. Config -> GiteaT m a -> m (Either Gitea.Error.Error a) +runGitea config m = runExceptT $ runReaderT (unwrap m) config diff --git a/src/Gitea.Repo.BranchProtections.purs b/src/Gitea.Repo.BranchProtections.purs new file mode 100644 index 0000000..bbfb40b --- /dev/null +++ b/src/Gitea.Repo.BranchProtections.purs @@ -0,0 +1,52 @@ +module Gitea.Repo.BranchProtection where + +import Prelude hiding ((/)) + +import Control.Monad.Reader (ask) +import Data.Tuple.Nested ((/\)) +import Data.URL (URL, (/)) +import Effect.Aff.Class (class MonadAff) +import Gitea.Auth as Auth +import Gitea.Error as Error +import Gitea.Trans (GiteaT) +import Gitea.Types (BranchProtection, BranchProtectionName(..), BranchProtectionUpdate, RepoName(..), Username(..)) +import HTTP (Method(..), fetch) as HTTP +import HTTP.Request (json) as HTTP +import Simple.JSON (class WriteForeign) +import Type.Row.Subset (class Subset) + +branchProtectionURL :: forall m. Monad m => Username -> RepoName -> GiteaT m URL +branchProtectionURL (Username owner) (RepoName repo) = (\{ baseURI } -> baseURI / "repos" / owner / repo) <$> ask + +branchProtectionOneURL :: forall m. Monad m => Username -> RepoName -> BranchProtectionName -> GiteaT m URL +branchProtectionOneURL (Username owner) (RepoName repo) (BranchProtectionName rule) = (\{ baseURI } -> baseURI / "repos" / owner / repo / "branch_protections" / rule) <$> ask + +get :: forall m. MonadAff m => Username -> RepoName -> BranchProtectionName -> GiteaT m (Record BranchProtection) +get u r b = do + { auth } <- ask + url <- branchProtectionOneURL u r b + rep <- HTTP.fetch $ HTTP.GET /\ url /\ Auth.headers auth + Error.tryGetRepJSON rep + +update + :: forall m patch + . MonadAff m + => WriteForeign (Record patch) + => Subset BranchProtectionUpdate patch + => Username + -> RepoName + -> BranchProtectionName + -> Record patch + -> GiteaT m (Record BranchProtection) +update u r b patch = do + { auth } <- ask + url <- branchProtectionOneURL u r b + rep <- HTTP.fetch $ HTTP.PATCH /\ url /\ HTTP.json patch /\ Auth.headers auth + Error.tryGetRepJSON rep + +delete :: forall m. MonadAff m => Username -> RepoName -> BranchProtectionName -> GiteaT m Unit +delete u r b = do + { auth } <- ask + url <- branchProtectionOneURL u r b + rep <- HTTP.fetch $ HTTP.DELETE /\ url /\ Auth.headers auth + Error.guardStatusOk rep diff --git a/src/Gitea.Repo.Secret.purs b/src/Gitea.Repo.Secret.purs new file mode 100644 index 0000000..874963c --- /dev/null +++ b/src/Gitea.Repo.Secret.purs @@ -0,0 +1,31 @@ +module Gitea.Repo.Secret where + +import Prelude hiding ((/)) + +import Control.Monad.Reader (ask) +import Data.Tuple.Nested ((/\)) +import Data.URL (URL, (/)) +import Effect.Aff.Class (class MonadAff) +import Gitea.Auth as Auth +import Gitea.Error as Error +import Gitea.Trans (GiteaT) +import Gitea.Types (RepoName(..), SecretName(..), Username(..)) +import HTTP (Method(..), fetch) as HTTP +import HTTP.Request (json) as HTTP + +secretsURL :: forall m. Monad m => Username -> RepoName -> SecretName -> GiteaT m URL +secretsURL (Username owner) (RepoName repo) (SecretName secret) = (\{ baseURI } -> baseURI / "repos" / owner / repo / secret) <$> ask + +set :: forall m. MonadAff m => Username -> RepoName -> SecretName -> String -> GiteaT m Unit +set u r s sv = do + { auth } <- ask + url <- secretsURL u r s + rep <- HTTP.fetch $ HTTP.PUT /\ url /\ HTTP.json { "data": sv } /\ Auth.headers auth + Error.guardStatusOk rep + +remove :: forall m. MonadAff m => Username -> RepoName -> SecretName -> GiteaT m Unit +remove u r s = do + { auth } <- ask + url <- secretsURL u r s + rep <- HTTP.fetch $ HTTP.DELETE /\ url /\ Auth.headers auth + Error.guardStatusOk rep diff --git a/src/Gitea.Repo.purs b/src/Gitea.Repo.purs index d81391b..e8a1e90 100644 --- a/src/Gitea.Repo.purs +++ b/src/Gitea.Repo.purs @@ -1,3 +1,67 @@ module Gitea.Repo where -import Prelude +import Prelude hiding ((/)) + +import Control.Monad.Reader (ask) +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 (Repo, RepoName(..), Username(..), RepoUpdate) +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) = (\{ baseURI } -> baseURI / "repos" / owner / repo) <$> ask + +get :: forall m. MonadAff m => Username -> RepoName -> GiteaT m (Record Repo) +get u r = do + { auth } <- ask + url <- reposURL u r + rep <- HTTP.fetch $ HTTP.GET /\ url /\ Auth.headers auth + Error.tryGetRepJSON rep + +update + :: forall m patch + . MonadAff m + => WriteForeign (Record patch) + => Subset RepoUpdate patch + => Username + -> RepoName + -> Record patch + -> GiteaT m (Record Repo) +update u r patch = do + { auth } <- ask + url <- reposURL u r + 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 u r = do + { auth } <- ask + url <- reposURL u r + rep <- HTTP.fetch $ HTTP.DELETE /\ url /\ Auth.headers auth + Error.guardStatusOk rep + +updateAvatar :: forall m. MonadAff m => Username -> RepoName -> Buffer -> GiteaT m Unit +updateAvatar u r av = do + { auth } <- ask + url <- map (_ / "avatar") $ reposURL u r + b64 <- liftEffect $ Buffer.toString Base64 av + 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 u r = do + { auth } <- ask + url <- map (_ / "avatar") $ reposURL u r + rep <- HTTP.fetch $ HTTP.DELETE /\ url /\ Auth.headers auth + Error.guardStatusOk rep diff --git a/src/Type.Row.Subset.purs b/src/Type.Row.Subset.purs new file mode 100644 index 0000000..e709db1 --- /dev/null +++ b/src/Type.Row.Subset.purs @@ -0,0 +1,8 @@ +module Type.Row.Subset where + +import Prim.Row (class Union) + +class Subset :: Row Type -> Row Type -> Constraint +class Subset whole part + +instance (Union part missing whole) => Subset whole part