feat: stuff

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

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

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 ())

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

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

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

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

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